Support for extra-package-dbs in 'stack ghci'

Extra package dbs support for GHC_PACKAGE_PATH
commercialhaskell · Nov 12, 2015 · 4799edc · 4799edc
1 parent 2f00f7b
commit 4799edc
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 5 deletions.
diff --git a/src/Stack/GhcPkg.hs b/src/Stack/GhcPkg.hs
@@ -170,10 +170,11 @@ getCabalPkgVer menv wc =
         maybe (throwM $ Couldn'tFindPkgId cabalPackageName) return
 
 -- | Get the value for GHC_PACKAGE_PATH
-mkGhcPackagePath :: Bool -> Path Abs Dir -> Path Abs Dir -> Path Abs Dir -> Text
-mkGhcPackagePath locals localdb deps globaldb =
+mkGhcPackagePath :: Bool -> Path Abs Dir -> Path Abs Dir -> [Path Abs Dir] -> Path Abs Dir -> Text
+mkGhcPackagePath locals localdb deps extras globaldb =
   T.pack $ intercalate [searchPathSeparator] $ concat
     [ [toFilePathNoTrailingSep localdb | locals]
     , [toFilePathNoTrailingSep deps]
+    , [toFilePathNoTrailingSep db | db <- reverse extras]
     , [toFilePathNoTrailingSep globaldb]
     ]
diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs
@@ -239,7 +239,8 @@ setupEnv mResolveMissingGHC = do
     localdb <- runReaderT packageDatabaseLocal envConfig0
     createDatabase menv wc localdb
     globaldb <- getGlobalDB menv wc
-    let mkGPP locals = mkGhcPackagePath locals localdb deps globaldb
+    extras <- runReaderT packageDatabaseExtra envConfig0
+    let mkGPP locals = mkGhcPackagePath locals localdb deps extras globaldb
 
     distDir <- runReaderT distRelativeDir envConfig0
 

diff --git a/src/main/Main.hs b/src/main/Main.hs
@@ -427,6 +427,7 @@ pathCmd keys go =
             menv <- getMinimalEnvOverride
             snap <- packageDatabaseDeps
             local <- packageDatabaseLocal
+            extra <- packageDatabaseExtra
             global <- getGlobalDB menv =<< getWhichCompiler
             snaproot <- installationRootDeps
             localroot <- installationRootLocal
@@ -456,7 +457,8 @@ pathCmd keys go =
                                     snaproot
                                     localroot
                                     distDir
-                                    hpcDir))))
+                                    hpcDir
+                                    extra))))
 
 -- | Passed to all the path printers as a source of info.
 data PathInfo = PathInfo
@@ -469,6 +471,7 @@ data PathInfo = PathInfo
     , piLocalRoot   :: Path Abs Dir
     , piDistDir     :: Path Rel Dir
     , piHpcDir      :: Path Abs Dir
+    , piExtraDbs    :: [Path Abs Dir]
     }
 
 -- | The paths of interest to a user. The first tuple string is used
@@ -517,7 +520,7 @@ paths =
       , T.pack . toFilePathNoTrailingSep . piGlobalDb )
     , ( "GHC_PACKAGE_PATH environment variable"
       , "ghc-package-path"
-      , \pi -> mkGhcPackagePath True (piLocalDb pi) (piSnapDb pi) (piGlobalDb pi) )
+      , \pi -> mkGhcPackagePath True (piLocalDb pi) (piSnapDb pi) (piExtraDbs pi) (piGlobalDb pi))
     , ( "Snapshot installation root"
       , "snapshot-install-root"
       , T.pack . toFilePathNoTrailingSep . piSnapRoot )