{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Stack.SourceMap
  ( mkProjectPackage
  , snapToDepPackage
  , additionalDepPackage
  , loadVersion
  , getPLIVersion
  , loadGlobalHints
  , DumpedGlobalPackage
  , actualFromGhc
  , actualFromHints
  , checkFlagsUsedThrowing
  , globalCondCheck
  , pruneGlobals
  , globalsFromHints
  , getCompilerInfo
  , immutableLocSha
  , loadProjectSnapshotCandidate
  , SnapshotCandidate
  , globalsFromDump
  ) where

import           Data.ByteString.Builder ( byteString )
import qualified Data.Conduit.List as CL
import qualified Data.Text as T
import qualified Distribution.PackageDescription as PD
import           Distribution.System ( Platform (..) )
import qualified Pantry.SHA256 as SHA256
import qualified RIO.Map as Map
import           RIO.Process ( HasProcessContext )
import qualified RIO.Set as Set
import           Stack.Constants ( stackProgName' )
import           Stack.PackageDump ( conduitDumpPackage, ghcPkgDump )
import           Stack.Prelude
import           Stack.Types.Build.Exception ( BuildPrettyException (..) )
import           Stack.Types.Compiler
                   ( ActualCompiler, actualToWanted, wantedToActual )
import           Stack.Types.CompilerPaths
                   ( CompilerPaths (..), GhcPkgExe, HasCompiler (..) )
import           Stack.Types.Config ( HasConfig )
import           Stack.Types.DumpPackage ( DumpPackage (..) )
import           Stack.Types.UnusedFlags ( FlagSource, UnusedFlags (..) )
import           Stack.Types.Platform ( HasPlatform (..) )
import           Stack.Types.Runner ( rslInLogL )
import           Stack.Types.SourceMap
                   ( CommonPackage (..), DepPackage (..), FromSnapshot (..)
                   , GlobalPackage (..), GlobalPackageVersion (..)
                   , ProjectPackage (..), SMActual (..), SMWanted (..)
                   )

-- | Create a 'ProjectPackage' from a directory containing a package.

mkProjectPackage ::
     forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => PrintWarnings
  -> ResolvedPath Dir
  -> Bool
     -- ^ Should Haddock documentation be built for the package?

  -> RIO env ProjectPackage
mkProjectPackage :: forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
printWarnings ResolvedPath Dir
dir Bool
buildHaddocks = do
  (PrintWarnings -> IO GenericPackageDescription
gpd, PackageName
name, Path Abs File
cabalfp) <-
    Maybe Text
-> Path Abs Dir
-> RIO
     env
     (PrintWarnings -> IO GenericPackageDescription, PackageName,
      Path Abs File)
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Maybe Text
-> Path Abs Dir
-> RIO
     env
     (PrintWarnings -> IO GenericPackageDescription, PackageName,
      Path Abs File)
loadCabalFilePath (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
stackProgName') (ResolvedPath Dir -> Path Abs Dir
forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath Dir
dir)
  ProjectPackage -> RIO env ProjectPackage
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectPackage
    { ppCabalFP :: Path Abs File
ppCabalFP = Path Abs File
cabalfp
    , ppResolvedDir :: ResolvedPath Dir
ppResolvedDir = ResolvedPath Dir
dir
    , ppCommon :: CommonPackage
ppCommon =
        CommonPackage
          { cpGPD :: IO GenericPackageDescription
cpGPD = PrintWarnings -> IO GenericPackageDescription
gpd PrintWarnings
printWarnings
          , cpName :: PackageName
cpName = PackageName
name
          , cpFlags :: Map FlagName Bool
cpFlags = Map FlagName Bool
forall a. Monoid a => a
mempty
          , cpGhcOptions :: [Text]
cpGhcOptions = [Text]
forall a. Monoid a => a
mempty
          , cpCabalConfigOpts :: [Text]
cpCabalConfigOpts = [Text]
forall a. Monoid a => a
mempty
          , cpHaddocks :: Bool
cpHaddocks = Bool
buildHaddocks
          }
    }

-- | Create a 'DepPackage' from a 'PackageLocation', from some additional

-- to a snapshot setting (extra-deps or command line)

additionalDepPackage ::
     forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => Bool
     -- ^ Should Haddock documentation be built for the package?

  -> PackageLocation
  -> RIO env DepPackage
additionalDepPackage :: forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Bool -> PackageLocation -> RIO env DepPackage
additionalDepPackage Bool
buildHaddocks PackageLocation
pl = do
  (PackageName
name, IO GenericPackageDescription
gpdio) <-
    case PackageLocation
pl of
      PLMutable ResolvedPath Dir
dir -> do
        (PrintWarnings -> IO GenericPackageDescription
gpdio, PackageName
name, Path Abs File
_cabalfp) <-
          Maybe Text
-> Path Abs Dir
-> RIO
     env
     (PrintWarnings -> IO GenericPackageDescription, PackageName,
      Path Abs File)
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Maybe Text
-> Path Abs Dir
-> RIO
     env
     (PrintWarnings -> IO GenericPackageDescription, PackageName,
      Path Abs File)
loadCabalFilePath (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
stackProgName') (ResolvedPath Dir -> Path Abs Dir
forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath Dir
dir)
        (PackageName, IO GenericPackageDescription)
-> RIO env (PackageName, IO GenericPackageDescription)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageName
name, PrintWarnings -> IO GenericPackageDescription
gpdio PrintWarnings
NoPrintWarnings)
      PLImmutable PackageLocationImmutable
pli -> do
        let PackageIdentifier PackageName
name Version
_ = PackageLocationImmutable -> PackageIdentifier
packageLocationIdent PackageLocationImmutable
pli
        RIO env GenericPackageDescription -> IO GenericPackageDescription
run <- RIO
  env
  (RIO env GenericPackageDescription -> IO GenericPackageDescription)
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
        (PackageName, IO GenericPackageDescription)
-> RIO env (PackageName, IO GenericPackageDescription)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageName
name, RIO env GenericPackageDescription -> IO GenericPackageDescription
run (RIO env GenericPackageDescription -> IO GenericPackageDescription)
-> RIO env GenericPackageDescription
-> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> RIO env GenericPackageDescription
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PackageLocationImmutable -> RIO env GenericPackageDescription
loadCabalFileImmutable PackageLocationImmutable
pli)
  DepPackage -> RIO env DepPackage
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DepPackage
    { dpLocation :: PackageLocation
dpLocation = PackageLocation
pl
    , dpHidden :: Bool
dpHidden = Bool
False
    , dpFromSnapshot :: FromSnapshot
dpFromSnapshot = FromSnapshot
NotFromSnapshot
    , dpCommon :: CommonPackage
dpCommon =
        CommonPackage
          { cpGPD :: IO GenericPackageDescription
cpGPD = IO GenericPackageDescription
gpdio
          , cpName :: PackageName
cpName = PackageName
name
          , cpFlags :: Map FlagName Bool
cpFlags = Map FlagName Bool
forall a. Monoid a => a
mempty
          , cpGhcOptions :: [Text]
cpGhcOptions = [Text]
forall a. Monoid a => a
mempty
          , cpCabalConfigOpts :: [Text]
cpCabalConfigOpts = [Text]
forall a. Monoid a => a
mempty
          , cpHaddocks :: Bool
cpHaddocks = Bool
buildHaddocks
          }
    }

