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