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