Expose MiniPackageInfo

chrisdone · chrisdone · commit fcd59d361b65 · 2015-06-01T19:51:26.000+02:00
diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs
@@ -283,7 +283,7 @@ getDependencies locals ranges = do
         ResolverSnapshot snapName -> do
             $logDebug $ "Checking resolver: " <> renderSnapName snapName
             mbp0 <- loadMiniBuildPlan snapName
-            globals <- getPackageVersionMapWithGlobalDb menv mbp0 []
+            globals <- getPackageVersionMapWithGlobalDb menv (Just mbp0) []
             let mbp = mbp0
                     { mbpPackages = mbpPackages mbp `Map.union`
                         fmap (\v -> MiniPackageInfo
@@ -323,7 +323,7 @@ getDependencies locals ranges = do
                     ]
             return deps
         ResolverGhc _ -> do
-            globals <- getPackageVersionMapWithGlobalDb menv []
+            globals <- getPackageVersionMapWithGlobalDb menv Nothing []
             return $ fmap (, M.empty) globals
 
     let checkDepRange (dep, users) =
@@ -353,7 +353,7 @@ installDependencies bopts deps' = do
     pkgDbs <- getPackageDatabases bconfig BTDeps
     menv <- getMinimalEnvOverride
 
-    installed <- liftM toIdents $ getPackageVersionMapWithGlobalDb menv pkgDbs
+    installed <- liftM toIdents $ getPackageVersionMapWithGlobalDb menv Nothing pkgDbs
     cabalPkgVer <- getCabalPkgVer menv
     let toInstall' = M.difference deps installed
 
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
@@ -258,7 +258,7 @@ loadBuildConfig mproject config = do
     ghcVersion <-
         case projectResolver project of
             ResolverSnapshot snapName -> do
-                mbp <- runReaderT (loadMiniBuildPlan snapName Map.empty) miniConfig
+                mbp <- runReaderT (loadMiniBuildPlan snapName) miniConfig
                 return $ mbpGhcVersion mbp
             ResolverGhc m -> return $ fromMajorVersion m
 
diff --git a/src/Stack/GhcPkg.hs b/src/Stack/GhcPkg.hs
@@ -108,10 +108,10 @@ ghcPkg menv pkgDbs args = do
 getPackageVersionMapWithGlobalDb
     :: (MonadCatch m, MonadIO m, MonadThrow m, MonadLogger m)
     => EnvOverride
-    -> MiniBuildPlan
+    -> Maybe MiniBuildPlan
     -> [Path Abs Dir] -- ^ package databases
     -> m (Map PackageName Version)
-getPackageVersionMapWithGlobalDb menv mbp pkgDbs = do
+getPackageVersionMapWithGlobalDb menv mmbp pkgDbs = do
     gdb <- getGlobalDB menv
     -- Use unionsWith max to account for cases where the snapshot introduces a
     -- newer version of a global package, see:
@@ -124,17 +124,32 @@ getPackageVersionMapWithGlobalDb menv mbp pkgDbs = do
             (M.unionsWith max .
              map (M.fromList . rights))
     globals <-
-        foldM
-            (\acc ident ->
-                  if versionMatches mbp ident
-                      then do
-                          hasProfiling <- packageHasProfiling [gdb] ident
-                          if hasProfiling
-                              then return acc
-                              else return (expunge ident acc)
-                      else return (expunge ident acc))
-            allGlobals
-            (map fromTuple (M.toList allGlobals))
+        case mmbp of
+            Nothing ->
+                return allGlobals
+            Just mbp ->
+                foldM
+                    (\acc ident ->
+                          let expunge ident acc =
+                                  foldr
+                                      M.delete
+                                      acc
+                                      (map
+                                           packageIdentifierName
+                                           (ident :
+                                            getTransInclusiveDeps mbp ident))
+                          in if versionMatches mbp ident
+                                 then do
+                                     hasProfiling <-
+                                         packageHasProfiling
+                                             [gdb]
+                                             ident
+                                     if hasProfiling
+                                         then return acc
+                                         else return (expunge ident acc)
+                                 else return (expunge ident acc))
+                    allGlobals
+                    (map fromTuple (M.toList allGlobals))
     rest <-
         getPackageVersions
             menv
@@ -146,12 +161,6 @@ getPackageVersionMapWithGlobalDb menv mbp pkgDbs = do
         (M.unionsWith
              max
              [globals, rest])
-  where
-    expunge ident acc = do
-        foldr
-            M.delete
-            acc
-            (map packageIdentifierName (ident : getTransInclusiveDeps mbp ident))
 
 -- | Get the packages depended on by the given package.
 versionMatches :: MiniBuildPlan -> PackageIdentifier -> Bool
diff --git a/src/Stack/Types/BuildPlan.hs b/src/Stack/Types/BuildPlan.hs
@@ -20,6 +20,7 @@ module Stack.Types.BuildPlan
     , Component (..)
     , SnapName (..)
     , MiniBuildPlan (..)
+    , MiniPackageInfo (..)
     , renderSnapName
     , parseSnapName
     ) where