snapToDepPackage ::
     forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => Bool
     -- ^ Should Haddock documentation be built for the package?

  -> PackageName
  -> SnapshotPackage
  -> RIO env DepPackage
snapToDepPackage :: forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Bool -> PackageName -> SnapshotPackage -> RIO env DepPackage
snapToDepPackage Bool
buildHaddocks PackageName
name SnapshotPackage{Bool
[Text]
Map FlagName Bool
PackageLocationImmutable
spLocation :: PackageLocationImmutable
spFlags :: Map FlagName Bool
spHidden :: Bool
spGhcOptions :: [Text]
spLocation :: SnapshotPackage -> PackageLocationImmutable
spFlags :: SnapshotPackage -> Map FlagName Bool
spHidden :: SnapshotPackage -> Bool
spGhcOptions :: SnapshotPackage -> [Text]
..} = do
  RIO env GenericPackageDescription -> IO GenericPackageDescription
run <- RIO
  env
  (RIO env GenericPackageDescription -> IO GenericPackageDescription)
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
  DepPackage -> RIO env DepPackage
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DepPackage
    { dpLocation :: PackageLocation
dpLocation = PackageLocationImmutable -> PackageLocation
PLImmutable PackageLocationImmutable
spLocation
    , dpHidden :: Bool
dpHidden = Bool
spHidden
    , dpFromSnapshot :: FromSnapshot
dpFromSnapshot = FromSnapshot
FromSnapshot
    , dpCommon :: CommonPackage
dpCommon =
        CommonPackage
          { cpGPD :: IO GenericPackageDescription
cpGPD = RIO env GenericPackageDescription -> IO GenericPackageDescription
run (RIO env GenericPackageDescription -> IO GenericPackageDescription)
-> RIO env GenericPackageDescription
-> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> RIO env GenericPackageDescription
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PackageLocationImmutable -> RIO env GenericPackageDescription
loadCabalFileImmutable PackageLocationImmutable
spLocation
          , cpName :: PackageName
cpName = PackageName
name
          , cpFlags :: Map FlagName Bool
cpFlags = Map FlagName Bool
spFlags
          , cpGhcOptions :: [Text]
cpGhcOptions = [Text]
spGhcOptions
          , cpCabalConfigOpts :: [Text]
cpCabalConfigOpts = [] -- No spCabalConfigOpts, not present in snapshots

          , cpHaddocks :: Bool
cpHaddocks = Bool
buildHaddocks
          }
    }

