git.iko.soy/rowtype-yoga/purescript-native
on d09d430 help sign in
rowtype-yoga/purescript-native/psc-docs/Main.hs
245 lines 8.3 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 err -> do
74 hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
75 exitFailure
76 Right ms' ->
77 case output of
78 EverythingToStdOut ->
79 putStrLn (D.renderModulesAsMarkdown ms')
80 ToStdOut names -> do
81 let (ms, missing) = takeModulesByName ms' names
82 guardMissing missing
83 putStrLn (D.renderModulesAsMarkdown ms)
84 ToFiles names -> do
85 let (ms, missing) = takeModulesByName' ms' names
86 guardMissing missing
87 let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
88 forM_ ms'' $ \grp -> do
89 let fp = fst (head grp)
90 createDirectoryIfMissing True (takeDirectory fp)
91 writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
92 where
93 guardMissing [] = return ()
94 guardMissing [mn] = do
95 hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
96 exitFailure
97 guardMissing mns = do
98 hPutStrLn stderr "psc-docs: error: unknown modules:"
99 forM_ mns $ \mn ->
100 hPutStrLn stderr (" * " ++ show mn)
101 exitFailure
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 :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
109takeModulesByName modules names =
110 first (map fst) (takeModulesByName' modules (map (,()) names))
112-- |
113-- Like takeModulesByName but also keeps some extra data with the module.
114--
115takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
116takeModulesByName' modules = foldl go ([], [])
117 where
118 go (ms, missing) (name, x) =
119 case find ((== name) . P.getModuleName) modules of
120 Just m -> ((m, x) : ms, missing)
121 Nothing -> (ms, name : missing)
123dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
124dumpTags input renderTags = do
125 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
126 case e of
127 Left err -> do
128 hPutStrLn stderr (show err)
129 exitFailure
130 Right ms ->
131 ldump (renderTags (pairs ms))
133 where
134 pairs :: [(Maybe String, m)] -> [(String, m)]
135 pairs = map (first (fromMaybe ""))
137 ldump :: [String] -> IO ()
138 ldump = mapM_ putStrLn
140parseFile :: FilePath -> IO (FilePath, String)
141parseFile input = (,) input <$> readFile input
143inputFile :: Parser FilePath
144inputFile = strArgument $
145 metavar "FILE"
146 <> help "The input .purs file(s)"
148instance Read Format where
149 readsPrec _ "etags" = [(Etags, "")]
150 readsPrec _ "ctags" = [(Ctags, "")]
151 readsPrec _ "markdown" = [(Markdown, "")]
152 readsPrec _ _ = []
154format :: Parser Format
155format = option auto $ value Markdown
156 <> long "format"
157 <> metavar "FORMAT"
158 <> help "Set output FORMAT (markdown | etags | ctags)"
160docgenModule :: Parser String
161docgenModule = strOption $
162 long "docgen"
163 <> 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."
165pscDocsOptions :: Parser (Format, [FilePath], [String])
166pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
168parseDocgen :: [String] -> Either String DocgenOutput
169parseDocgen [] = Right EverythingToStdOut
170parseDocgen xs = go xs
171 where
172 go = intersperse " "
173 >>> concat
174 >>> words
175 >>> map parseItem
176 >>> combine
178data DocgenOutputItem
179 = IToStdOut P.ModuleName
180 | IToFile (P.ModuleName, FilePath)
182parseItem :: String -> DocgenOutputItem
183parseItem s = case elemIndex ':' s of
184 Just i ->
185 s # splitAt i
186 >>> first P.moduleNameFromString
187 >>> second (drop 1)
188 >>> IToFile
189 Nothing ->
190 IToStdOut (P.moduleNameFromString s)
192 where
193 infixr 1 #
194 (#) = flip ($)
196combine :: [DocgenOutputItem] -> Either String DocgenOutput
197combine [] = Right EverythingToStdOut
198combine (x:xs) = foldM go (initial x) xs
199 where
200 initial (IToStdOut m) = ToStdOut [m]
201 initial (IToFile m) = ToFiles [m]
203 go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
204 go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
205 go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
207buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
208buildOptions (fmt, input, mapping) =
209 case parseDocgen mapping of
210 Right mapping' -> return (PSCDocsOptions fmt input mapping')
211 Left err -> do
212 hPutStrLn stderr "psc-docs: error in --docgen option:"
213 hPutStrLn stderr (" " ++ err)
214 exitFailure
216main :: IO ()
217main = execParser opts >>= buildOptions >>= docgen
218 where
219 opts = info (version <*> helper <*> pscDocsOptions) infoModList
220 infoModList = fullDesc <> headerInfo <> footerInfo
221 headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
222 footerInfo = footerDoc $ Just $ PP.vcat
223 [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
225 version :: Parser (a -> a)
226 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
228examples :: PP.Doc
229examples =
230 PP.vcat $ map PP.text
231 [ "Examples:"
232 , " print documentation for Data.List to stdout:"
233 , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
234 , " --docgen Data.List"
235 , ""
236 , " write documentation for Data.List to docs/Data.List.md:"
237 , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
238 , " --docgen Data.List:docs/Data.List.md"
239 , ""
240 , " write documentation for Data.List to docs/Data.List.md, and"
241 , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
242 , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
243 , " --docgen Data.List:docs/Data.List.md \\"
244 , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
245 ]