diff options
Diffstat (limited to 'haddock-api/src/Haddock/Options.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Options.hs | 541 |
1 files changed, 332 insertions, 209 deletions
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index aa10b5b3..e9fd0c5d 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -12,52 +12,56 @@ -- -- Definition of the command line interface of Haddock. ----------------------------------------------------------------------------- -module Haddock.Options ( - parseHaddockOpts, - Flag(..), - 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 @@ -119,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" ] @@ -239,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 = @@ -263,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 @@ -290,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 ] @@ -326,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 ] @@ -361,18 +476,26 @@ ghcFlags flags = [ option | Flag_OptGhc option <- flags ] reexportFlags :: [Flag] -> [String] reexportFlags flags = [ option | Flag_Reexport option <- flags ] +data Visibility = Visible | Hidden + deriving (Eq, Show) -readIfaceArgs :: [Flag] -> [(DocPaths, FilePath)] +readIfaceArgs :: [Flag] -> [(DocPaths, Visibility, FilePath)] readIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ] - where - parseIfaceOption :: String -> (DocPaths, FilePath) - parseIfaceOption str = - case break (==',') str of - (fpath, ',':rest) -> - case break (==',') rest of - (src, ',':file) -> ((fpath, Just src), file) - (file, _) -> ((fpath, Nothing), file) - (file, _) -> (("", Nothing), 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. @@ -387,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) |