loadVersion :: MonadIO m => CommonPackage -> m Version
loadVersion :: forall (m :: * -> *). MonadIO m => CommonPackage -> m Version
loadVersion CommonPackage
common = do
  GenericPackageDescription
gpd <- IO GenericPackageDescription -> m GenericPackageDescription
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> m GenericPackageDescription)
-> IO GenericPackageDescription -> m GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD CommonPackage
common
  Version -> m Version
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
PD.package (PackageDescription -> PackageIdentifier)
-> PackageDescription -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
PD.packageDescription GenericPackageDescription
gpd)

getPLIVersion :: PackageLocationImmutable -> Version
getPLIVersion :: PackageLocationImmutable -> Version
getPLIVersion (PLIHackage (PackageIdentifier PackageName
_ Version
v) BlobKey
_ TreeKey
_) = Version
v
getPLIVersion (PLIArchive Archive
_ PackageMetadata
pm) = PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
forall a b. (a -> b) -> a -> b
$ PackageMetadata -> PackageIdentifier
pmIdent PackageMetadata
pm
getPLIVersion (PLIRepo Repo
_ PackageMetadata
pm) = PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
forall a b. (a -> b) -> a -> b
$ PackageMetadata -> PackageIdentifier
pmIdent PackageMetadata
pm

globalsFromDump ::
     (HasProcessContext env, HasTerm env)
  => GhcPkgExe
  -> RIO env (Map PackageName DumpedGlobalPackage)
globalsFromDump :: forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe -> RIO env (Map PackageName DumpedGlobalPackage)
globalsFromDump GhcPkgExe
pkgexe = do
  let pkgConduit :: ConduitT Text c (RIO env) (Map GhcPkgId DumpedGlobalPackage)
pkgConduit =    ConduitM Text DumpedGlobalPackage (RIO env) ()
forall (m :: * -> *).
MonadThrow m =>
ConduitM Text DumpedGlobalPackage m ()
conduitDumpPackage
                   ConduitM Text DumpedGlobalPackage (RIO env) ()
-> ConduitT
     DumpedGlobalPackage c (RIO env) (Map GhcPkgId DumpedGlobalPackage)
-> ConduitT Text c (RIO env) (Map GhcPkgId DumpedGlobalPackage)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (DumpedGlobalPackage -> Map GhcPkgId DumpedGlobalPackage)
-> ConduitT
     DumpedGlobalPackage c (RIO env) (Map GhcPkgId DumpedGlobalPackage)
forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
CL.foldMap (\DumpedGlobalPackage
dp -> GhcPkgId -> DumpedGlobalPackage -> Map GhcPkgId DumpedGlobalPackage
forall k a. k -> a -> Map k a
Map.singleton (DumpedGlobalPackage -> GhcPkgId
dpGhcPkgId DumpedGlobalPackage
dp) DumpedGlobalPackage
dp)
      toGlobals :: Map k DumpedGlobalPackage -> Map PackageName DumpedGlobalPackage
toGlobals Map k DumpedGlobalPackage
ds =
        [(PackageName, DumpedGlobalPackage)]
-> Map PackageName DumpedGlobalPackage
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PackageName, DumpedGlobalPackage)]
 -> Map PackageName DumpedGlobalPackage)
-> [(PackageName, DumpedGlobalPackage)]
-> Map PackageName DumpedGlobalPackage
forall a b. (a -> b) -> a -> b
$ (DumpedGlobalPackage -> (PackageName, DumpedGlobalPackage))
-> [DumpedGlobalPackage] -> [(PackageName, DumpedGlobalPackage)]
forall a b. (a -> b) -> [a] -> [b]
map (PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> (DumpedGlobalPackage -> PackageIdentifier)
-> DumpedGlobalPackage
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumpedGlobalPackage -> PackageIdentifier
dpPackageIdent (DumpedGlobalPackage -> PackageName)
-> (DumpedGlobalPackage -> DumpedGlobalPackage)
-> DumpedGlobalPackage
-> (PackageName, DumpedGlobalPackage)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& DumpedGlobalPackage -> DumpedGlobalPackage
forall a. a -> a
id) ([DumpedGlobalPackage] -> [(PackageName, DumpedGlobalPackage)])
-> [DumpedGlobalPackage] -> [(PackageName, DumpedGlobalPackage)]
forall a b. (a -> b) -> a -> b
$ Map k DumpedGlobalPackage -> [DumpedGlobalPackage]
forall k a. Map k a -> [a]
Map.elems Map k DumpedGlobalPackage
ds
  Map GhcPkgId DumpedGlobalPackage
-> Map PackageName DumpedGlobalPackage
forall {k}.
Map k DumpedGlobalPackage -> Map PackageName DumpedGlobalPackage
toGlobals (Map GhcPkgId DumpedGlobalPackage
 -> Map PackageName DumpedGlobalPackage)
