@@ -26,15 +26,15 @@ import qualified System.IO.UTF8 as U
26import System.Console.CmdTheLine
26import System.Console.CmdTheLine
27import System.Exit (exitSuccess, exitFailure)
27import System.Exit (exitSuccess, exitFailure)
29−docgen :: FilePath -> IO ()
29+docgen :: FilePath -> Bool -> IO ()
30−docgen input = do
30+docgen input showHierarchy = do
31 text <- U.readFile input
31 text <- U.readFile input
32 case P.runIndentParser input P.parseModules text of
32 case P.runIndentParser input P.parseModules text of
33 Left err -> do
33 Left err -> do
34 U.print err
34 U.print err
35 exitFailure
35 exitFailure
36 Right ms -> do
36 Right ms -> do
37− U.putStrLn . runDocs $ renderModules ms
37+ U.putStrLn . runDocs $ (renderModules showHierarchy) ms
38 exitSuccess
38 exitSuccess
40type Docs = Writer [String] ()
40type Docs = Writer [String] ()
@@ -53,37 +53,45 @@ atIndent indent text =
53 let ls = lines text in
53 let ls = lines text in
54 forM_ ls $ \l -> tell [replicate indent ' ' ++ l]
54 forM_ ls $ \l -> tell [replicate indent ' ' ++ l]
56−renderModules :: [P.Module] -> Docs
56+renderModules :: Bool -> [P.Module] -> Docs
57−renderModules ms = do
57+renderModules showHierarchy ms = do
58 headerLevel 1 "Module Documentation"
58 headerLevel 1 "Module Documentation"
59− mapM_ renderModule ms
60+ mapM_ (renderModule showHierarchy) ms
61−renderModule :: P.Module -> Docs
62+renderModule :: Bool -> P.Module -> Docs
62−renderModule (P.Module moduleName ds exps) =
63+renderModule showHierarchy (P.Module moduleName ds exps) =
63 let exported = filter (isExported exps) ds
64 let exported = filter (isExported exps) ds
65+ hasTypes = any isTypeDeclaration ds
64 hasTypeclasses = any isTypeClassDeclaration ds
66 hasTypeclasses = any isTypeClassDeclaration ds
67+ hasTypeclassInstances = any isTypeInstanceDeclaration ds
68+ hasValues = any isValueDeclaration ds
66 headerLevel 2 $ "Module " ++ P.runModuleName moduleName
70 headerLevel 2 $ "Module " ++ P.runModuleName moduleName
68− headerLevel 3 "Types"
73+ headerLevel 3 "Types"
70− renderTopLevel exps (filter isTypeDeclaration exported)
75+ renderTopLevel exps (filter isTypeDeclaration exported)
72− headerLevel 3 "Type Classes"
74 when hasTypeclasses $ do
77 when hasTypeclasses $ do
78+ headerLevel 3 "Type Classes"
80+ when showHierarchy $ do
75− renderTypeclassImage moduleName
81+ renderTypeclassImage moduleName
83+ renderTopLevel exps (filter isTypeClassDeclaration exported)
85+ when hasTypeclassInstances $ do
86+ headerLevel 3 "Type Class Instances"
88+ renderTopLevel exps (filter isTypeInstanceDeclaration ds)
91+ headerLevel 3 "Values"
93+ renderTopLevel exps (filter isValueDeclaration exported)
77− renderTopLevel exps (filter isTypeClassDeclaration exported)
79− headerLevel 3 "Type Class Instances"
81− renderTopLevel exps (filter isTypeInstanceDeclaration ds)
83− headerLevel 3 "Values"
85− renderTopLevel exps (filter isValueDeclaration exported)
88isExported :: Maybe [P.DeclarationRef] -> P.Declaration -> Bool
96isExported :: Maybe [P.DeclarationRef] -> P.Declaration -> Bool
89isExported Nothing _ = True
97isExported Nothing _ = True
@@ -185,8 +193,11 @@ isTypeInstanceDeclaration _ = False
185inputFile :: Term FilePath
193inputFile :: Term FilePath
186inputFile = value $ pos 0 "input.ps" $ posInfo { posDoc = "The input .ps file" }
194inputFile = value $ pos 0 "input.ps" $ posInfo { posDoc = "The input .ps file" }
196+includeHeirarcy :: Term Bool
197+includeHeirarcy = value $ flag $ (optInfo [ "h", "hierarchy-images" ]) { optDoc = "Include markdown for type class hierarchy images in the output." }
188term :: Term (IO ())
199term :: Term (IO ())
189−term = docgen <$> inputFile
200+term = docgen <$> inputFile <*> includeHeirarcy
191termInfo :: TermInfo
202termInfo :: TermInfo
192termInfo = defTI
203termInfo = defTI