{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}

-- Determine which packages are already installed

module Stack.Build.Installed
  ( InstalledMap
  , Installed (..)
  , getInstalled
  , InstallMap
  , toInstallMap
  ) where

import           Data.Conduit ( ZipSink (..), getZipSink )
import qualified Data.Conduit.List as CL
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import           Stack.Build.Cache ( getInstalledExes )
import           Stack.Constants ( wiredInPackages )
import           Stack.PackageDump
                   ( conduitDumpPackage, ghcPkgDump, pruneDeps )
import           Stack.Prelude
import           Stack.SourceMap ( getPLIVersion, loadVersion )
import           Stack.Types.CompilerPaths ( getGhcPkgExe )
import           Stack.Types.DumpPackage ( DumpPackage (..) )
import           Stack.Types.EnvConfig
                    ( HasEnvConfig, packageDatabaseDeps, packageDatabaseExtra
                    , packageDatabaseLocal
                    )
import           Stack.Types.GhcPkgId ( GhcPkgId )
import           Stack.Types.Package
                   ( InstallLocation (..), InstallMap, Installed (..)
                   , InstalledMap, InstalledPackageLocation (..)
                   )
import           Stack.Types.SourceMap
                   ( DepPackage (..), ProjectPackage (..), SourceMap (..) )

toInstallMap :: MonadIO m => SourceMap -> m InstallMap
toInstallMap :: forall (m :: * -> *). MonadIO m => SourceMap -> m InstallMap
toInstallMap SourceMap
sourceMap = do
  InstallMap
projectInstalls <-
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sourceMap) forall a b. (a -> b) -> a -> b
$ \ProjectPackage
pp -> do
      Version
version <- forall (m :: * -> *). MonadIO m => CommonPackage -> m Version
loadVersion (ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstallLocation
Local, Version
version)
  InstallMap
depInstalls <-
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sourceMap) forall a b. (a -> b) -> a -> b
$ \DepPackage
dp ->
      case DepPackage -> PackageLocation
dpLocation DepPackage
dp of
        PLImmutable PackageLocationImmutable
pli -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstallLocation
Snap, PackageLocationImmutable -> Version
getPLIVersion PackageLocationImmutable
pli)
        PLMutable ResolvedPath Dir
_ -> do
          Version
version <- forall (m :: * -> *). MonadIO m => CommonPackage -> m Version
loadVersion (DepPackage -> CommonPackage
dpCommon DepPackage
dp)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstallLocation
Local, Version
version)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ InstallMap
projectInstalls forall a. Semigroup a => a -> a -> a
<> InstallMap
depInstalls

-- | Returns the new InstalledMap and all of the locally registered packages.

getInstalled :: HasEnvConfig env
             => InstallMap -- ^ does not contain any installed information

             -> RIO env
                  ( InstalledMap
                  , [DumpPackage] -- globally installed

                  , [DumpPackage] -- snapshot installed

                  , [DumpPackage] -- locally installed

                  )
getInstalled :: forall env.
HasEnvConfig env =>
InstallMap
-> RIO
     env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
getInstalled {-opts-} InstallMap
installMap = do
  forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Finding out which packages are already installed"
  Path Abs Dir
snapDBPath <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps
  Path Abs Dir
localDBPath <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal
  [Path Abs Dir]
extraDBPaths <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m) =>
m [Path Abs Dir]
packageDatabaseExtra

  let loadDatabase' :: Maybe (InstalledPackageLocation, Path Abs Dir)
-> [LoadHelper] -> RIO env ([LoadHelper], [DumpPackage])
loadDatabase' = forall env.
HasEnvConfig env =>
InstallMap
-> Maybe (InstalledPackageLocation, Path Abs Dir)
-> [LoadHelper]
-> RIO env ([LoadHelper], [DumpPackage])
loadDatabase {-opts mcache-} InstallMap
installMap

  ([LoadHelper]
installedLibs0, [DumpPackage]
globalDumpPkgs) <- Maybe (InstalledPackageLocation, Path Abs Dir)
-> [LoadHelper] -> RIO env ([LoadHelper], [DumpPackage])
loadDatabase' forall a. Maybe a
Nothing []
  ([LoadHelper]
installedLibs1, [DumpPackage]
_extraInstalled) <-
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\([LoadHelper], [DumpPackage])
lhs' Path Abs Dir
pkgdb ->
      Maybe (InstalledPackageLocation, Path Abs Dir)