-> RIO env (Map GhcPkgId DumpedGlobalPackage)
-> RIO env (Map PackageName DumpedGlobalPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcPkgExe
-> [Path Abs Dir]
-> ConduitM Text Void (RIO env) (Map GhcPkgId DumpedGlobalPackage)
-> RIO env (Map GhcPkgId DumpedGlobalPackage)
forall env a.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir] -> ConduitM Text Void (RIO env) a -> RIO env a
ghcPkgDump GhcPkgExe
pkgexe [] ConduitM Text Void (RIO env) (Map GhcPkgId DumpedGlobalPackage)
forall {c}.
ConduitT Text c (RIO env) (Map GhcPkgId DumpedGlobalPackage)
pkgConduit

globalsFromHints ::
     HasConfig env
  => WantedCompiler
  -> RIO env (Map PackageName Version)
globalsFromHints :: forall env.
HasConfig env =>
WantedCompiler -> RIO env (Map PackageName Version)
globalsFromHints WantedCompiler
compiler = do
  Maybe (Map PackageName Version)
mglobalHints <- WantedCompiler -> RIO env (Maybe (Map PackageName Version))
forall env.
(HasTerm env, HasPantryConfig env) =>
WantedCompiler -> RIO env (Maybe (Map PackageName Version))
loadGlobalHints WantedCompiler
compiler
  case Maybe (Map PackageName Version)
mglobalHints of
    Just Map PackageName Version
hints -> Map PackageName Version -> RIO env (Map PackageName Version)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map PackageName Version
hints
    Maybe (Map PackageName Version)
Nothing -> do
      [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
        [ String -> StyleDoc
flow String
"Unable to load global hints for"
        , String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc) -> String -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Text
forall a. Display a => a -> Text
textDisplay WantedCompiler
compiler
        ]
      Map PackageName Version -> RIO env (Map PackageName Version)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map PackageName Version
forall a. Monoid a => a
mempty

type DumpedGlobalPackage = DumpPackage

actualFromGhc ::
     (HasConfig env, HasCompiler env)
  => SMWanted
  -> ActualCompiler
  -> RIO env (SMActual DumpedGlobalPackage)
actualFromGhc :: forall env.
(HasConfig env, HasCompiler env) =>
SMWanted
-> ActualCompiler -> RIO env (SMActual DumpedGlobalPackage)
actualFromGhc SMWanted
smw ActualCompiler
ac = do
  Map PackageName DumpedGlobalPackage
globals <- Getting
  (Map PackageName DumpedGlobalPackage)
  env
  (Map PackageName DumpedGlobalPackage)
-> RIO env (Map PackageName DumpedGlobalPackage)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (Map PackageName DumpedGlobalPackage)
   env
   (Map PackageName DumpedGlobalPackage)
 -> RIO env (Map PackageName DumpedGlobalPackage))
-> Getting
     (Map PackageName DumpedGlobalPackage)
     env
     (Map PackageName DumpedGlobalPackage)
-> RIO env (Map PackageName DumpedGlobalPackage)
forall a b. (a -> b) -> a -> b
$ Getting (Map PackageName DumpedGlobalPackage) env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsLGetting (Map PackageName DumpedGlobalPackage) env CompilerPaths
-> ((Map PackageName DumpedGlobalPackage
     -> Const
          (Map PackageName DumpedGlobalPackage)
          (Map PackageName DumpedGlobalPackage))
    -> CompilerPaths
    -> Const (Map PackageName DumpedGlobalPackage) CompilerPaths)
-> Getting
     (Map PackageName DumpedGlobalPackage)
     env
     (Map PackageName DumpedGlobalPackage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> Map PackageName DumpedGlobalPackage)
-> SimpleGetter CompilerPaths (Map PackageName DumpedGlobalPackage)
forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Map PackageName DumpedGlobalPackage
cpGlobalDump
  SMActual DumpedGlobalPackage
-> RIO env (SMActual DumpedGlobalPackage)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SMActual
      { smaCompiler :: ActualCompiler
smaCompiler = ActualCompiler
ac
      , smaProject :: Map PackageName ProjectPackage
smaProject = SMWanted -> Map PackageName ProjectPackage
smwProject SMWanted
smw
      , smaDeps :: Map PackageName DepPackage
smaDeps = SMWanted -> Map PackageName DepPackage
smwDeps SMWanted
smw
      , smaGlobal :: Map PackageName DumpedGlobalPackage
smaGlobal = Map PackageName DumpedGlobalPackage
globals
      }

actualFromHints ::
     (HasConfig env)
  => SMWanted
  -> ActualCompiler
  -> RIO env (SMActual GlobalPackageVersion)
actualFromHints :: forall env.
HasConfig env =>
SMWanted
-> ActualCompiler -> RIO env (SMActual GlobalPackageVersion)
actualFromHints SMWanted
smw ActualCompiler
ac = do
  Map PackageName Version
globals <- WantedCompiler -> RIO env (Map PackageName Version)
forall env.
HasConfig env =>
WantedCompiler -> RIO env (Map PackageName Version)
globalsFromHints (ActualCompiler -> WantedCompiler
actualToWanted ActualCompiler
ac)
  SMActual GlobalPackageVersion
