diff options
| author | Yuchen Pei <hi@ypei.me> | 2022-07-18 18:08:00 +1000 | 
|---|---|---|
| committer | Yuchen Pei <hi@ypei.me> | 2022-07-18 18:08:00 +1000 | 
| commit | 1713efee8a913784e93746c4a339b2641a24df51 (patch) | |
| tree | cb51e22721cc82760af1ebb8aa14c5b96ca068a6 /haddock-api/src/Haddock/Options.hs | |
| parent | 118dd4ed0c901f56070052405f533d9deff5bb22 (diff) | |
Adding org backend.
Diffstat (limited to 'haddock-api/src/Haddock/Options.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Options.hs | 549 | 
1 files changed, 329 insertions, 220 deletions
| diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index 78bfe1a1..e9fd0c5d 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -12,53 +12,56 @@  --  -- Definition of the command line interface of Haddock.  ----------------------------------------------------------------------------- -module Haddock.Options ( -  parseHaddockOpts, -  Flag(..), -  Visibility(..), -  getUsage, -  optTitle, -  outputDir, -  optContentsUrl, -  optIndexUrl, -  optCssFile, -  optSourceCssFile, -  sourceUrls, -  wikiUrls, -  baseUrl, -  optParCount, -  optDumpInterfaceFile, -  optShowInterfaceFile, -  optLaTeXStyle, -  optMathjax, -  qualification, -  sinceQualification, -  verbosity, -  ghcFlags, -  reexportFlags, -  readIfaceArgs, -  optPackageName, -  optPackageVersion, -  modulePackageInfo, -  ignoredSymbols -) where - - -import qualified Data.Char as Char -import           Data.Version +module Haddock.Options +  ( parseHaddockOpts +  , Flag(..) +  , Visibility(..) +  , getUsage +  , optTitle +  , outputDir +  , optContentsUrl +  , optIndexUrl +  , optCssFile +  , optSourceCssFile +  , sourceUrls +  , wikiUrls +  , baseUrl +  , optParCount +  , optDumpInterfaceFile +  , optShowInterfaceFile +  , optLaTeXStyle +  , optMathjax +  , qualification +  , sinceQualification +  , verbosity +  , ghcFlags +  , reexportFlags +  , readIfaceArgs +  , optPackageName +  , optPackageVersion +  , modulePackageInfo +  , ignoredSymbols +  ) where + +  import           Control.Applicative +import qualified Data.Char                     as Char +import           Data.Version +import           GHC                            ( Module +                                                , moduleUnit +                                                )  import           GHC.Data.FastString -import           GHC ( Module, moduleUnit )  import           GHC.Unit.State  import           Haddock.Types  import           Haddock.Utils  import           System.Console.GetOpt -import qualified Text.ParserCombinators.ReadP as RP +import qualified Text.ParserCombinators.ReadP  as RP  data Flag    = Flag_BuiltInThemes    | Flag_CSS String +  | Flag_Org  --  | Flag_DocBook    | Flag_ReadInterface String    | Flag_DumpInterface String @@ -120,119 +123,231 @@ data Flag  options :: Bool -> [OptDescr Flag]  options backwardsCompat = -  [ -    Option ['B']  []     (ReqArg Flag_GhcLibDir "DIR") -      "path to a GHC lib dir, to override the default path", -    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 ['i'] ["read-interface"] (ReqArg Flag_ReadInterface "FILE") -      "read an interface from FILE", -    Option ['D']  ["dump-interface"] (ReqArg Flag_DumpInterface "FILE") -      "write the resulting interface to FILE", -    Option []     ["show-interface"] (ReqArg Flag_ShowInterface "FILE") -      "print the interface in a human readable form", +  [ Option ['B'] +           [] +           (ReqArg Flag_GhcLibDir "DIR") +           "path to a GHC lib dir, to override the default path" +  , 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 ['i'] +           ["read-interface"] +           (ReqArg Flag_ReadInterface "FILE") +           "read an interface from FILE" +  , Option ['D'] +           ["dump-interface"] +           (ReqArg Flag_DumpInterface "FILE") +           "write the resulting interface to FILE" +  , Option [] +           ["show-interface"] +           (ReqArg Flag_ShowInterface "FILE") +           "print the interface in a human readable form" +  ,  --    Option ['S']  ["docbook"]  (NoArg Flag_DocBook)  --  "output in DocBook XML", -    Option ['h']  ["html"]     (NoArg Flag_Html) -      "output in HTML (XHTML 1.0)", -    Option []  ["latex"]  (NoArg Flag_LaTeX) "use experimental LaTeX rendering", -    Option []  ["latex-style"]  (ReqArg Flag_LaTeXStyle "FILE") "provide your own LaTeX style in FILE", -    Option []  ["mathjax"]  (ReqArg Flag_Mathjax "URL") "URL FOR mathjax", -    Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output", -    Option []  ["hoogle"]     (NoArg Flag_Hoogle) -      "output for Hoogle; you may want --package-name and --package-version too", -    Option [] ["quickjump"] (NoArg Flag_QuickJumpIndex) -      "generate an index for interactive documentation navigation", -    Option [] ["hyperlinked-source"] (NoArg Flag_HyperlinkedSource) -      "generate highlighted and hyperlinked source code (for use with --html)", -    Option [] ["source-css"] (ReqArg Flag_SourceCss "FILE") -      "use custom CSS file instead of default one in hyperlinked source", -    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}, %{NAME},\n%{KIND} or %{LINE} vars)", -    Option []  ["source-entity-line"] (ReqArg Flag_SourceLEntityURL "URL") -      "URL for a source code link for each entity.\nUsed if name links are unavailable, eg. for TH splices.", -    Option []  ["comments-base"]   (ReqArg Flag_WikiBaseURL "URL") -      "URL for a comments link on the contents\nand index pages", -    Option [] ["base-url"] (ReqArg Flag_BaseURL "URL") -      "Base URL for static assets (eg. css, javascript, json files etc.).\nWhen given statis assets will not be copied.", -    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}, %{NAME},\n%{KIND} or %{LINE} vars)", -    Option ['c']  ["css", "theme"] (ReqArg Flag_CSS "PATH") -      "the CSS file or theme directory to use for HTML output", -    Option []  ["built-in-themes"] (NoArg Flag_BuiltInThemes) -      "include all the built-in haddock themes", -    Option ['p']  ["prologue"] (ReqArg Flag_Prologue "FILE") -      "file containing prologue text", -    Option ['t']  ["title"]    (ReqArg Flag_Heading "TITLE") -      "page heading", -    Option ['q']  ["qual"] (ReqArg Flag_Qualification "QUAL") -      "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'aliased'", -    Option ['?']  ["help"]  (NoArg Flag_Help) -      "display this help and exit", -    Option ['V']  ["version"]  (NoArg Flag_Version) -      "output version information and exit", -    Option []  ["compatible-interface-versions"]  (NoArg Flag_CompatibleInterfaceVersions) -      "output compatible interface file versions and exit", -    Option []  ["interface-version"]  (NoArg Flag_InterfaceVersion) -      "output interface file version and exit", -    Option []  ["bypass-interface-version-check"] (NoArg Flag_BypassInterfaceVersonCheck) -      "bypass the interface file version check (dangerous)", -    Option ['v']  ["verbosity"]  (ReqArg Flag_Verbosity "VERBOSITY") -      "set verbosity level", -    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 attribute", -    Option [] ["hide"] (ReqArg Flag_HideModule "MODULE") -      "behave as if MODULE has the hide attribute", -    Option [] ["show"] (ReqArg Flag_ShowModule "MODULE") -      "behave as if MODULE does not have the hide attribute", -    Option [] ["show-all"] (NoArg Flag_ShowAllModules) -      "behave as if not modules have the hide attribute", -    Option [] ["show-extensions"] (ReqArg Flag_ShowExtensions "MODULE") -      "behave as if MODULE has the show-extensions attribute", -    Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION") -      "option to be forwarded to GHC", -    Option []  ["ghc-version"]  (NoArg Flag_GhcVersion) -      "output GHC version in numeric format", -    Option []  ["print-ghc-path"]  (NoArg Flag_PrintGhcPath) -      "output path to GHC binary", -    Option []  ["print-ghc-libdir"]  (NoArg Flag_PrintGhcLibDir) -      "output GHC lib dir", -    Option ['w'] ["no-warnings"] (NoArg Flag_NoWarnings) "turn off all warnings", -    Option [] ["no-tmp-comp-dir"] (NoArg Flag_NoTmpCompDir) -      "do not re-direct compilation output to a temporary directory", -    Option [] ["pretty-html"] (NoArg Flag_PrettyHtml) -      "generate html with newlines and indenting (for use with --html)", -    Option [] ["no-print-missing-docs"] (NoArg Flag_NoPrintMissingDocs) -      "don't print information about any undocumented entities", -    Option []  ["reexport"] (ReqArg Flag_Reexport "MOD") -      "reexport the module MOD, adding it to the index", -    Option [] ["package-name"] (ReqArg Flag_PackageName "NAME") -      "name of the package being documented", -    Option [] ["package-version"] (ReqArg Flag_PackageVersion "VERSION") -      "version of the package being documented in usual x.y.z.w format", -    Option []  ["since-qual"] (ReqArg Flag_SinceQualification "QUAL") -      "package qualification of @since, one of\n'always' (default) or 'only-external'", -    Option [] ["ignore-link-symbol"] (ReqArg Flag_IgnoreLinkSymbol "SYMBOL") -      "name of a symbol which does not trigger a warning in case of link issue", -    Option ['j'] [] (OptArg (\count -> Flag_ParCount (fmap read count)) "n") -      "load modules in parallel" +    Option ['h'] ["html"]  (NoArg Flag_Html)  "output in HTML (XHTML 1.0)" +  , Option ['O'] ["org"]   (NoArg Flag_Org)   "output in Org" +  , Option []    ["latex"] (NoArg Flag_LaTeX) "use experimental LaTeX rendering" +  , Option [] +           ["latex-style"] +           (ReqArg Flag_LaTeXStyle "FILE") +           "provide your own LaTeX style in FILE" +  , Option [] ["mathjax"] (ReqArg Flag_Mathjax "URL") "URL FOR mathjax" +  , Option ['U'] +           ["use-unicode"] +           (NoArg Flag_UseUnicode) +           "use Unicode in HTML output" +  , Option +    [] +    ["hoogle"] +    (NoArg Flag_Hoogle) +    "output for Hoogle; you may want --package-name and --package-version too" +  , Option [] +           ["quickjump"] +           (NoArg Flag_QuickJumpIndex) +           "generate an index for interactive documentation navigation" +  , Option +    [] +    ["hyperlinked-source"] +    (NoArg Flag_HyperlinkedSource) +    "generate highlighted and hyperlinked source code (for use with --html)" +  , Option [] +           ["source-css"] +           (ReqArg Flag_SourceCss "FILE") +           "use custom CSS file instead of default one in hyperlinked source" +  , 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}, %{NAME},\n%{KIND} or %{LINE} vars)" +  , Option +    [] +    ["source-entity-line"] +    (ReqArg Flag_SourceLEntityURL "URL") +    "URL for a source code link for each entity.\nUsed if name links are unavailable, eg. for TH splices." +  , Option [] +           ["comments-base"] +           (ReqArg Flag_WikiBaseURL "URL") +           "URL for a comments link on the contents\nand index pages" +  , Option +    [] +    ["base-url"] +    (ReqArg Flag_BaseURL "URL") +    "Base URL for static assets (eg. css, javascript, json files etc.).\nWhen given statis assets will not be copied." +  , 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}, %{NAME},\n%{KIND} or %{LINE} vars)" +  , Option ['c'] +           ["css", "theme"] +           (ReqArg Flag_CSS "PATH") +           "the CSS file or theme directory to use for HTML output" +  , Option [] +           ["built-in-themes"] +           (NoArg Flag_BuiltInThemes) +           "include all the built-in haddock themes" +  , Option ['p'] +           ["prologue"] +           (ReqArg Flag_Prologue "FILE") +           "file containing prologue text" +  , Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE") "page heading" +  , Option +    ['q'] +    ["qual"] +    (ReqArg Flag_Qualification "QUAL") +    "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'aliased'" +  , Option ['?'] ["help"] (NoArg Flag_Help) "display this help and exit" +  , Option ['V'] +           ["version"] +           (NoArg Flag_Version) +           "output version information and exit" +  , Option [] +           ["compatible-interface-versions"] +           (NoArg Flag_CompatibleInterfaceVersions) +           "output compatible interface file versions and exit" +  , Option [] +           ["interface-version"] +           (NoArg Flag_InterfaceVersion) +           "output interface file version and exit" +  , Option [] +           ["bypass-interface-version-check"] +           (NoArg Flag_BypassInterfaceVersonCheck) +           "bypass the interface file version check (dangerous)" +  , Option ['v'] +           ["verbosity"] +           (ReqArg Flag_Verbosity "VERBOSITY") +           "set verbosity level" +  , 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 attribute" +  , Option [] +           ["hide"] +           (ReqArg Flag_HideModule "MODULE") +           "behave as if MODULE has the hide attribute" +  , Option [] +           ["show"] +           (ReqArg Flag_ShowModule "MODULE") +           "behave as if MODULE does not have the hide attribute" +  , Option [] +           ["show-all"] +           (NoArg Flag_ShowAllModules) +           "behave as if not modules have the hide attribute" +  , Option [] +           ["show-extensions"] +           (ReqArg Flag_ShowExtensions "MODULE") +           "behave as if MODULE has the show-extensions attribute" +  , Option [] +           ["optghc"] +           (ReqArg Flag_OptGhc "OPTION") +           "option to be forwarded to GHC" +  , Option [] +           ["ghc-version"] +           (NoArg Flag_GhcVersion) +           "output GHC version in numeric format" +  , Option [] +           ["print-ghc-path"] +           (NoArg Flag_PrintGhcPath) +           "output path to GHC binary" +  , Option [] +           ["print-ghc-libdir"] +           (NoArg Flag_PrintGhcLibDir) +           "output GHC lib dir" +  , Option ['w'] ["no-warnings"] (NoArg Flag_NoWarnings) "turn off all warnings" +  , Option [] +           ["no-tmp-comp-dir"] +           (NoArg Flag_NoTmpCompDir) +           "do not re-direct compilation output to a temporary directory" +  , Option [] +           ["pretty-html"] +           (NoArg Flag_PrettyHtml) +           "generate html with newlines and indenting (for use with --html)" +  , Option [] +           ["no-print-missing-docs"] +           (NoArg Flag_NoPrintMissingDocs) +           "don't print information about any undocumented entities" +  , Option [] +           ["reexport"] +           (ReqArg Flag_Reexport "MOD") +           "reexport the module MOD, adding it to the index" +  , Option [] +           ["package-name"] +           (ReqArg Flag_PackageName "NAME") +           "name of the package being documented" +  , Option [] +           ["package-version"] +           (ReqArg Flag_PackageVersion "VERSION") +           "version of the package being documented in usual x.y.z.w format" +  , Option +    [] +    ["since-qual"] +    (ReqArg Flag_SinceQualification "QUAL") +    "package qualification of @since, one of\n'always' (default) or 'only-external'" +  , Option +    [] +    ["ignore-link-symbol"] +    (ReqArg Flag_IgnoreLinkSymbol "SYMBOL") +    "name of a symbol which does not trigger a warning in case of link issue" +  , Option ['j'] +           [] +           (OptArg (\count -> Flag_ParCount (fmap read count)) "n") +           "load modules in parallel"    ] @@ -240,23 +355,22 @@ getUsage :: IO String  getUsage = do    prog <- getProgramName    return $ usageInfo (usageHeader prog) (options False) -  where -    usageHeader :: String -> String -    usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file...\n" + 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) +parseHaddockOpts params = case getOpt Permute (options True) params of +  (flags, args, []    ) -> return (flags, args) +  (_    , _   , errors) -> do +    usage <- getUsage +    throwE (concat errors ++ usage)  optPackageVersion :: [Flag] -> Maybe Data.Version.Version  optPackageVersion flags =    let ver = optLast [ v | Flag_PackageVersion v <- flags ] -  in ver >>= fmap fst . optLast . RP.readP_to_S parseVersion +  in  ver >>= fmap fst . optLast . RP.readP_to_S parseVersion  optPackageName :: [Flag] -> Maybe PackageName  optPackageName flags = @@ -264,17 +378,15 @@ optPackageName flags =  optTitle :: [Flag] -> Maybe String -optTitle flags = -  case [str | Flag_Heading str <- flags] of -    [] -> Nothing -    (t:_) -> Just t +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 +outputDir flags = case [ path | Flag_OutputDir path <- flags ] of +  []    -> "." +  paths -> last paths  optContentsUrl :: [Flag] -> Maybe String @@ -291,23 +403,26 @@ optCssFile flags = optLast [ str | Flag_CSS str <- flags ]  optSourceCssFile :: [Flag] -> Maybe FilePath  optSourceCssFile flags = optLast [ str | Flag_SourceCss str <- flags ] -sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String) +sourceUrls +  :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String)  sourceUrls flags = -  (optLast [str | Flag_SourceBaseURL    str <- flags] -  ,optLast [str | Flag_SourceModuleURL  str <- flags] -  ,optLast [str | Flag_SourceEntityURL  str <- flags] -  ,optLast [str | Flag_SourceLEntityURL str <- flags]) +  ( optLast [ str | Flag_SourceBaseURL str <- flags ] +  , optLast [ str | Flag_SourceModuleURL str <- flags ] +  , optLast [ str | Flag_SourceEntityURL str <- flags ] +  , optLast [ str | Flag_SourceLEntityURL str <- flags ] +  )  wikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)  wikiUrls flags = -  (optLast [str | Flag_WikiBaseURL   str <- flags] -  ,optLast [str | Flag_WikiModuleURL str <- flags] -  ,optLast [str | Flag_WikiEntityURL str <- flags]) +  ( optLast [ str | Flag_WikiBaseURL str <- flags ] +  , optLast [ str | Flag_WikiModuleURL str <- flags ] +  , optLast [ str | Flag_WikiEntityURL str <- flags ] +  )  baseUrl :: [Flag] -> Maybe String -baseUrl flags = optLast [str | Flag_BaseURL str <- flags] +baseUrl flags = optLast [ str | Flag_BaseURL str <- flags ]  optDumpInterfaceFile :: [Flag] -> Maybe FilePath  optDumpInterfaceFile flags = optLast [ str | Flag_DumpInterface str <- flags ] @@ -327,31 +442,30 @@ optParCount flags = optLast [ n | Flag_ParCount n <- flags ]  qualification :: [Flag] -> Either String QualOption  qualification flags =    case map (map Char.toLower) [ str | Flag_Qualification str <- flags ] of -      []             -> Right OptNoQual -      ["none"]       -> Right OptNoQual -      ["full"]       -> Right OptFullQual -      ["local"]      -> Right OptLocalQual -      ["relative"]   -> Right OptRelativeQual -      ["aliased"]    -> Right OptAliasedQual -      [arg]          -> Left $ "unknown qualification type " ++ show arg -      _:_            -> Left "qualification option given multiple times" +    []            -> Right OptNoQual +    [ "none"    ] -> Right OptNoQual +    [ "full"    ] -> Right OptFullQual +    [ "local"   ] -> Right OptLocalQual +    [ "relative"] -> Right OptRelativeQual +    [ "aliased" ] -> Right OptAliasedQual +    [ arg       ] -> Left $ "unknown qualification type " ++ show arg +    _ :         _ -> Left "qualification option given multiple times"  sinceQualification :: [Flag] -> Either String SinceQual  sinceQualification flags =    case map (map Char.toLower) [ str | Flag_SinceQualification str <- flags ] of -      []             -> Right Always -      ["always"]     -> Right Always -      ["external"]   -> Right External -      [arg]          -> Left $ "unknown since-qualification type " ++ show arg -      _:_            -> Left "since-qualification option given multiple times" +    []            -> Right Always +    [ "always"  ] -> Right Always +    [ "external"] -> Right External +    [ arg       ] -> Left $ "unknown since-qualification type " ++ show arg +    _ :         _ -> Left "since-qualification option given multiple times"  verbosity :: [Flag] -> Verbosity -verbosity flags = -  case [ str | Flag_Verbosity str <- flags ] of -    []  -> Normal -    x:_ -> case parseVerbosity x of -      Left e -> throwE e -      Right v -> v +verbosity flags = case [ str | Flag_Verbosity str <- flags ] of +  []    -> Normal +  x : _ -> case parseVerbosity x of +    Left  e -> throwE e +    Right v -> v  ignoredSymbols :: [Flag] -> [String]  ignoredSymbols flags = [ symbol | Flag_IgnoreLinkSymbol symbol <- flags ] @@ -367,26 +481,21 @@ data Visibility = Visible | Hidden  readIfaceArgs :: [Flag] -> [(DocPaths, Visibility, FilePath)]  readIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ] -  where -    parseIfaceOption :: String -> (DocPaths, Visibility, FilePath) -    parseIfaceOption str = -      case break (==',') str of -        (fpath, ',':rest) -> -          case break (==',') rest of -            (src, ',':rest') -> -              let src' = case src of -                    "" -> Nothing -                    _  -> Just src -              in -              case break (==',') rest' of -                (visibility, ',':file) | visibility == "hidden" -> -                  ((fpath, src'), Hidden, file) -                                       | otherwise -> -                  ((fpath, src'), Visible, file) -                (file, _) -> -                  ((fpath, src'), Visible, file) -            (file, _) -> ((fpath, Nothing), Visible, file) -        (file, _) -> (("", Nothing), Visible, file) + where +  parseIfaceOption :: String -> (DocPaths, Visibility, FilePath) +  parseIfaceOption str = case break (== ',') str of +    (fpath, ',' : rest) -> case break (== ',') rest of +      (src, ',' : rest') -> +        let src' = case src of +              "" -> Nothing +              _  -> Just src +        in  case break (== ',') rest' of +              (visibility, ',' : file) +                | visibility == "hidden" -> ((fpath, src'), Hidden, file) +                | otherwise              -> ((fpath, src'), Visible, file) +              (file, _) -> ((fpath, src'), Visible, file) +      (file, _) -> ((fpath, Nothing), Visible, file) +    (file, _) -> (("", Nothing), Visible, file)  -- | Like 'listToMaybe' but returns the last element instead of the first. @@ -401,16 +510,16 @@ optLast xs = Just (last xs)  --  -- The @--package-name@ and @--package-version@ Haddock flags allow the user to  -- specify this information manually and it is returned here if present. -modulePackageInfo :: UnitState -                  -> [Flag] -- ^ Haddock flags are checked as they may contain +modulePackageInfo +  :: UnitState +  -> [Flag] -- ^ Haddock flags are checked as they may contain                              -- the package name or version provided by the user                              -- which we prioritise -                  -> Maybe Module -                  -> (Maybe PackageName, Maybe Data.Version.Version) +  -> Maybe Module +  -> (Maybe PackageName, Maybe Data.Version.Version)  modulePackageInfo _unit_state _flags Nothing = (Nothing, Nothing)  modulePackageInfo unit_state flags (Just modu) = -  ( optPackageName flags    <|> fmap unitPackageName pkgDb +  ( optPackageName flags <|> fmap unitPackageName pkgDb    , optPackageVersion flags <|> fmap unitPackageVersion pkgDb    ) -  where -    pkgDb = lookupUnit unit_state (moduleUnit modu) +  where pkgDb = lookupUnit unit_state (moduleUnit modu) | 
