git.iko.soy/rowtype-yoga/purescript-native
on 89121bb help sign in
rowtype-yoga/purescript-native/psc-docs/Main.hs
249 lines 8.5 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)
38import Etags
39import Ctags
40import qualified Language.PureScript.Docs as D
41import qualified Language.PureScript.Docs.AsMarkdown as D
43-- Available output formats
44data Format = Markdown -- Output documentation in Markdown format
45 | Ctags -- Output ctags symbol index suitable for use with vi
46 | Etags -- Output etags symbol index suitable for use with emacs
47 deriving (Show, Eq, Ord)
49-- | Available methods of outputting Markdown documentation
50data DocgenOutput
51 = EverythingToStdOut
52 | ToStdOut [P.ModuleName]
53 | ToFiles [(P.ModuleName, FilePath)]
54 deriving (Show)
56data PSCDocsOptions = PSCDocsOptions
57 { pscdFormat :: Format
58 , pscdInputFiles :: [FilePath]
59 , pscdDocgen :: DocgenOutput
60 }
61 deriving (Show)
63docgen :: PSCDocsOptions -> IO ()
64docgen (PSCDocsOptions fmt input output) =
65 case fmt of
66 Etags -> dumpTags input dumpEtags
67 Ctags -> dumpTags input dumpCtags
68 Markdown -> do
69 e <- D.parseAndDesugar input [] (\_ ms -> return ms)
70 case e of
71 Left (D.ParseError err) -> do
72 hPutStrLn stderr $ show err
73 exitFailure
74 Left (D.SortModulesError err) -> do
75 hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
76 exitFailure
77 Left (D.DesugarError err) -> do
78 hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
79 exitFailure
80 Right ms' ->
81 case output of
82 EverythingToStdOut ->
83 putStrLn (D.renderModulesAsMarkdown ms')
84 ToStdOut names -> do
85 let (ms, missing) = takeModulesByName ms' names
86 guardMissing missing
87 putStrLn (D.renderModulesAsMarkdown ms)
88 ToFiles names -> do
89 let (ms, missing) = takeModulesByName' ms' names
90 guardMissing missing
91 let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
92 forM_ ms'' $ \grp -> do
93 let fp = fst (head grp)
94 createDirectoryIfMissing True (takeDirectory fp)
95 writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
96 where
97 guardMissing [] = return ()
98 guardMissing [mn] = do
99 hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
100 exitFailure
101 guardMissing mns = do
102 hPutStrLn stderr "psc-docs: error: unknown modules:"
103 forM_ mns $ \mn ->
104 hPutStrLn stderr (" * " ++ show mn)
105 exitFailure
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 :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
113takeModulesByName modules names =
114 first (map fst) (takeModulesByName' modules (map (,()) names))
116-- |
117-- Like takeModulesByName but also keeps some extra data with the module.
118--
119takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
120takeModulesByName' modules = foldl go ([], [])
121 where
122 go (ms, missing) (name, x) =
123 case find ((== name) . P.getModuleName) modules of
124 Just m -> ((m, x) : ms, missing)
125 Nothing -> (ms, name : missing)
127dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
128dumpTags input renderTags = do
129 e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
130 case e of
131 Left err -> do
132 hPutStrLn stderr (show err)
133 exitFailure
134 Right ms ->
135 ldump (renderTags (pairs ms))
137 where
138 pairs :: [(Maybe String, m)] -> [(String, m)]
139 pairs = map (first (fromMaybe ""))
141 ldump :: [String] -> IO ()
142 ldump = mapM_ putStrLn
144parseFile :: FilePath -> IO (FilePath, String)
145parseFile input = (,) input <$> readFile input
147inputFile :: Parser FilePath
148inputFile = strArgument $
149 metavar "FILE"
150 <> help "The input .purs file(s)"
152instance Read Format where
153 readsPrec _ "etags" = [(Etags, "")]
154 readsPrec _ "ctags" = [(Ctags, "")]
155 readsPrec _ "markdown" = [(Markdown, "")]
156 readsPrec _ _ = []
158format :: Parser Format
159format = option auto $ value Markdown
160 <> long "format"
161 <> metavar "FORMAT"
162 <> help "Set output FORMAT (markdown | etags | ctags)"
164docgenModule :: Parser String
165docgenModule = strOption $
166 long "docgen"
167 <> 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."
169pscDocsOptions :: Parser (Format, [FilePath], [String])
170pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
172parseDocgen :: [String] -> Either String DocgenOutput
173parseDocgen [] = Right EverythingToStdOut
174parseDocgen xs = go xs
175 where
176 go = intersperse " "
177 >>> concat
178 >>> words
179 >>> map parseItem
180 >>> combine
182data DocgenOutputItem
183 = IToStdOut P.ModuleName
184 | IToFile (P.ModuleName, FilePath)
186parseItem :: String -> DocgenOutputItem
187parseItem s = case elemIndex ':' s of
188 Just i ->
189 s # splitAt i
190 >>> first P.moduleNameFromString
191 >>> second (drop 1)
192 >>> IToFile
193 Nothing ->
194 IToStdOut (P.moduleNameFromString s)
196 where
197 infixr 1 #
198 (#) = flip ($)
200combine :: [DocgenOutputItem] -> Either String DocgenOutput
201combine [] = Right EverythingToStdOut
202combine (x:xs) = foldM go (initial x) xs
203 where
204 initial (IToStdOut m) = ToStdOut [m]
205 initial (IToFile m) = ToFiles [m]
207 go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
208 go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
209 go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
211buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
212buildOptions (fmt, input, mapping) =
213 case parseDocgen mapping of
214 Right mapping' -> return (PSCDocsOptions fmt input mapping')
215 Left err -> do
216 hPutStrLn stderr "psc-docs: error in --docgen option:"
217 hPutStrLn stderr (" " ++ err)
218 exitFailure
220main :: IO ()
221main = 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 ]