@@ -10,6 +10,7 @@ module Stack.Build.Installed
10
10
11
11
import Data.Conduit ( ZipSink (.. ), getZipSink )
12
12
import qualified Data.Conduit.List as CL
13
+ import Data.Foldable ( Foldable (.. ) )
13
14
import qualified Data.Set as Set
14
15
import qualified Data.Map.Strict as Map
15
16
import Stack.Build.Cache ( getInstalledExes )
@@ -19,21 +20,23 @@ import Stack.PackageDump
19
20
import Stack.Prelude
20
21
import Stack.SourceMap ( getPLIVersion , loadVersion )
21
22
import Stack.Types.CompilerPaths ( getGhcPkgExe )
22
- import Stack.Types.DumpPackage ( DumpPackage (.. ), dpParentLibIdent , SublibDump (.. ), sdPackageName )
23
+ import Stack.Types.DumpPackage
24
+ ( DumpPackage (.. ), SublibDump (.. ), dpParentLibIdent
25
+ , sdPackageName
26
+ )
23
27
import Stack.Types.EnvConfig
24
28
( HasEnvConfig , packageDatabaseDeps , packageDatabaseExtra
25
29
, packageDatabaseLocal
26
30
)
27
31
import Stack.Types.GhcPkgId ( GhcPkgId )
28
32
import Stack.Types.Package
29
33
( InstallLocation (.. ), InstallMap , Installed (.. )
30
- , InstalledMap , InstalledPackageLocation (.. )
31
- , PackageDatabase (.. ), PackageDbVariety (.. )
32
- , toPackageDbVariety , InstalledLibraryInfo ( InstalledLibraryInfo , iliSublib , iliId )
34
+ , InstalledLibraryInfo (.. ), InstalledMap
35
+ , InstalledPackageLocation (.. ), PackageDatabase (.. )
36
+ , PackageDbVariety ( .. ), toPackageDbVariety
33
37
)
34
38
import Stack.Types.SourceMap
35
39
( DepPackage (.. ), ProjectPackage (.. ), SourceMap (.. ) )
36
- import Data.Foldable (Foldable (.. ))
37
40
38
41
toInstallMap :: MonadIO m => SourceMap -> m InstallMap
39
42
toInstallMap sourceMap = do
@@ -76,7 +79,8 @@ getInstalled {-opts-} installMap = do
76
79
loadDatabase' (UserPkgDb (InstalledTo Snap ) snapDBPath) installedLibs1
77
80
(installedLibs3, localDumpPkgs) <-
78
81
loadDatabase' (UserPkgDb (InstalledTo Local ) localDBPath) installedLibs2
79
- let installedLibs = foldr' gatherAndTransformSubLoadHelper mempty installedLibs3
82
+ let installedLibs =
83
+ foldr' gatherAndTransformSubLoadHelper mempty installedLibs3
80
84
81
85
-- Add in the executables that are installed, making sure to only trust a
82
86
-- listed installation under the right circumstances (see below)
@@ -280,27 +284,39 @@ toLoadHelper pkgDb dp = LoadHelper
280
284
toInstallLocation WriteOnlyDb = Snap
281
285
toInstallLocation MutableDb = Local
282
286
283
- -- | This is where sublibraries and main libraries are assembled into
284
- -- a single entity Installed package, where all ghcPkgId live.
287
+ -- | This is where sublibraries and main libraries are assembled into a single
288
+ -- entity Installed package, where all ghcPkgId live.
285
289
gatherAndTransformSubLoadHelper ::
286
- LoadHelper
290
+ LoadHelper
287
291
-> Map PackageName (InstallLocation , Installed )
288
292
-> Map PackageName (InstallLocation , Installed )
289
293
gatherAndTransformSubLoadHelper lh =
290
294
Map. insertWith onPreviousLoadHelper key value
291
- where
292
- -- here we assume that both have the same location
293
- -- which already was a prior assumption in stack
294
- onPreviousLoadHelper (pLoc, Library pn incomingLibInfo) (_, Library _ existingLibInfo) =
295
- (pLoc, Library pn existingLibInfo{
296
- iliSublib= Map. union (iliSublib incomingLibInfo) (iliSublib existingLibInfo),
297
- iliId= if isJust $ lhSublibrary lh then iliId existingLibInfo else iliId incomingLibInfo
298
- })
299
- onPreviousLoadHelper newVal _oldVal = newVal
300
- (key, value) = case lhSublibrary lh of
301
- Nothing -> (rawPackageName, rawValue)
302
- Just sd -> (sdPackageName sd, updateAsSublib sd <$> rawValue)
303
- (rawPackageName, rawValue) = lhPair lh
304
- updateAsSublib sd (Library (PackageIdentifier _sublibMungedPackageName version) libInfo) =
305
- Library (PackageIdentifier key version) libInfo{iliSublib= Map. singleton (sdLibraryName sd) (iliId libInfo)}
306
- updateAsSublib _ v = v
295
+ where
296
+ -- Here we assume that both have the same location which already was a prior
297
+ -- assumption in Stack.
298
+ onPreviousLoadHelper
299
+ (pLoc, Library pn incomingLibInfo)
300
+ (_, Library _ existingLibInfo)
301
+ = ( pLoc
302
+ , Library pn existingLibInfo
303
+ { iliSublib = Map. union
304
+ (iliSublib incomingLibInfo)
305
+ (iliSublib existingLibInfo)
306
+ , iliId = if isJust $ lhSublibrary lh
307
+ then iliId existingLibInfo
308
+ else iliId incomingLibInfo
309
+ }
310
+ )
311
+ onPreviousLoadHelper newVal _oldVal = newVal
312
+ (key, value) = case lhSublibrary lh of
313
+ Nothing -> (rawPackageName, rawValue)
314
+ Just sd -> (sdPackageName sd, updateAsSublib sd <$> rawValue)
315
+ (rawPackageName, rawValue) = lhPair lh
316
+ updateAsSublib
317
+ sd
318
+ (Library (PackageIdentifier _sublibMungedPackageName version) libInfo)
319
+ = Library
320
+ (PackageIdentifier key version)
321
+ libInfo {iliSublib = Map. singleton (sdLibraryName sd) (iliId libInfo)}
322
+ updateAsSublib _ v = v
0 commit comments