aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-01-22 23:34:05 +0000
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-01-22 23:34:05 +0000
commit8e06728afb0784128ab2df0be7a5d7a191d30ff4 (patch)
tree38e862855249d31dd2789b2a9a6c17ee61e9a656 /haddock-api/src/Haddock
parentfe10d3082457f744fd27bbb1085edcfd813f6290 (diff)
--package-name and --package-version flags
Used for --hoogle amongst other things. Now we need to teach cabal to use it. The situation is still a bit sub-par because if the flags aren't passed in, the crash will occur. Closes #353.
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs14
-rw-r--r--haddock-api/src/Haddock/Options.hs37
2 files changed, 29 insertions, 22 deletions
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 5aa9b818..416f5d71 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -16,18 +16,14 @@
module Haddock.GhcUtils where
-import Data.Version
import Control.Applicative ( (<$>) )
import Control.Arrow
-import Data.Foldable hiding (concatMap)
import Data.Function
-import Data.Traversable
import Exception
import Outputable
import Name
import Lexeme
-import Packages
import Module
import RdrName (GlobalRdrEnv)
import GhcMonad (withSession)
@@ -40,15 +36,6 @@ import Class
moduleString :: Module -> String
moduleString = moduleNameString . moduleName
-
--- return the (name,version) of the package
-modulePackageInfo :: DynFlags -> Module -> (PackageName, Version)
-modulePackageInfo dflags modu =
- (packageName pkg, packageVersion pkg)
- where
- pkg = getPackageDetails dflags (modulePackageKey modu)
-
-
lookupLoadedHomeModuleGRE :: GhcMonad m => ModuleName -> m (Maybe GlobalRdrEnv)
lookupLoadedHomeModuleGRE mod_name = withSession $ \hsc_env ->
case lookupUFM (hsc_HPT hsc_env) mod_name of
@@ -288,4 +275,3 @@ setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d }
-- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
-- \#included from the .hc file when compiling with -fvia-C.
setOutputDir f = setObjectDir f . setHiDir f . setStubDir f
-
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index 3fa6397f..e847333e 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -28,15 +28,21 @@ module Haddock.Options (
qualification,
verbosity,
ghcFlags,
- readIfaceArgs
+ readIfaceArgs,
+ optPackageName,
+ optPackageVersion
) where
-import Distribution.Verbosity
-import Haddock.Utils
-import Haddock.Types
-import System.Console.GetOpt
import qualified Data.Char as Char
+import Data.Version
+import Distribution.Verbosity
+import FastString
+import Haddock.Types
+import Haddock.Utils
+import Packages
+import System.Console.GetOpt
+import qualified Text.ParserCombinators.ReadP as RP
data Flag
@@ -83,7 +89,9 @@ data Flag
| Flag_Qualification String
| Flag_PrettyHtml
| Flag_NoPrintMissingDocs
- deriving (Eq)
+ | Flag_PackageName String
+ | Flag_PackageVersion String
+ deriving (Eq, Show)
options :: Bool -> [OptDescr Flag]
@@ -107,7 +115,7 @@ options backwardsCompat =
Option [] ["latex-style"] (ReqArg Flag_LaTeXStyle "FILE") "provide your own LaTeX style in FILE",
Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output",
Option [] ["hoogle"] (NoArg Flag_Hoogle)
- "output for Hoogle",
+ "output for Hoogle; you may want --package-name and --package-version too",
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"])
@@ -171,7 +179,11 @@ options backwardsCompat =
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"
+ "don't print information about any undocumented entities",
+ 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"
]
@@ -192,6 +204,15 @@ parseHaddockOpts params =
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
+
+optPackageName :: [Flag] -> Maybe PackageName
+optPackageName flags =
+ optLast [ PackageName $ mkFastString n | Flag_PackageName n <- flags ]
+
optTitle :: [Flag] -> Maybe String
optTitle flags =