Add support for explicit package ids with HASKELL_PACKAGE_IDS var

src/PackageDBs.hs

@@ -22,6 +22,7 @@ data PackageDBs = PackageDBs
     -- | Unsupported on GHC < 7.6
     , includeGlobal :: Bool
     , extraDBs :: [FilePath]
+    , explicitPackageIds :: Maybe [String]
     }
     deriving (Show, Eq)
 
@@ -31,22 +32,30 @@ data ArgStyle = Pre76 | Post76
 
 -- | Determine command line arguments to be passed to GHC to set databases correctly
 --
--- >>> dbArgs Post76 (PackageDBs False True [])
--- ["-no-user-package-db"]
+-- >>> dbArgs Post76 (PackageDBs False True [] (Just ["x-1.0.0-ABCDEFGH"]))
+-- ["-no-user-package-db","-hide-all-packages","-package-id","x-1.0.0-ABCDEFGH"]
 --
--- >>> dbArgs Pre76 (PackageDBs True True ["somedb"])
+-- >>> dbArgs Pre76 (PackageDBs True True ["somedb"] Nothing)
 -- ["-package-conf","somedb"]
 dbArgs :: ArgStyle -> PackageDBs -> [String]
-dbArgs Post76 (PackageDBs user global extras) =
+dbArgs Post76 (PackageDBs user global extras mPackageIds) =
     (if user then id else ("-no-user-package-db":)) $
     (if global then id else ("-no-global-package-db":)) $
-    concatMap (\extra -> ["-package-db", extra]) extras
-dbArgs Pre76 (PackageDBs _ False _) =
+    foldr (\extra -> ("-package-db":).( extra:)) (maybePackageIdArgs mPackageIds) extras
+dbArgs Pre76 (PackageDBs _ False _ _) =
     error "Global package database must be included with GHC < 7.6"
-dbArgs Pre76 (PackageDBs user True extras) =
+dbArgs Pre76 (PackageDBs user True extras _) =
     (if user then id else ("-no-user-package-conf":)) $
     concatMap (\extra -> ["-package-conf", extra]) extras
 
+-- | hide all packages and add explicit package ids if those
+-- were specified
+maybePackageIdArgs :: Maybe [String] -> [String]
+maybePackageIdArgs Nothing = []
+maybePackageIdArgs (Just pids) =
+  "-hide-all-packages":
+  concatMap (\extra -> ["-package-id", extra]) pids
+
 -- | The argument style to be used with the current GHC version
 buildArgStyle :: ArgStyle
 #if __GLASGOW_HASKELL__ >= 706
@@ -60,6 +69,18 @@ buildArgStyle = Pre76
 getPackageDBsFromEnv :: IO PackageDBs
 getPackageDBsFromEnv = do
     env <- getEnvironment
+    let packageIds = fmap words $ lookup "HASKELL_PACKAGE_IDS" env
+        fromEnvMulti s = PackageDBs
+            { includeUser = False
+            , includeGlobal = global
+            , extraDBs = splitSearchPath s'
+            , explicitPackageIds = packageIds
+            }
+          where
+            (s', global) =
+                case reverse s of
+                    c:rest | c == searchPathSeparator -> (reverse rest, True)
+                    _ -> (s, False)
     case () of
         ()
             | Just sandboxes <- lookup "HASKELL_PACKAGE_SANDBOXES" env
@@ -69,6 +90,7 @@ getPackageDBsFromEnv = do
                     { includeUser = True
                     , includeGlobal = True
                     , extraDBs = [extra]
+                    , explicitPackageIds = packageIds
                     }
             | Just sandboxes <- lookup "GHC_PACKAGE_PATH" env
                 -> return $ fromEnvMulti sandboxes
@@ -77,19 +99,8 @@ getPackageDBsFromEnv = do
                           >>= Sandbox.getSandboxConfigFile
                           >>= Sandbox.getPackageDbDir
                 return $ case eres :: Either SomeException FilePath of
-                    Left _ -> PackageDBs True True []
-                    Right db -> PackageDBs False True [db]
-  where
-    fromEnvMulti s = PackageDBs
-        { includeUser = False
-        , includeGlobal = global
-        , extraDBs = splitSearchPath s'
-        }
-      where
-        (s', global) =
-            case reverse s of
-                c:rest | c == searchPathSeparator -> (reverse rest, True)
-                _ -> (s, False)
+                    Left _ -> PackageDBs True True [] Nothing
+                    Right db -> PackageDBs False True [db] Nothing
 
 -- | Get the package DB flags for the current GHC version and from the
 -- environment.

test/PackageDBsSpec.hs

@@ -44,30 +44,34 @@ spec = around_ clearEnv $ do
     context "without a cabal sandbox present" $ do
       around_ (inTempDirectory) $ do
         it "uses global and user when no env or sandboxing used" $ do
-          getPackageDBsFromEnv `shouldReturn` PackageDBs True True []
+          getPackageDBsFromEnv `shouldReturn` PackageDBs True True [] Nothing
 
         it "respects GHC_PACKAGE_PATH" $
           withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo", "bar", ""]) $ do
-            getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo", "bar"]
+            getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo", "bar"] Nothing
 
         it "HASKELL_PACKAGE_SANDBOXES trumps GHC_PACKAGE_PATH" $
           withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo1", "bar1", ""]) $ do
           withEnv "HASKELL_PACKAGE_SANDBOXES" (combineDirs ["foo2", "bar2", ""]) $ do
-            getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo2", "bar2"]
+            getPackageDBsFromEnv `shouldReturn` PackageDBs False True ["foo2", "bar2"] Nothing
 
         it "HASKELL_PACKAGE_SANDBOX trumps GHC_PACKAGE_PATH" $
           withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo1", "bar1", ""]) $ do
           withEnv "HASKELL_PACKAGE_SANDBOX" (combineDirs ["foo2"]) $ do
+            getPackageDBsFromEnv `shouldReturn` PackageDBs True True ["foo2"] Nothing
 
-            getPackageDBsFromEnv `shouldReturn` PackageDBs True True ["foo2"]
+        it "HASKELL_PACKAGE_SANDBOX with explicit package ids" $
+          withEnv "HASKELL_PACKAGE_SANDBOX" (combineDirs ["foo2"]) $ do
+          withEnv "HASKELL_PACKAGE_IDS" (unwords ["pkg1-1.0", "pkgX-1.1.1-HASHHERE"]) $ do
+            getPackageDBsFromEnv `shouldReturn` PackageDBs True True ["foo2"] (Just ["pkg1-1.0", "pkgX-1.1.1-HASHHERE"])
 
     context "with a cabal sandbox present" $ do
       around_ (withCurrentDirectory "test/sandbox") $ do
         it "respects cabal sandboxes" $ do
             getPackageDBsFromEnv `shouldReturn`
-              PackageDBs False True ["/home/me/doctest-haskell/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
+              PackageDBs False True ["/home/me/doctest-haskell/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"] Nothing
 
         it "GHC_PACKAGE_PATH takes precedence" $
           withEnv "GHC_PACKAGE_PATH" (combineDirs ["foo", "bar"]) $ do
             getPackageDBsFromEnv `shouldReturn`
-              PackageDBs False False ["foo", "bar"]
+              PackageDBs False False ["foo", "bar"] Nothing