git.iko.soy/rowtype-yoga/purescript-native
on 67bfcd5 help sign in
rowtype-yoga/purescript-native/psc-docs/Main.hs
251 lines 8.5 kB history raw
1{-# LANGUAGE TupleSections #-}
3module Main where
5import Control.Applicative
6import Control.Monad.Trans.Except (runExceptT)
7import Control.Arrow (first, second)
8import Control.Category ((>>>))
9import Control.Monad.Writer
10import Data.Text (Text)
11import Data.Function (on)
12import Data.List
13import Data.Maybe (fromMaybe)
14import Data.Tuple (swap)
15import Data.Version (showVersion)
17import Options.Applicative
18import qualified Text.PrettyPrint.ANSI.Leijen as PP
20import qualified Language.PureScript as P
21import qualified Paths_purescript as Paths
22import System.Exit (exitFailure)
23import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)
24import System.IO.UTF8 (readUTF8FileT)
25import System.Directory (createDirectoryIfMissing)
26import System.FilePath (takeDirectory)
27import System.FilePath.Glob (glob)
29import Etags
30import Ctags
31import qualified Language.PureScript.Docs as D
32import qualified Language.PureScript.Docs.AsMarkdown as D
34-- Available output formats
35data Format = Markdown -- Output documentation in Markdown format
36 | Ctags -- Output ctags symbol index suitable for use with vi
37 | Etags -- Output etags symbol index suitable for use with emacs
38 deriving (Show, Eq, Ord)
40-- | Available methods of outputting Markdown documentation
41data DocgenOutput
42 = EverythingToStdOut
43 | ToStdOut [P.ModuleName]
44 | ToFiles [(P.ModuleName, FilePath)]
45 deriving (Show)
47data PSCDocsOptions = PSCDocsOptions
48 { pscdFormat :: Format
49 , pscdInputFiles :: [FilePath]
50 , pscdDocgen :: DocgenOutput
51 }
52 deriving (Show)
54docgen :: PSCDocsOptions -> IO ()
55docgen (PSCDocsOptions fmt inputGlob output) = do
56 input <- concat <$> mapM glob inputGlob
57 case fmt of
58 Etags -> dumpTags input dumpEtags
59 Ctags -> dumpTags input dumpCtags
60 Markdown -> do
61 ms <- runExceptT (D.parseAndBookmark input []
62 >>= (fst >>> D.convertModulesInPackage))
63 >>= successOrExit
65 case output of
66 EverythingToStdOut ->
67 putStrLn (D.runDocs (D.modulesAsMarkdown ms))
68 ToStdOut names -> do
69 let (ms', missing) = takeByName ms names
70 guardMissing missing
71 putStrLn (D.runDocs (D.modulesAsMarkdown ms'))
72 ToFiles names -> do
73 let (ms', missing) = takeByName' ms names
74 guardMissing missing
76 let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms'
77 forM_ ms'' $ \grp -> do
78 let fp = fst (head grp)
79 createDirectoryIfMissing True (takeDirectory fp)
80 writeFile fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))
82 where
83 guardMissing [] = return ()
84 guardMissing [mn] = do
85 hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ P.runModuleName mn ++ "\"")
86 exitFailure
87 guardMissing mns = do
88 hPutStrLn stderr "psc-docs: error: unknown modules:"
89 forM_ mns $ \mn ->
90 hPutStrLn stderr (" * " ++ P.runModuleName mn)
91 exitFailure
93 successOrExit :: Either P.MultipleErrors a -> IO a
94 successOrExit act =
95 case act of
96 Right x ->
97 return x
98 Left err -> do
99 hPutStrLn stderr $ P.prettyPrintMultipleErrors P.defaultPPEOptions err
100 exitFailure
102 takeByName = takeModulesByName D.modName
103 takeByName' = takeModulesByName' D.modName
105-- |
106-- Given a list of module names and a list of modules, return a list of modules
107-- whose names appeared in the given name list, together with a list of names
108-- for which no module could be found in the module list.
109--
110takeModulesByName :: (Eq n) => (m -> n) -> [m] -> [n] -> ([m], [n])
111takeModulesByName getModuleName modules names =
112 first (map fst) (takeModulesByName' getModuleName modules (map (,()) names))
114-- |
115-- Like takeModulesByName, but also keeps some extra information with each
116-- module.
117--
118takeModulesByName' :: (Eq n) => (m -> n) -> [m] -> [(n, a)] -> ([(m, a)], [n])
119takeModulesByName' getModuleName modules = foldl go ([], [])
120 where
121 go (ms, missing) (name, x) =
122 case find ((== name) . getModuleName) modules of
123 Just m -> ((m, x) : ms, missing)
124 Nothing -> (ms, name : missing)
126dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
127dumpTags input renderTags = do
128 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
129 case e of
130 Left err -> do
131 hPrint stderr err
132 exitFailure
133 Right ms ->
134 ldump (renderTags (pairs ms))
136 where
137 pairs :: [(Maybe String, m)] -> [(String, m)]
138 pairs = map (first (fromMaybe ""))
140 ldump :: [String] -> IO ()
141 ldump = mapM_ putStrLn
143parseFile :: FilePath -> IO (FilePath, Text)
144parseFile input = (,) input <$> readUTF8FileT input
146inputFile :: Parser FilePath
147inputFile = strArgument $
148 metavar "FILE"
149 <> help "The input .purs file(s)"
151instance Read Format where
152 readsPrec _ "etags" = [(Etags, "")]
153 readsPrec _ "ctags" = [(Ctags, "")]
154 readsPrec _ "markdown" = [(Markdown, "")]
155 readsPrec _ _ = []
157format :: Parser Format
158format = option auto $ value Markdown
159 <> long "format"
160 <> metavar "FORMAT"
161 <> help "Set output FORMAT (markdown | etags | ctags)"
163docgenModule :: Parser String
164docgenModule = strOption $
165 long "docgen"
166 <> 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."
168pscDocsOptions :: Parser (Format, [FilePath], [String])
169pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
171parseDocgen :: [String] -> Either String DocgenOutput
172parseDocgen [] = Right EverythingToStdOut
173parseDocgen xs = go xs
174 where
175 go = intersperse " "
176 >>> concat
177 >>> words
178 >>> map parseItem
179 >>> combine
181data DocgenOutputItem
182 = IToStdOut P.ModuleName
183 | IToFile (P.ModuleName, FilePath)
185parseItem :: String -> DocgenOutputItem
186parseItem s = case elemIndex ':' s of
187 Just i ->
188 s # splitAt i
189 >>> first P.moduleNameFromString
190 >>> second (drop 1)
191 >>> IToFile
192 Nothing ->
193 IToStdOut (P.moduleNameFromString s)
195 where
196 infixr 1 #
197 (#) = flip ($)
199combine :: [DocgenOutputItem] -> Either String DocgenOutput
200combine [] = Right EverythingToStdOut
201combine (x:xs) = foldM go (initial x) xs
202 where
203 initial (IToStdOut m) = ToStdOut [m]
204 initial (IToFile m) = ToFiles [m]
206 go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
207 go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
208 go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
210buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
211buildOptions (fmt, input, mapping) =
212 case parseDocgen mapping of
213 Right mapping' -> return (PSCDocsOptions fmt input mapping')
214 Left err -> do
215 hPutStrLn stderr "psc-docs: error in --docgen option:"
216 hPutStrLn stderr (" " ++ err)
217 exitFailure
219main :: IO ()
220main = do
221 hSetEncoding stdout utf8
222 hSetEncoding stderr utf8
223 execParser opts >>= buildOptions >>= docgen
224 where
225 opts = info (version <*> helper <*> pscDocsOptions) infoModList
226 infoModList = fullDesc <> headerInfo <> footerInfo
227 headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
228 footerInfo = footerDoc $ Just $ PP.vcat
229 [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
231 version :: Parser (a -> a)
232 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
234examples :: PP.Doc
235examples =
236 PP.vcat $ map PP.text
237 [ "Examples:"
238 , " print documentation for Data.List to stdout:"
239 , " psc-docs \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\" \\"
240 , " --docgen Data.List"
241 , ""
242 , " write documentation for Data.List to docs/Data.List.md:"
243 , " psc-docs \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\" \\"
244 , " --docgen Data.List:docs/Data.List.md"
245 , ""
246 , " write documentation for Data.List to docs/Data.List.md, and"
247 , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
248 , " psc-docs \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\" \\"
249 , " --docgen Data.List:docs/Data.List.md \\"
250 , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
251 ]