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.

Author: harpocrates

haddock-api/src/Haddock.hs

@@ -270,7 +270,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
     pkgKey           = moduleUnitId pkgMod
     pkgStr           = Just (unitIdString pkgKey)
     pkgNameVer       = modulePackageInfo dflags flags pkgMod
-    pkgName          = fmap (unpackFS . (\(PackageName n) -> n) . fst) pkgNameVer
+    pkgName          = fmap (unpackFS . (\(PackageName n) -> n)) (fst pkgNameVer)
     sincePkg         = case sinceQual of
                          External -> pkgName
                          Always -> Nothing
@@ -362,22 +362,19 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
   -- might want to fix that if/when these two get some work on them
   when (Flag_Hoogle `elem` flags) $ do
     case pkgNameVer of
-      Nothing -> putStrLn . unlines $
+      (Just (PackageName pkgNameFS), Just pkgVer) ->
+          let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title
+                         | otherwise = unpackFS pkgNameFS
+          in ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)
+               visibleIfaces odir
+      _ -> putStrLn . unlines $
           [ "haddock: Unable to find a package providing module "
             ++ moduleNameString (moduleName pkgMod) ++ ", skipping Hoogle."
           , ""
           , "         Perhaps try specifying the desired package explicitly"
             ++ " using the --package-name"
           , "         and --package-version arguments."
           ]
-      Just (PackageName pkgNameFS, pkgVer) ->
-          let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title
-                         | otherwise = unpackFS pkgNameFS
-          in withTiming (pure dflags') "ppHoogle" (const ()) $ do
-               _ <- {-# SCC ppHoogle #-}
-                    ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)
-                      visibleIfaces odir
-               return ()
 
   when (Flag_LaTeX `elem` flags) $ do
     withTiming (pure dflags') "ppLatex" (const ()) $ do

haddock-api/src/Haddock/Interface/Create.hs

@@ -85,8 +85,8 @@ createInterface tm flags modMap instIfaceMap = do
       !instances     = modInfoInstances mi
       !fam_instances = md_fam_insts md
       !exportedNames = modInfoExportsWithSelectors mi
-      pkgNameVer     = modulePackageInfo dflags flags mdl
-      pkgName        = fmap (unpackFS . (\(PackageName n) -> n) . fst) pkgNameVer
+      (pkgNameFS, _) = modulePackageInfo dflags flags mdl
+      pkgName        = fmap (unpackFS . (\(PackageName n) -> n)) pkgNameFS
 
       (TcGblEnv { tcg_rdr_env = gre
                 , tcg_warns   = warnings

haddock-api/src/Haddock/Options.hs

@@ -43,7 +43,6 @@ module Haddock.Options (
 import qualified Data.Char as Char
 import           Data.Version
 import           Control.Applicative
-import           Control.Arrow ( (&&&) )
 import           Distribution.Verbosity
 import           FastString
 import           GHC ( DynFlags, Module, moduleUnitId )
@@ -373,8 +372,10 @@ modulePackageInfo :: DynFlags
                             -- the package name or version provided by the user
                             -- which we prioritise
                   -> Module
-                  -> Maybe (PackageName, Data.Version.Version)
-modulePackageInfo dflags flags modu = cmdline <|> pkgDb
+                  -> (Maybe PackageName, Maybe Data.Version.Version)
+modulePackageInfo dflags flags modu =
+  ( optPackageName flags    <|> fmap packageName pkgDb
+  , optPackageVersion flags <|> fmap packageVersion pkgDb
+  )
   where
-    cmdline = (,) <$> optPackageName flags <*> optPackageVersion flags
-    pkgDb = (packageName &&& packageVersion) <$> lookupPackage dflags (moduleUnitId modu)
+    pkgDb = lookupPackage dflags (moduleUnitId modu)