Improved comments handling

csicar · csicar · commit b843afc06aa8 · 2020-10-04T23:12:13.000+02:00
diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs
@@ -182,8 +182,10 @@ renderChildren r xs = ul $ mapM_ item xs
       case Render.renderChildDeclaration decl of
         Render.RenderedAsCode renderedCode -> renderCode renderedCode
         Render.RenderedAsStructure struct -> 
-            ul $ for_ struct $ \(title, el) ->
-              li ! A.id (v (T.drop 1 (subFragement decl title))) $ (renderCode el)
+            ul $ for_ struct $ \(instChainEl, el) -> do
+              li ! A.id (v (T.drop 1 (subFragement decl (icTitle instChainEl)))) $ (renderCode el)
+              for_ (icComments instChainEl) $ \coms ->
+                H.div ! A.class_ "decl__child__comments" $ renderMarkdown coms
       for_ (cdeclComments decl) $ \coms ->
         H.div ! A.class_ "decl__child_comments" $ renderMarkdown coms
 
diff --git a/src/Language/PureScript/Docs/AsMarkdown.hs b/src/Language/PureScript/Docs/AsMarkdown.hs
@@ -12,6 +12,7 @@ import Control.Monad (unless, zipWithM_)
 import Control.Monad.Writer (Writer, tell, execWriter)
 
 import Data.Foldable (for_)
+import Data.Maybe (fromMaybe)
 import Data.List (partition)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -45,14 +46,14 @@ declAsMarkdown decl@Declaration{..} = do
   let (instances, children) = partition (isChildInstance . cdeclInfo) declChildren
   fencedBlock $ do
     tell' (codeToString $ Render.renderDeclaration decl)
-    zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children
+    zipWithM_ (\f c -> childToString f c) (First : repeat NotFirst) children
   spacer
 
   for_ declComments tell'
 
   unless (null instances) $ do
     headerLevel 5 "Instances"
-    fencedBlock $ mapM_ (tell' . childToString NotFirst) instances
+    mapM_ (childToString NotFirst) instances
     spacer
 
   where
@@ -82,22 +83,31 @@ codeToString = outputWith elemAsMarkdown
 --     P.Infixr -> "right-associative"
 --     P.Infix  -> "non-associative"
 
-childToString :: First -> ChildDeclaration -> Text
+childToString :: First -> ChildDeclaration -> Docs
 childToString f decl@ChildDeclaration{..} =
   case cdeclInfo of
     ChildDataConstructor _ ->
       let c = if f == First then "=" else "|"
-      in  "  " <> c <> " " <> str
+      in  fencedBlock $ do
+        tell' $ "  " <> c <> " " 
+        str
     ChildTypeClassMember _ ->
-      "  " <> str
+      fencedBlock $ do
+        tell' $ "  " 
+        str
     ChildInstanceChain  _ ->
       str
     ChildPartOfInstanceChain _ ->
-      str
+      fencedBlock $ str
   where
   str = case  Render.renderChildDeclaration decl of 
-      Render.RenderedAsCode code -> codeToString code
-      Render.RenderedAsStructure structure -> T.unlines $ ("    - "<>) <$> codeToString <$> snd <$> structure
+      Render.RenderedAsCode code -> tell' $ codeToString code
+      Render.RenderedAsStructure structure -> mapM_ chainInstanceToString structure
+
+  chainInstanceToString :: (ChildInstanceChainInfo, RenderedCode) -> Docs
+  chainInstanceToString (inst, code) = do
+    fencedBlock $ tell' $ codeToString code
+    mapM_ tell' $ icComments inst
 
 data First
   = First
diff --git a/src/Language/PureScript/Docs/Render.hs b/src/Language/PureScript/Docs/Render.hs
@@ -82,7 +82,7 @@ renderDeclaration Declaration{..} =
 
 data RenderedChildDeclaration
   = RenderedAsCode RenderedCode
-  | RenderedAsStructure [(Text, RenderedCode)]
+  | RenderedAsStructure [(ChildInstanceChainInfo, RenderedCode)]
   deriving (Show, Eq, Ord)
 
 renderChildDeclaration :: ChildDeclaration -> RenderedChildDeclaration
@@ -110,9 +110,9 @@ renderChildDeclaration ChildDeclaration{..} =
 
     mapSnd f (a, b) = (a, f b)
     
-    renderInstanceChain :: ChildInstanceChainInfo -> (Text, RenderedCode)
+    renderInstanceChain :: ChildInstanceChainInfo -> (ChildInstanceChainInfo, RenderedCode)
     renderInstanceChain inst =
-      (icTitle inst, mintersperse sp $ renderChildInstance $ inst)
+      (inst, mintersperse sp $ renderChildInstance $ inst)
 
 renderChildInstance :: ChildInstanceChainInfo -> [RenderedCode]
 renderChildInstance (ChildInstanceChainInfo{..}) =