-> [LoadHelper] -> RIO env ([LoadHelper], [DumpPackage])
loadDatabase' (forall a. a -> Maybe a
Just (InstalledPackageLocation
ExtraGlobal, Path Abs Dir
pkgdb)) (forall a b. (a, b) -> a
fst ([LoadHelper], [DumpPackage])
lhs')
      ) ([LoadHelper]
installedLibs0, [DumpPackage]
globalDumpPkgs) [Path Abs Dir]
extraDBPaths
  ([LoadHelper]
installedLibs2, [DumpPackage]
snapshotDumpPkgs) <-
    Maybe (InstalledPackageLocation, Path Abs Dir)
-> [LoadHelper] -> RIO env ([LoadHelper], [DumpPackage])
loadDatabase' (forall a. a -> Maybe a
Just (InstallLocation -> InstalledPackageLocation
InstalledTo InstallLocation
Snap, Path Abs Dir
snapDBPath)) [LoadHelper]
installedLibs1
  ([LoadHelper]
installedLibs3, [DumpPackage]
localDumpPkgs) <-
    Maybe (InstalledPackageLocation, Path Abs Dir)
-> [LoadHelper] -> RIO env ([LoadHelper], [DumpPackage])
loadDatabase' (forall a. a -> Maybe a
Just (InstallLocation -> InstalledPackageLocation
InstalledTo InstallLocation
Local, Path Abs Dir
localDBPath)) [LoadHelper]
installedLibs2
  let installedLibs :: InstalledMap
installedLibs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LoadHelper -> (PackageName, (InstallLocation, Installed))
lhPair [LoadHelper]
installedLibs3

  -- Add in the executables that are installed, making sure to only trust a

  -- listed installation under the right circumstances (see below)

  let exesToSM :: InstallLocation -> [PackageIdentifier] -> InstalledMap
exesToSM InstallLocation
loc = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (InstallLocation -> PackageIdentifier -> InstalledMap
exeToSM InstallLocation
loc)
      exeToSM :: InstallLocation -> PackageIdentifier -> InstalledMap
exeToSM InstallLocation
loc (PackageIdentifier PackageName
name Version
version) =
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name InstallMap
installMap of
          -- Doesn't conflict with anything, so that's OK

          Maybe (InstallLocation, Version)
Nothing -> InstalledMap
m
          Just (InstallLocation
iLoc, Version
iVersion)
            -- Not the version we want, ignore it

            | Version
version forall a. Eq a => a -> a -> Bool
/= Version
iVersion Bool -> Bool -> Bool
|| InstallLocation -> InstallLocation -> Bool
mismatchingLoc InstallLocation
loc InstallLocation
iLoc -> forall k a. Map k a
Map.empty
            | Bool
otherwise -> InstalledMap
m
       where
        m :: InstalledMap
m = forall k a. k -> a -> Map k a
Map.singleton PackageName
name (InstallLocation
loc, PackageIdentifier -> Installed
Executable forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
version)
        mismatchingLoc :: InstallLocation -> InstallLocation -> Bool
mismatchingLoc InstallLocation
installed InstallLocation
target
          | InstallLocation
target forall a. Eq a => a -> a -> Bool
== InstallLocation
installed = Bool
False
          | InstallLocation
installed forall a. Eq a => a -> a -> Bool
== InstallLocation
Local = Bool
False -- snapshot dependency could end up

                                       -- in a local install as being mutable

          | Bool
otherwise = Bool
True
  [PackageIdentifier]
exesSnap <- forall env.
HasEnvConfig env =>
InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes InstallLocation
Snap
  [PackageIdentifier]
exesLocal <- forall env.
HasEnvConfig env =>
InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes InstallLocation
Local
  let installedMap :: InstalledMap
installedMap = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
        [ InstallLocation -> [PackageIdentifier] -> InstalledMap
exesToSM InstallLocation
Local [PackageIdentifier]
exesLocal
        , InstallLocation -> [PackageIdentifier] -> InstalledMap
exesToSM InstallLocation
Snap [PackageIdentifier]
exesSnap
        , InstalledMap
installedLibs
        ]

  forall (f :: * -> *) a. Applicative f => a -> f a
pure ( InstalledMap
installedMap
       , [DumpPackage]
globalDumpPkgs
       , [DumpPackage]
snapshotDumpPkgs
       , [DumpPackage]
localDumpPkgs
       )

