@@ -26,15 +26,15 @@ import qualified System.IO.UTF8 as U
2626import System.Console.CmdTheLine
2727import System.Exit (exitSuccess, exitFailure)
2828
29−docgen :: FilePath -> IO ()
30−docgen input = do
29+docgen :: FilePath -> Bool -> IO ()
30+docgen input showHierarchy = do
3131 text <- U.readFile input
3232 case P.runIndentParser input P.parseModules text of
3333 Left err -> do
3434 U.print err
3535 exitFailure
3636 Right ms -> do
37− U.putStrLn . runDocs $ renderModules ms
37+ U.putStrLn . runDocs $ (renderModules showHierarchy) ms
3838 exitSuccess
3939
4040type Docs = Writer [String] ()
@@ -53,37 +53,45 @@ atIndent indent text =
5353 let ls = lines text in
5454 forM_ ls $ \l -> tell [replicate indent ' ' ++ l]
5555
56−renderModules :: [P.Module] -> Docs
57−renderModules ms = do
56+renderModules :: Bool -> [P.Module] -> Docs
57+renderModules showHierarchy ms = do
5858 headerLevel 1 "Module Documentation"
59− mapM_ renderModule ms
59+ spacer
60+ mapM_ (renderModule showHierarchy) ms
6061
61−renderModule :: P.Module -> Docs
62−renderModule (P.Module moduleName ds exps) =
62+renderModule :: Bool -> P.Module -> Docs
63+renderModule showHierarchy (P.Module moduleName ds exps) =
6364 let exported = filter (isExported exps) ds
65+ hasTypes = any isTypeDeclaration ds
6466 hasTypeclasses = any isTypeClassDeclaration ds
67+ hasTypeclassInstances = any isTypeInstanceDeclaration ds
68+ hasValues = any isValueDeclaration ds
6569 in do
6670 headerLevel 2 $ "Module " ++ P.runModuleName moduleName
6771 spacer
68− headerLevel 3 "Types"
69− spacer
70− renderTopLevel exps (filter isTypeDeclaration exported)
71− spacer
72− headerLevel 3 "Type Classes"
73− spacer
72+ when hasTypes $ do
73+ headerLevel 3 "Types"
74+ spacer
75+ renderTopLevel exps (filter isTypeDeclaration exported)
76+ spacer
7477 when hasTypeclasses $ do
75− renderTypeclassImage moduleName
78+ headerLevel 3 "Type Classes"
79+ spacer
80+ when showHierarchy $ do
81+ renderTypeclassImage moduleName
82+ spacer
83+ renderTopLevel exps (filter isTypeClassDeclaration exported)
84+ spacer
85+ when hasTypeclassInstances $ do
86+ headerLevel 3 "Type Class Instances"
87+ spacer
88+ renderTopLevel exps (filter isTypeInstanceDeclaration ds)
89+ spacer
90+ when hasValues $ do
91+ headerLevel 3 "Values"
92+ spacer
93+ renderTopLevel exps (filter isValueDeclaration exported)
7694 spacer
77− renderTopLevel exps (filter isTypeClassDeclaration exported)
78− spacer
79− headerLevel 3 "Type Class Instances"
80− spacer
81− renderTopLevel exps (filter isTypeInstanceDeclaration ds)
82− spacer
83− headerLevel 3 "Values"
84− spacer
85− renderTopLevel exps (filter isValueDeclaration exported)
86− spacer
8795
8896isExported :: Maybe [P.DeclarationRef] -> P.Declaration -> Bool
8997isExported Nothing _ = True
@@ -185,8 +193,11 @@ isTypeInstanceDeclaration _ = False
185193inputFile :: Term FilePath
186194inputFile = value $ pos 0 "input.ps" $ posInfo { posDoc = "The input .ps file" }
187195
196+includeHeirarcy :: Term Bool
197+includeHeirarcy = value $ flag $ (optInfo [ "h", "hierarchy-images" ]) { optDoc = "Include markdown for type class hierarchy images in the output." }
198+
188199term :: Term (IO ())
189−term = docgen <$> inputFile
200+term = docgen <$> inputFile <*> includeHeirarcy
190201
191202termInfo :: TermInfo
192203termInfo = defTI