-> RIO env (SMActual GlobalPackageVersion)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SMActual
      { smaCompiler :: ActualCompiler
smaCompiler = ActualCompiler
ac
      , smaProject :: Map PackageName ProjectPackage
smaProject = SMWanted -> Map PackageName ProjectPackage
smwProject SMWanted
smw
      , smaDeps :: Map PackageName DepPackage
smaDeps = SMWanted -> Map PackageName DepPackage
smwDeps SMWanted
smw
      , smaGlobal :: Map PackageName GlobalPackageVersion
smaGlobal = (Version -> GlobalPackageVersion)
-> Map PackageName Version -> Map PackageName GlobalPackageVersion
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Version -> GlobalPackageVersion
GlobalPackageVersion Map PackageName Version
globals
      }

-- | Simple cond check for boot packages - checks only OS and Arch

globalCondCheck ::
     (HasConfig env)
  => RIO env (PD.ConfVar
  -> Either PD.ConfVar Bool)
globalCondCheck :: forall env.
HasConfig env =>
RIO env (ConfVar -> Either ConfVar Bool)
globalCondCheck = do
  Platform Arch
arch OS
os <- Getting Platform env Platform -> RIO env Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
Lens' env Platform
platformL
  let condCheck :: ConfVar -> Either ConfVar Bool
condCheck (PD.OS OS
os') = Bool -> Either ConfVar Bool
forall a. a -> Either ConfVar a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Either ConfVar Bool) -> Bool -> Either ConfVar Bool
forall a b. (a -> b) -> a -> b
$ OS
os' OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
os
      condCheck (PD.Arch Arch
arch') = Bool -> Either ConfVar Bool
forall a. a -> Either ConfVar a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Either ConfVar Bool) -> Bool -> Either ConfVar Bool
forall a b. (a -> b) -> a -> b
$ Arch
arch' Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
arch
      condCheck ConfVar
c = ConfVar -> Either ConfVar Bool
forall a b. a -> Either a b
Left ConfVar
c
  (ConfVar -> Either ConfVar Bool)
-> RIO env (ConfVar -> Either ConfVar Bool)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfVar -> Either ConfVar Bool
condCheck

checkFlagsUsedThrowing ::
     (MonadIO m, MonadThrow m)
  => Map PackageName (Map FlagName Bool)
  -> FlagSource
  -> Map PackageName ProjectPackage
  -> Map PackageName DepPackage
  -> m ()