-- | Outputs both the modified InstalledMap and the Set of all installed

-- packages in this database

--

-- The goal is to ascertain that the dependencies for a package are present,

-- that it has profiling if necessary, and that it matches the version and

-- location needed by the SourceMap

loadDatabase ::
     HasEnvConfig env
  => InstallMap -- ^ to determine which installed things we should include

  -> Maybe (InstalledPackageLocation, Path Abs Dir)
     -- ^ package database, Nothing for global

  -> [LoadHelper] -- ^ from parent databases

  -> RIO env ([LoadHelper], [DumpPackage])
loadDatabase :: forall env.
HasEnvConfig env =>
InstallMap
-> Maybe (InstalledPackageLocation, Path Abs Dir)
-> [LoadHelper]
-> RIO env ([LoadHelper], [DumpPackage])
loadDatabase InstallMap
installMap Maybe (InstalledPackageLocation, Path Abs Dir)
mdb [LoadHelper]
lhs0 = do
  GhcPkgExe
pkgexe <- forall env. HasCompiler env => RIO env GhcPkgExe
getGhcPkgExe
  ([(Allowed, LoadHelper)]
lhs1', [DumpPackage]
dps) <- forall env a.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir] -> ConduitM Text Void (RIO env) a -> RIO env a
ghcPkgDump GhcPkgExe
pkgexe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall a. Maybe a -> [a]
maybeToList Maybe (InstalledPackageLocation, Path Abs Dir)
mdb)) forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *).
MonadThrow m =>
ConduitM Text DumpPackage m ()
conduitDumpPackage forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
  DumpPackage Void (RIO env) ([(Allowed, LoadHelper)], [DumpPackage])
sink
  [LoadHelper]
lhs1 <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (forall env.
HasLogFunc env =>
Maybe (InstalledPackageLocation, Path Abs Dir)
-> (Allowed, LoadHelper) -> RIO env (Maybe LoadHelper)
processLoadResult Maybe (InstalledPackageLocation, Path Abs Dir)
mdb) [(Allowed, LoadHelper)]
lhs1'
  let lhs :: Map GhcPkgId LoadHelper
lhs = forall name id item.
(Ord name, Ord id) =>
(id -> name)
-> (item -> id)
-> (item -> [id])
-> (item -> item -> item)
-> [item]
-> Map name item
pruneDeps forall a. a -> a
id LoadHelper -> GhcPkgId
lhId LoadHelper -> [GhcPkgId]
lhDeps forall a b. a -> b -> a
const ([LoadHelper]
lhs0 forall a. [a] -> [a] -> [a]
++ [LoadHelper]
lhs1)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a -> b) -> [a] -> [b]
map (\LoadHelper
lh -> LoadHelper
lh { lhDeps :: [GhcPkgId]
lhDeps = [] }) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map GhcPkgId LoadHelper
lhs, [DumpPackage]
dps)
 where
  mloc :: Maybe InstalledPackageLocation
mloc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Maybe (InstalledPackageLocation, Path Abs Dir)
mdb
  sinkDP :: ConduitT DumpPackage c (RIO env) [(Allowed, LoadHelper)]
sinkDP =  forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map (InstallMap
-> Maybe InstalledPackageLocation -> DumpPackage -> Allowed
isAllowed InstallMap
installMap Maybe InstalledPackageLocation
mloc forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Maybe InstalledPackageLocation -> DumpPackage -> LoadHelper
toLoadHelper Maybe InstalledPackageLocation
mloc)
         forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
  sink :: ConduitT
  DumpPackage Void (RIO env) ([(Allowed, LoadHelper)], [DumpPackage])
sink =   forall i (m :: * -> *) r. ZipSink i m r -> ConduitT i Void m r
getZipSink forall a b. (a -> b) -> a -> b
$ (,)
       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
ZipSink forall {c}.
ConduitT DumpPackage c (RIO env) [(Allowed, LoadHelper)]
sinkDP
       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
ZipSink forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume

processLoadResult :: HasLogFunc env
                  => Maybe (InstalledPackageLocation, Path Abs Dir)
                  -> (Allowed, LoadHelper)
                  -> RIO env (Maybe LoadHelper)
