1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
|
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Options
-- Copyright : (c) Simon Marlow 2003-2006,
-- David Waern 2006-2009
-- License : BSD-like
--
-- Maintainer : haddock@projects.haskell.org
-- Stability : experimental
-- Portability : portable
--
-- Definition of the command line interface of Haddock.
-----------------------------------------------------------------------------
module Haddock.Options (
parseHaddockOpts,
Flag(..),
getUsage,
optTitle,
outputDir,
optContentsUrl,
optIndexUrl,
optCssFile,
sourceUrls,
wikiUrls,
optDumpInterfaceFile,
optLaTeXStyle,
qualification,
verbosity,
ghcFlags,
readIfaceArgs
) where
import Data.Maybe
import Distribution.Verbosity
import Haddock.Utils
import Haddock.Types
import System.Console.GetOpt
import qualified Data.Char as Char
data Flag
= Flag_BuiltInThemes
| Flag_CSS String
-- | Flag_DocBook
| Flag_ReadInterface String
| Flag_DumpInterface String
| Flag_Heading String
| Flag_Html
| Flag_Hoogle
| Flag_Lib String
| Flag_OutputDir FilePath
| Flag_Prologue FilePath
| Flag_SourceBaseURL String
| Flag_SourceModuleURL String
| Flag_SourceEntityURL String
| Flag_WikiBaseURL String
| Flag_WikiModuleURL String
| Flag_WikiEntityURL String
| Flag_LaTeX
| Flag_LaTeXStyle String
| Flag_Help
| Flag_Verbosity String
| Flag_Version
| Flag_InterfaceVersion
| Flag_UseContents String
| Flag_GenContents
| Flag_UseIndex String
| Flag_GenIndex
| Flag_IgnoreAllExports
| Flag_HideModule String
| Flag_OptGhc String
| Flag_GhcLibDir String
| Flag_GhcVersion
| Flag_PrintGhcPath
| Flag_PrintGhcLibDir
| Flag_NoWarnings
| Flag_UseUnicode
| Flag_NoTmpCompDir
| Flag_Qualification String
| Flag_PrettyHtml
deriving (Eq)
options :: Bool -> [OptDescr Flag]
options backwardsCompat =
[
Option ['B'] [] (ReqArg Flag_GhcLibDir "DIR")
"path to a GHC lib dir, to override the default path",
Option ['o'] ["odir"] (ReqArg Flag_OutputDir "DIR")
"directory in which to put the output files",
Option ['l'] ["lib"] (ReqArg Flag_Lib "DIR")
"location of Haddock's auxiliary files",
Option ['i'] ["read-interface"] (ReqArg Flag_ReadInterface "FILE")
"read an interface from FILE",
Option ['D'] ["dump-interface"] (ReqArg Flag_DumpInterface "FILE")
"write the resulting interface to FILE",
-- Option ['S'] ["docbook"] (NoArg Flag_DocBook)
-- "output in DocBook XML",
Option ['h'] ["html"] (NoArg Flag_Html)
"output in HTML (XHTML 1.0)",
Option [] ["latex"] (NoArg Flag_LaTeX) "use experimental LaTeX rendering",
Option [] ["latex-style"] (ReqArg Flag_LaTeXStyle "FILE") "provide your own LaTeX style in FILE",
Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output",
Option [] ["hoogle"] (NoArg Flag_Hoogle)
"output for Hoogle",
Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL")
"URL for a source code link on the contents\nand index pages",
Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"])
(ReqArg Flag_SourceModuleURL "URL")
"URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)",
Option [] ["source-entity"] (ReqArg Flag_SourceEntityURL "URL")
"URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
Option [] ["comments-base"] (ReqArg Flag_WikiBaseURL "URL")
"URL for a comments link on the contents\nand index pages",
Option [] ["comments-module"] (ReqArg Flag_WikiModuleURL "URL")
"URL for a comments link for each module\n(using the %{MODULE} var)",
Option [] ["comments-entity"] (ReqArg Flag_WikiEntityURL "URL")
"URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
Option ['c'] ["css", "theme"] (ReqArg Flag_CSS "PATH")
"the CSS file or theme directory to use for HTML output",
Option [] ["built-in-themes"] (NoArg Flag_BuiltInThemes)
"include all the built-in haddock themes",
Option ['p'] ["prologue"] (ReqArg Flag_Prologue "FILE")
"file containing prologue text",
Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE")
"page heading",
Option ['q'] ["qual"] (ReqArg Flag_Qualification "QUAL")
"qualification of names, one of \n'none' (default), 'full', 'local'\nor 'relative'",
Option ['?'] ["help"] (NoArg Flag_Help)
"display this help and exit",
Option ['V'] ["version"] (NoArg Flag_Version)
"output version information and exit",
Option [] ["interface-version"] (NoArg Flag_InterfaceVersion)
"output interface file version and exit",
Option ['v'] ["verbosity"] (ReqArg Flag_Verbosity "VERBOSITY")
"set verbosity level",
Option [] ["use-contents"] (ReqArg Flag_UseContents "URL")
"use a separately-generated HTML contents page",
Option [] ["gen-contents"] (NoArg Flag_GenContents)
"generate an HTML contents from specified\ninterfaces",
Option [] ["use-index"] (ReqArg Flag_UseIndex "URL")
"use a separately-generated HTML index",
Option [] ["gen-index"] (NoArg Flag_GenIndex)
"generate an HTML index from specified\ninterfaces",
Option [] ["ignore-all-exports"] (NoArg Flag_IgnoreAllExports)
"behave as if all modules have the\nignore-exports atribute",
Option [] ["hide"] (ReqArg Flag_HideModule "MODULE")
"behave as if MODULE has the hide attribute",
Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION")
"option to be forwarded to GHC",
Option [] ["ghc-version"] (NoArg Flag_GhcVersion)
"output GHC version in numeric format",
Option [] ["print-ghc-path"] (NoArg Flag_PrintGhcPath)
"output path to GHC binary",
Option [] ["print-ghc-libdir"] (NoArg Flag_PrintGhcLibDir)
"output GHC lib dir",
Option ['w'] ["no-warnings"] (NoArg Flag_NoWarnings) "turn off all warnings",
Option [] ["no-tmp-comp-dir"] (NoArg Flag_NoTmpCompDir)
"do not re-direct compilation output to a temporary directory",
Option [] ["pretty-html"] (NoArg Flag_PrettyHtml)
"generate html with newlines and indenting (for use with --html)"
]
getUsage :: IO String
getUsage = do
prog <- getProgramName
return $ usageInfo (usageHeader prog) (options False)
where
usageHeader :: String -> String
usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file...\n"
parseHaddockOpts :: [String] -> IO ([Flag], [String])
parseHaddockOpts params =
case getOpt Permute (options True) params of
(flags, args, []) -> return (flags, args)
(_, _, errors) -> do
usage <- getUsage
throwE (concat errors ++ usage)
optTitle :: [Flag] -> Maybe String
optTitle flags =
case [str | Flag_Heading str <- flags] of
[] -> Nothing
(t:_) -> Just t
outputDir :: [Flag] -> FilePath
outputDir flags =
case [ path | Flag_OutputDir path <- flags ] of
[] -> "."
paths -> last paths
optContentsUrl :: [Flag] -> Maybe String
optContentsUrl flags = optLast [ url | Flag_UseContents url <- flags ]
optIndexUrl :: [Flag] -> Maybe String
optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ]
optCssFile :: [Flag] -> Maybe FilePath
optCssFile flags = optLast [ str | Flag_CSS str <- flags ]
sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)
sourceUrls flags =
(listToMaybe [str | Flag_SourceBaseURL str <- flags]
,listToMaybe [str | Flag_SourceModuleURL str <- flags]
,listToMaybe [str | Flag_SourceEntityURL str <- flags])
wikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)
wikiUrls flags =
(listToMaybe [str | Flag_WikiBaseURL str <- flags]
,listToMaybe [str | Flag_WikiModuleURL str <- flags]
,listToMaybe [str | Flag_WikiEntityURL str <- flags])
optDumpInterfaceFile :: [Flag] -> Maybe FilePath
optDumpInterfaceFile flags = optLast [ str | Flag_DumpInterface str <- flags ]
optLaTeXStyle :: [Flag] -> Maybe String
optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ]
qualification :: [Flag] -> Qualification
qualification flags =
case map (map Char.toLower) [ str | Flag_Qualification str <- flags ] of
"full":_ -> FullQual
"local":_ -> LocalQual Nothing
"relative":_ -> RelativeQual Nothing
_ -> NoQual
verbosity :: [Flag] -> Verbosity
verbosity flags =
case [ str | Flag_Verbosity str <- flags ] of
[] -> normal
x:_ -> case parseVerbosity x of
Left e -> throwE e
Right v -> v
ghcFlags :: [Flag] -> [String]
ghcFlags flags = [ option | Flag_OptGhc option <- flags ]
readIfaceArgs :: [Flag] -> [(DocPaths, FilePath)]
readIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ]
where
parseIfaceOption :: String -> (DocPaths, FilePath)
parseIfaceOption str =
case break (==',') str of
(fpath, ',':rest) ->
case break (==',') rest of
(src, ',':file) -> ((fpath, Just src), file)
(file, _) -> ((fpath, Nothing), file)
(file, _) -> (("", Nothing), file)
-- | Like 'listToMaybe' but returns the last element instead of the first.
optLast :: [a] -> Maybe a
optLast [] = Nothing
optLast xs = Just (last xs)
|
