aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorDavid Waern <unknown>2007-08-17 11:16:48 +0000
committerDavid Waern <unknown>2007-08-17 11:16:48 +0000
commit070a0d9cd70eca65400b9a10fe7b0d45424fe498 (patch)
tree6e8e07e40bcb6d6888445d3f62973190a39844be /src/Main.hs
parent050b525fb33ca60a9e4a374eab19b65d585ab1e8 (diff)
Move options out of Main into Haddock.Options
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs125
1 files changed, 5 insertions, 120 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 0592c6fe..e86cede5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -18,6 +18,7 @@ import Haddock.Utils
import Haddock.Version
import Haddock.InterfaceFile
import Haddock.Exception
+import Haddock.Options
import Haddock.Utils.GHC
import Paths_haddock
@@ -135,10 +136,9 @@ handleGhcExceptions inner =
main :: IO ()
main = handleTopExceptions $ do
- args <- getArgs
- prog <- getProgramName
-- parse command-line flags and handle some of them initially
+ args <- getArgs
(flags, fileArgs) <- parseHaddockOpts args
libDir <- handleFlags flags fileArgs
@@ -178,12 +178,11 @@ main = handleTopExceptions $ do
handleFlags flags fileArgs = do
- prog <- getProgramName
- let byeUsage = bye (usageInfo (usageHeader prog) (options False))
+ usage <- getUsage
- when (Flag_Help `elem` flags) byeUsage
+ when (Flag_Help `elem` flags) (bye usage)
when (Flag_Version `elem` flags) byeVersion
- when (null fileArgs) byeUsage
+ when (null fileArgs) (bye usage)
let ghcLibDir = case [ dir | Flag_GhcLibDir dir <- flags ] of
[] -> throwE "no GHC lib dir specified"
@@ -251,120 +250,6 @@ parseGhcFlags session ghcFlags = do
return dynflags'
-parseHaddockOpts :: [String] -> IO ([Flag], [String])
-parseHaddockOpts words =
- case getOpt Permute (options True) words of
- (flags, args, []) -> return (flags, args)
- (_, _, errors) -> do
- prog <- getProgramName
- throwE (concat errors ++ usageInfo (usageHeader prog) (options False))
-
-
-usageHeader :: String -> String
-usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file...\n"
-
-
-data Flag
- = Flag_CSS String
- | Flag_Debug
--- | Flag_DocBook
- | Flag_DumpInterface String
- | Flag_Heading String
- | Flag_Html
- | Flag_Hoogle
- | Flag_HtmlHelp String
- | Flag_Lib String
- | Flag_NoImplicitPrelude
- | 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_Help
- | Flag_Verbose
- | Flag_Version
- | Flag_UseContents String
- | Flag_GenContents
- | Flag_UseIndex String
- | Flag_GenIndex
- | Flag_IgnoreAllExports
- | Flag_HideModule String
- | Flag_UsePackage String
- | Flag_GhcFlag String
- | Flag_GhcLibDir String
- deriving (Eq)
-
-
-options :: Bool -> [OptDescr Flag]
-options backwardsCompat =
- [
- Option ['B'] [] (ReqArg Flag_GhcLibDir "DIR")
- "path to the GHC lib dir, e.g /usr/lib/ghc",
- 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 ['D'] ["dump-interface"] (ReqArg Flag_DumpInterface "FILE")
- "interface file name",
--- Option ['S'] ["docbook"] (NoArg Flag_DocBook)
--- "output in DocBook XML",
- Option ['h'] ["html"] (NoArg Flag_Html)
- "output in HTML",
- Option [] ["hoogle"] (NoArg Flag_Hoogle)
- "output for Hoogle",
- Option [] ["html-help"] (ReqArg Flag_HtmlHelp "format")
- "produce index and table of contents in\nmshelp, mshelp2 or devhelp format (with -h)",
- 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} or %{NAME} 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} or %{NAME} vars)",
- Option ['c'] ["css"] (ReqArg Flag_CSS "FILE")
- "the CSS file to use for HTML output",
- Option ['p'] ["prologue"] (ReqArg Flag_Prologue "FILE")
- "file containing prologue text",
- Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE")
- "page heading",
- Option ['n'] ["no-implicit-prelude"] (NoArg Flag_NoImplicitPrelude)
- "do not assume Prelude is imported",
- Option ['d'] ["debug"] (NoArg Flag_Debug)
- "extra debugging output",
- Option ['?'] ["help"] (NoArg Flag_Help)
- "display this help and exit",
- Option ['V'] ["version"] (NoArg Flag_Version)
- "output version information and exit",
- Option ['v'] ["verbose"] (NoArg Flag_Verbose)
- "increase verbosity",
- 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 [] ["use-package"] (ReqArg Flag_UsePackage "PACKAGE")
- "the modules being processed depend on PACKAGE",
- Option ['g'] [] (ReqArg Flag_GhcFlag "FLAGS + ARGS")
- ("send a flag to the Glasgow Haskell Compiler (use quotation to "
- ++ "pass arguments to the flag)")
- ]
-
byeVersion =
bye ("Haddock version " ++ projectVersion ++