processLoadResult :: forall env.
HasLogFunc env =>
Maybe (InstalledPackageLocation, Path Abs Dir)
-> (Allowed, LoadHelper) -> RIO env (Maybe LoadHelper)
processLoadResult Maybe (InstalledPackageLocation, Path Abs Dir)
_ (Allowed
Allowed, LoadHelper
lh) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just LoadHelper
lh)
processLoadResult Maybe (InstalledPackageLocation, Path Abs Dir)
mdb (Allowed
reason, LoadHelper
lh) = do
  forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$
       Utf8Builder
"Ignoring package "
    forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString (forall a b. (a, b) -> a
fst (LoadHelper -> (PackageName, (InstallLocation, Installed))
lhPair LoadHelper
lh)))
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe
         forall a. Monoid a => a
mempty
         ( \(InstalledPackageLocation, Path Abs Dir)
db ->    Utf8Builder
", from "
                  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (InstalledPackageLocation, Path Abs Dir)
db
                  forall a. Semigroup a => a -> a -> a
<> Utf8Builder
","
         )
         Maybe (InstalledPackageLocation, Path Abs Dir)
mdb
    forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" due to"
    forall a. Semigroup a => a -> a -> a
<> case Allowed
reason of
         Allowed
UnknownPkg -> Utf8Builder
" it being unknown to the resolver / extra-deps."
         WrongLocation Maybe InstalledPackageLocation
mloc InstallLocation
loc -> Utf8Builder
" wrong location: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (Maybe InstalledPackageLocation
mloc, InstallLocation
loc)
         WrongVersion Version
actual Version
wanted ->
              Utf8Builder
" wanting version "
          forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
wanted)
          forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" instead of "
          forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (Version -> String
versionString Version
actual)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

data Allowed
  = Allowed
  | UnknownPkg
  | WrongLocation (Maybe InstalledPackageLocation) InstallLocation
  | WrongVersion Version Version
  deriving (Allowed -> Allowed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Allowed -> Allowed -> Bool
$c/= :: Allowed -> Allowed -> Bool
== :: Allowed -> Allowed -> Bool
$c== :: Allowed -> Allowed -> Bool
Eq, Int -> Allowed -> ShowS
[Allowed] -> ShowS
Allowed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Allowed] -> ShowS
$cshowList :: [Allowed] -> ShowS
show :: Allowed -> String
$cshow :: Allowed -> String
showsPrec :: Int -> Allowed -> ShowS
$cshowsPrec :: Int -> Allowed -> ShowS
Show)

-- | Check if a can be included in the set of installed packages or not, based

-- on the package selections made by the user. This does not perform any

-- dirtiness or flag change checks.

isAllowed :: InstallMap
          -> Maybe InstalledPackageLocation
          -> DumpPackage
          -> Allowed
isAllowed :: InstallMap
-> Maybe InstalledPackageLocation -> DumpPackage -> Allowed
isAllowed InstallMap
installMap Maybe InstalledPackageLocation
mloc DumpPackage
dp = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name InstallMap
installMap of
  Maybe (InstallLocation, Version)
Nothing ->
    -- If the sourceMap has nothing to say about this package,

    -- check if it represents a sublibrary first

    -- See: https://github.com/commercialhaskell/stack/issues/3899

    case DumpPackage -> Maybe PackageIdentifier
