only render else if declaration is shown in typeclass

csicar · csicar · commit bc3cc4e1e351 · 2019-08-18T18:37:34.000+02:00
diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs
@@ -155,16 +155,19 @@ declAsHtml r d@Declaration{..} = do
 
       unless (null dctors) $ do
         h4 "Constructors"
-        renderChildren r dctors
+        renderChildren isTypeClassDecl r dctors
 
       unless (null members) $ do
         h4 "Members"
-        renderChildren r members
+        renderChildren isTypeClassDecl r members
 
       unless (null instances) $ do
         h4 "Instances"
-        renderChildren r instances
+        renderChildren isTypeClassDecl r instances
   where
+    isTypeClassDecl = case declInfo of
+      TypeClassDeclaration{} -> True
+      _ -> False
     linkToSource :: HtmlRenderContext -> P.SourceSpan -> Html
     linkToSource ctx srcspan =
       maybe (return ()) go (renderSourceLink ctx srcspan)
@@ -173,9 +176,9 @@ declAsHtml r d@Declaration{..} = do
         H.span ! A.class_ "decl__source" $
           a ! A.href (v href) $ text "Source"
 
-renderChildren :: HtmlRenderContext -> [ChildDeclaration] -> Html
-renderChildren _ [] = return ()
-renderChildren r xs = ul $ mapM_ item xs
+renderChildren :: Bool -> HtmlRenderContext  -> [ChildDeclaration] -> Html
+renderChildren _ _ [] = return ()
+renderChildren isInTypeClass r xs = ul $ mapM_ item xs
   where
   item decl =
     li ! A.id (v (T.drop 1 (fragment decl))) $ do
@@ -184,7 +187,7 @@ renderChildren r xs = ul $ mapM_ item xs
         H.div ! A.class_ "decl__child_comments" $ renderMarkdown coms
 
   fragment decl = makeFragment (childDeclInfoNamespace (cdeclInfo decl)) (cdeclTitle decl)
-  renderCode = code . codeAsHtml r . Render.renderChildDeclaration
+  renderCode = code . codeAsHtml r . Render.renderChildDeclaration isInTypeClass
 
 codeAsHtml :: HtmlRenderContext -> RenderedCode -> Html
 codeAsHtml r = outputWith elemAsHtml
diff --git a/src/Language/PureScript/Docs/AsMarkdown.hs b/src/Language/PureScript/Docs/AsMarkdown.hs
@@ -45,17 +45,20 @@ 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 -> tell' (childToString isTypeClassDecl f c)) (First : repeat NotFirst) children
   spacer
 
   for_ declComments tell'
 
   unless (null instances) $ do
     headerLevel 5 "Instances"
-    fencedBlock $ mapM_ (tell' . childToString NotFirst) instances
+    fencedBlock $ mapM_ (tell' . childToString isTypeClassDecl NotFirst) instances
     spacer
 
   where
+  isTypeClassDecl = case declInfo of
+    TypeClassDeclaration{} -> True
+    _ -> False
   isChildInstance (ChildInstance _ _ _) = True
   isChildInstance _ = False
 
@@ -81,8 +84,8 @@ codeToString = outputWith elemAsMarkdown
 --     P.Infixr -> "right-associative"
 --     P.Infix  -> "non-associative"
 
-childToString :: First -> ChildDeclaration -> Text
-childToString f decl@ChildDeclaration{..} =
+childToString :: Bool -> First -> ChildDeclaration -> Text
+childToString inTypeClass f decl@ChildDeclaration{..} =
   case cdeclInfo of
     ChildDataConstructor _ ->
       let c = if f == First then "=" else "|"
@@ -92,7 +95,7 @@ childToString f decl@ChildDeclaration{..} =
     ChildInstance _ _ _ ->
       str
   where
-  str = codeToString $ Render.renderChildDeclaration decl
+  str = codeToString $ Render.renderChildDeclaration inTypeClass decl
 
 data First
   = First
diff --git a/src/Language/PureScript/Docs/Render.hs b/src/Language/PureScript/Docs/Render.hs
@@ -85,11 +85,11 @@ renderDeclaration Declaration{..} =
       , kind (notQualified declTitle)
       ]
 
-renderChildDeclaration :: ChildDeclaration -> RenderedCode
-renderChildDeclaration ChildDeclaration{..} =
+renderChildDeclaration :: Bool -> ChildDeclaration -> RenderedCode
+renderChildDeclaration isInTypeClassContext ChildDeclaration{..} =
   mintersperse sp $ case cdeclInfo of
     ChildInstance constraints ty inChain ->
-      (if inChain then [keywordElse] else []) ++ maybeToList (renderConstraints constraints) ++ [ renderType ty ]
+      (if inChain && isInTypeClassContext then [keywordElse] else []) ++ maybeToList (renderConstraints constraints) ++ [ renderType ty ]
     ChildDataConstructor args ->
       [ dataCtor' cdeclTitle ]
       ++ map renderTypeAtom args
