git.iko.soy/rowtype-yoga/purescript-native
on c193571 help sign in
rowtype-yoga/purescript-native/psc-docs/Main.hs
251 lines 8.6 kB history raw
1{-# LANGUAGE TupleSections #-}
2----------------------------------------------------------------------------
3--
4-- Module : Main
5-- Copyright : (c) Phil Freeman 2013
6-- License : MIT
7--
8-- Maintainer : Phil Freeman <paf31@cantab.net>
9-- Stability : experimental
10-- Portability :
11--
12-- |
13--
14-----------------------------------------------------------------------------
16module Main where
18import Control.Applicative
19import Control.Arrow (first, second)
20import Control.Category ((>>>))
21import Control.Monad.Writer
22import Data.Function (on)
23import Data.List
24import Data.Maybe (fromMaybe)
25import Data.Tuple (swap)
26import Data.Version (showVersion)
28import Options.Applicative
29import qualified Text.PrettyPrint.ANSI.Leijen as PP
31import qualified Language.PureScript as P
32import qualified Paths_purescript as Paths
33import System.Exit (exitFailure)
34import System.IO (hPutStrLn, stderr)
35import System.Directory (createDirectoryIfMissing)
36import System.FilePath (takeDirectory)
37import System.FilePath.Glob (glob)
39import Etags
40import Ctags
41import qualified Language.PureScript.Docs as D
42import qualified Language.PureScript.Docs.AsMarkdown as D
44-- Available output formats
45data Format = Markdown -- Output documentation in Markdown format
46 | Ctags -- Output ctags symbol index suitable for use with vi
47 | Etags -- Output etags symbol index suitable for use with emacs
48 deriving (Show, Eq, Ord)
50-- | Available methods of outputting Markdown documentation
51data DocgenOutput
52 = EverythingToStdOut
53 | ToStdOut [P.ModuleName]
54 | ToFiles [(P.ModuleName, FilePath)]
55 deriving (Show)
57data PSCDocsOptions = PSCDocsOptions
58 { pscdFormat :: Format
59 , pscdInputFiles :: [FilePath]
60 , pscdDocgen :: DocgenOutput
61 }
62 deriving (Show)
64docgen :: PSCDocsOptions -> IO ()
65docgen (PSCDocsOptions fmt inputGlob output) = do
66 input <- concat <$> mapM glob inputGlob
67 case fmt of
68 Etags -> dumpTags input dumpEtags
69 Ctags -> dumpTags input dumpCtags
70 Markdown -> do
71 e <- D.parseAndDesugar input [] (\_ ms -> return ms)
72 case e of
73 Left (D.ParseError err) -> do
74 hPutStrLn stderr $ show err
75 exitFailure
76 Left (D.SortModulesError err) -> do
77 hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
78 exitFailure
79 Left (D.DesugarError err) -> do
80 hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
81 exitFailure
82 Right ms' ->
83 case output of
84 EverythingToStdOut ->
85 putStrLn (D.renderModulesAsMarkdown ms')
86 ToStdOut names -> do
87 let (ms, missing) = takeModulesByName ms' names
88 guardMissing missing
89 putStrLn (D.renderModulesAsMarkdown ms)
90 ToFiles names -> do
91 let (ms, missing) = takeModulesByName' ms' names
92 guardMissing missing
93 let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
94 forM_ ms'' $ \grp -> do
95 let fp = fst (head grp)
96 createDirectoryIfMissing True (takeDirectory fp)
97 writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
98 where
99 guardMissing [] = return ()
100 guardMissing [mn] = do
101 hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
102 exitFailure
103 guardMissing mns = do
104 hPutStrLn stderr "psc-docs: error: unknown modules:"
105 forM_ mns $ \mn ->
106 hPutStrLn stderr (" * " ++ show mn)
107 exitFailure
109-- |
110-- Given a list of module names and a list of modules, return a list of modules
111-- whose names appeared in the given name list, together with a list of names
112-- for which no module could be found in the module list.
113--
114takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
115takeModulesByName modules names =
116 first (map fst) (takeModulesByName' modules (map (,()) names))
118-- |
119-- Like takeModulesByName but also keeps some extra data with the module.
120--
121takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
122takeModulesByName' modules = foldl go ([], [])
123 where
124 go (ms, missing) (name, x) =
125 case find ((== name) . P.getModuleName) modules of
126 Just m -> ((m, x) : ms, missing)
127 Nothing -> (ms, name : missing)
129dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
130dumpTags input renderTags = do
131 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
132 case e of
133 Left err -> do
134 hPutStrLn stderr (show err)
135 exitFailure
136 Right ms ->
137 ldump (renderTags (pairs ms))
139 where
140 pairs :: [(Maybe String, m)] -> [(String, m)]
141 pairs = map (first (fromMaybe ""))
143 ldump :: [String] -> IO ()
144 ldump = mapM_ putStrLn
146parseFile :: FilePath -> IO (FilePath, String)
147parseFile input = (,) input <$> readFile input
149inputFile :: Parser FilePath
150inputFile = strArgument $
151 metavar "FILE"
152 <> help "The input .purs file(s)"
154instance Read Format where
155 readsPrec _ "etags" = [(Etags, "")]
156 readsPrec _ "ctags" = [(Ctags, "")]
157 readsPrec _ "markdown" = [(Markdown, "")]
158 readsPrec _ _ = []
160format :: Parser Format
161format = option auto $ value Markdown
162 <> long "format"
163 <> metavar "FORMAT"
164 <> help "Set output FORMAT (markdown | etags | ctags)"
166docgenModule :: Parser String
167docgenModule = strOption $
168 long "docgen"
169 <> 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."
171pscDocsOptions :: Parser (Format, [FilePath], [String])
172pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
174parseDocgen :: [String] -> Either String DocgenOutput
175parseDocgen [] = Right EverythingToStdOut
176parseDocgen xs = go xs
177 where
178 go = intersperse " "
179 >>> concat
180 >>> words
181 >>> map parseItem
182 >>> combine
184data DocgenOutputItem
185 = IToStdOut P.ModuleName
186 | IToFile (P.ModuleName, FilePath)
188parseItem :: String -> DocgenOutputItem
189parseItem s = case elemIndex ':' s of
190 Just i ->
191 s # splitAt i
192 >>> first P.moduleNameFromString
193 >>> second (drop 1)
194 >>> IToFile
195 Nothing ->
196 IToStdOut (P.moduleNameFromString s)
198 where
199 infixr 1 #
200 (#) = flip ($)
202combine :: [DocgenOutputItem] -> Either String DocgenOutput
203combine [] = Right EverythingToStdOut
204combine (x:xs) = foldM go (initial x) xs
205 where
206 initial (IToStdOut m) = ToStdOut [m]
207 initial (IToFile m) = ToFiles [m]
209 go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
210 go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
211 go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
213buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
214buildOptions (fmt, input, mapping) =
215 case parseDocgen mapping of
216 Right mapping' -> return (PSCDocsOptions fmt input mapping')
217 Left err -> do
218 hPutStrLn stderr "psc-docs: error in --docgen option:"
219 hPutStrLn stderr (" " ++ err)
220 exitFailure
222main :: IO ()
223main = 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 bower_components/*/src/**/*.purs \\"
240 , " --docgen Data.List"
241 , ""
242 , " write documentation for Data.List to docs/Data.List.md:"
243 , " psc-docs src/**/*.purs bower_components/*/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 bower_components/*/src/**/*.purs \\"
249 , " --docgen Data.List:docs/Data.List.md \\"
250 , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
251 ]