diff options
| author | David Waern <david.waern@gmail.com> | 2010-05-14 19:06:49 +0000 | 
|---|---|---|
| committer | David Waern <david.waern@gmail.com> | 2010-05-14 19:06:49 +0000 | 
| commit | 111dc76375fe87cd98ece8c6c3e95c666b1b3007 (patch) | |
| tree | 3697fc02f0bd4e04af19b38e2c4d288f1e3ae64e /src/Haddock | |
| parent | 3c258e7377f8bf546b58a26a65e8da83c76acb43 (diff) | |
Re-order things in Haddock.Options a bit
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Options.hs | 154 | 
1 files changed, 77 insertions, 77 deletions
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs index 1c194166..2b39aadf 100644 --- a/src/Haddock/Options.hs +++ b/src/Haddock/Options.hs @@ -34,83 +34,6 @@ import Haddock.Types  import System.Console.GetOpt  -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 ] - - -optHtmlHelpFormat :: [Flag] -> Maybe String -optHtmlHelpFormat flags = optLast [ hhformat | Flag_HtmlHelp hhformat <- flags ] - - -optCssFile :: [Flag] -> Maybe FilePath -optCssFile flags = optLast [ str | Flag_CSS str <- flags ] - - -optSourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String) -optSourceUrls flags = -  (listToMaybe [str | Flag_SourceBaseURL   str <- flags] -  ,listToMaybe [str | Flag_SourceModuleURL str <- flags] -  ,listToMaybe [str | Flag_SourceEntityURL str <- flags]) - - -optWikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String) -optWikiUrls flags = -  (listToMaybe [str | Flag_WikiBaseURL   str <- flags] -  ,listToMaybe [str | Flag_WikiModuleURL str <- flags] -  ,listToMaybe [str | Flag_WikiEntityURL str <- flags]) - - -ghcFlags :: [Flag] -> [String] -ghcFlags flags = [ option | Flag_OptGhc option <- flags ] - - -ifacePairs :: [Flag] -> [(FilePath, FilePath)] -ifacePairs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ] - - -parseIfaceOption :: String -> (FilePath, FilePath) -parseIfaceOption s =  -  case break (==',') s of -	(fpath,',':file) -> (fpath, file) -	(file, _)        -> ("", file) - -  data Flag    = Flag_CSS String    | Flag_Debug @@ -224,6 +147,83 @@ options backwardsCompat =     ] +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 ] + + +optHtmlHelpFormat :: [Flag] -> Maybe String +optHtmlHelpFormat flags = optLast [ hhformat | Flag_HtmlHelp hhformat <- flags ] + + +optCssFile :: [Flag] -> Maybe FilePath +optCssFile flags = optLast [ str | Flag_CSS str <- flags ] + + +optSourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String) +optSourceUrls flags = +  (listToMaybe [str | Flag_SourceBaseURL   str <- flags] +  ,listToMaybe [str | Flag_SourceModuleURL str <- flags] +  ,listToMaybe [str | Flag_SourceEntityURL str <- flags]) + + +optWikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String) +optWikiUrls flags = +  (listToMaybe [str | Flag_WikiBaseURL   str <- flags] +  ,listToMaybe [str | Flag_WikiModuleURL str <- flags] +  ,listToMaybe [str | Flag_WikiEntityURL str <- flags]) + + +ghcFlags :: [Flag] -> [String] +ghcFlags flags = [ option | Flag_OptGhc option <- flags ] + + +ifacePairs :: [Flag] -> [(FilePath, FilePath)] +ifacePairs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ] + + +parseIfaceOption :: String -> (FilePath, FilePath) +parseIfaceOption s =  +  case break (==',') s of +	(fpath,',':file) -> (fpath, file) +	(file, _)        -> ("", file) + +  -- | Like 'listToMaybe' but returns the last element instead of the first.  optLast :: [a] -> Maybe a  optLast [] = Nothing  | 
