aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Options.hs
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-03-26 23:35:59 -0700
committerAlexander Biehl <alexbiehl@gmail.com>2018-03-27 08:35:59 +0200
commit978dbc859df09eb991d9ccc0911276cc9655b783 (patch)
tree8082d90d0c73db65292ba844e19ae92c3e9ad1a6 /haddock-api/src/Haddock/Options.hs
parentd270aeee23427c8cfe582549ead8f495704603f6 (diff)
@since includes package name (#749)
* Metadoc stores a package name This means that '@since' annotations can be package aware. * Get the package name the right way This should extract the package name for `@since` annotations the right way. I had to move `modulePackageInfo` around to do this and, in the process, I took the liberty to update it. Since it appears that finding the package name is something that can fail, I added a warning for this case. * Silence warnings * Hide package for local 'since' annotations As discussed, this is still the usual case (and we should avoid being noisy for it). Although this commit is large, it is basically only about threading a 'Maybe Package' from 'Haddock.render' all the way to 'Haddock.Backends.Xhtml.DocMarkup.renderMeta'. * Bump binary interface version * Add a '--since-qual' option This controls when to qualify since annotations with the package they come from. The default is always, but I've left an 'external' variant where only those annotations coming from outside of the current package are qualified. * Make ParserSpec work * Make Fixtures work * Use package name even if package version is not available The @since stuff needs only the package name passed in, so it makes sense to not be forced to pass in a version too.
Diffstat (limited to 'haddock-api/src/Haddock/Options.hs')
-rw-r--r--haddock-api/src/Haddock/Options.hs39
1 files changed, 37 insertions, 2 deletions
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index 0609aa63..b5e987d8 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -29,19 +29,23 @@ module Haddock.Options (
optLaTeXStyle,
optMathjax,
qualification,
+ sinceQualification,
verbosity,
ghcFlags,
reexportFlags,
readIfaceArgs,
optPackageName,
- optPackageVersion
+ optPackageVersion,
+ modulePackageInfo
) where
import qualified Data.Char as Char
import Data.Version
+import Control.Applicative
import Distribution.Verbosity
import FastString
+import GHC ( DynFlags, Module, moduleUnitId )
import Haddock.Types
import Haddock.Utils
import Packages
@@ -103,6 +107,7 @@ data Flag
| Flag_PackageName String
| Flag_PackageVersion String
| Flag_Reexport String
+ | Flag_SinceQualification String
deriving (Eq, Show)
@@ -210,7 +215,9 @@ options backwardsCompat =
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"
+ "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'"
]
@@ -310,6 +317,14 @@ qualification flags =
[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"
verbosity :: [Flag] -> Verbosity
verbosity flags =
@@ -344,3 +359,23 @@ readIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ]
optLast :: [a] -> Maybe a
optLast [] = Nothing
optLast xs = Just (last xs)
+
+
+-- | This function has a potential to return 'Nothing' because package name and
+-- versions can no longer reliably be extracted in all cases: if the package is
+-- not installed yet then this info is no longer available.
+--
+-- The @--package-name@ and @--package-version@ Haddock flags allow the user to
+-- specify this information manually and it is returned here if present.
+modulePackageInfo :: DynFlags
+ -> [Flag] -- ^ Haddock flags are checked as they may contain
+ -- the package name or version provided by the user
+ -- which we prioritise
+ -> Module
+ -> (Maybe PackageName, Maybe Data.Version.Version)
+modulePackageInfo dflags flags modu =
+ ( optPackageName flags <|> fmap packageName pkgDb
+ , optPackageVersion flags <|> fmap packageVersion pkgDb
+ )
+ where
+ pkgDb = lookupPackage dflags (moduleUnitId modu)