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