diff options
author | panne <unknown> | 2003-08-26 19:01:19 +0000 |
---|---|---|
committer | panne <unknown> | 2003-08-26 19:01:19 +0000 |
commit | 32e889cbe0d011daad4cd22f2be67acc768d2827 (patch) | |
tree | 866b07f8e1aebb9002271772830af7a91eeff1b0 /src/Main.hs | |
parent | 6bbdadb769912b622b6d47ea7129a411d8bb3a19 (diff) |
[haddock @ 2003-08-26 19:01:18 by panne]
Made option handling a bit more consistent with other tools, in
particular: Every program in fptools should output
* version info on stdout and terminate successfully when -V or --version
* usage info on stdout and terminate successfully when -? or --help
* usage info on stderr and terminate unsuccessfully when an unknown option
is given.
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 34 |
1 files changed, 20 insertions, 14 deletions
diff --git a/src/Main.hs b/src/Main.hs index d0a1721e..9954cadd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -56,11 +56,12 @@ main = do cmdline <- getArgs case getOpt Permute options cmdline of (flags, args, [] ) -> run flags args - (_, _, errors) -> do sequence_ (map putStr errors) - putStr usage + (_, _, errors) -> do prog <- getProgName + die (concat errors ++ + usageInfo (usageHeader prog) options) -usage :: String -usage = usageInfo "usage: haddock [OPTION] file...\n" options +usageHeader :: String -> String +usageHeader prog = prog ++ " [OPTION...] file...\n" data Flag = Flag_CSS String @@ -76,7 +77,8 @@ data Flag | Flag_Prologue FilePath | Flag_ReadInterface FilePath | Flag_SourceURL String - | Flag_Verbose + | Flag_Help + | Flag_Version deriving (Eq) options :: [OptDescr Flag] @@ -96,8 +98,6 @@ options = "base URL for links to source code", Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE") "page heading", - Option ['v'] ["verbose"] (NoArg Flag_Verbose) - "be verbose", Option ['i'] ["read-interface"] (ReqArg Flag_ReadInterface "FILE") "read an interface from FILE", Option [] ["css"] (ReqArg Flag_CSS "FILE") @@ -109,7 +109,11 @@ options = Option [] ["ms-help"] (NoArg Flag_MSHtmlHelp) "Produce Microsoft HTML Help files (with -h)", Option [] ["no-implicit-prelude"] (NoArg Flag_NoImplicitPrelude) - "Do not assume Prelude is imported" + "Do not assume Prelude is imported", + Option ['?'] ["help"] (NoArg Flag_Help) + "display this help and exit", + Option ['V'] ["version"] (NoArg Flag_Version) + "output version information and exit" ] saved_flags :: IORef [Flag] @@ -117,6 +121,11 @@ saved_flags = unsafePerformIO (newIORef (error "no flags yet")) run :: [Flag] -> [FilePath] -> IO () run flags files = do + when (Flag_Help `elem` flags) $ do + prog <- getProgName + putStrLn (usageInfo (usageHeader prog) options) + exitWith ExitSuccess + let title = case [str | Flag_Heading str <- flags] of [] -> "" (t:_) -> t @@ -125,10 +134,8 @@ run flags files = do [] -> Nothing (t:_) -> Just t - when (Flag_Verbose `elem` flags) $ - hPutStrLn stderr - ("Haddock version " ++ projectVersion ++ - ", (c) Simon Marlow 2002") + when (Flag_Version `elem` flags) $ + putStrLn ("Haddock version " ++ projectVersion ++ ", (c) Simon Marlow 2002") libdir <- case [str | Flag_Lib str <- flags] of [] -> dieMsg "no --lib option" @@ -257,8 +264,7 @@ parse_file file = do (\h -> do stuff <- hGetContents h case parse stuff (SrcLoc 1 1) 1 0 [] of Ok _ e -> return e - Failed err -> do hPutStrLn stderr (file ++ ':':err) - exitWith (ExitFailure 1) + Failed err -> die (file ++ ':':err) ) getPrologue :: [Flag] -> IO (Maybe Doc) |