@@ -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,13 +53,14 @@ 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
64 hasTypes = any isTypeDeclaration ds
65 hasTypes = any isTypeDeclaration ds
65 hasTypeclasses = any isTypeClassDeclaration ds
66 hasTypeclasses = any isTypeClassDeclaration ds
@@ -76,8 +77,9 @@ renderModule (P.Module moduleName ds exps) =
76 when hasTypeclasses $ do
77 when hasTypeclasses $ do
77 headerLevel 3 "Type Classes"
78 headerLevel 3 "Type Classes"
80+ when showHierarchy $ do
79− renderTypeclassImage moduleName
81+ renderTypeclassImage moduleName
81 renderTopLevel exps (filter isTypeClassDeclaration exported)
83 renderTopLevel exps (filter isTypeClassDeclaration exported)
83 when hasTypeclassInstances $ do
85 when hasTypeclassInstances $ do
@@ -191,8 +193,11 @@ isTypeInstanceDeclaration _ = False
191inputFile :: Term FilePath
193inputFile :: Term FilePath
192inputFile = 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." }
194term :: Term (IO ())
199term :: Term (IO ())
195−term = docgen <$> inputFile
200+term = docgen <$> inputFile <*> includeHeirarcy
197termInfo :: TermInfo
202termInfo :: TermInfo
198termInfo = defTI
203termInfo = defTI