checkFlagsUsedThrowing :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Map PackageName (Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> m ()
checkFlagsUsedThrowing Map PackageName (Map FlagName Bool)
packageFlags FlagSource
source Map PackageName ProjectPackage
prjPackages Map PackageName DepPackage
deps = do
  [UnusedFlags]
unusedFlags <-
    [(PackageName, Map FlagName Bool)]
-> ((PackageName, Map FlagName Bool) -> m (Maybe UnusedFlags))
-> m [UnusedFlags]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM (Map PackageName (Map FlagName Bool)
-> [(PackageName, Map FlagName Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName (Map FlagName Bool)
packageFlags) (((PackageName, Map FlagName Bool) -> m (Maybe UnusedFlags))
 -> m [UnusedFlags])
-> ((PackageName, Map FlagName Bool) -> m (Maybe UnusedFlags))
-> m [UnusedFlags]
forall a b. (a -> b) -> a -> b
$ \(PackageName
pname, Map FlagName Bool
flags) ->
      (PackageName, Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> m (Maybe UnusedFlags)
forall (m :: * -> *).
MonadIO m =>
(PackageName, Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> m (Maybe UnusedFlags)
getUnusedPackageFlags (PackageName
pname, Map FlagName Bool
flags) FlagSource
source Map PackageName ProjectPackage
prjPackages Map PackageName DepPackage
deps
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([UnusedFlags] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnusedFlags]
unusedFlags) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    BuildPrettyException -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM (BuildPrettyException -> m ()) -> BuildPrettyException -> m ()
forall a b. (a -> b) -> a -> b
$ Set UnusedFlags -> BuildPrettyException
InvalidFlagSpecification (Set UnusedFlags -> BuildPrettyException)
-> Set UnusedFlags -> BuildPrettyException
forall a b. (a -> b) -> a -> b
$ [UnusedFlags] -> Set UnusedFlags
forall a. Ord a => [a] -> Set a
Set.fromList [UnusedFlags]
unusedFlags

getUnusedPackageFlags ::
     MonadIO m
  => (PackageName, Map FlagName Bool)
  -> FlagSource
  -> Map PackageName ProjectPackage
  -> Map PackageName DepPackage
  -> m (Maybe UnusedFlags)
getUnusedPackageFlags :: forall (m :: * -> *).
MonadIO m =>
(PackageName, Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> m (Maybe UnusedFlags)
getUnusedPackageFlags (PackageName
name, Map FlagName Bool
userFlags) FlagSource
source Map PackageName ProjectPackage
prj Map PackageName DepPackage
deps =
  let maybeCommon :: Maybe CommonPackage
maybeCommon =     (ProjectPackage -> CommonPackage)
-> Maybe ProjectPackage -> Maybe CommonPackage
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProjectPackage -> CommonPackage
ppCommon (PackageName
-> Map PackageName ProjectPackage -> Maybe ProjectPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName ProjectPackage
prj)
                    Maybe CommonPackage -> Maybe CommonPackage -> Maybe CommonPackage
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (DepPackage -> CommonPackage)
-> Maybe DepPackage -> Maybe CommonPackage
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DepPackage -> CommonPackage
dpCommon (PackageName -> Map PackageName DepPackage -> Maybe DepPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName DepPackage
deps)
  in  case Maybe CommonPackage
maybeCommon of
        -- Package is not available as project or dependency

        Maybe CommonPackage
Nothing ->
          Maybe UnusedFlags -> m (Maybe UnusedFlags)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UnusedFlags -> m (Maybe UnusedFlags))
-> Maybe UnusedFlags -> m (Maybe UnusedFlags)
forall a b. (a -> b) -> a -> b
$ UnusedFlags -> Maybe UnusedFlags
forall a. a -> Maybe a
Just (UnusedFlags -> Maybe UnusedFlags)
-> UnusedFlags -> Maybe UnusedFlags
forall a b. (a -> b) -> a -> b
$ FlagSource -> PackageName -> UnusedFlags
UFNoPackage FlagSource
source PackageName
name
        -- Package exists, let's check if the flags are defined

        Just CommonPackage
common -> do
          GenericPackageDescription
gpd <- IO GenericPackageDescription -> m GenericPackageDescription
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> m GenericPackageDescription)
-> IO GenericPackageDescription -> m GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD CommonPackage
common
          let pname :: PackageName
pname = PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> PackageIdentifier -> PackageName
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
PD.package (PackageDescription -> PackageIdentifier)
-> PackageDescription -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
PD.packageDescription GenericPackageDescription
gpd
              pkgFlags :: Set FlagName
pkgFlags = [FlagName] -> Set FlagName
forall a. Ord a => [a] -> Set a
Set.fromList ([FlagName] -> Set FlagName) -> [FlagName] -> Set FlagName
forall a b. (a -> b) -> a -> b
$ (PackageFlag -> FlagName) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
PD.flagName ([PackageFlag] -> [FlagName]) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> [PackageFlag]
PD.genPackageFlags GenericPackageDescription
gpd
              unused :: Set FlagName
unused = Map FlagName Bool -> Set FlagName
forall k a. Map k a -> Set k
Map.keysSet (Map FlagName Bool -> Set FlagName)
-> Map FlagName Bool -> Set FlagName
forall a b. (a -> b) -> a -> b
$ Map FlagName Bool -> Set FlagName -> Map FlagName Bool
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map FlagName Bool
userFlags Set FlagName
pkgFlags
          if Set FlagName -> Bool
forall a. Set a -> Bool
Set.null Set FlagName
unused
            -- All flags are defined, nothing to do

            then Maybe UnusedFlags -> m (Maybe UnusedFlags)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UnusedFlags
forall a. Maybe a
Nothing
            -- Error about the undefined flags

            else Maybe UnusedFlags -> m (Maybe UnusedFlags)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UnusedFlags -> m (Maybe UnusedFlags))
-> Maybe UnusedFlags -> m (Maybe UnusedFlags)
forall a b. (a -> b) -> a -> b
$ UnusedFlags -> Maybe UnusedFlags
forall a. a -> Maybe a
Just (UnusedFlags -> Maybe UnusedFlags)
-> UnusedFlags -> Maybe UnusedFlags
forall a b. (a -> b) -> a -> b
$ FlagSource
-> PackageName -> Set FlagName -> Set FlagName -> UnusedFlags
UFFlagsNotDefined FlagSource
source PackageName
pname Set FlagName
pkgFlags Set FlagName
unused

pruneGlobals ::
     Map PackageName DumpedGlobalPackage
  -> Set PackageName
  -> Map PackageName GlobalPackage
pruneGlobals :: Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals Map PackageName DumpedGlobalPackage
globals Set PackageName
deps =
  let (Map PackageName [PackageName]
prunedGlobals, Map PackageName DumpedGlobalPackage
keptGlobals) =
        Map PackageName DumpedGlobalPackage
-> (DumpedGlobalPackage -> PackageName)
-> (DumpedGlobalPackage -> GhcPkgId)
-> (DumpedGlobalPackage -> [GhcPkgId])
-> Set PackageName
-> (Map PackageName [PackageName],
    Map PackageName DumpedGlobalPackage)
forall id a.
Ord id =>
Map PackageName a
-> (a -> PackageName)
-> (a -> id)
-> (a -> [id])
-> Set PackageName
-> (Map PackageName [PackageName], Map PackageName a)
partitionReplacedDependencies Map PackageName DumpedGlobalPackage
globals (PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> (DumpedGlobalPackage -> PackageIdentifier)
-> DumpedGlobalPackage
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumpedGlobalPackage -> PackageIdentifier
dpPackageIdent)
          DumpedGlobalPackage -> GhcPkgId
dpGhcPkgId DumpedGlobalPackage -> [GhcPkgId]
dpDepends Set PackageName
deps
  in  (DumpedGlobalPackage -> GlobalPackage)
-> Map PackageName DumpedGlobalPackage
-> Map PackageName GlobalPackage
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Version -> GlobalPackage
GlobalPackage (Version -> GlobalPackage)
-> (DumpedGlobalPackage -> Version)
-> DumpedGlobalPackage
-> GlobalPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version)
-> (DumpedGlobalPackage -> PackageIdentifier)
-> DumpedGlobalPackage
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumpedGlobalPackage -> PackageIdentifier
dpPackageIdent) Map PackageName DumpedGlobalPackage
keptGlobals Map PackageName GlobalPackage
-> Map PackageName GlobalPackage -> Map PackageName GlobalPackage
forall a. Semigroup a => a -> a -> a
<>
      ([PackageName] -> GlobalPackage)