dpParentLibIdent DumpPackage
dp of
      Just (PackageIdentifier PackageName
parentLibName Version
version') ->
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
parentLibName InstallMap
installMap of
          Maybe (InstallLocation, Version)
Nothing -> Allowed
checkNotFound
          Just (InstallLocation, Version)
instInfo
            | Version
version' forall a. Eq a => a -> a -> Bool
== Version
version -> (InstallLocation, Version) -> Allowed
checkFound (InstallLocation, Version)
instInfo
            | Bool
otherwise -> Allowed
checkNotFound -- different versions

      Maybe PackageIdentifier
Nothing -> Allowed
checkNotFound
  Just (InstallLocation, Version)
pii -> (InstallLocation, Version) -> Allowed
checkFound (InstallLocation, Version)
pii
 where
  PackageIdentifier PackageName
name Version
version = DumpPackage -> PackageIdentifier
dpPackageIdent DumpPackage
dp
  -- Ensure that the installed location matches where the sourceMap says it

  -- should be installed

  checkLocation :: InstallLocation -> Bool
checkLocation InstallLocation
Snap = Bool
True -- snapshot deps could become mutable after getting

                            -- any mutable dependency

  checkLocation InstallLocation
Local =
    Maybe InstalledPackageLocation
mloc forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (InstallLocation -> InstalledPackageLocation
InstalledTo InstallLocation
Local) Bool -> Bool -> Bool
|| Maybe InstalledPackageLocation
mloc forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just InstalledPackageLocation
ExtraGlobal -- 'locally' installed snapshot packages can come from extra dbs

  -- Check if a package is allowed if it is found in the sourceMap

  checkFound :: (InstallLocation, Version) -> Allowed
checkFound (InstallLocation
installLoc, Version
installVer)
    | Bool -> Bool
not (InstallLocation -> Bool
checkLocation InstallLocation
installLoc) = Maybe InstalledPackageLocation -> InstallLocation -> Allowed
WrongLocation Maybe InstalledPackageLocation
mloc InstallLocation
installLoc
    | Version
version forall a. Eq a => a -> a -> Bool
/= Version
installVer = Version -> Version -> Allowed
WrongVersion Version
version Version
installVer
    | Bool
otherwise = Allowed
Allowed
  -- check if a package is allowed if it is not found in the sourceMap

  checkNotFound :: Allowed
checkNotFound = case Maybe InstalledPackageLocation
mloc of
    -- The sourceMap has nothing to say about this global package, so we can use it

    Maybe InstalledPackageLocation
Nothing -> Allowed
Allowed
    Just InstalledPackageLocation
ExtraGlobal -> Allowed
Allowed
    -- For non-global packages, don't include unknown packages.

    -- See: https://github.com/commercialhaskell/stack/issues/292

    Just InstalledPackageLocation
_ -> Allowed
UnknownPkg

data LoadHelper = LoadHelper
  { LoadHelper -> GhcPkgId
lhId   :: !GhcPkgId
  , LoadHelper -> [GhcPkgId]
lhDeps :: ![GhcPkgId]
  , LoadHelper -> (PackageName, (InstallLocation, Installed))
lhPair :: !(PackageName, (InstallLocation, Installed))
  }
  deriving Int -> LoadHelper -> ShowS
[LoadHelper] -> ShowS
LoadHelper -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadHelper] -> ShowS
$cshowList :: [LoadHelper] -> ShowS
show :: LoadHelper -> String
$cshow :: LoadHelper -> String
showsPrec :: Int -> LoadHelper -> ShowS
$cshowsPrec :: Int -> LoadHelper -> ShowS
Show

toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage -> LoadHelper
toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage -> LoadHelper
toLoadHelper Maybe InstalledPackageLocation
mloc DumpPackage
dp = LoadHelper
  { lhId :: GhcPkgId
lhId = GhcPkgId
gid
  , lhDeps :: [GhcPkgId]
lhDeps =
      -- We always want to consider the wired in packages as having all of their

      -- dependencies installed, since we have no ability to reinstall them.

      -- This is especially important for using different minor versions of GHC,

      -- where the dependencies of wired-in packages may change slightly and

      -- therefore not match the snapshot.

      if PackageName
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageName
wiredInPackages
        then []
        else DumpPackage -> [GhcPkgId]
dpDepends DumpPackage
dp
  , lhPair :: (PackageName, (InstallLocation, Installed))
lhPair = (PackageName
name, (Maybe InstalledPackageLocation -> InstallLocation
toPackageLocation Maybe InstalledPackageLocation
mloc, PackageIdentifier
-> GhcPkgId -> Maybe (Either License License) -> Installed
Library PackageIdentifier
ident GhcPkgId
gid (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DumpPackage -> Maybe License
dpLicense DumpPackage
dp)))
  }
 where
  gid :: GhcPkgId
gid = DumpPackage -> GhcPkgId
dpGhcPkgId DumpPackage
dp
  ident :: PackageIdentifier
ident@(PackageIdentifier PackageName
name Version
_) = DumpPackage -> PackageIdentifier
dpPackageIdent DumpPackage
dp

toPackageLocation :: Maybe InstalledPackageLocation -> InstallLocation
toPackageLocation :: Maybe InstalledPackageLocation -> InstallLocation
toPackageLocation Maybe InstalledPackageLocation
Nothing = InstallLocation
Snap
toPackageLocation (Just InstalledPackageLocation
ExtraGlobal) = InstallLocation
Snap
toPackageLocation (Just (InstalledTo InstallLocation
loc)) = InstallLocation
loc