--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.

(cherry picked from commit 8e06728afb0784128ab2df0be7a5d7a191d30ff4)

2 files changed, 29 insertions, 22 deletions

diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index b0ea1730..5caefa77 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
@@ -280,4 +267,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 =