diff options
| -rw-r--r-- | haddock.cabal | 1 | ||||
| -rw-r--r-- | src/Haddock/Exception.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Options.hs | 131 | ||||
| -rw-r--r-- | src/Main.hs | 125 |
4 files changed, 141 insertions, 122 deletions
diff --git a/haddock.cabal b/haddock.cabal index 2dd9546d..87881708 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -93,4 +93,5 @@ other-modules: Haddock.Utils.GHC Haddock.InterfaceFile Haddock.Exception + Haddock.Options Main diff --git a/src/Haddock/Exception.hs b/src/Haddock/Exception.hs index 73ec2c5d..df6d3236 100644 --- a/src/Haddock/Exception.hs +++ b/src/Haddock/Exception.hs @@ -1,14 +1,16 @@ module Haddock.Exception ( HaddockException, throwE -)where +) where + import Data.Typeable import Control.Exception + data HaddockException = HaddockException String deriving Typeable throwE str = throwDyn (HaddockException str) + instance Show HaddockException where show (HaddockException str) = str - diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs new file mode 100644 index 00000000..18b5597c --- /dev/null +++ b/src/Haddock/Options.hs @@ -0,0 +1,131 @@ +module Haddock.Options ( + parseHaddockOpts, + Flag(..), + getUsage +) where + + +import Haddock.Utils +import Haddock.Exception +import System.Console.GetOpt + + +getUsage :: IO String +getUsage = do + prog <- getProgramName + return $ usageInfo (usageHeader prog) (options False) + + +parseHaddockOpts :: [String] -> IO ([Flag], [String]) +parseHaddockOpts words = + case getOpt Permute (options True) words of + (flags, args, []) -> return (flags, args) + (_, _, errors) -> do + usage <- getUsage + throwE (concat errors ++ usage) + + +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)") + ] 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 ++ |