Skip to content

Commit

Permalink
Render Markdown files as HTML (#2579)
Browse files Browse the repository at this point in the history
  • Loading branch information
kukimik authored Apr 7, 2024
1 parent 4d21a18 commit 9075b91
Show file tree
Hide file tree
Showing 11 changed files with 272 additions and 66 deletions.
2 changes: 2 additions & 0 deletions .gitattributes
Original file line number Diff line number Diff line change
Expand Up @@ -6,4 +6,6 @@
dhall-csv/tasty/data/* binary
dhall-docs/tasty/data/golden/**/*.html binary
dhall-docs/tasty/data/package/StandaloneTextFile.txt binary
dhall-docs/tasty/data/package/MarkdownFile.md binary
dhall-docs/tasty/data/package/InvalidMarkdownFile.md binary
dhall-yaml/tasty/data/* binary
2 changes: 2 additions & 0 deletions dhall-docs/dhall-docs.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -22,12 +22,14 @@ Category: Compiler
Extra-Source-Files:
CHANGELOG.md
README.md
tasty/data/package/*.md
tasty/data/package/*.txt
tasty/data/package/*.dhall
tasty/data/package/a/*.dhall
tasty/data/package/a/b/*.dhall
tasty/data/package/a/b/c/*.dhall
tasty/data/package/deep/nested/folder/*.dhall
tasty/data/golden/*.md.html
tasty/data/golden/*.txt.html
tasty/data/golden/*.dhall.html
tasty/data/golden/a/*.dhall.html
Expand Down
67 changes: 54 additions & 13 deletions dhall-docs/src/Dhall/Docs/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -105,7 +105,8 @@ instance MonadWriter [DocsGenWarning] GeneratedDocs where

data DocsGenWarning
= InvalidDhall (Text.Megaparsec.ParseErrorBundle Text Void)
| InvalidMarkdown MarkdownParseError
| InvalidMarkdownHeader MarkdownParseError
| InvalidMarkdownFile MarkdownParseError
| DhallDocsCommentError (Path Rel File) CommentParseError

warn :: String
Expand All @@ -117,11 +118,16 @@ instance Show DocsGenWarning where
Text.Megaparsec.errorBundlePretty err <>
"... documentation won't be generated for this file"

show (InvalidMarkdown MarkdownParseError{..}) =
show (InvalidMarkdownHeader MarkdownParseError{..}) =
warn <>"Header comment is not markdown\n\n" <>
Text.Megaparsec.errorBundlePretty unwrap <>
"The original non-markdown text will be pasted in the documentation"

show (InvalidMarkdownFile MarkdownParseError{..}) =
warn <>"Failed to parse file as markdown\n\n" <>
Text.Megaparsec.errorBundlePretty unwrap <>
"The original file contents will be pasted in the documentation"

show (DhallDocsCommentError path err) =
warn <> Path.fromRelFile path <> specificError
where
Expand Down Expand Up @@ -167,9 +173,15 @@ data FileType
-- ^ Examples extracted from assertions in the file
, fileComments :: FileComments
}
| MarkdownFile
{ mmark :: MMark
-- ^ Parsed Markdown from 'contents'
}
| TextFile
deriving (Show)

data FileExtension = DhallExtension | MarkdownExtension | OtherExtension deriving (Show)

{-| Takes a list of files paths with their contents and returns the list of
valid `RenderedFile`s.
Expand All @@ -182,10 +194,12 @@ getAllRenderedFiles :: [(Path Rel File, ByteString)] -> GeneratedDocs [RenderedF
getAllRenderedFiles =
fmap Maybe.catMaybes . mapM toRenderedFile . foldr validFiles []
where
hasDhallExtension :: Path Rel File -> Bool
hasDhallExtension absFile = case Path.splitExtension absFile of
Nothing -> False
Just (_, ext) -> ext == ".dhall"
getFileExtension :: Path Rel File -> FileExtension
getFileExtension absFile =
case snd <$> Path.splitExtension absFile of
Just ".dhall" -> DhallExtension
Just ".md" -> MarkdownExtension
_ -> OtherExtension

validFiles :: (Path Rel File, ByteString) -> [(Path Rel File, Text)] -> [(Path Rel File, Text)]
validFiles (relFile, content) xs = case Data.Text.Encoding.decodeUtf8' content of
Expand All @@ -195,8 +209,8 @@ getAllRenderedFiles =
toRenderedFile
:: (Path Rel File, Text) -> GeneratedDocs (Maybe RenderedFile)
toRenderedFile (relFile, contents) =
case exprAndHeaderFromText (Path.fromRelFile relFile) contents of
Right (Header header, expr) -> do
case (exprAndHeaderFromText (Path.fromRelFile relFile) contents, getFileExtension relFile) of
(Right (Header header, expr), _) -> do
let denoted = denote expr :: Expr Void Import

headerContents <-
Expand All @@ -217,11 +231,27 @@ getAllRenderedFiles =
, fileComments = FileComments headerContents
}
}
Left ParseError{..} | hasDhallExtension relFile -> do
(Left ParseError{..}, DhallExtension) -> do
Writer.tell [InvalidDhall unwrap]
return Nothing

Left _ -> do
(Left ParseError{}, MarkdownExtension) ->
case parseMarkdown relFile contents of
Right mmark ->
return $ Just $ RenderedFile
{ contents
, path = relFile
, fileType = MarkdownFile mmark
}
Left err -> do
Writer.tell [InvalidMarkdownFile err]
return $ Just $ RenderedFile
{ contents
, path = relFile
, fileType = TextFile
}

_ -> do
return $ Just $ RenderedFile
{ contents
, path = relFile
Expand Down Expand Up @@ -330,7 +360,7 @@ makeHtml baseImportUrl packageName characterSet RenderedFile{..} = do
headerAsHtml <-
case markdownToHtml path strippedHeader of
Left err -> do
Writer.tell [InvalidMarkdown err]
Writer.tell [InvalidMarkdownHeader err]
return $ Lucid.toHtml strippedHeader
Right html -> return html

Expand All @@ -344,6 +374,16 @@ makeHtml baseImportUrl packageName characterSet RenderedFile{..} = do
DocParams{ relativeResourcesPath, packageName, characterSet, baseImportUrl }

return htmlAsText

MarkdownFile mmark -> do
let htmlAsText =
Text.Lazy.toStrict $ Lucid.renderText $ markdownFileToHtml
path
contents
(render mmark)
DocParams{ relativeResourcesPath, packageName, characterSet, baseImportUrl }
return htmlAsText

TextFile -> do
let htmlAsText =
Text.Lazy.toStrict $ Lucid.renderText $ textFileToHtml
Expand Down Expand Up @@ -420,8 +460,9 @@ createIndexes baseImportUrl packageName characterSet renderedFiles = map toIndex
adapt RenderedFile{..} = (stripPrefix (addHtmlExt path), m)
where
m = case fileType of
DhallFile{..} -> mType
TextFile -> Nothing
DhallFile{..} -> mType
MarkdownFile _ -> Nothing
TextFile -> Nothing

html = indexToHtml
indexDir
Expand Down
111 changes: 60 additions & 51 deletions dhall-docs/src/Dhall/Docs/Html.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@

module Dhall.Docs.Html
( dhallFileToHtml
, markdownFileToHtml
, textFileToHtml
, indexToHtml
, DocParams(..)
Expand Down Expand Up @@ -47,57 +48,75 @@ data DocParams = DocParams
, baseImportUrl :: Maybe Text -- ^ Base import URL
}

-- | Generates an @`Html` ()@ with all the information about a dhall file
dhallFileToHtml
:: Path Rel File -- ^ Source file name, used to extract the title
-> Text -- ^ Contents of the file
-> Expr Src Import -- ^ AST of the file
-> [Expr Void Import] -- ^ Examples extracted from the assertions of the file
-> Html () -- ^ Header document as HTML
-- | Generates an @`Html` ()@ containing standard elements like title,
-- navbar, breadcrumbs, and the provided content.
htmlTemplate
:: Path Rel a -- ^ Source file name or index directory, used to extract the title
-> DocParams -- ^ Parameters for the documentation
-> HtmlFileType -- ^ Are we rendering an index page?
-> Html () -- ^ Content to be included
-> Html ()
dhallFileToHtml filePath contents expr examples header params@DocParams{..} =
htmlTemplate filePath params@DocParams{..} isIndex html =
doctypehtml_ $ do
headContents htmlTitle params
body_ $ do
navBar params
mainContainer $ do
setPageTitle params NotIndex breadcrumb
setPageTitle params isIndex breadcrumb
copyToClipboardButton clipboardText
br_ []
div_ [class_ "doc-contents"] header
Control.Monad.unless (null examples) $ do
h3_ "Examples"
div_ [class_ "source-code code-examples"] $
mapM_ (renderCodeSnippet characterSet AssertionExample) examples
h3_ "Source"
div_ [class_ "source-code"] $ renderCodeWithHyperLinks contents expr
html
where
breadcrumb = relPathToBreadcrumb filePath
htmlTitle = breadCrumbsToText breadcrumb
clipboardText = fold baseImportUrl <> htmlTitle

-- | Generates an @`Html` ()@ with all the information about a non-dhall text file
-- | Generates an @`Html` ()@ with all the information about a dhall file
dhallFileToHtml
:: Path Rel File -- ^ Source file name, used to extract the title
-> Text -- ^ Contents of the file
-> Expr Src Import -- ^ AST of the file
-> [Expr Void Import] -- ^ Examples extracted from the assertions of the file
-> Html () -- ^ Header document as HTML
-> DocParams -- ^ Parameters for the documentation
-> Html ()
dhallFileToHtml filePath contents expr examples header params@DocParams{..} =
htmlTemplate filePath params NotIndex $ do
div_ [class_ "doc-contents"] header
Control.Monad.unless (null examples) $ do
h3_ "Examples"
div_ [class_ "source-code code-examples"] $
mapM_ (renderCodeSnippet characterSet AssertionExample) examples
h3_ "Source"
div_ [class_ "source-code"] $ renderCodeWithHyperLinks contents expr

-- | Generates an @`Html` ()@ with all the information about a Markdown file
markdownFileToHtml
:: Path Rel File -- ^ Source file name, used to extract the title
-> Text -- ^ Original text contents of the file
-> Html () -- ^ Contents converted to HTML
-> DocParams -- ^ Parameters for the documentation
-> Html ()
markdownFileToHtml filePath contents html params =
htmlTemplate filePath params NotIndex $ do
details_ [open_ ""] $ do
summary_ [class_ "part-summary"] "Rendered content"
div_ [class_ "doc-contents"] html
details_ $ do
summary_ [class_ "part-summary"] "Source"
div_ [class_ "source-code"] $ pre_ (toHtml contents)


-- | Generates an @`Html` ()@ with all the information about a text file
textFileToHtml
:: Path Rel File -- ^ Source file name, used to extract the title
-> Text -- ^ Contents of the file
-> DocParams -- ^ Parameters for the documentation
-> Html ()
textFileToHtml filePath contents params@DocParams{..} =
doctypehtml_ $ do
headContents htmlTitle params
body_ $ do
navBar params
mainContainer $ do
setPageTitle params NotIndex breadcrumb
copyToClipboardButton clipboardText
br_ []
h3_ "Source"
div_ [class_ "source-code"] $ pre_ (toHtml contents)
where
breadcrumb = relPathToBreadcrumb filePath
htmlTitle = breadCrumbsToText breadcrumb
clipboardText = fold baseImportUrl <> htmlTitle
textFileToHtml filePath contents params =
htmlTemplate filePath params NotIndex $ do
h3_ "Source"
div_ [class_ "source-code"] $ pre_ (toHtml contents)

-- | Generates an index @`Html` ()@ that list all the dhall files in that folder
indexToHtml
Expand All @@ -106,21 +125,15 @@ indexToHtml
-> [Path Rel Dir] -- ^ Generated directories in that directory
-> DocParams -- ^ Parameters for the documentation
-> Html ()
indexToHtml indexDir files dirs params@DocParams{..} = doctypehtml_ $ do
headContents htmlTitle params
body_ $ do
navBar params
mainContainer $ do
setPageTitle params Index breadcrumbs
copyToClipboardButton clipboardText
br_ []
Control.Monad.unless (null files) $ do
h3_ "Exported files: "
ul_ $ mconcat $ map listFile files

Control.Monad.unless (null dirs) $ do
h3_ "Exported packages: "
ul_ $ mconcat $ map listDir dirs
indexToHtml indexDir files dirs params@DocParams{..} =
htmlTemplate indexDir params Index $ do
Control.Monad.unless (null files) $ do
h3_ "Exported files: "
ul_ $ mconcat $ map listFile files

Control.Monad.unless (null dirs) $ do
h3_ "Exported packages: "
ul_ $ mconcat $ map listDir dirs

where
listFile :: (Path Rel File, Maybe (Expr Void Import)) -> Html ()
Expand All @@ -145,10 +158,6 @@ indexToHtml indexDir files dirs params@DocParams{..} = doctypehtml_ $ do
Nothing -> file
Just (f, _) -> f

breadcrumbs = relPathToBreadcrumb indexDir
htmlTitle = breadCrumbsToText breadcrumbs
clipboardText = fold baseImportUrl <> htmlTitle

copyToClipboardButton :: Text -> Html ()
copyToClipboardButton filePath =
a_ [class_ "copy-to-clipboard", data_ "path" filePath]
Expand Down
17 changes: 15 additions & 2 deletions dhall-docs/src/Dhall/Docs/Markdown.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,13 +2,16 @@
-}
module Dhall.Docs.Markdown
( MarkdownParseError(..)
, MMark
, parseMarkdown
, markdownToHtml
, MMark.render
) where

import Data.Text (Text)
import Lucid
import Path (File, Path, Rel)
import Text.MMark (MMarkErr)
import Text.MMark (MMarkErr, MMark)
import Text.Megaparsec (ParseErrorBundle (..))

import qualified Path
Expand All @@ -27,6 +30,16 @@ markdownToHtml
-> Text -- ^ Text to parse
-> Either MarkdownParseError (Html ())
markdownToHtml relFile contents =
MMark.render <$> parseMarkdown relFile contents

{-| Takes a text that could contain markdown and returns either the parsed
markdown or, if parsing fails, the error information.
-}
parseMarkdown
:: Path Rel File -- ^ Used by `Mmark.parse` for error messages
-> Text -- ^ Text to parse
-> Either MarkdownParseError MMark
parseMarkdown relFile contents =
case MMark.parse (Path.fromRelFile relFile) contents of
Left err -> Left MarkdownParseError { unwrap = err }
Right mmark -> Right $ MMark.render mmark
Right mmark -> Right mmark
7 changes: 7 additions & 0 deletions dhall-docs/src/Dhall/data/assets/index.css
Original file line number Diff line number Diff line change
Expand Up @@ -125,6 +125,13 @@ h2.doc-title {
margin-bottom: 0;
}

summary.part-summary {
cursor: pointer;
font-size: 1.5rem;
font-weight: bold;
margin-top: 1rem;
}

/******** Source code **********/


Expand Down
Loading

0 comments on commit 9075b91

Please sign in to comment.