Render Markdown files as HTML

.gitattributes

@@ -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

dhall-docs/dhall-docs.cabal

@@ -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

dhall-docs/src/Dhall/Docs/Core.hs

@@ -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
@@ -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
@@ -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.
 
@@ -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
@@ -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 <-
@@ -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
@@ -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
 
@@ -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
@@ -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

dhall-docs/src/Dhall/Docs/Html.hs

@@ -13,6 +13,7 @@
 
 module Dhall.Docs.Html
     ( dhallFileToHtml
+    , markdownFileToHtml
     , textFileToHtml
     , indexToHtml
     , DocParams(..)
@@ -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
@@ -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 ()
@@ -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]

dhall-docs/src/Dhall/Docs/Markdown.hs

@@ -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
@@ -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

dhall-docs/src/Dhall/data/assets/index.css

@@ -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 **********/