git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
desugar imports in psc-docs
580d96cHarry Garrood
psc-docs/Main.hs+171−23
compare with golang
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE TupleSections #-}
1----------------------------------------------------------------------------
2----------------------------------------------------------------------------
2--
3--
3-- Module : Main
4-- Module : Main
@@ -16,50 +17,124 @@ module Main where
16
17
17import Control.Applicative
18import Control.Applicative
18import Control.Monad.Writer
19import Control.Monad.Writer
19−import Control.Arrow (first)
20+import Control.Arrow (first, second)
21+import Control.Category ((>>>))
20import Data.List
22import Data.List
21import Data.Maybe (fromMaybe)
23import Data.Maybe (fromMaybe)
22import Data.Version (showVersion)
24import Data.Version (showVersion)
23
25
24import Options.Applicative
26import Options.Applicative
27+import qualified Text.PrettyPrint.ANSI.Leijen as PP
25
28
26import qualified Language.PureScript as P
29import qualified Language.PureScript as P
27import qualified Paths_purescript as Paths
30import qualified Paths_purescript as Paths
28−import System.Exit (exitSuccess, exitFailure)
31+import System.Exit (exitFailure)
29import System.IO (hPutStrLn, stderr)
32import System.IO (hPutStrLn, stderr)
30
33
31import Etags
34import Etags
32import Ctags
35import Ctags
36+import qualified Language.PureScript.Docs as D
33−import Language.PureScript.Docs.AsMarkdown
37+import qualified Language.PureScript.Docs.AsMarkdown as D
34
38
35-- Available output formats
39-- Available output formats
36data Format = Markdown -- Output documentation in Markdown format
40data Format = Markdown -- Output documentation in Markdown format
37 | Ctags -- Output ctags symbol index suitable for use with vi
41 | Ctags -- Output ctags symbol index suitable for use with vi
38 | Etags -- Output etags symbol index suitable for use with emacs
42 | Etags -- Output etags symbol index suitable for use with emacs
43+ deriving (Show, Eq, Ord)
44+
45+-- | Available methods of outputting Markdown documentation
46+data DocgenOutput
47+ = EverythingToStdOut
48+ | ToStdOut [P.ModuleName]
49+ | ToFiles [(P.ModuleName, FilePath)]
50+ deriving (Show)
39
51
40data PSCDocsOptions = PSCDocsOptions
52data PSCDocsOptions = PSCDocsOptions
41 { pscdFormat :: Format
53 { pscdFormat :: Format
42 , pscdInputFiles :: [FilePath]
54 , pscdInputFiles :: [FilePath]
55+ , pscdDocgen :: DocgenOutput
43 }
56 }
57+ deriving (Show)
44
58
45docgen :: PSCDocsOptions -> IO ()
59docgen :: PSCDocsOptions -> IO ()
46−docgen (PSCDocsOptions fmt input) = do
60+docgen (PSCDocsOptions fmt input output) =
61+ case fmt of
62+ Etags -> dumpTags input dumpEtags
63+ Ctags -> dumpTags input dumpCtags
64+ Markdown -> do
65+ e <- D.parseAndDesugar input [] (\_ ms -> return ms)
66+ case e of
67+ Left (D.ParseError err) -> do
68+ hPutStrLn stderr $ show err
69+ exitFailure
70+ Left (D.SortModulesError err) -> do
71+ hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
72+ exitFailure
73+ Left (D.DesugarError err) -> do
74+ hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
75+ exitFailure
76+ Right ms' -> do
77+ case output of
78+ EverythingToStdOut ->
79+ putStrLn (D.renderModulesAsMarkdown ms')
80+ ToStdOut names -> do
81+ let (ms, missing) = takeModulesByName ms' names
82+ guardMissing missing
83+ putStrLn (D.renderModulesAsMarkdown ms)
84+ ToFiles names -> do
85+ let (ms, missing) = takeModulesByName' ms' names
86+ guardMissing missing
87+ forM_ ms $ \(m, fp) ->
88+ writeFile fp (D.renderModulesAsMarkdown [m])
89+
90+ where
91+ guardMissing [] = return ()
92+ guardMissing [mn] = do
93+ hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
94+ exitFailure
95+ guardMissing mns = do
96+ hPutStrLn stderr "psc-docs: error: unknown modules:"
97+ forM_ mns $ \mn ->
98+ hPutStrLn stderr (" * " ++ show mn)
99+ exitFailure
100+
101+-- |
102+-- Given a list of module names and a list of modules, return a list of modules
103+-- whose names appeared in the given name list, together with a list of names
104+-- for which no module could be found in the module list.
105+--
106+takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
107+takeModulesByName modules names =
108+ first (map fst) (takeModulesByName' modules (map (,()) names))
109+
110+-- |
111+-- Like takeModulesByName but also keeps some extra data with the module.
112+--
113+takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
114+takeModulesByName' modules = foldl go ([], [])
115+ where
116+ go (ms, missing) (name, x) =
117+ case find ((== name) . P.getModuleName) modules of
118+ Just m -> ((m, x) : ms, missing)
119+ Nothing -> (ms, name : missing)
120+
121+dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
122+dumpTags input renderTags = do
47 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
123 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
48 case e of
124 case e of
49 Left err -> do
125 Left err -> do
50− hPutStrLn stderr $ show err
126+ hPutStrLn stderr (show err)
51 exitFailure
127 exitFailure
52− Right ms -> do
128+ Right ms ->
53− case fmt of
54− Markdown -> putStrLn $ renderModulesAsMarkdown $ map snd ms
55− Etags -> ldump $ dumpEtags $ pairs ms
129+ ldump (renderTags (pairs ms))
56− Ctags -> ldump $ dumpCtags $ pairs ms
130+
57− exitSuccess
131+ where
58− where pairs :: [(Maybe String, m)] -> [(String, m)]
132+ pairs :: [(Maybe String, m)] -> [(String, m)]
59− pairs = map (\(k,m) -> (fromMaybe "" k,m))
133+ pairs = map (first (fromMaybe ""))
134+
60− ldump :: [String] -> IO ()
135+ ldump :: [String] -> IO ()
61− ldump = mapM_ putStrLn
136+ ldump = mapM_ putStrLn
62−
137+
63parseFile :: FilePath -> IO (FilePath, String)
138parseFile :: FilePath -> IO (FilePath, String)
64parseFile input = (,) input <$> readFile input
139parseFile input = (,) input <$> readFile input
65
140
@@ -72,24 +147,97 @@ instance Read Format where
72 readsPrec _ "etags" = [(Etags, "")]
147 readsPrec _ "etags" = [(Etags, "")]
73 readsPrec _ "ctags" = [(Ctags, "")]
148 readsPrec _ "ctags" = [(Ctags, "")]
74 readsPrec _ "markdown" = [(Markdown, "")]
149 readsPrec _ "markdown" = [(Markdown, "")]
75− readsPrec _ _ = []
150+ readsPrec _ _ = []
76
151
77format :: Parser Format
152format :: Parser Format
78format = option auto $ value Markdown
153format = option auto $ value Markdown
79 <> long "format"
154 <> long "format"
80 <> metavar "FORMAT"
155 <> metavar "FORMAT"
81− <> help "Set output FORMAT (markdown | etags | ctags)"
156+ <> help "Set output FORMAT (markdown | etags | ctags)"
82
157
158+docgenModule :: Parser String
159+docgenModule = strOption $
160+ long "docgen"
161+ <> help "A list of module names which should appear in the output. This can optionally include file paths to write individual modules to, by separating with a colon ':'. For example, Prelude:docs/Prelude.md. This option may be specified multiple times."
162+
83−pscDocsOptions :: Parser PSCDocsOptions
163+pscDocsOptions :: Parser (Format, [FilePath], [String])
84−pscDocsOptions = PSCDocsOptions <$> format <*> many inputFile
164+pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
165+
166+parseDocgen :: [String] -> Either String DocgenOutput
167+parseDocgen [] = Right EverythingToStdOut
168+parseDocgen xs = go xs
169+ where
170+ go = intersperse " "
171+ >>> concat
172+ >>> words
173+ >>> map parseItem
174+ >>> combine
175+
176+data DocgenOutputItem
177+ = IToStdOut P.ModuleName
178+ | IToFile (P.ModuleName, FilePath)
179+
180+parseItem :: String -> DocgenOutputItem
181+parseItem s = case elemIndex ':' s of
182+ Just i ->
183+ s # splitAt i
184+ >>> first P.moduleNameFromString
185+ >>> second (drop 1)
186+ >>> IToFile
187+ Nothing ->
188+ IToStdOut (P.moduleNameFromString s)
189+
190+ where
191+ infixr 1 #
192+ (#) = flip ($)
193+
194+combine :: [DocgenOutputItem] -> Either String DocgenOutput
195+combine [] = Right EverythingToStdOut
196+combine (x:xs) = foldM go (initial x) xs
197+ where
198+ initial (IToStdOut m) = ToStdOut [m]
199+ initial (IToFile m) = ToFiles [m]
200+
201+ go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
202+ go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
203+ go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
204+
205+buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
206+buildOptions (fmt, input, mapping) =
207+ case parseDocgen mapping of
208+ Right mapping' -> return (PSCDocsOptions fmt input mapping')
209+ Left err -> do
210+ hPutStrLn stderr "psc-docs: error in --docgen option:"
211+ hPutStrLn stderr (" " ++ err)
212+ exitFailure
85
213
86main :: IO ()
214main :: IO ()
87−main = execParser opts >>= docgen
215+main = execParser opts >>= buildOptions >>= docgen
88 where
216 where
89 opts = info (version <*> helper <*> pscDocsOptions) infoModList
217 opts = info (version <*> helper <*> pscDocsOptions) infoModList
90 infoModList = fullDesc <> headerInfo <> footerInfo
218 infoModList = fullDesc <> headerInfo <> footerInfo
91− headerInfo = header "psc-docs - Generate Markdown documentation from PureScript extern files"
219+ headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
220+ footerInfo = footerDoc $ Just $ PP.vcat
92− footerInfo = footer $ "psc-docs " ++ showVersion Paths.version
221+ [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
93
222
94 version :: Parser (a -> a)
223 version :: Parser (a -> a)
95 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
224 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
225+
226+examples :: PP.Doc
227+examples =
228+ PP.vcat $ map PP.text
229+ [ "Examples:"
230+ , " print documentation for Data.List to stdout:"
231+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
232+ , " --docgen Data.List"
233+ , ""
234+ , " write documentation for Data.List to docs/Data.List.md:"
235+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
236+ , " --docgen Data.List:docs/Data.List.md"
237+ , ""
238+ , " write documentation for Data.List to docs/Data.List.md, and"
239+ , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
240+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
241+ , " --docgen Data.List:docs/Data.List.md \\"
242+ , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
243+ ]
purescript.cabal+2−1
@@ -184,7 +184,8 @@ executable psci
184
184
185executable psc-docs
185executable psc-docs
186 build-depends: base >=4 && <5, purescript -any,
186 build-depends: base >=4 && <5, purescript -any,
187− optparse-applicative >= 0.10.0, process -any, mtl -any
187+ optparse-applicative >= 0.10.0, process -any, mtl -any,
188+ split -any, ansi-wl-pprint -any
188 main-is: Main.hs
189 main-is: Main.hs
189 buildable: True
190 buildable: True
190 hs-source-dirs: psc-docs
191 hs-source-dirs: psc-docs
src/Language/PureScript/Docs/AsMarkdown.hs+12−10
@@ -4,7 +4,7 @@ module Language.PureScript.Docs.AsMarkdown (
4 renderModulesAsMarkdown
4 renderModulesAsMarkdown
5) where
5) where
6
6
7−import Control.Monad.Writer
7+import Control.Monad.Writer hiding (First)
8import Data.Foldable (for_)
8import Data.Foldable (for_)
9import Data.List (partition)
9import Data.List (partition)
10
10
@@ -23,10 +23,7 @@ renderModulesAsMarkdown =
23 runDocs . modulesAsMarkdown . map Render.renderModule
23 runDocs . modulesAsMarkdown . map Render.renderModule
24
24
25modulesAsMarkdown :: [RenderedModule] -> Docs
25modulesAsMarkdown :: [RenderedModule] -> Docs
26−modulesAsMarkdown ms = do
27− headerLevel 1 "Module Documentation"
28− spacer
29− mapM_ moduleAsMarkdown ms
26+modulesAsMarkdown = mapM_ moduleAsMarkdown
30
27
31moduleAsMarkdown :: RenderedModule -> Docs
28moduleAsMarkdown :: RenderedModule -> Docs
32moduleAsMarkdown RenderedModule{..} = do
29moduleAsMarkdown RenderedModule{..} = do
@@ -44,13 +41,13 @@ declAsMarkdown RenderedDeclaration{..} = do
44 let (instances, children) = partition ((==) ChildInstance . rcdType) rdChildren
41 let (instances, children) = partition ((==) ChildInstance . rcdType) rdChildren
45 fencedBlock $ do
42 fencedBlock $ do
46 tell' (codeToString rdCode)
43 tell' (codeToString rdCode)
47− zipWithM_ (\f c -> tell' (childToString f c)) (True : repeat False) children
44+ zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children
48 spacer
45 spacer
49
46
50 unless (null instances) $ do
47 unless (null instances) $ do
51 headerLevel 5 "Instances"
48 headerLevel 5 "Instances"
52 fencedBlock $ do
49 fencedBlock $ do
53− mapM_ (tell' . childToString False) instances
50+ mapM_ (tell' . childToString NotFirst) instances
54 spacer
51 spacer
55
52
56 for_ rdComments tell'
53 for_ rdComments tell'
@@ -65,17 +62,22 @@ codeToString = outputWith elemAsMarkdown
65 elemAsMarkdown (Keyword x) = x
62 elemAsMarkdown (Keyword x) = x
66 elemAsMarkdown Space = " "
63 elemAsMarkdown Space = " "
67
64
68−childToString :: Bool -> RenderedChildDeclaration -> String
65+childToString :: First -> RenderedChildDeclaration -> String
69−childToString isFirst RenderedChildDeclaration{..} =
66+childToString f RenderedChildDeclaration{..} =
70 case rcdType of
67 case rcdType of
71 ChildDataConstructor ->
68 ChildDataConstructor ->
72− let c = if isFirst then "=" else "|"
69+ let c = if f == First then "=" else "|"
73 in " " ++ c ++ " " ++ codeToString rcdCode
70 in " " ++ c ++ " " ++ codeToString rcdCode
74 ChildTypeClassMember ->
71 ChildTypeClassMember ->
75 " " ++ codeToString rcdCode
72 " " ++ codeToString rcdCode
76 ChildInstance ->
73 ChildInstance ->
77 codeToString rcdCode
74 codeToString rcdCode
78
75
76+data First
77+ = First
78+ | NotFirst
79+ deriving (Show, Eq, Ord)
80+
79type Docs = Writer [String] ()
81type Docs = Writer [String] ()
80
82
81runDocs :: Docs -> String
83runDocs :: Docs -> String