{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

-- Determine which packages are already installed

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

import           Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import           Path
import           Stack.Build.Cache
import           Stack.Constants
import           Stack.PackageDump
import           Stack.Prelude
import           Stack.SourceMap (getPLIVersion, loadVersion)
import           Stack.Types.Build
import           Stack.Types.Config
import           Stack.Types.GhcPkgId
import           Stack.Types.Package
import           Stack.Types.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 :: * -> *).
(MonadReader env m, HasEnvConfig env) =>
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, HasLogFunc 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