-> Map PackageName [PackageName] -> Map PackageName GlobalPackage
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [PackageName] -> GlobalPackage
ReplacedGlobalPackage Map PackageName [PackageName]
prunedGlobals

getCompilerInfo :: (HasConfig env, HasCompiler env) => RIO env Builder
getCompilerInfo :: forall env. (HasConfig env, HasCompiler env) => RIO env Builder
getCompilerInfo = Getting Builder env Builder -> RIO env Builder
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Builder env Builder -> RIO env Builder)
-> Getting Builder env Builder -> RIO env Builder
forall a b. (a -> b) -> a -> b
$ Getting Builder env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsLGetting Builder env CompilerPaths
-> ((Builder -> Const Builder Builder)
    -> CompilerPaths -> Const Builder CompilerPaths)
-> Getting Builder env Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> Builder) -> SimpleGetter CompilerPaths Builder
forall s a. (s -> a) -> SimpleGetter s a
to (ByteString -> Builder
byteString (ByteString -> Builder)
-> (CompilerPaths -> ByteString) -> CompilerPaths -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerPaths -> ByteString
cpGhcInfo)

immutableLocSha :: PackageLocationImmutable -> Builder
immutableLocSha :: PackageLocationImmutable -> Builder
immutableLocSha = ByteString -> Builder
byteString (ByteString -> Builder)
-> (PackageLocationImmutable -> ByteString)
-> PackageLocationImmutable
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeKey -> ByteString
treeKeyToBs (TreeKey -> ByteString)
-> (PackageLocationImmutable -> TreeKey)
-> PackageLocationImmutable
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageLocationImmutable -> TreeKey
locationTreeKey
 where
  locationTreeKey :: PackageLocationImmutable -> TreeKey
locationTreeKey (PLIHackage PackageIdentifier
_ BlobKey
_ TreeKey
tk) = TreeKey
tk
  locationTreeKey (PLIArchive Archive
_ PackageMetadata
pm) = PackageMetadata -> TreeKey
pmTreeKey PackageMetadata
pm
  locationTreeKey (PLIRepo Repo
_ PackageMetadata
pm) = PackageMetadata -> TreeKey
pmTreeKey PackageMetadata
pm
  treeKeyToBs :: TreeKey -> ByteString
treeKeyToBs (TreeKey (BlobKey SHA256
sha FileSize
_)) = SHA256 -> ByteString
SHA256.toHexBytes SHA256
sha

type SnapshotCandidate env
  = [ResolvedPath Dir] -> RIO env (SMActual GlobalPackageVersion)

loadProjectSnapshotCandidate ::
     (HasConfig env)
  => RawSnapshotLocation
  -> PrintWarnings
  -> Bool
     -- ^ Should Haddock documentation be build for the package?

  -> RIO env (SnapshotCandidate env)
loadProjectSnapshotCandidate :: forall env.
HasConfig env =>
RawSnapshotLocation
-> PrintWarnings -> Bool -> RIO env (SnapshotCandidate env)
loadProjectSnapshotCandidate RawSnapshotLocation
loc PrintWarnings
printWarnings Bool
buildHaddocks = do
  Bool
debugRSL <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool env Bool
forall env. HasRunner env => SimpleGetter env Bool
SimpleGetter env Bool
rslInLogL
  (Snapshot
snapshot, [CompletedSL]
_, [CompletedPLI]
_) <- Bool
-> RawSnapshotLocation
-> Map RawSnapshotLocation SnapshotLocation
-> Map RawPackageLocationImmutable PackageLocationImmutable
-> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Bool
-> RawSnapshotLocation
-> Map RawSnapshotLocation SnapshotLocation
-> Map RawPackageLocationImmutable PackageLocationImmutable
-> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
loadAndCompleteSnapshotRaw' Bool
debugRSL RawSnapshotLocation
loc Map RawSnapshotLocation SnapshotLocation
forall k a. Map k a
Map.empty Map RawPackageLocationImmutable PackageLocationImmutable
forall k a. Map k a
Map.empty
  Map PackageName DepPackage
