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