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_ReadInterface String
| Flag_DumpInterface String
| Flag_Heading String
| Flag_Html
| Flag_Hoogle
| Flag_Annot FilePath
| 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_UseContents String
| Flag_GenContents
| Flag_UseIndex String
| Flag_GenIndex
| Flag_IgnoreAllExports
| Flag_HideModule String
| Flag_OptGhc String
| Flag_GhcLibDir String
| Flag_GhcVersion
| Flag_PrintGhcLibDir
| Flag_NoWarnings
| Flag_UseUnicode
| Flag_NoTmpCompDir
| Flag_Qualification String
| Flag_PrettyHtml
deriving (D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq)
options :: Bool -> [OptDescr Flag]
options backwardsCompat =
[
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['B'] [] :: [a][] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_GhcLibDir :: String -> FlagFlag_GhcLibDir "DIR")
"path to a GHC lib dir, to override the default path",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['o'] ["odir"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_OutputDir :: FilePath -> FlagFlag_OutputDir "DIR")
"directory in which to put the output files",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['l'] ["lib"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_Lib :: String -> FlagFlag_Lib "DIR")
"location of Haddock's auxiliary files",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['i'] ["read-interface"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_ReadInterface :: String -> FlagFlag_ReadInterface "FILE")
"read an interface from FILE",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['D'] ["dump-interface"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_DumpInterface :: String -> FlagFlag_DumpInterface "FILE")
"write the resulting interface to FILE",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['h'] ["html"] (NoArg :: a -> ArgDescr aNoArg Flag_Html :: FlagFlag_Html)
"output in HTML (XHTML 1.0)",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["latex"] (NoArg :: a -> ArgDescr aNoArg Flag_LaTeX :: FlagFlag_LaTeX) "use experimental LaTeX rendering",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["latex-style"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_LaTeXStyle :: String -> FlagFlag_LaTeXStyle "FILE") "provide your own LaTeX style in FILE",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['U'] ["use-unicode"] (NoArg :: a -> ArgDescr aNoArg Flag_UseUnicode :: FlagFlag_UseUnicode) "use Unicode in HTML output",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["hoogle"] (NoArg :: a -> ArgDescr aNoArg Flag_Hoogle :: FlagFlag_Hoogle)
"output for Hoogle",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["annot"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_Annot :: FilePath -> FlagFlag_Annot "FILE") "output type annotations",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["source-base"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_SourceBaseURL :: String -> FlagFlag_SourceBaseURL "URL")
"URL for a source code link on the contents\nand index pages",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['s'] (if backwardsCompat :: BoolbackwardsCompat then ["source", "source-module"] else ["source-module"])
(ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_SourceModuleURL :: String -> FlagFlag_SourceModuleURL "URL")
"URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["source-entity"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_SourceEntityURL :: String -> FlagFlag_SourceEntityURL "URL")
"URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["comments-base"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_WikiBaseURL :: String -> FlagFlag_WikiBaseURL "URL")
"URL for a comments link on the contents\nand index pages",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["comments-module"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_WikiModuleURL :: String -> FlagFlag_WikiModuleURL "URL")
"URL for a comments link for each module\n(using the %{MODULE} var)",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["comments-entity"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_WikiEntityURL :: String -> FlagFlag_WikiEntityURL "URL")
"URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['c'] ["css", "theme"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_CSS :: String -> FlagFlag_CSS "PATH")
"the CSS file or theme directory to use for HTML output",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["built-in-themes"] (NoArg :: a -> ArgDescr aNoArg Flag_BuiltInThemes :: FlagFlag_BuiltInThemes)
"include all the built-in haddock themes",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['p'] ["prologue"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_Prologue :: FilePath -> FlagFlag_Prologue "FILE")
"file containing prologue text",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['t'] ["title"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_Heading :: String -> FlagFlag_Heading "TITLE")
"page heading",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['q'] ["qual"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_Qualification :: String -> FlagFlag_Qualification "QUAL")
"qualification of names, one of \n'none' (default), 'full', 'local'\nor 'relative'",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['?'] ["help"] (NoArg :: a -> ArgDescr aNoArg Flag_Help :: FlagFlag_Help)
"display this help and exit",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['V'] ["version"] (NoArg :: a -> ArgDescr aNoArg Flag_Version :: FlagFlag_Version)
"output version information and exit",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['v'] ["verbosity"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_Verbosity :: String -> FlagFlag_Verbosity "VERBOSITY")
"set verbosity level",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["use-contents"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_UseContents :: String -> FlagFlag_UseContents "URL")
"use a separately-generated HTML contents page",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["gen-contents"] (NoArg :: a -> ArgDescr aNoArg Flag_GenContents :: FlagFlag_GenContents)
"generate an HTML contents from specified\ninterfaces",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["use-index"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_UseIndex :: String -> FlagFlag_UseIndex "URL")
"use a separately-generated HTML index",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["gen-index"] (NoArg :: a -> ArgDescr aNoArg Flag_GenIndex :: FlagFlag_GenIndex)
"generate an HTML index from specified\ninterfaces",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["ignore-all-exports"] (NoArg :: a -> ArgDescr aNoArg Flag_IgnoreAllExports :: FlagFlag_IgnoreAllExports)
"behave as if all modules have the\nignore-exports atribute",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["hide"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_HideModule :: String -> FlagFlag_HideModule "MODULE")
"behave as if MODULE has the hide attribute",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["optghc"] (ReqArg :: (String -> a) -> String -> ArgDescr aReqArg Flag_OptGhc :: String -> FlagFlag_OptGhc "OPTION")
"option to be forwarded to GHC",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["ghc-version"] (NoArg :: a -> ArgDescr aNoArg Flag_GhcVersion :: FlagFlag_GhcVersion)
"output GHC version in numeric format",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["print-ghc-libdir"] (NoArg :: a -> ArgDescr aNoArg Flag_PrintGhcLibDir :: FlagFlag_PrintGhcLibDir)
"output GHC lib dir",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption ['w'] ["no-warnings"] (NoArg :: a -> ArgDescr aNoArg Flag_NoWarnings :: FlagFlag_NoWarnings) "turn off all warnings",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["no-tmp-comp-dir"] (NoArg :: a -> ArgDescr aNoArg Flag_NoTmpCompDir :: FlagFlag_NoTmpCompDir)
"do not re-direct compilation output to a temporary directory",
Option :: [Char] -> [String] -> ArgDescr a -> String -> OptDescr aOption [] :: [a][] ["pretty-html"] (NoArg :: a -> ArgDescr aNoArg Flag_PrettyHtml :: FlagFlag_PrettyHtml)
"generate html with newlines and indenting (for use with --html)"
]
getUsage :: IO String
getUsage = do
prog <- getProgramName :: IO StringgetProgramName
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ usageInfo :: String -> [OptDescr a] -> StringusageInfo (usageHeader :: String -> StringusageHeader prog :: Stringprog) (options :: Bool -> [OptDescr Flag]options False :: BoolFalse)
where
usageHeader :: String -> String
usageHeader prog = "Usage: " (++) :: [a] -> [a] -> [a]++ prog :: Stringprog (++) :: [a] -> [a] -> [a]++ " [OPTION...] file...\n"
parseHaddockOpts :: [String] -> IO ([Flag], [String])
parseHaddockOpts params =
case getOpt ::
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])getOpt Permute :: ArgOrder aPermute (options :: Bool -> [OptDescr Flag]options True :: BoolTrue) params :: [String]params of
(flags, args, []) -> return :: Monad m => forall a. a -> m areturn (flags :: [Flag]flags, args :: [String]args)
(_, _, errors) -> do
usage <- getUsage :: IO StringgetUsage
throwE :: String -> athrowE (concat :: [[a]] -> [a]concat errors :: [String]errors (++) :: [a] -> [a] -> [a]++ usage :: Stringusage)
optTitle :: [Flag] -> Maybe String
optTitle flags =
case [str :: Stringstr | Flag_Heading str <- flags :: [Flag]flags] of
[] -> Nothing :: Maybe aNothing
(t:_) -> Just :: a -> Maybe aJust t :: Stringt
outputDir :: [Flag] -> FilePath
outputDir flags =
case [ path :: FilePathpath | Flag_OutputDir path <- flags :: [Flag]flags ] of
[] -> "."
paths -> last :: [a] -> alast paths :: [FilePath]paths
optContentsUrl :: [Flag] -> Maybe String
optContentsUrl flags = optLast :: [a] -> Maybe aoptLast [ url :: Stringurl | Flag_UseContents url <- flags :: [Flag]flags ]
optIndexUrl :: [Flag] -> Maybe String
optIndexUrl flags = optLast :: [a] -> Maybe aoptLast [ url :: Stringurl | Flag_UseIndex url <- flags :: [Flag]flags ]
optCssFile :: [Flag] -> Maybe FilePath
optCssFile flags = optLast :: [a] -> Maybe aoptLast [ str :: Stringstr | Flag_CSS str <- flags :: [Flag]flags ]
sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)
sourceUrls flags =
(listToMaybe :: [a] -> Maybe alistToMaybe [str :: Stringstr | Flag_SourceBaseURL str <- flags :: [Flag]flags]
,listToMaybe :: [a] -> Maybe alistToMaybe [str :: Stringstr | Flag_SourceModuleURL str <- flags :: [Flag]flags]
,listToMaybe :: [a] -> Maybe alistToMaybe [str :: Stringstr | Flag_SourceEntityURL str <- flags :: [Flag]flags])
wikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)
wikiUrls flags =
(listToMaybe :: [a] -> Maybe alistToMaybe [str :: Stringstr | Flag_WikiBaseURL str <- flags :: [Flag]flags]
,listToMaybe :: [a] -> Maybe alistToMaybe [str :: Stringstr | Flag_WikiModuleURL str <- flags :: [Flag]flags]
,listToMaybe :: [a] -> Maybe alistToMaybe [str :: Stringstr | Flag_WikiEntityURL str <- flags :: [Flag]flags])
optDumpInterfaceFile :: [Flag] -> Maybe FilePath
optDumpInterfaceFile flags = optLast :: [a] -> Maybe aoptLast [ str :: Stringstr | Flag_DumpInterface str <- flags :: [Flag]flags ]
optLaTeXStyle :: [Flag] -> Maybe String
optLaTeXStyle flags = optLast :: [a] -> Maybe aoptLast [ str :: Stringstr | Flag_LaTeXStyle str <- flags :: [Flag]flags ]
qualification :: [Flag] -> Qualification
qualification flags =
case map :: (a -> b) -> [a] -> [b]map (map :: (a -> b) -> [a] -> [b]map toLower :: Char -> CharChar.toLower) [ str :: Stringstr | Flag_Qualification str <- flags :: [Flag]flags ] of
"full":_ -> FullQual :: QualificationFullQual
"local":_ -> LocalQual :: Maybe Module -> QualificationLocalQual Nothing :: Maybe aNothing
"relative":_ -> RelativeQual :: Maybe Module -> QualificationRelativeQual Nothing :: Maybe aNothing
_ -> NoQual :: QualificationNoQual
verbosity :: [Flag] -> Verbosity
verbosity flags =
case [ str :: Stringstr | Flag_Verbosity str <- flags :: [Flag]flags ] of
[] -> normal :: Verbositynormal
x:_ -> case parseVerbosity :: String -> Either String VerbosityparseVerbosity x :: Stringx of
Left e -> throwE :: String -> athrowE e :: Stringe
Right v -> v :: Verbosityv
ghcFlags :: [Flag] -> [String]
ghcFlags flags = [ option :: Stringoption | Flag_OptGhc option <- flags :: [Flag]flags ]
readIfaceArgs :: [Flag] -> [(DocPaths, FilePath)]
readIfaceArgs flags = [ parseIfaceOption :: String -> (DocPaths, FilePath)parseIfaceOption s :: Strings | Flag_ReadInterface s <- flags :: [Flag]flags ]
where
parseIfaceOption :: String -> (DocPaths, FilePath)
parseIfaceOption str =
case break :: (a -> Bool) -> [a] -> ([a], [a])break ((==) :: Eq a => a -> a -> Bool==',') str :: Stringstr of
(fpath, ',':rest) ->
case break :: (a -> Bool) -> [a] -> ([a], [a])break ((==) :: Eq a => a -> a -> Bool==',') rest :: [Char]rest of
(src, ',':file) -> ((fpath :: [Char]fpath, Just :: a -> Maybe aJust src :: [Char]src), file :: [Char]file)
(file, _) -> ((fpath :: [Char]fpath, Nothing :: Maybe aNothing), file :: [Char]file)
(file, _) -> (("", Nothing :: Maybe aNothing), file :: [Char]file)
optLast :: [a] -> Maybe a
optLast [] = Nothing :: Maybe aNothing
optLast xs = Just :: a -> Maybe aJust (last :: [a] -> alast xs :: [a]xs)