deps <- (PackageName -> SnapshotPackage -> RIO env DepPackage)
-> Map PackageName SnapshotPackage
-> RIO env (Map PackageName DepPackage)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (Bool -> PackageName -> SnapshotPackage -> RIO env DepPackage
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Bool -> PackageName -> SnapshotPackage -> RIO env DepPackage
snapToDepPackage Bool
False) (Snapshot -> Map PackageName SnapshotPackage
snapshotPackages Snapshot
snapshot)
  let wc :: WantedCompiler
wc = Snapshot -> WantedCompiler
snapshotCompiler Snapshot
snapshot
  Map PackageName GlobalPackageVersion
globals <- (Version -> GlobalPackageVersion)
-> Map PackageName Version -> Map PackageName GlobalPackageVersion
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Version -> GlobalPackageVersion
GlobalPackageVersion (Map PackageName Version -> Map PackageName GlobalPackageVersion)
-> RIO env (Map PackageName Version)
-> RIO env (Map PackageName GlobalPackageVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WantedCompiler -> RIO env (Map PackageName Version)
forall env.
HasConfig env =>
WantedCompiler -> RIO env (Map PackageName Version)
globalsFromHints WantedCompiler
wc
  SnapshotCandidate env -> RIO env (SnapshotCandidate env)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapshotCandidate env -> RIO env (SnapshotCandidate env))
-> SnapshotCandidate env -> RIO env (SnapshotCandidate env)
forall a b. (a -> b) -> a -> b
$ \[ResolvedPath Dir]
projectPackages -> do
    Map PackageName ProjectPackage
prjPkgs <- ([(PackageName, ProjectPackage)] -> Map PackageName ProjectPackage)
-> RIO env [(PackageName, ProjectPackage)]
-> RIO env (Map PackageName ProjectPackage)
forall a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(PackageName, ProjectPackage)] -> Map PackageName ProjectPackage
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (RIO env [(PackageName, ProjectPackage)]
 -> RIO env (Map PackageName ProjectPackage))
-> ((ResolvedPath Dir -> RIO env (PackageName, ProjectPackage))
    -> RIO env [(PackageName, ProjectPackage)])
-> (ResolvedPath Dir -> RIO env (PackageName, ProjectPackage))
-> RIO env (Map PackageName ProjectPackage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ResolvedPath Dir]
-> (ResolvedPath Dir -> RIO env (PackageName, ProjectPackage))
-> RIO env [(PackageName, ProjectPackage)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ResolvedPath Dir]
projectPackages ((ResolvedPath Dir -> RIO env (PackageName, ProjectPackage))
 -> RIO env (Map PackageName ProjectPackage))
-> (ResolvedPath Dir -> RIO env (PackageName, ProjectPackage))
-> RIO env (Map PackageName ProjectPackage)
forall a b. (a -> b) -> a -> b
$ \ResolvedPath Dir
resolved -> do
      ProjectPackage
pp <- PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
printWarnings ResolvedPath Dir
resolved Bool
buildHaddocks
      (PackageName, ProjectPackage)
-> RIO env (PackageName, ProjectPackage)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommonPackage -> PackageName
cpName (CommonPackage -> PackageName) -> CommonPackage -> PackageName
forall a b. (a -> b) -> a -> b
$ ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp, ProjectPackage
pp)
    ActualCompiler
compiler <- (CompilerException -> RIO env ActualCompiler)
-> (ActualCompiler -> RIO env ActualCompiler)
-> Either CompilerException ActualCompiler
-> RIO env ActualCompiler
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompilerException -> RIO env ActualCompiler
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ActualCompiler -> RIO env ActualCompiler
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerException ActualCompiler -> RIO env ActualCompiler)
-> Either CompilerException ActualCompiler
-> RIO env ActualCompiler
forall a b. (a -> b) -> a -> b
$ WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual (WantedCompiler -> Either CompilerException ActualCompiler)
-> WantedCompiler -> Either CompilerException ActualCompiler
forall a b. (a -> b) -> a -> b
$ Snapshot -> WantedCompiler
snapshotCompiler Snapshot
snapshot
    SMActual GlobalPackageVersion
-> RIO env (SMActual GlobalPackageVersion)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      SMActual
        { smaCompiler :: ActualCompiler
smaCompiler = ActualCompiler
compiler
        , smaProject :: Map PackageName ProjectPackage
smaProject = Map PackageName ProjectPackage
prjPkgs
        , smaDeps :: Map PackageName DepPackage
smaDeps = Map PackageName DepPackage
-> Map PackageName ProjectPackage -> Map PackageName DepPackage
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map PackageName DepPackage
deps Map PackageName ProjectPackage
prjPkgs
        , smaGlobal :: Map PackageName GlobalPackageVersion
smaGlobal = Map PackageName GlobalPackageVersion
globals
        }