    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    -- | Content addressable Haskell package management, providing for
    -- secure, reproducible acquisition of Haskell package contents and
    -- metadata.
    --
    -- @since 0.1.0.0
    module Pantry
      ( -- * Running
        PantryConfig
      , HackageSecurityConfig (..)
      , defaultHackageSecurityConfig
      , defaultCasaRepoPrefix
      , defaultCasaMaxPerRequest
      , HasPantryConfig (..)
      , withPantryConfig
      , HpackExecutable (..)

        -- ** Convenience
      , PantryApp
      , runPantryApp
      , runPantryAppClean
      , runPantryAppWith
      , hpackExecutableL

        -- * Types

        -- ** Exceptions
      , PantryException (..)

        -- ** Cabal types
      , PackageName
      , Version
      , FlagName
      , PackageIdentifier (..)

        -- ** Files
      , FileSize (..)
      , RelFilePath (..)
      , ResolvedPath (..)
      , Unresolved

        -- ** Cryptography
      , SHA256
      , TreeKey (..)
      , BlobKey (..)

        -- ** Packages
      , RawPackageMetadata (..)
      , PackageMetadata (..)
      , Package (..)

        -- ** Hackage
      , CabalFileInfo (..)
      , Revision (..)
      , PackageIdentifierRevision (..)
      , UsePreferredVersions (..)

        -- ** Archives
      , RawArchive (..)
      , Archive (..)
      , ArchiveLocation (..)

        -- ** Repos
      , Repo (..)
      , RepoType (..)
      , withRepo

        -- ** Package location
      , RawPackageLocation (..)
      , PackageLocation (..)
      , toRawPL
      , RawPackageLocationImmutable (..)
      , PackageLocationImmutable (..)

        -- ** Snapshots
      , RawSnapshotLocation (..)
      , SnapshotLocation (..)
      , toRawSL
      , RawSnapshot (..)
      , Snapshot (..)
      , RawSnapshotPackage (..)
      , SnapshotPackage (..)
      , RawSnapshotLayer (..)
      , SnapshotLayer (..)
      , toRawSnapshotLayer
      , WantedCompiler (..)

        -- * Loading values
      , resolvePaths
      , loadPackageRaw
      , tryLoadPackageRawViaCasa
      , loadPackage
      , loadRawSnapshotLayer
      , loadSnapshotLayer
      , loadSnapshot
      , loadAndCompleteSnapshot
      , loadAndCompleteSnapshotRaw
      , CompletedSL (..)
      , CompletedPLI (..)
      , addPackagesToSnapshot
      , AddPackagesConfig (..)

        -- * Completion functions
      , CompletePackageLocation (..)
      , completePackageLocation
      , completeSnapshotLocation
      , warnMissingCabalFile

        -- * Parsers
      , parseWantedCompiler
      , parseRawSnapshotLocation
      , parsePackageIdentifierRevision
      , parseHackageText

        -- ** Cabal values
      , parsePackageIdentifier
      , parsePackageName
      , parsePackageNameThrowing
      , parseFlagName
      , parseVersion
      , parseVersionThrowing

        -- * Stackage snapshots
      , ltsSnapshotLocation
      , nightlySnapshotLocation

        -- * Cabal helpers
      , packageIdentifierString
      , packageNameString
      , flagNameString
      , versionString
      , moduleNameString
      , CabalString (..)
      , toCabalStringMap
      , unCabalStringMap
      , gpdPackageIdentifier
      , gpdPackageName
      , gpdVersion

        -- * Package location
      , fetchPackages
      , unpackPackageLocationRaw
      , unpackPackageLocation
      , getPackageLocationName
      , getRawPackageLocationIdent
      , packageLocationIdent
      , packageLocationVersion
      , getRawPackageLocationTreeKey
      , getPackageLocationTreeKey

        -- * Cabal files
      , loadCabalFileRaw
      , loadCabalFile
      , loadCabalFileRawImmutable
      , loadCabalFileImmutable
      , loadCabalFilePath
      , findOrGenerateCabalFile
      , PrintWarnings (..)

        -- * Hackage index
      , updateHackageIndex
      , DidUpdateOccur (..)
      , RequireHackageIndex (..)
      , hackageIndexTarballL
      , getHackagePackageVersions
      , getLatestHackageVersion
      , getLatestHackageLocation
      , getLatestHackageRevision
      , getHackageTypoCorrections
      , loadGlobalHints
      , partitionReplacedDependencies
        -- * Snapshot cache
      , SnapshotCacheHash (..)
      , withSnapshotCache
      ) where

    import Database.Persist (entityKey)
    import RIO
    import Conduit
    import Control.Arrow (right)
    import Control.Monad.State.Strict (State, execState, get, modify')
    import qualified RIO.Map as Map
    import qualified RIO.Set as Set
    import qualified RIO.ByteString as B
    import qualified RIO.Text as T
    import qualified RIO.List as List
    import qualified RIO.FilePath as FilePath
    import Pantry.Archive
    import Pantry.Casa
    import Casa.Client (thParserCasaRepo, CasaRepoPrefix)
    import Pantry.Repo
    import qualified Pantry.SHA256 as SHA256
    import Pantry.Storage hiding (TreeEntry, PackageName, Version)
    import Pantry.Tree
    import Pantry.Types as P
    import Pantry.Hackage
    import Path (Path, Abs, File, toFilePath, Dir, (</>), filename, parseAbsDir, parent, parseRelFile)
    import Path.IO (doesFileExist, resolveDir', listDir)
    import Distribution.PackageDescription (GenericPackageDescription, FlagName)
    import qualified Distribution.PackageDescription as D
    import Distribution.Parsec (PWarning (..), showPos)
    import qualified Hpack
    import qualified Hpack.Config as Hpack
    import Network.HTTP.Download
    import RIO.PrettyPrint
    import RIO.PrettyPrint.StylesUpdate
    import RIO.Process
    import RIO.Directory (getAppUserDataDirectory)
    import qualified Data.Yaml as Yaml
    import Pantry.Internal.AesonExtended (WithJSONWarnings (..), Value)
    import Data.Aeson.Types (parseEither)
    import Data.Monoid (Endo (..))
    import Pantry.HTTP
    import Data.Char (isHexDigit)
    import Data.Time (getCurrentTime, diffUTCTime)

    -- | Create a new 'PantryConfig' with the given settings.
    --
    -- For something easier to use in simple cases, see 'runPantryApp'.
    --
    -- @since 0.1.0.0
    withPantryConfig
      :: HasLogFunc env
      => Path Abs Dir
      -- ^ pantry root directory, where the SQLite database and Hackage
      -- downloads are kept.
      -> HackageSecurityConfig
      -- ^ Hackage configuration. You probably want
      -- 'defaultHackageSecurityConfig'.
      -> HpackExecutable
      -- ^ When converting an hpack @package.yaml@ file to a cabal file,
      -- what version of hpack should we use?
      -> Int
      -- ^ Maximum connection count
      -> CasaRepoPrefix
      -- ^ The casa pull URL e.g. https://casa.fpcomplete.com/v1/pull.
      -> Int
      -- ^ Max casa keys to pull per request.
      -> (PantryConfig -> RIO env a)
      -- ^ What to do with the config
      -> RIO env a
    withPantryConfig :: Path Abs Dir
    -> HackageSecurityConfig
    -> HpackExecutable
    -> Int
    -> CasaRepoPrefix
    -> Int
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig root :: Path Abs Dir
    root hsc :: HackageSecurityConfig
    hsc he :: HpackExecutable
    he count :: Int
    count pullURL :: CasaRepoPrefix
    pullURL maxPerRequest :: Int
    maxPerRequest inner :: PantryConfig -> RIO env a
    inner = do
      env
    env <- RIO env env
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      Path Rel File
    pantryRelFile <- FilePath -> RIO env (Path Rel File)
    forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
    parseRelFile "pantry.sqlite3"
      -- Silence persistent's logging output, which is really noisy
      LogFunc -> RIO LogFunc a -> RIO env a
    forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
    runRIO (LogFunc
    forall a. Monoid a => a
    mempty :: LogFunc) (RIO LogFunc a -> RIO env a) -> RIO LogFunc a -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> (Storage -> RIO LogFunc a) -> RIO LogFunc a
    forall env a.
    HasLogFunc env =>
    Path Abs File -> (Storage -> RIO env a) -> RIO env a
    initStorage (Path Abs Dir
    root Path Abs Dir -> Path Rel File -> Path Abs File
    forall b t. Path b Dir -> Path Rel t -> Path b t
    </> Path Rel File
    pantryRelFile) ((Storage -> RIO LogFunc a) -> RIO LogFunc a)
    -> (Storage -> RIO LogFunc a) -> RIO LogFunc a
    forall a b. (a -> b) -> a -> b
    $ \storage :: Storage
    storage -> env -> RIO env a -> RIO LogFunc a
    forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
    runRIO env
    env (RIO env a -> RIO LogFunc a) -> RIO env a -> RIO LogFunc a
    forall a b. (a -> b) -> a -> b
    $ do
        MVar Bool
    ur <- Bool -> RIO env (MVar Bool)
    forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
    newMVar Bool
    True
        IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref1 <- Map RawPackageLocationImmutable GenericPackageDescription
    -> RIO
         env
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
    newIORef Map RawPackageLocationImmutable GenericPackageDescription
    forall a. Monoid a => a
    mempty
        IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    ref2 <- Map
      (Path Abs Dir)
      (PrintWarnings -> IO GenericPackageDescription, PackageName,
       Path Abs File)
    -> RIO
         env
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
    forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
    newIORef Map
      (Path Abs Dir)
      (PrintWarnings -> IO GenericPackageDescription, PackageName,
       Path Abs File)
    forall a. Monoid a => a
    mempty
        PantryConfig -> RIO env a
    inner $WPantryConfig :: HackageSecurityConfig
    -> HpackExecutable
    -> Path Abs Dir
    -> Storage
    -> MVar Bool
    -> IORef
         (Map RawPackageLocationImmutable GenericPackageDescription)
    -> IORef
         (Map
            (Path Abs Dir)
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File))
    -> Int
    -> CasaRepoPrefix
    -> Int
    -> PantryConfig
    PantryConfig
          { pcHackageSecurity :: HackageSecurityConfig
    pcHackageSecurity = HackageSecurityConfig
    hsc
          , pcHpackExecutable :: HpackExecutable
    pcHpackExecutable = HpackExecutable
    he
          , pcRootDir :: Path Abs Dir
    pcRootDir = Path Abs Dir
    root
          , pcStorage :: Storage
    pcStorage = Storage
    storage
          , pcUpdateRef :: MVar Bool
    pcUpdateRef = MVar Bool
    ur
          , pcConnectionCount :: Int
    pcConnectionCount = Int
    count
          , pcParsedCabalFilesRawImmutable :: IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    pcParsedCabalFilesRawImmutable = IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref1
          , pcParsedCabalFilesMutable :: IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    pcParsedCabalFilesMutable = IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    ref2
          , pcCasaRepoPrefix :: CasaRepoPrefix
    pcCasaRepoPrefix = CasaRepoPrefix
    pullURL
          , pcCasaMaxPerRequest :: Int
    pcCasaMaxPerRequest = Int
    maxPerRequest
          }

    -- | Default pull URL for Casa.
    --
    -- @since 0.1.1.1
    defaultCasaRepoPrefix :: CasaRepoPrefix
    defaultCasaRepoPrefix :: CasaRepoPrefix
    defaultCasaRepoPrefix = $(thParserCasaRepo "https://casa.fpcomplete.com")

    -- | Default max keys to pull per request.
    --
    -- @since 0.1.1.1
    defaultCasaMaxPerRequest :: Int
    defaultCasaMaxPerRequest :: Int
    defaultCasaMaxPerRequest = 1280

    -- | Default 'HackageSecurityConfig' value using the official Hackage server.
    --
    -- @since 0.1.0.0
    defaultHackageSecurityConfig :: HackageSecurityConfig
    defaultHackageSecurityConfig :: HackageSecurityConfig
    defaultHackageSecurityConfig = $WHackageSecurityConfig :: [Text] -> Int -> Text -> Bool -> HackageSecurityConfig
    HackageSecurityConfig
      { hscKeyIds :: [Text]
    hscKeyIds =
          [ "0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d"
          , "1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42"
          , "280b10153a522681163658cb49f632cde3f38d768b736ddbc901d99a1a772833"
          , "2a96b1889dc221c17296fcc2bb34b908ca9734376f0f361660200935916ef201"
          , "2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3"
          , "51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"
          , "772e9f4c7db33d251d5c6e357199c819e569d130857dc225549b40845ff0890d"
          , "aa315286e6ad281ad61182235533c41e806e5a787e0b6d1e7eef3f09d137d2e9"
          , "fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0"
          ]
      , hscKeyThreshold :: Int
    hscKeyThreshold = 3
      , hscDownloadPrefix :: Text
    hscDownloadPrefix = "https://s3.amazonaws.com/hackage.fpcomplete.com/"
      , hscIgnoreExpiry :: Bool
    hscIgnoreExpiry = Bool
    False
      }

    -- | Returns the latest version of the given package available from
    -- Hackage.
    --
    -- @since 0.1.0.0
    getLatestHackageVersion
      :: (HasPantryConfig env, HasLogFunc env)
      => RequireHackageIndex
      -> PackageName -- ^ package name
      -> UsePreferredVersions
      -> RIO env (Maybe PackageIdentifierRevision)
    getLatestHackageVersion :: RequireHackageIndex
    -> PackageName
    -> UsePreferredVersions
    -> RIO env (Maybe PackageIdentifierRevision)
    getLatestHackageVersion req :: RequireHackageIndex
    req name :: PackageName
    name preferred :: UsePreferredVersions
    preferred =
      (((((Version, Map Revision BlobKey),
      Map Version (Map Revision BlobKey))
     -> (Version, Map Revision BlobKey))
    -> Maybe
         ((Version, Map Revision BlobKey),
          Map Version (Map Revision BlobKey))
    -> Maybe (Version, Map Revision BlobKey)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Version, Map Revision BlobKey),
     Map Version (Map Revision BlobKey))
    -> (Version, Map Revision BlobKey)
    forall a b. (a, b) -> a
    fst (Maybe
       ((Version, Map Revision BlobKey),
        Map Version (Map Revision BlobKey))
     -> Maybe (Version, Map Revision BlobKey))
    -> (Map Version (Map Revision BlobKey)
        -> Maybe
             ((Version, Map Revision BlobKey),
              Map Version (Map Revision BlobKey)))
    -> Map Version (Map Revision BlobKey)
    -> Maybe (Version, Map Revision BlobKey)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Version (Map Revision BlobKey)
    -> Maybe
         ((Version, Map Revision BlobKey),
          Map Version (Map Revision BlobKey))
    forall k a. Map k a -> Maybe ((k, a), Map k a)
    Map.maxViewWithKey) (Map Version (Map Revision BlobKey)
     -> Maybe (Version, Map Revision BlobKey))
    -> ((Version, Map Revision BlobKey)
        -> Maybe PackageIdentifierRevision)
    -> Map Version (Map Revision BlobKey)
    -> Maybe PackageIdentifierRevision
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> (Version, Map Revision BlobKey) -> Maybe PackageIdentifierRevision
    forall k.
    (Version, Map k BlobKey) -> Maybe PackageIdentifierRevision
    go) (Map Version (Map Revision BlobKey)
     -> Maybe PackageIdentifierRevision)
    -> RIO env (Map Version (Map Revision BlobKey))
    -> RIO env (Maybe PackageIdentifierRevision)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    getHackagePackageVersions RequireHackageIndex
    req UsePreferredVersions
    preferred PackageName
    name
      where
        go :: (Version, Map k BlobKey) -> Maybe PackageIdentifierRevision
    go (version :: Version
    version, m :: Map k BlobKey
    m) = do
          (_rev :: k
    _rev, BlobKey sha :: SHA256
    sha size :: FileSize
    size) <- ((k, BlobKey), Map k BlobKey) -> (k, BlobKey)
    forall a b. (a, b) -> a
    fst (((k, BlobKey), Map k BlobKey) -> (k, BlobKey))
    -> Maybe ((k, BlobKey), Map k BlobKey) -> Maybe (k, BlobKey)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map k BlobKey -> Maybe ((k, BlobKey), Map k BlobKey)
    forall k a. Map k a -> Maybe ((k, a), Map k a)
    Map.maxViewWithKey Map k BlobKey
    m
          PackageIdentifierRevision -> Maybe PackageIdentifierRevision
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageIdentifierRevision -> Maybe PackageIdentifierRevision)
    -> PackageIdentifierRevision -> Maybe PackageIdentifierRevision
    forall a b. (a -> b) -> a -> b
    $ PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    PackageIdentifierRevision PackageName
    name Version
    version (CabalFileInfo -> PackageIdentifierRevision)
    -> CabalFileInfo -> PackageIdentifierRevision
    forall a b. (a -> b) -> a -> b
    $ SHA256 -> Maybe FileSize -> CabalFileInfo
    CFIHash SHA256
    sha (Maybe FileSize -> CabalFileInfo)
    -> Maybe FileSize -> CabalFileInfo
    forall a b. (a -> b) -> a -> b
    $ FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size

    -- | Returns location of the latest version of the given package available from
    -- Hackage.
    --
    -- @since 0.1.0.0
    getLatestHackageLocation
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RequireHackageIndex
      -> PackageName -- ^ package name
      -> UsePreferredVersions
      -> RIO env (Maybe PackageLocationImmutable)
    getLatestHackageLocation :: RequireHackageIndex
    -> PackageName
    -> UsePreferredVersions
    -> RIO env (Maybe PackageLocationImmutable)
    getLatestHackageLocation req :: RequireHackageIndex
    req name :: PackageName
    name preferred :: UsePreferredVersions
    preferred = do
      Maybe (Version, Map Revision BlobKey)
    mversion <-
        (((Version, Map Revision BlobKey),
      Map Version (Map Revision BlobKey))
     -> (Version, Map Revision BlobKey))
    -> Maybe
         ((Version, Map Revision BlobKey),
          Map Version (Map Revision BlobKey))
    -> Maybe (Version, Map Revision BlobKey)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Version, Map Revision BlobKey),
     Map Version (Map Revision BlobKey))
    -> (Version, Map Revision BlobKey)
    forall a b. (a, b) -> a
    fst (Maybe
       ((Version, Map Revision BlobKey),
        Map Version (Map Revision BlobKey))
     -> Maybe (Version, Map Revision BlobKey))
    -> (Map Version (Map Revision BlobKey)
        -> Maybe
             ((Version, Map Revision BlobKey),
              Map Version (Map Revision BlobKey)))
    -> Map Version (Map Revision BlobKey)
    -> Maybe (Version, Map Revision BlobKey)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Version (Map Revision BlobKey)
    -> Maybe
         ((Version, Map Revision BlobKey),
          Map Version (Map Revision BlobKey))
    forall k a. Map k a -> Maybe ((k, a), Map k a)
    Map.maxViewWithKey (Map Version (Map Revision BlobKey)
     -> Maybe (Version, Map Revision BlobKey))
    -> RIO env (Map Version (Map Revision BlobKey))
    -> RIO env (Maybe (Version, Map Revision BlobKey))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex
    -> UsePreferredVersions
    -> PackageName
    -> RIO env (Map Version (Map Revision BlobKey))
    getHackagePackageVersions RequireHackageIndex
    req UsePreferredVersions
    preferred PackageName
    name
      let mVerCfKey :: Maybe (Version, BlobKey)
    mVerCfKey = do
            (version :: Version
    version, revisions :: Map Revision BlobKey
    revisions) <- Maybe (Version, Map Revision BlobKey)
    mversion
            (_rev :: Revision
    _rev, cfKey :: BlobKey
    cfKey) <- ((Revision, BlobKey), Map Revision BlobKey) -> (Revision, BlobKey)
    forall a b. (a, b) -> a
    fst (((Revision, BlobKey), Map Revision BlobKey)
     -> (Revision, BlobKey))
    -> Maybe ((Revision, BlobKey), Map Revision BlobKey)
    -> Maybe (Revision, BlobKey)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map Revision BlobKey
    -> Maybe ((Revision, BlobKey), Map Revision BlobKey)
    forall k a. Map k a -> Maybe ((k, a), Map k a)
    Map.maxViewWithKey Map Revision BlobKey
    revisions
            (Version, BlobKey) -> Maybe (Version, BlobKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Version
    version, BlobKey
    cfKey)

      Maybe (Version, BlobKey)
    -> ((Version, BlobKey) -> RIO env PackageLocationImmutable)
    -> RIO env (Maybe PackageLocationImmutable)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM Maybe (Version, BlobKey)
    mVerCfKey (((Version, BlobKey) -> RIO env PackageLocationImmutable)
     -> RIO env (Maybe PackageLocationImmutable))
    -> ((Version, BlobKey) -> RIO env PackageLocationImmutable)
    -> RIO env (Maybe PackageLocationImmutable)
    forall a b. (a -> b) -> a -> b
    $ \(version :: Version
    version, cfKey :: BlobKey
    cfKey@(BlobKey sha :: SHA256
    sha size :: FileSize
    size)) -> do
        let pir :: PackageIdentifierRevision
    pir = PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    PackageIdentifierRevision PackageName
    name Version
    version (SHA256 -> Maybe FileSize -> CabalFileInfo
    CFIHash SHA256
    sha (FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size))
        TreeKey
    treeKey' <- PackageIdentifierRevision -> RIO env TreeKey
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision -> RIO env TreeKey
    getHackageTarballKey PackageIdentifierRevision
    pir
        PackageLocationImmutable -> RIO env PackageLocationImmutable
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageLocationImmutable -> RIO env PackageLocationImmutable)
    -> PackageLocationImmutable -> RIO env PackageLocationImmutable
    forall a b. (a -> b) -> a -> b
    $ PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
    PLIHackage (PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    version) BlobKey
    cfKey TreeKey
    treeKey'

    -- | Returns the latest revision of the given package version available from
    -- Hackage.
    --
    -- @since 0.1.0.0
    getLatestHackageRevision
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RequireHackageIndex
      -> PackageName -- ^ package name
      -> Version
      -> RIO env (Maybe (Revision, BlobKey, TreeKey))
    getLatestHackageRevision :: RequireHackageIndex
    -> PackageName
    -> Version
    -> RIO env (Maybe (Revision, BlobKey, TreeKey))
    getLatestHackageRevision req :: RequireHackageIndex
    req name :: PackageName
    name version :: Version
    version = do
      Map Revision BlobKey
    revisions <- RequireHackageIndex
    -> PackageName -> Version -> RIO env (Map Revision BlobKey)
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex
    -> PackageName -> Version -> RIO env (Map Revision BlobKey)
    getHackagePackageVersionRevisions RequireHackageIndex
    req PackageName
    name Version
    version
      case (((Revision, BlobKey), Map Revision BlobKey)
     -> (Revision, BlobKey))
    -> Maybe ((Revision, BlobKey), Map Revision BlobKey)
    -> Maybe (Revision, BlobKey)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Revision, BlobKey), Map Revision BlobKey) -> (Revision, BlobKey)
    forall a b. (a, b) -> a
    fst (Maybe ((Revision, BlobKey), Map Revision BlobKey)
     -> Maybe (Revision, BlobKey))
    -> Maybe ((Revision, BlobKey), Map Revision BlobKey)
    -> Maybe (Revision, BlobKey)
    forall a b. (a -> b) -> a -> b
    $ Map Revision BlobKey
    -> Maybe ((Revision, BlobKey), Map Revision BlobKey)
    forall k a. Map k a -> Maybe ((k, a), Map k a)
    Map.maxViewWithKey Map Revision BlobKey
    revisions of
        Nothing -> Maybe (Revision, BlobKey, TreeKey)
    -> RIO env (Maybe (Revision, BlobKey, TreeKey))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Revision, BlobKey, TreeKey)
    forall a. Maybe a
    Nothing
        Just (revision :: Revision
    revision, cfKey :: BlobKey
    cfKey@(BlobKey sha :: SHA256
    sha size :: FileSize
    size)) -> do
          let cfi :: CabalFileInfo
    cfi = SHA256 -> Maybe FileSize -> CabalFileInfo
    CFIHash SHA256
    sha (FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size)
          TreeKey
    treeKey' <- PackageIdentifierRevision -> RIO env TreeKey
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision -> RIO env TreeKey
    getHackageTarballKey (PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    PackageIdentifierRevision PackageName
    name Version
    version CabalFileInfo
    cfi)
          Maybe (Revision, BlobKey, TreeKey)
    -> RIO env (Maybe (Revision, BlobKey, TreeKey))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Revision, BlobKey, TreeKey)
     -> RIO env (Maybe (Revision, BlobKey, TreeKey)))
    -> Maybe (Revision, BlobKey, TreeKey)
    -> RIO env (Maybe (Revision, BlobKey, TreeKey))
    forall a b. (a -> b) -> a -> b
    $ (Revision, BlobKey, TreeKey) -> Maybe (Revision, BlobKey, TreeKey)
    forall a. a -> Maybe a
    Just (Revision
    revision, BlobKey
    cfKey, TreeKey
    treeKey')

    -- | Fetch keys and blobs and insert into the database where possible.
    fetchTreeKeys ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => [RawPackageLocationImmutable]
      -> RIO env ()
    fetchTreeKeys :: [RawPackageLocationImmutable] -> RIO env ()
    fetchTreeKeys treeKeys :: [RawPackageLocationImmutable]
    treeKeys = do
      () -> RIO env ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      -- Find all tree keys that are missing from the database.
      [RawPackageLocationImmutable]
    packageLocationsMissing :: [RawPackageLocationImmutable] <-
        ReaderT SqlBackend (RIO env) [RawPackageLocationImmutable]
    -> RIO env [RawPackageLocationImmutable]
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage
          ((RawPackageLocationImmutable -> ReaderT SqlBackend (RIO env) Bool)
    -> [RawPackageLocationImmutable]
    -> ReaderT SqlBackend (RIO env) [RawPackageLocationImmutable]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM
             ((Maybe (Entity Tree) -> Bool)
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    -> ReaderT SqlBackend (RIO env) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Entity Tree) -> Bool
    forall a. Maybe a -> Bool
    isNothing (ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
     -> ReaderT SqlBackend (RIO env) Bool)
    -> (RawPackageLocationImmutable
        -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)))
    -> RawPackageLocationImmutable
    -> ReaderT SqlBackend (RIO env) Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    -> (TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)))
    -> Maybe TreeKey
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe (Entity Tree)
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Entity Tree)
    forall a. Maybe a
    Nothing) TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey (Maybe TreeKey
     -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)))
    -> (RawPackageLocationImmutable -> Maybe TreeKey)
    -> RawPackageLocationImmutable
    -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey)
             [RawPackageLocationImmutable]
    treeKeys)
      UTCTime
    pullTreeStart <- IO UTCTime -> RIO env UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
      -- Pull down those tree keys from Casa, automatically inserting into
      -- our local database.
      Map TreeKey Tree
    treeKeyBlobs :: Map TreeKey P.Tree <-
        ([(TreeKey, Tree)] -> Map TreeKey Tree)
    -> RIO env [(TreeKey, Tree)] -> RIO env (Map TreeKey Tree)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap
          [(TreeKey, Tree)] -> Map TreeKey Tree
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
          (ReaderT SqlBackend (RIO env) [(TreeKey, Tree)]
    -> RIO env [(TreeKey, Tree)]
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage
             (ConduitT
      ()
      Void
      (ResourceT (ReaderT SqlBackend (RIO env)))
      [(TreeKey, Tree)]
    -> ReaderT SqlBackend (RIO env) [(TreeKey, Tree)]
    forall (m :: * -> *) r.
    MonadUnliftIO m =>
    ConduitT () Void (ResourceT m) r -> m r
    runConduitRes
                ([BlobKey]
    -> ConduitT
         ()
         (BlobKey, ByteString)
         (ResourceT (ReaderT SqlBackend (RIO env)))
         ()
    forall (f :: * -> *) env i.
    (Foldable f, HasPantryConfig env, HasLogFunc env) =>
    f BlobKey
    -> ConduitT
         i
         (BlobKey, ByteString)
         (ResourceT (ReaderT SqlBackend (RIO env)))
         ()
    casaBlobSource
                   ((TreeKey -> BlobKey) -> [TreeKey] -> [BlobKey]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TreeKey -> BlobKey
    unTreeKey ((RawPackageLocationImmutable -> Maybe TreeKey)
    -> [RawPackageLocationImmutable] -> [TreeKey]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey [RawPackageLocationImmutable]
    packageLocationsMissing)) ConduitT
      ()
      (BlobKey, ByteString)
      (ResourceT (ReaderT SqlBackend (RIO env)))
      ()
    -> ConduitM
         (BlobKey, ByteString)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         [(TreeKey, Tree)]
    -> ConduitT
         ()
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         [(TreeKey, Tree)]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .|
                 ((BlobKey, ByteString)
     -> ResourceT (ReaderT SqlBackend (RIO env)) (TreeKey, Tree))
    -> ConduitT
         (BlobKey, ByteString)
         (TreeKey, Tree)
         (ResourceT (ReaderT SqlBackend (RIO env)))
         ()
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ConduitT a b m ()
    mapMC (BlobKey, ByteString)
    -> ResourceT (ReaderT SqlBackend (RIO env)) (TreeKey, Tree)
    forall (m :: * -> *).
    MonadThrow m =>
    (BlobKey, ByteString) -> m (TreeKey, Tree)
    parseTreeM ConduitT
      (BlobKey, ByteString)
      (TreeKey, Tree)
      (ResourceT (ReaderT SqlBackend (RIO env)))
      ()
    -> ConduitM
         (TreeKey, Tree)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         [(TreeKey, Tree)]
    -> ConduitM
         (BlobKey, ByteString)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         [(TreeKey, Tree)]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .|
                 ConduitM
      (TreeKey, Tree)
      Void
      (ResourceT (ReaderT SqlBackend (RIO env)))
      [(TreeKey, Tree)]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    sinkList)))
      UTCTime
    pullTreeEnd <- IO UTCTime -> RIO env UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
      let pulledPackages :: [RawPackageLocationImmutable]
    pulledPackages =
            (TreeKey -> Maybe RawPackageLocationImmutable)
    -> [TreeKey] -> [RawPackageLocationImmutable]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
              (\treeKey' :: TreeKey
    treeKey' ->
                 (RawPackageLocationImmutable -> Bool)
    -> [RawPackageLocationImmutable]
    -> Maybe RawPackageLocationImmutable
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    List.find
                   ((Maybe TreeKey -> Maybe TreeKey -> Bool
    forall a. Eq a => a -> a -> Bool
    == TreeKey -> Maybe TreeKey
    forall a. a -> Maybe a
    Just TreeKey
    treeKey') (Maybe TreeKey -> Bool)
    -> (RawPackageLocationImmutable -> Maybe TreeKey)
    -> RawPackageLocationImmutable
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey)
                   [RawPackageLocationImmutable]
    packageLocationsMissing)
              (Map TreeKey Tree -> [TreeKey]
    forall k a. Map k a -> [k]
    Map.keys Map TreeKey Tree
    treeKeyBlobs)
      -- Pull down all unique file blobs.
      let uniqueFileBlobKeys :: Set BlobKey
          uniqueFileBlobKeys :: Set BlobKey
    uniqueFileBlobKeys =
            (Tree -> Set BlobKey) -> Map TreeKey Tree -> Set BlobKey
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap
              (\(P.TreeMap files :: Map SafeFilePath TreeEntry
    files) -> [BlobKey] -> Set BlobKey
    forall a. Ord a => [a] -> Set a
    Set.fromList ((TreeEntry -> BlobKey) -> [TreeEntry] -> [BlobKey]
    forall a b. (a -> b) -> [a] -> [b]
    map TreeEntry -> BlobKey
    teBlob (Map SafeFilePath TreeEntry -> [TreeEntry]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Map SafeFilePath TreeEntry
    files)))
              Map TreeKey Tree
    treeKeyBlobs
      UTCTime
    pullBlobStart <- IO UTCTime -> RIO env UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
      Int
    pulledBlobKeys :: Int <-
        ReaderT SqlBackend (RIO env) Int -> RIO env Int
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage
          (ConduitT () Void (ResourceT (ReaderT SqlBackend (RIO env))) Int
    -> ReaderT SqlBackend (RIO env) Int
    forall (m :: * -> *) r.
    MonadUnliftIO m =>
    ConduitT () Void (ResourceT m) r -> m r
    runConduitRes
             (Set BlobKey
    -> ConduitT
         ()
         (BlobKey, ByteString)
         (ResourceT (ReaderT SqlBackend (RIO env)))
         ()
    forall (f :: * -> *) env i.
    (Foldable f, HasPantryConfig env, HasLogFunc env) =>
    f BlobKey
    -> ConduitT
         i
         (BlobKey, ByteString)
         (ResourceT (ReaderT SqlBackend (RIO env)))
         ()
    casaBlobSource Set BlobKey
    uniqueFileBlobKeys ConduitT
      ()
      (BlobKey, ByteString)
      (ResourceT (ReaderT SqlBackend (RIO env)))
      ()
    -> ConduitM
         (BlobKey, ByteString)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         Int
    -> ConduitT () Void (ResourceT (ReaderT SqlBackend (RIO env))) Int
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .| ((BlobKey, ByteString) -> Int)
    -> ConduitT
         (BlobKey, ByteString)
         Int
         (ResourceT (ReaderT SqlBackend (RIO env)))
         ()
    forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
    mapC (Int -> (BlobKey, ByteString) -> Int
    forall a b. a -> b -> a
    const 1) ConduitT
      (BlobKey, ByteString)
      Int
      (ResourceT (ReaderT SqlBackend (RIO env)))
      ()
    -> ConduitM Int Void (ResourceT (ReaderT SqlBackend (RIO env))) Int
    -> ConduitM
         (BlobKey, ByteString)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         Int
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
    .| ConduitM Int Void (ResourceT (ReaderT SqlBackend (RIO env))) Int
    forall (m :: * -> *) a o. (Monad m, Num a) => ConduitT a o m a
    sumC))
      UTCTime
    pullBlobEnd <- IO UTCTime -> RIO env UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug
        ("Pulled from Casa: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         [Utf8Builder] -> Utf8Builder
    forall a. Monoid a => [a] -> a
    mconcat (Utf8Builder -> [Utf8Builder] -> [Utf8Builder]
    forall a. a -> [a] -> [a]
    List.intersperse ", " ((RawPackageLocationImmutable -> Utf8Builder)
    -> [RawPackageLocationImmutable] -> [Utf8Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display [RawPackageLocationImmutable]
    pulledPackages)) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         " (" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display (FilePath -> Text
    T.pack (NominalDiffTime -> FilePath
    forall a. Show a => a -> FilePath
    show (UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    pullTreeEnd UTCTime
    pullTreeStart))) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         "), " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         Int -> Utf8Builder -> Utf8Builder
    plural Int
    pulledBlobKeys "file" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         " (" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display (FilePath -> Text
    T.pack (NominalDiffTime -> FilePath
    forall a. Show a => a -> FilePath
    show (UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    pullBlobEnd UTCTime
    pullBlobStart))) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
         ")")
      -- Store the tree for each missing package.
      [RawPackageLocationImmutable]
    -> (RawPackageLocationImmutable -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_
        [RawPackageLocationImmutable]
    packageLocationsMissing
        (\rawPackageLocationImmutable :: RawPackageLocationImmutable
    rawPackageLocationImmutable ->
           let mkey :: Maybe TreeKey
    mkey = RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey RawPackageLocationImmutable
    rawPackageLocationImmutable
            in case Maybe TreeKey
    mkey of
                 Nothing ->
                   Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug
                     ("Ignoring package with no tree key " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                      RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    rawPackageLocationImmutable Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                      ", can't look in Casa for it.")
                 Just key :: TreeKey
    key ->
                   case TreeKey -> Map TreeKey Tree -> Maybe Tree
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup TreeKey
    key Map TreeKey Tree
    treeKeyBlobs of
                     Nothing ->
                       Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug
                         ("Package key " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> TreeKey -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display TreeKey
    key Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> " (" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                          RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    rawPackageLocationImmutable Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                          ") not returned from Casa.")
                     Just tree :: Tree
    tree -> do
                       PackageIdentifier
    identifier <-
                         RawPackageLocationImmutable -> RIO env PackageIdentifier
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env PackageIdentifier
    getRawPackageLocationIdent RawPackageLocationImmutable
    rawPackageLocationImmutable
                       case RawPackageLocationImmutable -> Tree -> Maybe BuildFile
    forall (m :: * -> *).
    MonadThrow m =>
    RawPackageLocationImmutable -> Tree -> m BuildFile
    findCabalOrHpackFile RawPackageLocationImmutable
    rawPackageLocationImmutable Tree
    tree of
                         Just buildFile :: BuildFile
    buildFile ->
                           RIO env (TreeId, TreeKey) -> RIO env ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void
                             (ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    -> RIO env (TreeId, TreeKey)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage
                                (RawPackageLocationImmutable
    -> PackageIdentifier
    -> Tree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageIdentifier
    -> Tree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    storeTree
                                   RawPackageLocationImmutable
    rawPackageLocationImmutable
                                   PackageIdentifier
    identifier
                                   Tree
    tree
                                   BuildFile
    buildFile))
                         Nothing ->
                           Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn
                             ("Unable to find build file for package: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                              RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    rawPackageLocationImmutable))
      where
        unTreeKey :: TreeKey -> BlobKey
        unTreeKey :: TreeKey -> BlobKey
    unTreeKey (P.TreeKey blobKey :: BlobKey
    blobKey) = BlobKey
    blobKey

    -- | Download all of the packages provided into the local cache
    -- without performing any unpacking. Can be useful for build tools
    -- wanting to prefetch or provide an offline mode.
    --
    -- @since 0.1.0.0
    fetchPackages
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env, Foldable f)
      => f PackageLocationImmutable
      -> RIO env ()
    fetchPackages :: f PackageLocationImmutable -> RIO env ()
    fetchPackages pls :: f PackageLocationImmutable
    pls = do
        [RawPackageLocationImmutable] -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [RawPackageLocationImmutable] -> RIO env ()
    fetchTreeKeys ((PackageLocationImmutable -> RawPackageLocationImmutable)
    -> [PackageLocationImmutable] -> [RawPackageLocationImmutable]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI (f PackageLocationImmutable -> [PackageLocationImmutable]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList f PackageLocationImmutable
    pls))
        ((PackageIdentifierRevision, Maybe TreeKey) -> RIO env ())
    -> [(PackageIdentifierRevision, Maybe TreeKey)] -> RIO env ()
    forall (f :: * -> *) env a.
    (Foldable f, HasPantryConfig env) =>
    (a -> RIO env ()) -> f a -> RIO env ()
    traverseConcurrently_ (RIO env HackageTarballResult -> RIO env ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (RIO env HackageTarballResult -> RIO env ())
    -> ((PackageIdentifierRevision, Maybe TreeKey)
        -> RIO env HackageTarballResult)
    -> (PackageIdentifierRevision, Maybe TreeKey)
    -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PackageIdentifierRevision
     -> Maybe TreeKey -> RIO env HackageTarballResult)
    -> (PackageIdentifierRevision, Maybe TreeKey)
    -> RIO env HackageTarballResult
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    getHackageTarball) [(PackageIdentifierRevision, Maybe TreeKey)]
    hackages
        -- TODO in the future, be concurrent in these as well
        [(Archive, PackageMetadata)] -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(Archive, PackageMetadata)] -> RIO env ()
    fetchArchives [(Archive, PackageMetadata)]
    archives
        [(Repo, PackageMetadata)] -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(Repo, PackageMetadata)] -> RIO env ()
    fetchRepos [(Repo, PackageMetadata)]
    repos
      where
        s :: a -> Endo [a]
    s x :: a
    x = ([a] -> [a]) -> Endo [a]
    forall a. (a -> a) -> Endo a
    Endo (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :)
        run :: Endo [a] -> [a]
    run (Endo f :: [a] -> [a]
    f) = [a] -> [a]
    f []
        (hackagesE :: Endo [(PackageIdentifierRevision, Maybe TreeKey)]
    hackagesE, archivesE :: Endo [(Archive, PackageMetadata)]
    archivesE, reposE :: Endo [(Repo, PackageMetadata)]
    reposE) = (PackageLocationImmutable
     -> (Endo [(PackageIdentifierRevision, Maybe TreeKey)],
         Endo [(Archive, PackageMetadata)], Endo [(Repo, PackageMetadata)]))
    -> f PackageLocationImmutable
    -> (Endo [(PackageIdentifierRevision, Maybe TreeKey)],
        Endo [(Archive, PackageMetadata)], Endo [(Repo, PackageMetadata)])
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap PackageLocationImmutable
    -> (Endo [(PackageIdentifierRevision, Maybe TreeKey)],
        Endo [(Archive, PackageMetadata)], Endo [(Repo, PackageMetadata)])
    go f PackageLocationImmutable
    pls
        hackages :: [(PackageIdentifierRevision, Maybe TreeKey)]
    hackages = Endo [(PackageIdentifierRevision, Maybe TreeKey)]
    -> [(PackageIdentifierRevision, Maybe TreeKey)]
    forall a. Endo [a] -> [a]
    run Endo [(PackageIdentifierRevision, Maybe TreeKey)]
    hackagesE
        archives :: [(Archive, PackageMetadata)]
    archives = Endo [(Archive, PackageMetadata)] -> [(Archive, PackageMetadata)]
    forall a. Endo [a] -> [a]
    run Endo [(Archive, PackageMetadata)]
    archivesE
        repos :: [(Repo, PackageMetadata)]
    repos = Endo [(Repo, PackageMetadata)] -> [(Repo, PackageMetadata)]
    forall a. Endo [a] -> [a]
    run Endo [(Repo, PackageMetadata)]
    reposE

        go :: PackageLocationImmutable
    -> (Endo [(PackageIdentifierRevision, Maybe TreeKey)],
        Endo [(Archive, PackageMetadata)], Endo [(Repo, PackageMetadata)])
    go (PLIHackage ident :: PackageIdentifier
    ident cfHash :: BlobKey
    cfHash tree :: TreeKey
    tree) = ((PackageIdentifierRevision, Maybe TreeKey)
    -> Endo [(PackageIdentifierRevision, Maybe TreeKey)]
    forall a. a -> Endo [a]
    s (PackageIdentifier -> BlobKey -> PackageIdentifierRevision
    toPir PackageIdentifier
    ident BlobKey
    cfHash, TreeKey -> Maybe TreeKey
    forall a. a -> Maybe a
    Just TreeKey
    tree), Endo [(Archive, PackageMetadata)]
    forall a. Monoid a => a
    mempty, Endo [(Repo, PackageMetadata)]
    forall a. Monoid a => a
    mempty)
        go (PLIArchive archive :: Archive
    archive pm :: PackageMetadata
    pm) = (Endo [(PackageIdentifierRevision, Maybe TreeKey)]
    forall a. Monoid a => a
    mempty, (Archive, PackageMetadata) -> Endo [(Archive, PackageMetadata)]
    forall a. a -> Endo [a]
    s (Archive
    archive, PackageMetadata
    pm), Endo [(Repo, PackageMetadata)]
    forall a. Monoid a => a
    mempty)
        go (PLIRepo repo :: Repo
    repo pm :: PackageMetadata
    pm) = (Endo [(PackageIdentifierRevision, Maybe TreeKey)]
    forall a. Monoid a => a
    mempty, Endo [(Archive, PackageMetadata)]
    forall a. Monoid a => a
    mempty, (Repo, PackageMetadata) -> Endo [(Repo, PackageMetadata)]
    forall a. a -> Endo [a]
    s (Repo
    repo, PackageMetadata
    pm))

        toPir :: PackageIdentifier -> BlobKey -> PackageIdentifierRevision
    toPir (PackageIdentifier name :: PackageName
    name ver :: Version
    ver) (BlobKey sha :: SHA256
    sha size :: FileSize
    size) =
          PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    PackageIdentifierRevision PackageName
    name Version
    ver (SHA256 -> Maybe FileSize -> CabalFileInfo
    CFIHash SHA256
    sha (FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size))

    -- | Unpack a given 'RawPackageLocationImmutable' into the given
    -- directory. Does not generate any extra subdirectories.
    --
    -- @since 0.1.0.0
    unpackPackageLocationRaw
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Path Abs Dir -- ^ unpack directory
      -> RawPackageLocationImmutable
      -> RIO env ()
    unpackPackageLocationRaw :: Path Abs Dir -> RawPackageLocationImmutable -> RIO env ()
    unpackPackageLocationRaw fp :: Path Abs Dir
    fp loc :: RawPackageLocationImmutable
    loc = RawPackageLocationImmutable -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env Package
    loadPackageRaw RawPackageLocationImmutable
    loc RIO env Package -> (Package -> RIO env ()) -> RIO env ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= RawPackageLocationImmutable -> Path Abs Dir -> Tree -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawPackageLocationImmutable -> Path Abs Dir -> Tree -> RIO env ()
    unpackTree RawPackageLocationImmutable
    loc Path Abs Dir
    fp (Tree -> RIO env ()) -> (Package -> Tree) -> Package -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Package -> Tree
    packageTree

    -- | Unpack a given 'PackageLocationImmutable' into the given
    -- directory. Does not generate any extra subdirectories.
    --
    -- @since 0.1.0.0
    unpackPackageLocation
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Path Abs Dir -- ^ unpack directory
      -> PackageLocationImmutable
      -> RIO env ()
    unpackPackageLocation :: Path Abs Dir -> PackageLocationImmutable -> RIO env ()
    unpackPackageLocation fp :: Path Abs Dir
    fp loc :: PackageLocationImmutable
    loc = PackageLocationImmutable -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env Package
    loadPackage PackageLocationImmutable
    loc RIO env Package -> (Package -> RIO env ()) -> RIO env ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= RawPackageLocationImmutable -> Path Abs Dir -> Tree -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawPackageLocationImmutable -> Path Abs Dir -> Tree -> RIO env ()
    unpackTree (PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI PackageLocationImmutable
    loc) Path Abs Dir
    fp (Tree -> RIO env ()) -> (Package -> Tree) -> Package -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Package -> Tree
    packageTree

    -- | Load the cabal file for the given 'PackageLocationImmutable'.
    --
    -- This function ignores all warnings.
    --
    -- @since 0.1.0.0
    loadCabalFileImmutable
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageLocationImmutable
      -> RIO env GenericPackageDescription
    loadCabalFileImmutable :: PackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileImmutable loc :: PackageLocationImmutable
    loc = RIO env GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall (m :: * -> *) s.
    (MonadReader s m, HasPantryConfig s, MonadIO m) =>
    m GenericPackageDescription -> m GenericPackageDescription
    withCache (RIO env GenericPackageDescription
     -> RIO env GenericPackageDescription)
    -> RIO env GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ do
      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Parsing cabal file for " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> PackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display PackageLocationImmutable
    loc
      ByteString
    bs <- PackageLocationImmutable -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env ByteString
    loadCabalFileBytes PackageLocationImmutable
    loc
      (_warnings :: [PWarning]
    _warnings, gpd :: GenericPackageDescription
    gpd) <- Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> RIO env ([PWarning], GenericPackageDescription)
    forall (m :: * -> *).
    MonadThrow m =>
    Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> m ([PWarning], GenericPackageDescription)
    rawParseGPD (RawPackageLocationImmutable
    -> Either RawPackageLocationImmutable (Path Abs File)
    forall a b. a -> Either a b
    Left (RawPackageLocationImmutable
     -> Either RawPackageLocationImmutable (Path Abs File))
    -> RawPackageLocationImmutable
    -> Either RawPackageLocationImmutable (Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI PackageLocationImmutable
    loc) ByteString
    bs
      let pm :: PackageMetadata
    pm =
            case PackageLocationImmutable
    loc of
              PLIHackage (PackageIdentifier name :: PackageName
    name version :: Version
    version) _cfHash :: BlobKey
    _cfHash mtree :: TreeKey
    mtree -> $WPackageMetadata :: PackageIdentifier -> TreeKey -> PackageMetadata
    PackageMetadata
                { pmIdent :: PackageIdentifier
    pmIdent = PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    version
                , pmTreeKey :: TreeKey
    pmTreeKey = TreeKey
    mtree
                }
              PLIArchive _ pm' :: PackageMetadata
    pm' -> PackageMetadata
    pm'
              PLIRepo _ pm' :: PackageMetadata
    pm' -> PackageMetadata
    pm'
      let exc :: PantryException
    exc = RawPackageLocationImmutable
    -> RawPackageMetadata
    -> Maybe TreeKey
    -> PackageIdentifier
    -> PantryException
    MismatchedPackageMetadata (PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI PackageLocationImmutable
    loc) (PackageMetadata -> RawPackageMetadata
    toRawPM PackageMetadata
    pm) Maybe TreeKey
    forall a. Maybe a
    Nothing
            (GenericPackageDescription -> PackageIdentifier
    gpdPackageIdentifier GenericPackageDescription
    gpd)
          PackageIdentifier name :: PackageName
    name ver :: Version
    ver = PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm
      RIO env GenericPackageDescription
    -> (GenericPackageDescription -> RIO env GenericPackageDescription)
    -> Maybe GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (PantryException -> RIO env GenericPackageDescription
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO PantryException
    exc) GenericPackageDescription -> RIO env GenericPackageDescription
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe GenericPackageDescription
     -> RIO env GenericPackageDescription)
    -> Maybe GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ do
        Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ PackageName
    name PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == GenericPackageDescription -> PackageName
    gpdPackageName GenericPackageDescription
    gpd
        Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Version
    ver Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == GenericPackageDescription -> Version
    gpdVersion GenericPackageDescription
    gpd
        GenericPackageDescription -> Maybe GenericPackageDescription
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    gpd
      where
        withCache :: m GenericPackageDescription -> m GenericPackageDescription
    withCache inner :: m GenericPackageDescription
    inner = do
          let rawLoc :: RawPackageLocationImmutable
    rawLoc = PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI PackageLocationImmutable
    loc
          IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref <- Getting
      (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
      s
      (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    -> m (IORef
            (Map RawPackageLocationImmutable GenericPackageDescription))
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting
       (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
       s
       (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
     -> m (IORef
             (Map RawPackageLocationImmutable GenericPackageDescription)))
    -> Getting
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
         s
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    -> m (IORef
            (Map RawPackageLocationImmutable GenericPackageDescription))
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig
     -> Const
          (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
          PantryConfig)
    -> s
    -> Const
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
         s
    forall env. HasPantryConfig env => Lens' env PantryConfig
    pantryConfigL((PantryConfig
      -> Const
           (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
           PantryConfig)
     -> s
     -> Const
          (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
          s)
    -> ((IORef
           (Map RawPackageLocationImmutable GenericPackageDescription)
         -> Const
              (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
              (IORef
                 (Map RawPackageLocationImmutable GenericPackageDescription)))
        -> PantryConfig
        -> Const
             (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
             PantryConfig)
    -> Getting
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
         s
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig
     -> IORef
          (Map RawPackageLocationImmutable GenericPackageDescription))
    -> SimpleGetter
         PantryConfig
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig
    -> IORef
         (Map RawPackageLocationImmutable GenericPackageDescription)
    pcParsedCabalFilesRawImmutable
          Map RawPackageLocationImmutable GenericPackageDescription
    m0 <- IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    -> m (Map RawPackageLocationImmutable GenericPackageDescription)
    forall (m :: * -> *) a. MonadIO m => IORef a -> m a
    readIORef IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref
          case RawPackageLocationImmutable
    -> Map RawPackageLocationImmutable GenericPackageDescription
    -> Maybe GenericPackageDescription
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup RawPackageLocationImmutable
    rawLoc Map RawPackageLocationImmutable GenericPackageDescription
    m0 of
            Just x :: GenericPackageDescription
    x -> GenericPackageDescription -> m GenericPackageDescription
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    x
            Nothing -> do
              GenericPackageDescription
    x <- m GenericPackageDescription
    inner
              IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    -> (Map RawPackageLocationImmutable GenericPackageDescription
        -> (Map RawPackageLocationImmutable GenericPackageDescription,
            GenericPackageDescription))
    -> m GenericPackageDescription
    forall (m :: * -> *) a b.
    MonadIO m =>
    IORef a -> (a -> (a, b)) -> m b
    atomicModifyIORef' IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref ((Map RawPackageLocationImmutable GenericPackageDescription
      -> (Map RawPackageLocationImmutable GenericPackageDescription,
          GenericPackageDescription))
     -> m GenericPackageDescription)
    -> (Map RawPackageLocationImmutable GenericPackageDescription
        -> (Map RawPackageLocationImmutable GenericPackageDescription,
            GenericPackageDescription))
    -> m GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ \m :: Map RawPackageLocationImmutable GenericPackageDescription
    m -> (RawPackageLocationImmutable
    -> GenericPackageDescription
    -> Map RawPackageLocationImmutable GenericPackageDescription
    -> Map RawPackageLocationImmutable GenericPackageDescription
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert RawPackageLocationImmutable
    rawLoc GenericPackageDescription
    x Map RawPackageLocationImmutable GenericPackageDescription
    m, GenericPackageDescription
    x)

    -- | Load the cabal file for the given 'RawPackageLocationImmutable'.
    --
    -- This function ignores all warnings.
    --
    -- Note that, for now, this will not allow support for hpack files in
    -- these package locations. Instead, all @PackageLocationImmutable@s
    -- will require a .cabal file. This may be relaxed in the future.
    --
    -- @since 0.1.0.0
    loadCabalFileRawImmutable
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RIO env GenericPackageDescription
    loadCabalFileRawImmutable :: RawPackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileRawImmutable loc :: RawPackageLocationImmutable
    loc = RIO env GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall (m :: * -> *) s.
    (MonadReader s m, HasPantryConfig s, MonadIO m) =>
    m GenericPackageDescription -> m GenericPackageDescription
    withCache (RIO env GenericPackageDescription
     -> RIO env GenericPackageDescription)
    -> RIO env GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ do
      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Parsing cabal file for " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    loc
      ByteString
    bs <- RawPackageLocationImmutable -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env ByteString
    loadRawCabalFileBytes RawPackageLocationImmutable
    loc
      (_warnings :: [PWarning]
    _warnings, gpd :: GenericPackageDescription
    gpd) <- Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> RIO env ([PWarning], GenericPackageDescription)
    forall (m :: * -> *).
    MonadThrow m =>
    Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> m ([PWarning], GenericPackageDescription)
    rawParseGPD (RawPackageLocationImmutable
    -> Either RawPackageLocationImmutable (Path Abs File)
    forall a b. a -> Either a b
    Left RawPackageLocationImmutable
    loc) ByteString
    bs
      let rpm :: RawPackageMetadata
    rpm =
            case RawPackageLocationImmutable
    loc of
              RPLIHackage (PackageIdentifierRevision name :: PackageName
    name version :: Version
    version _cfi :: CabalFileInfo
    _cfi) mtree :: Maybe TreeKey
    mtree -> $WRawPackageMetadata :: Maybe PackageName
    -> Maybe Version -> Maybe TreeKey -> RawPackageMetadata
    RawPackageMetadata
                { rpmName :: Maybe PackageName
    rpmName = PackageName -> Maybe PackageName
    forall a. a -> Maybe a
    Just PackageName
    name
                , rpmVersion :: Maybe Version
    rpmVersion = Version -> Maybe Version
    forall a. a -> Maybe a
    Just Version
    version
                , rpmTreeKey :: Maybe TreeKey
    rpmTreeKey = Maybe TreeKey
    mtree
                }
              RPLIArchive _ rpm' :: RawPackageMetadata
    rpm' -> RawPackageMetadata
    rpm'
              RPLIRepo _ rpm' :: RawPackageMetadata
    rpm' -> RawPackageMetadata
    rpm'
      let exc :: PantryException
    exc = RawPackageLocationImmutable
    -> RawPackageMetadata
    -> Maybe TreeKey
    -> PackageIdentifier
    -> PantryException
    MismatchedPackageMetadata RawPackageLocationImmutable
    loc RawPackageMetadata
    rpm Maybe TreeKey
    forall a. Maybe a
    Nothing (GenericPackageDescription -> PackageIdentifier
    gpdPackageIdentifier GenericPackageDescription
    gpd)
      RIO env GenericPackageDescription
    -> (GenericPackageDescription -> RIO env GenericPackageDescription)
    -> Maybe GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (PantryException -> RIO env GenericPackageDescription
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO PantryException
    exc) GenericPackageDescription -> RIO env GenericPackageDescription
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe GenericPackageDescription
     -> RIO env GenericPackageDescription)
    -> Maybe GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ do
        Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> (PackageName -> Bool) -> Maybe PackageName -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == GenericPackageDescription -> PackageName
    gpdPackageName GenericPackageDescription
    gpd) (RawPackageMetadata -> Maybe PackageName
    rpmName RawPackageMetadata
    rpm)
        Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> (Version -> Bool) -> Maybe Version -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == GenericPackageDescription -> Version
    gpdVersion GenericPackageDescription
    gpd) (RawPackageMetadata -> Maybe Version
    rpmVersion RawPackageMetadata
    rpm)
        GenericPackageDescription -> Maybe GenericPackageDescription
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    gpd
      where
        withCache :: m GenericPackageDescription -> m GenericPackageDescription
    withCache inner :: m GenericPackageDescription
    inner = do
          IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref <- Getting
      (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
      s
      (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    -> m (IORef
            (Map RawPackageLocationImmutable GenericPackageDescription))
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting
       (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
       s
       (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
     -> m (IORef
             (Map RawPackageLocationImmutable GenericPackageDescription)))
    -> Getting
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
         s
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    -> m (IORef
            (Map RawPackageLocationImmutable GenericPackageDescription))
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig
     -> Const
          (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
          PantryConfig)
    -> s
    -> Const
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
         s
    forall env. HasPantryConfig env => Lens' env PantryConfig
    pantryConfigL((PantryConfig
      -> Const
           (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
           PantryConfig)
     -> s
     -> Const
          (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
          s)
    -> ((IORef
           (Map RawPackageLocationImmutable GenericPackageDescription)
         -> Const
              (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
              (IORef
                 (Map RawPackageLocationImmutable GenericPackageDescription)))
        -> PantryConfig
        -> Const
             (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
             PantryConfig)
    -> Getting
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
         s
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig
     -> IORef
          (Map RawPackageLocationImmutable GenericPackageDescription))
    -> SimpleGetter
         PantryConfig
         (IORef (Map RawPackageLocationImmutable GenericPackageDescription))
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig
    -> IORef
         (Map RawPackageLocationImmutable GenericPackageDescription)
    pcParsedCabalFilesRawImmutable
          Map RawPackageLocationImmutable GenericPackageDescription
    m0 <- IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    -> m (Map RawPackageLocationImmutable GenericPackageDescription)
    forall (m :: * -> *) a. MonadIO m => IORef a -> m a
    readIORef IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref
          case RawPackageLocationImmutable
    -> Map RawPackageLocationImmutable GenericPackageDescription
    -> Maybe GenericPackageDescription
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup RawPackageLocationImmutable
    loc Map RawPackageLocationImmutable GenericPackageDescription
    m0 of
            Just x :: GenericPackageDescription
    x -> GenericPackageDescription -> m GenericPackageDescription
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    x
            Nothing -> do
              GenericPackageDescription
    x <- m GenericPackageDescription
    inner
              IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    -> (Map RawPackageLocationImmutable GenericPackageDescription
        -> (Map RawPackageLocationImmutable GenericPackageDescription,
            GenericPackageDescription))
    -> m GenericPackageDescription
    forall (m :: * -> *) a b.
    MonadIO m =>
    IORef a -> (a -> (a, b)) -> m b
    atomicModifyIORef' IORef (Map RawPackageLocationImmutable GenericPackageDescription)
    ref ((Map RawPackageLocationImmutable GenericPackageDescription
      -> (Map RawPackageLocationImmutable GenericPackageDescription,
          GenericPackageDescription))
     -> m GenericPackageDescription)
    -> (Map RawPackageLocationImmutable GenericPackageDescription
        -> (Map RawPackageLocationImmutable GenericPackageDescription,
            GenericPackageDescription))
    -> m GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ \m :: Map RawPackageLocationImmutable GenericPackageDescription
    m -> (RawPackageLocationImmutable
    -> GenericPackageDescription
    -> Map RawPackageLocationImmutable GenericPackageDescription
    -> Map RawPackageLocationImmutable GenericPackageDescription
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert RawPackageLocationImmutable
    loc GenericPackageDescription
    x Map RawPackageLocationImmutable GenericPackageDescription
    m, GenericPackageDescription
    x)

    -- | Same as 'loadCabalFileRawImmutable', but takes a
    -- 'RawPackageLocation'. Never prints warnings, see 'loadCabalFilePath'
    -- for that.
    --
    -- @since 0.1.0.0
    loadCabalFileRaw
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocation
      -> RIO env GenericPackageDescription
    loadCabalFileRaw :: RawPackageLocation -> RIO env GenericPackageDescription
    loadCabalFileRaw (RPLImmutable loc :: RawPackageLocationImmutable
    loc) = RawPackageLocationImmutable -> RIO env GenericPackageDescription
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileRawImmutable RawPackageLocationImmutable
    loc
    loadCabalFileRaw (RPLMutable rfp :: ResolvedPath Dir
    rfp) = do
      (gpdio :: PrintWarnings -> IO GenericPackageDescription
    gpdio, _, _) <- Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    loadCabalFilePath (ResolvedPath Dir -> Path Abs Dir
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath Dir
    rfp)
      IO GenericPackageDescription -> RIO env GenericPackageDescription
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GenericPackageDescription -> RIO env GenericPackageDescription)
    -> IO GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ PrintWarnings -> IO GenericPackageDescription
    gpdio PrintWarnings
    NoPrintWarnings

    -- | Same as 'loadCabalFileImmutable', but takes a
    -- 'PackageLocation'. Never prints warnings, see 'loadCabalFilePath'
    -- for that.
    --
    -- @since 0.1.0.0
    loadCabalFile
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageLocation
      -> RIO env GenericPackageDescription
    loadCabalFile :: PackageLocation -> RIO env GenericPackageDescription
    loadCabalFile (PLImmutable loc :: PackageLocationImmutable
    loc) = PackageLocationImmutable -> RIO env GenericPackageDescription
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileImmutable PackageLocationImmutable
    loc
    loadCabalFile (PLMutable rfp :: ResolvedPath Dir
    rfp) = do
      (gpdio :: PrintWarnings -> IO GenericPackageDescription
    gpdio, _, _) <- Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    loadCabalFilePath (ResolvedPath Dir -> Path Abs Dir
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath Dir
    rfp)
      IO GenericPackageDescription -> RIO env GenericPackageDescription
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GenericPackageDescription -> RIO env GenericPackageDescription)
    -> IO GenericPackageDescription
    -> RIO env GenericPackageDescription
    forall a b. (a -> b) -> a -> b
    $ PrintWarnings -> IO GenericPackageDescription
    gpdio PrintWarnings
    NoPrintWarnings

    -- | Parse the cabal file for the package inside the given
    -- directory. Performs various sanity checks, such as the file name
    -- being correct and having only a single cabal file.
    --
    -- @since 0.1.0.0
    loadCabalFilePath
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Path Abs Dir -- ^ project directory, with a cabal file or hpack file
      -> RIO env
           ( PrintWarnings -> IO GenericPackageDescription
           , PackageName
           , Path Abs File
           )
    loadCabalFilePath :: Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    loadCabalFilePath dir :: Path Abs Dir
    dir = do
      IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    ref <- Getting
      (IORef
         (Map
            (Path Abs Dir)
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File)))
      env
      (IORef
         (Map
            (Path Abs Dir)
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File)))
    -> RIO
         env
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting
       (IORef
          (Map
             (Path Abs Dir)
             (PrintWarnings -> IO GenericPackageDescription, PackageName,
              Path Abs File)))
       env
       (IORef
          (Map
             (Path Abs Dir)
             (PrintWarnings -> IO GenericPackageDescription, PackageName,
              Path Abs File)))
     -> RIO
          env
          (IORef
             (Map
                (Path Abs Dir)
                (PrintWarnings -> IO GenericPackageDescription, PackageName,
                 Path Abs File))))
    -> Getting
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
         env
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
    -> RIO
         env
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig
     -> Const
          (IORef
             (Map
                (Path Abs Dir)
                (PrintWarnings -> IO GenericPackageDescription, PackageName,
                 Path Abs File)))
          PantryConfig)
    -> env
    -> Const
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
         env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    pantryConfigL((PantryConfig
      -> Const
           (IORef
              (Map
                 (Path Abs Dir)
                 (PrintWarnings -> IO GenericPackageDescription, PackageName,
                  Path Abs File)))
           PantryConfig)
     -> env
     -> Const
          (IORef
             (Map
                (Path Abs Dir)
                (PrintWarnings -> IO GenericPackageDescription, PackageName,
                 Path Abs File)))
          env)
    -> ((IORef
           (Map
              (Path Abs Dir)
              (PrintWarnings -> IO GenericPackageDescription, PackageName,
               Path Abs File))
         -> Const
              (IORef
                 (Map
                    (Path Abs Dir)
                    (PrintWarnings -> IO GenericPackageDescription, PackageName,
                     Path Abs File)))
              (IORef
                 (Map
                    (Path Abs Dir)
                    (PrintWarnings -> IO GenericPackageDescription, PackageName,
                     Path Abs File))))
        -> PantryConfig
        -> Const
             (IORef
                (Map
                   (Path Abs Dir)
                   (PrintWarnings -> IO GenericPackageDescription, PackageName,
                    Path Abs File)))
             PantryConfig)
    -> Getting
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
         env
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig
     -> IORef
          (Map
             (Path Abs Dir)
             (PrintWarnings -> IO GenericPackageDescription, PackageName,
              Path Abs File)))
    -> SimpleGetter
         PantryConfig
         (IORef
            (Map
               (Path Abs Dir)
               (PrintWarnings -> IO GenericPackageDescription, PackageName,
                Path Abs File)))
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig
    -> IORef
         (Map
            (Path Abs Dir)
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File))
    pcParsedCabalFilesMutable
      Maybe
      (PrintWarnings -> IO GenericPackageDescription, PackageName,
       Path Abs File)
    mcached <- Path Abs Dir
    -> Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    -> Maybe
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Path Abs Dir
    dir (Map
       (Path Abs Dir)
       (PrintWarnings -> IO GenericPackageDescription, PackageName,
        Path Abs File)
     -> Maybe
          (PrintWarnings -> IO GenericPackageDescription, PackageName,
           Path Abs File))
    -> RIO
         env
         (Map
            (Path Abs Dir)
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File))
    -> RIO
         env
         (Maybe
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    -> RIO
         env
         (Map
            (Path Abs Dir)
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File))
    forall (m :: * -> *) a. MonadIO m => IORef a -> m a
    readIORef IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    ref
      case Maybe
      (PrintWarnings -> IO GenericPackageDescription, PackageName,
       Path Abs File)
    mcached of
        Just triple :: (PrintWarnings -> IO GenericPackageDescription, PackageName,
     Path Abs File)
    triple -> (PrintWarnings -> IO GenericPackageDescription, PackageName,
     Path Abs File)
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PrintWarnings -> IO GenericPackageDescription, PackageName,
     Path Abs File)
    triple
        Nothing -> do
          (name :: PackageName
    name, cabalfp :: Path Abs File
    cabalfp) <- Path Abs Dir -> RIO env (PackageName, Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile Path Abs Dir
    dir
          IORef (Maybe ([PWarning], GenericPackageDescription))
    gpdRef <- Maybe ([PWarning], GenericPackageDescription)
    -> RIO env (IORef (Maybe ([PWarning], GenericPackageDescription)))
    forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
    newIORef Maybe ([PWarning], GenericPackageDescription)
    forall a. Maybe a
    Nothing
          RIO env GenericPackageDescription -> IO GenericPackageDescription
    run <- RIO
      env
      (RIO env GenericPackageDescription -> IO GenericPackageDescription)
    forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
    askRunInIO
          let gpdio :: PrintWarnings -> IO GenericPackageDescription
    gpdio = RIO env GenericPackageDescription -> IO GenericPackageDescription
    run (RIO env GenericPackageDescription -> IO GenericPackageDescription)
    -> (PrintWarnings -> RIO env GenericPackageDescription)
    -> PrintWarnings
    -> IO GenericPackageDescription
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Abs File
    -> IORef (Maybe ([PWarning], GenericPackageDescription))
    -> PrintWarnings
    -> RIO env GenericPackageDescription
    forall (m :: * -> *) env.
    (MonadIO m, MonadThrow m, MonadReader env m, HasLogFunc env) =>
    Path Abs File
    -> IORef (Maybe ([PWarning], GenericPackageDescription))
    -> PrintWarnings
    -> m GenericPackageDescription
    getGPD Path Abs File
    cabalfp IORef (Maybe ([PWarning], GenericPackageDescription))
    gpdRef
              triple :: (PrintWarnings -> IO GenericPackageDescription, PackageName,
     Path Abs File)
    triple = (PrintWarnings -> IO GenericPackageDescription
    gpdio, PackageName
    name, Path Abs File
    cabalfp)
          IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    -> (Map
          (Path Abs Dir)
          (PrintWarnings -> IO GenericPackageDescription, PackageName,
           Path Abs File)
        -> (Map
              (Path Abs Dir)
              (PrintWarnings -> IO GenericPackageDescription, PackageName,
               Path Abs File),
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File)))
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall (m :: * -> *) a b.
    MonadIO m =>
    IORef a -> (a -> (a, b)) -> m b
    atomicModifyIORef' IORef
      (Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File))
    ref ((Map
        (Path Abs Dir)
        (PrintWarnings -> IO GenericPackageDescription, PackageName,
         Path Abs File)
      -> (Map
            (Path Abs Dir)
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File),
          (PrintWarnings -> IO GenericPackageDescription, PackageName,
           Path Abs File)))
     -> RIO
          env
          (PrintWarnings -> IO GenericPackageDescription, PackageName,
           Path Abs File))
    -> (Map
          (Path Abs Dir)
          (PrintWarnings -> IO GenericPackageDescription, PackageName,
           Path Abs File)
        -> (Map
              (Path Abs Dir)
              (PrintWarnings -> IO GenericPackageDescription, PackageName,
               Path Abs File),
            (PrintWarnings -> IO GenericPackageDescription, PackageName,
             Path Abs File)))
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ \m :: Map
      (Path Abs Dir)
      (PrintWarnings -> IO GenericPackageDescription, PackageName,
       Path Abs File)
    m -> (Path Abs Dir
    -> (PrintWarnings -> IO GenericPackageDescription, PackageName,
        Path Abs File)
    -> Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    -> Map
         (Path Abs Dir)
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Path Abs Dir
    dir (PrintWarnings -> IO GenericPackageDescription, PackageName,
     Path Abs File)
    triple Map
      (Path Abs Dir)
      (PrintWarnings -> IO GenericPackageDescription, PackageName,
       Path Abs File)
    m, (PrintWarnings -> IO GenericPackageDescription, PackageName,
     Path Abs File)
    triple)
      where
        getGPD :: Path Abs File
    -> IORef (Maybe ([PWarning], GenericPackageDescription))
    -> PrintWarnings
    -> m GenericPackageDescription
    getGPD cabalfp :: Path Abs File
    cabalfp gpdRef :: IORef (Maybe ([PWarning], GenericPackageDescription))
    gpdRef printWarnings :: PrintWarnings
    printWarnings = do
          Maybe ([PWarning], GenericPackageDescription)
    mpair <- IORef (Maybe ([PWarning], GenericPackageDescription))
    -> m (Maybe ([PWarning], GenericPackageDescription))
    forall (m :: * -> *) a. MonadIO m => IORef a -> m a
    readIORef IORef (Maybe ([PWarning], GenericPackageDescription))
    gpdRef
          (warnings0 :: [PWarning]
    warnings0, gpd :: GenericPackageDescription
    gpd) <-
            case Maybe ([PWarning], GenericPackageDescription)
    mpair of
              Just pair :: ([PWarning], GenericPackageDescription)
    pair -> ([PWarning], GenericPackageDescription)
    -> m ([PWarning], GenericPackageDescription)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PWarning], GenericPackageDescription)
    pair
              Nothing -> do
                ByteString
    bs <- IO ByteString -> m ByteString
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO ByteString
    forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
    B.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs File
    cabalfp
                (warnings0 :: [PWarning]
    warnings0, gpd :: GenericPackageDescription
    gpd) <- Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> m ([PWarning], GenericPackageDescription)
    forall (m :: * -> *).
    MonadThrow m =>
    Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> m ([PWarning], GenericPackageDescription)
    rawParseGPD (Path Abs File -> Either RawPackageLocationImmutable (Path Abs File)
    forall a b. b -> Either a b
    Right Path Abs File
    cabalfp) ByteString
    bs
                PackageName -> Path Abs File -> m ()
    forall (m :: * -> *).
    MonadThrow m =>
    PackageName -> Path Abs File -> m ()
    checkCabalFileName (GenericPackageDescription -> PackageName
    gpdPackageName GenericPackageDescription
    gpd) Path Abs File
    cabalfp
                ([PWarning], GenericPackageDescription)
    -> m ([PWarning], GenericPackageDescription)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PWarning]
    warnings0, GenericPackageDescription
    gpd)
          [PWarning]
    warnings <-
            case PrintWarnings
    printWarnings of
              YesPrintWarnings -> (PWarning -> m ()) -> [PWarning] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Utf8Builder -> m ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> m ())
    -> (PWarning -> Utf8Builder) -> PWarning -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Abs File -> PWarning -> Utf8Builder
    toPretty Path Abs File
    cabalfp) [PWarning]
    warnings0 m () -> [PWarning] -> m [PWarning]
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> []
              NoPrintWarnings -> [PWarning] -> m [PWarning]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [PWarning]
    warnings0
          IORef (Maybe ([PWarning], GenericPackageDescription))
    -> Maybe ([PWarning], GenericPackageDescription) -> m ()
    forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
    writeIORef IORef (Maybe ([PWarning], GenericPackageDescription))
    gpdRef (Maybe ([PWarning], GenericPackageDescription) -> m ())
    -> Maybe ([PWarning], GenericPackageDescription) -> m ()
    forall a b. (a -> b) -> a -> b
    $ ([PWarning], GenericPackageDescription)
    -> Maybe ([PWarning], GenericPackageDescription)
    forall a. a -> Maybe a
    Just ([PWarning]
    warnings, GenericPackageDescription
    gpd)
          GenericPackageDescription -> m GenericPackageDescription
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    gpd

        toPretty :: Path Abs File -> PWarning -> Utf8Builder
        toPretty :: Path Abs File -> PWarning -> Utf8Builder
    toPretty src :: Path Abs File
    src (PWarning _type :: PWarnType
    _type pos :: Position
    pos msg :: FilePath
    msg) =
          "Cabal file warning in" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
          FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs File
    src) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> "@" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
          FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (Position -> FilePath
    showPos Position
    pos) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> ": " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
          FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString FilePath
    msg

        -- | Check if the given name in the @Package@ matches the name of the .cabal file
        checkCabalFileName :: MonadThrow m => PackageName -> Path Abs File -> m ()
        checkCabalFileName :: PackageName -> Path Abs File -> m ()
    checkCabalFileName name :: PackageName
    name cabalfp :: Path Abs File
    cabalfp = do
            -- Previously, we just use parsePackageNameFromFilePath. However, that can
            -- lead to confusing error messages. See:
            -- https://github.com/commercialhaskell/stack/issues/895
            let expected :: FilePath
    expected = Text -> FilePath
    T.unpack (Text -> FilePath) -> Text -> FilePath
    forall a b. (a -> b) -> a -> b
    $ SafeFilePath -> Text
    unSafeFilePath (SafeFilePath -> Text) -> SafeFilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ PackageName -> SafeFilePath
    cabalFileName PackageName
    name
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (FilePath
    expected FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Path Rel File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath (Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename Path Abs File
    cabalfp))
                (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ PantryException -> m ()
    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
    throwM (PantryException -> m ()) -> PantryException -> m ()
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> PackageName -> PantryException
    MismatchedCabalName Path Abs File
    cabalfp PackageName
    name

    -- | Get the filename for the cabal file in the given directory.
    --
    -- If no .cabal file is present, or more than one is present, an exception is
    -- thrown via 'throwM'.
    --
    -- If the directory contains a file named package.yaml, hpack is used to
    -- generate a .cabal file from it.
    --
    -- @since 0.1.0.0
    findOrGenerateCabalFile
        :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
        => Path Abs Dir -- ^ package directory
        -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile :: Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile pkgDir :: Path Abs Dir
    pkgDir = do
        Path Abs Dir -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> RIO env ()
    hpack Path Abs Dir
    pkgDir
        [Path Abs File]
    files <- (Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip FilePath -> FilePath -> Bool
    hasExtension "cabal" (FilePath -> Bool)
    -> (Path Abs File -> FilePath) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath) ([Path Abs File] -> [Path Abs File])
    -> (([Path Abs Dir], [Path Abs File]) -> [Path Abs File])
    -> ([Path Abs Dir], [Path Abs File])
    -> [Path Abs File]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Path Abs Dir], [Path Abs File]) -> [Path Abs File]
    forall a b. (a, b) -> b
    snd
             (([Path Abs Dir], [Path Abs File]) -> [Path Abs File])
    -> RIO env ([Path Abs Dir], [Path Abs File])
    -> RIO env [Path Abs File]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Path Abs Dir -> RIO env ([Path Abs Dir], [Path Abs File])
    forall (m :: * -> *) b.
    MonadIO m =>
    Path b Dir -> m ([Path Abs Dir], [Path Abs File])
    listDir Path Abs Dir
    pkgDir
        -- If there are multiple files, ignore files that start with
        -- ".". On unixlike environments these are hidden, and this
        -- character is not valid in package names. The main goal is
        -- to ignore emacs lock files - see
        -- https://github.com/commercialhaskell/stack/issues/1897.
        let isHidden :: FilePath -> Bool
    isHidden ('.':_) = Bool
    True
            isHidden _ = Bool
    False
        case (Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Path Abs File -> Bool) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Bool
    isHidden (FilePath -> Bool)
    -> (Path Abs File -> FilePath) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Rel File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath (Path Rel File -> FilePath)
    -> (Path Abs File -> Path Rel File) -> Path Abs File -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename) [Path Abs File]
    files of
            [] -> PantryException -> RIO env (PackageName, Path Abs File)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (PackageName, Path Abs File))
    -> PantryException -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> PantryException
    NoCabalFileFound Path Abs Dir
    pkgDir
            [x :: Path Abs File
    x] -> RIO env (PackageName, Path Abs File)
    -> (PackageName -> RIO env (PackageName, Path Abs File))
    -> Maybe PackageName
    -> RIO env (PackageName, Path Abs File)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
              (PantryException -> RIO env (PackageName, Path Abs File)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (PackageName, Path Abs File))
    -> PantryException -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> PantryException
    InvalidCabalFilePath Path Abs File
    x)
              (\pn :: PackageName
    pn -> (PackageName, Path Abs File)
    -> RIO env (PackageName, Path Abs File)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((PackageName, Path Abs File)
     -> RIO env (PackageName, Path Abs File))
    -> (PackageName, Path Abs File)
    -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ (PackageName
    pn, Path Abs File
    x)) (Maybe PackageName -> RIO env (PackageName, Path Abs File))
    -> Maybe PackageName -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $
                FilePath -> FilePath -> Maybe FilePath
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    List.stripSuffix ".cabal" (Path Rel File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath (Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename Path Abs File
    x)) Maybe FilePath
    -> (FilePath -> Maybe PackageName) -> Maybe PackageName
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                FilePath -> Maybe PackageName
    parsePackageName
            _:_ -> PantryException -> RIO env (PackageName, Path Abs File)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env (PackageName, Path Abs File))
    -> PantryException -> RIO env (PackageName, Path Abs File)
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> [Path Abs File] -> PantryException
    MultipleCabalFilesFound Path Abs Dir
    pkgDir [Path Abs File]
    files
          where hasExtension :: FilePath -> FilePath -> Bool
    hasExtension fp :: FilePath
    fp x :: FilePath
    x = FilePath -> FilePath
    FilePath.takeExtension FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == "." FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    x

    -- | Generate .cabal file from package.yaml, if necessary.
    hpack
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Path Abs Dir
      -> RIO env ()
    hpack :: Path Abs Dir -> RIO env ()
    hpack pkgDir :: Path Abs Dir
    pkgDir = do
        Path Rel File
    packageConfigRelFile <- FilePath -> RIO env (Path Rel File)
    forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
    parseRelFile FilePath
    Hpack.packageConfig
        let hpackFile :: Path Abs File
    hpackFile = Path Abs Dir
    pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
    forall b t. Path b Dir -> Path Rel t -> Path b t
    </> Path Rel File
    packageConfigRelFile
        Bool
    exists <- IO Bool -> RIO env Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> RIO env Bool) -> IO Bool -> RIO env Bool
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> IO Bool
    forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
    doesFileExist Path Abs File
    hpackFile
        Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    exists (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ do
            Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Running hpack on " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs File
    hpackFile)

            HpackExecutable
    he <- Getting HpackExecutable env HpackExecutable
    -> RIO env HpackExecutable
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting HpackExecutable env HpackExecutable
     -> RIO env HpackExecutable)
    -> Getting HpackExecutable env HpackExecutable
    -> RIO env HpackExecutable
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig -> Const HpackExecutable PantryConfig)
    -> env -> Const HpackExecutable env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    pantryConfigL((PantryConfig -> Const HpackExecutable PantryConfig)
     -> env -> Const HpackExecutable env)
    -> ((HpackExecutable -> Const HpackExecutable HpackExecutable)
        -> PantryConfig -> Const HpackExecutable PantryConfig)
    -> Getting HpackExecutable env HpackExecutable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig -> HpackExecutable)
    -> SimpleGetter PantryConfig HpackExecutable
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig -> HpackExecutable
    pcHpackExecutable
            case HpackExecutable
    he of
                HpackBundled -> do
                    Result
    r <- IO Result -> RIO env Result
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> RIO env Result) -> IO Result -> RIO env Result
    forall a b. (a -> b) -> a -> b
    $ Options -> IO Result
    Hpack.hpackResult (Options -> IO Result) -> Options -> IO Result
    forall a b. (a -> b) -> a -> b
    $ ProgramName -> Options -> Options
    Hpack.setProgramName "stack" (Options -> Options) -> Options -> Options
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Options -> Options
    Hpack.setTarget (Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs File
    hpackFile) Options
    Hpack.defaultOptions
                    [FilePath] -> (FilePath -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Result -> [FilePath]
    Hpack.resultWarnings Result
    r) (Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ())
    -> (FilePath -> Utf8Builder) -> FilePath -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString)
                    let cabalFile :: Utf8Builder
    cabalFile = FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (FilePath -> Utf8Builder)
    -> (Result -> FilePath) -> Result -> Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> FilePath
    Hpack.resultCabalFile (Result -> Utf8Builder) -> Result -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ Result
    r
                    case Result -> Status
    Hpack.resultStatus Result
    r of
                        Hpack.Generated -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "hpack generated a modified version of " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    cabalFile
                        Hpack.OutputUnchanged -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "hpack output unchanged in " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    cabalFile
                        Hpack.AlreadyGeneratedByNewerHpack -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                            Utf8Builder
    cabalFile Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            " was generated with a newer version of hpack,\n" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            "please upgrade and try again."
                        Hpack.ExistingCabalFileWasModifiedManually -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                            Utf8Builder
    cabalFile Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            " was modified manually. Ignoring " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs File
    hpackFile) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            " in favor of the cabal file.\nIf you want to use the " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (Path Rel File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath (Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename Path Abs File
    hpackFile)) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            " file instead of the cabal file,\n" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            "then please delete the cabal file."
                HpackCommand command :: FilePath
    command ->
                    FilePath -> RIO env () -> RIO env ()
    forall env (m :: * -> *) a.
    (HasProcessContext env, MonadReader env m, MonadIO m) =>
    FilePath -> m a -> m a
    withWorkingDir (Path Abs Dir -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path Abs Dir
    pkgDir) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                    FilePath
    -> [FilePath]
    -> (ProcessConfig () () () -> RIO env ())
    -> RIO env ()
    forall env (m :: * -> *) a.
    (HasProcessContext env, HasLogFunc env, MonadReader env m,
     MonadIO m, HasCallStack) =>
    FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
    proc FilePath
    command [] ProcessConfig () () () -> RIO env ()
    forall (m :: * -> *) stdin stdout stderr.
    MonadIO m =>
    ProcessConfig stdin stdout stderr -> m ()
    runProcess_

    -- | Get the 'PackageIdentifier' from a 'GenericPackageDescription'.
    --
    -- @since 0.1.0.0
    gpdPackageIdentifier :: GenericPackageDescription -> PackageIdentifier
    gpdPackageIdentifier :: GenericPackageDescription -> PackageIdentifier
    gpdPackageIdentifier = PackageDescription -> PackageIdentifier
    D.package (PackageDescription -> PackageIdentifier)
    -> (GenericPackageDescription -> PackageDescription)
    -> GenericPackageDescription
    -> PackageIdentifier
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenericPackageDescription -> PackageDescription
    D.packageDescription

    -- | Get the 'PackageName' from a 'GenericPackageDescription'.
    --
    -- @since 0.1.0.0
    gpdPackageName :: GenericPackageDescription -> PackageName
    gpdPackageName :: GenericPackageDescription -> PackageName
    gpdPackageName = PackageIdentifier -> PackageName
    pkgName (PackageIdentifier -> PackageName)
    -> (GenericPackageDescription -> PackageIdentifier)
    -> GenericPackageDescription
    -> PackageName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenericPackageDescription -> PackageIdentifier
    gpdPackageIdentifier

    -- | Get the 'Version' from a 'GenericPackageDescription'.
    --
    -- @since 0.1.0.0
    gpdVersion :: GenericPackageDescription -> Version
    gpdVersion :: GenericPackageDescription -> Version
    gpdVersion = PackageIdentifier -> Version
    pkgVersion (PackageIdentifier -> Version)
    -> (GenericPackageDescription -> PackageIdentifier)
    -> GenericPackageDescription
    -> Version
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenericPackageDescription -> PackageIdentifier
    gpdPackageIdentifier

    loadCabalFileBytes
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageLocationImmutable
      -> RIO env ByteString

    -- Just ignore the mtree for this. Safe assumption: someone who filled
    -- in the TreeKey also filled in the cabal file hash, and that's a
    -- more efficient lookup mechanism.
    loadCabalFileBytes :: PackageLocationImmutable -> RIO env ByteString
    loadCabalFileBytes (PLIHackage pident :: PackageIdentifier
    pident cfHash :: BlobKey
    cfHash _mtree :: TreeKey
    _mtree) = PackageIdentifierRevision -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env ByteString
    getHackageCabalFile (PackageIdentifier -> BlobKey -> PackageIdentifierRevision
    pirForHash PackageIdentifier
    pident BlobKey
    cfHash)

    loadCabalFileBytes pl :: PackageLocationImmutable
    pl = do
      Package
    package <- PackageLocationImmutable -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env Package
    loadPackage PackageLocationImmutable
    pl
      let sfp :: SafeFilePath
    sfp = PackageName -> SafeFilePath
    cabalFileName (PackageName -> SafeFilePath) -> PackageName -> SafeFilePath
    forall a b. (a -> b) -> a -> b
    $ PackageIdentifier -> PackageName
    pkgName (PackageIdentifier -> PackageName)
    -> PackageIdentifier -> PackageName
    forall a b. (a -> b) -> a -> b
    $ Package -> PackageIdentifier
    packageIdent Package
    package
      BlobKey
    cabalBlobKey <- case (Package -> PackageCabal
    packageCabalEntry Package
    package) of
                           PCHpack pcHpack :: PHpack
    pcHpack -> BlobKey -> RIO env BlobKey
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (BlobKey -> RIO env BlobKey) -> BlobKey -> RIO env BlobKey
    forall a b. (a -> b) -> a -> b
    $ TreeEntry -> BlobKey
    teBlob (TreeEntry -> BlobKey)
    -> (PHpack -> TreeEntry) -> PHpack -> BlobKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PHpack -> TreeEntry
    phGenerated (PHpack -> BlobKey) -> PHpack -> BlobKey
    forall a b. (a -> b) -> a -> b
    $ PHpack
    pcHpack
                           PCCabalFile (TreeEntry blobKey :: BlobKey
    blobKey _) -> BlobKey -> RIO env BlobKey
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure BlobKey
    blobKey
      Maybe ByteString
    mbs <- ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe ByteString)
     -> RIO env (Maybe ByteString))
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob BlobKey
    cabalBlobKey
      case Maybe ByteString
    mbs of
        Nothing -> do
          PantryException -> RIO env ByteString
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ByteString)
    -> PantryException -> RIO env ByteString
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> SafeFilePath -> BlobKey -> PantryException
    TreeReferencesMissingBlob (PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI PackageLocationImmutable
    pl) SafeFilePath
    sfp BlobKey
    cabalBlobKey
        Just bs :: ByteString
    bs -> ByteString -> RIO env ByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs

    -- FIXME: to be removed
    loadRawCabalFileBytes
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RIO env ByteString

    -- Just ignore the mtree for this. Safe assumption: someone who filled
    -- in the TreeKey also filled in the cabal file hash, and that's a
    -- more efficient lookup mechanism.
    loadRawCabalFileBytes :: RawPackageLocationImmutable -> RIO env ByteString
    loadRawCabalFileBytes (RPLIHackage pir :: PackageIdentifierRevision
    pir _mtree :: Maybe TreeKey
    _mtree) = PackageIdentifierRevision -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env ByteString
    getHackageCabalFile PackageIdentifierRevision
    pir

    loadRawCabalFileBytes pl :: RawPackageLocationImmutable
    pl = do
      Package
    package <- RawPackageLocationImmutable -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env Package
    loadPackageRaw RawPackageLocationImmutable
    pl
      let sfp :: SafeFilePath
    sfp = PackageName -> SafeFilePath
    cabalFileName (PackageName -> SafeFilePath) -> PackageName -> SafeFilePath
    forall a b. (a -> b) -> a -> b
    $ PackageIdentifier -> PackageName
    pkgName (PackageIdentifier -> PackageName)
    -> PackageIdentifier -> PackageName
    forall a b. (a -> b) -> a -> b
    $ Package -> PackageIdentifier
    packageIdent Package
    package
          TreeEntry cabalBlobKey :: BlobKey
    cabalBlobKey _ft :: FileType
    _ft = case Package -> PackageCabal
    packageCabalEntry Package
    package of
                                         PCCabalFile cabalTE :: TreeEntry
    cabalTE -> TreeEntry
    cabalTE
                                         PCHpack hpackCE :: PHpack
    hpackCE -> PHpack -> TreeEntry
    phGenerated PHpack
    hpackCE
      Maybe ByteString
    mbs <- ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe ByteString)
     -> RIO env (Maybe ByteString))
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob BlobKey
    cabalBlobKey
      case Maybe ByteString
    mbs of
        Nothing -> do
          PantryException -> RIO env ByteString
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ByteString)
    -> PantryException -> RIO env ByteString
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> SafeFilePath -> BlobKey -> PantryException
    TreeReferencesMissingBlob RawPackageLocationImmutable
    pl SafeFilePath
    sfp BlobKey
    cabalBlobKey
        Just bs :: ByteString
    bs -> ByteString -> RIO env ByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs

    -- | Load a 'Package' from a 'PackageLocationImmutable'.
    --
    -- @since 0.1.0.0
    loadPackage
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageLocationImmutable
      -> RIO env Package
    loadPackage :: PackageLocationImmutable -> RIO env Package
    loadPackage = RawPackageLocationImmutable -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env Package
    loadPackageRaw (RawPackageLocationImmutable -> RIO env Package)
    -> (PackageLocationImmutable -> RawPackageLocationImmutable)
    -> PackageLocationImmutable
    -> RIO env Package
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI

    -- | Load a 'Package' from a 'RawPackageLocationImmutable'.
    --
    -- Load the package either from the local DB, Casa, or as a last
    -- resort, the third party (hackage, archive or repo).
    --
    -- @since 0.1.0.0
    loadPackageRaw
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RIO env Package
    loadPackageRaw :: RawPackageLocationImmutable -> RIO env Package
    loadPackageRaw rpli :: RawPackageLocationImmutable
    rpli = do
      case RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey RawPackageLocationImmutable
    rpli of
        Just treeKey' :: TreeKey
    treeKey' -> do
          Maybe Package
    mpackage <- RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaDbOrCasa RawPackageLocationImmutable
    rpli TreeKey
    treeKey'
          case Maybe Package
    mpackage of
            Nothing -> RIO env Package
    loadPackageRawViaThirdParty
            Just package :: Package
    package -> Package -> RIO env Package
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Package
    package
        Nothing -> RIO env Package
    loadPackageRawViaThirdParty
      where
        loadPackageRawViaThirdParty :: RIO env Package
    loadPackageRawViaThirdParty = do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug ("Loading package from third-party: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    rpli)
          case RawPackageLocationImmutable
    rpli of
            RPLIHackage pir :: PackageIdentifierRevision
    pir mtree :: Maybe TreeKey
    mtree -> HackageTarballResult -> Package
    htrPackage (HackageTarballResult -> Package)
    -> RIO env HackageTarballResult -> RIO env Package
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision
    -> Maybe TreeKey -> RIO env HackageTarballResult
    getHackageTarball PackageIdentifierRevision
    pir Maybe TreeKey
    mtree
            RPLIArchive archive :: RawArchive
    archive pm :: RawPackageMetadata
    pm -> RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    getArchivePackage RawPackageLocationImmutable
    rpli RawArchive
    archive RawPackageMetadata
    pm
            RPLIRepo repo :: Repo
    repo rpm :: RawPackageMetadata
    rpm -> Repo -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env Package
    getRepo Repo
    repo RawPackageMetadata
    rpm

    -- | Try to load a package via the database or Casa.
    tryLoadPackageRawViaDbOrCasa ::
         (HasLogFunc env, HasPantryConfig env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> TreeKey
      -> RIO env (Maybe Package)
    tryLoadPackageRawViaDbOrCasa :: RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaDbOrCasa rpli :: RawPackageLocationImmutable
    rpli treeKey' :: TreeKey
    treeKey' = do
      Maybe Package
    mviaDb <- RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaLocalDb RawPackageLocationImmutable
    rpli TreeKey
    treeKey'
      case Maybe Package
    mviaDb of
        Just package :: Package
    package -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug ("Loaded package from Pantry: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    rpli)
          Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Package -> Maybe Package
    forall a. a -> Maybe a
    Just Package
    package)
        Nothing -> do
          Maybe Package
    mviaCasa <- RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaCasa RawPackageLocationImmutable
    rpli TreeKey
    treeKey'
          case Maybe Package
    mviaCasa of
            Just package :: Package
    package -> do
              Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug ("Loaded package from Casa: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    rpli)
              Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Package -> Maybe Package
    forall a. a -> Maybe a
    Just Package
    package)
            Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing

    -- | Maybe load the package from Casa.
    tryLoadPackageRawViaCasa ::
         (HasLogFunc env, HasPantryConfig env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> TreeKey
      -> RIO env (Maybe Package)
    tryLoadPackageRawViaCasa :: RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaCasa rlpi :: RawPackageLocationImmutable
    rlpi treeKey' :: TreeKey
    treeKey' = do
      Maybe (TreeKey, Tree)
    mtreePair <- TreeKey -> RIO env (Maybe (TreeKey, Tree))
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    TreeKey -> RIO env (Maybe (TreeKey, Tree))
    casaLookupTree TreeKey
    treeKey'
      case Maybe (TreeKey, Tree)
    mtreePair of
        Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
        Just (treeKey'' :: TreeKey
    treeKey'', _tree :: Tree
    _tree) -> do
          [RawPackageLocationImmutable] -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [RawPackageLocationImmutable] -> RIO env ()
    fetchTreeKeys [RawPackageLocationImmutable
    rlpi]
          Maybe Package
    mdb <- RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaLocalDb RawPackageLocationImmutable
    rlpi TreeKey
    treeKey''
          case Maybe Package
    mdb of
            Nothing -> do
              Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn
                ("Did not find tree key in DB after pulling it from Casa: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                 TreeKey -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display TreeKey
    treeKey'' Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                 " (for " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                 RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    rlpi Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                 ")")
              Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
            Just package :: Package
    package -> Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Package -> Maybe Package
    forall a. a -> Maybe a
    Just Package
    package)

    -- | Maybe load the package from the local database.
    tryLoadPackageRawViaLocalDb ::
         (HasLogFunc env, HasPantryConfig env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> TreeKey
      -> RIO env (Maybe Package)
    tryLoadPackageRawViaLocalDb :: RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaLocalDb rlpi :: RawPackageLocationImmutable
    rlpi treeKey' :: TreeKey
    treeKey' = do
      Maybe (Entity Tree)
    mtreeEntity <- ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    -> RIO env (Maybe (Entity Tree))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey TreeKey
    treeKey')
      case Maybe (Entity Tree)
    mtreeEntity of
        Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
        Just treeId :: Entity Tree
    treeId ->
          (Package -> Maybe Package)
    -> RIO env Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Package -> Maybe Package
    forall a. a -> Maybe a
    Just (ReaderT SqlBackend (RIO env) Package -> RIO env Package
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    loadPackageById RawPackageLocationImmutable
    rlpi (Entity Tree -> TreeId
    forall record. Entity record -> Key record
    entityKey Entity Tree
    treeId)))

    -- | Complete package location, plus whether the package has a cabal file. This
    -- is relevant to reproducibility, see
    -- <https://tech.fpcomplete.com/blog/storing-generated-cabal-files>
    --
    -- @since 0.4.0.0
    data CompletePackageLocation = CompletePackageLocation
      { CompletePackageLocation -> PackageLocationImmutable
    cplComplete :: !PackageLocationImmutable
      , CompletePackageLocation -> Bool
    cplHasCabalFile :: !Bool
      }

    -- | Fill in optional fields in a 'PackageLocationImmutable' for more reproducible builds.
    --
    -- @since 0.1.0.0
    completePackageLocation
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RIO env CompletePackageLocation
    completePackageLocation :: RawPackageLocationImmutable -> RIO env CompletePackageLocation
    completePackageLocation (RPLIHackage (PackageIdentifierRevision n :: PackageName
    n v :: Version
    v (CFIHash sha :: SHA256
    sha (Just size :: FileSize
    size))) (Just tk :: TreeKey
    tk)) =
      CompletePackageLocation -> RIO env CompletePackageLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WCompletePackageLocation :: PackageLocationImmutable -> Bool -> CompletePackageLocation
    CompletePackageLocation
        { cplComplete :: PackageLocationImmutable
    cplComplete = PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
    PLIHackage (PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    n Version
    v) (SHA256 -> FileSize -> BlobKey
    BlobKey SHA256
    sha FileSize
    size) TreeKey
    tk
        , cplHasCabalFile :: Bool
    cplHasCabalFile = Bool
    True
        }
    completePackageLocation (RPLIHackage pir0 :: PackageIdentifierRevision
    pir0@(PackageIdentifierRevision name :: PackageName
    name version :: Version
    version cfi0 :: CabalFileInfo
    cfi0) _) = do
      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Completing package location information from " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> PackageIdentifierRevision -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display PackageIdentifierRevision
    pir0
      (pir :: PackageIdentifierRevision
    pir, cfKey :: BlobKey
    cfKey) <-
        case CabalFileInfo
    cfi0 of
          CFIHash sha :: SHA256
    sha (Just size :: FileSize
    size) -> (PackageIdentifierRevision, BlobKey)
    -> RIO env (PackageIdentifierRevision, BlobKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageIdentifierRevision
    pir0, SHA256 -> FileSize -> BlobKey
    BlobKey SHA256
    sha FileSize
    size)
          _ -> do
            ByteString
    bs <- PackageIdentifierRevision -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env ByteString
    getHackageCabalFile PackageIdentifierRevision
    pir0
            let size :: FileSize
    size = Word -> FileSize
    FileSize (Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    B.length ByteString
    bs))
                sha :: SHA256
    sha = ByteString -> SHA256
    SHA256.hashBytes ByteString
    bs
                cfi :: CabalFileInfo
    cfi = SHA256 -> Maybe FileSize -> CabalFileInfo
    CFIHash SHA256
    sha (FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size)
                pir :: PackageIdentifierRevision
    pir = PackageName
    -> Version -> CabalFileInfo -> PackageIdentifierRevision
    PackageIdentifierRevision PackageName
    name Version
    version CabalFileInfo
    cfi
            Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Added in cabal file hash: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> PackageIdentifierRevision -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display PackageIdentifierRevision
    pir
            (PackageIdentifierRevision, BlobKey)
    -> RIO env (PackageIdentifierRevision, BlobKey)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageIdentifierRevision
    pir, SHA256 -> FileSize -> BlobKey
    BlobKey SHA256
    sha FileSize
    size)
      TreeKey
    treeKey' <- PackageIdentifierRevision -> RIO env TreeKey
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision -> RIO env TreeKey
    getHackageTarballKey PackageIdentifierRevision
    pir
      CompletePackageLocation -> RIO env CompletePackageLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WCompletePackageLocation :: PackageLocationImmutable -> Bool -> CompletePackageLocation
    CompletePackageLocation
        { cplComplete :: PackageLocationImmutable
    cplComplete = PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
    PLIHackage (PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    version) BlobKey
    cfKey TreeKey
    treeKey'
        , cplHasCabalFile :: Bool
    cplHasCabalFile = Bool
    True
        }
    completePackageLocation pl :: RawPackageLocationImmutable
    pl@(RPLIArchive archive :: RawArchive
    archive rpm :: RawPackageMetadata
    rpm) = do
      Maybe Package
    mpackage <-
        case RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    rpm of
          Just treeKey' :: TreeKey
    treeKey' -> RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaDbOrCasa RawPackageLocationImmutable
    pl TreeKey
    treeKey'
          Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
      case (,,) (SHA256 -> FileSize -> Package -> (SHA256, FileSize, Package))
    -> Maybe SHA256
    -> Maybe (FileSize -> Package -> (SHA256, FileSize, Package))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawArchive -> Maybe SHA256
    raHash RawArchive
    archive Maybe (FileSize -> Package -> (SHA256, FileSize, Package))
    -> Maybe FileSize -> Maybe (Package -> (SHA256, FileSize, Package))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> RawArchive -> Maybe FileSize
    raSize RawArchive
    archive Maybe (Package -> (SHA256, FileSize, Package))
    -> Maybe Package -> Maybe (SHA256, FileSize, Package)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Package
    mpackage of
        Just (sha256 :: SHA256
    sha256, fileSize :: FileSize
    fileSize, package :: Package
    package) -> do
          let RawArchive loc :: ArchiveLocation
    loc _ _ subdir :: Text
    subdir = RawArchive
    archive
          CompletePackageLocation -> RIO env CompletePackageLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WCompletePackageLocation :: PackageLocationImmutable -> Bool -> CompletePackageLocation
    CompletePackageLocation
            { cplComplete :: PackageLocationImmutable
    cplComplete = Archive -> PackageMetadata -> PackageLocationImmutable
    PLIArchive (ArchiveLocation -> SHA256 -> FileSize -> Text -> Archive
    Archive ArchiveLocation
    loc SHA256
    sha256 FileSize
    fileSize Text
    subdir) (Package -> PackageMetadata
    packagePM Package
    package)
            , cplHasCabalFile :: Bool
    cplHasCabalFile =
                case Package -> PackageCabal
    packageCabalEntry Package
    package of
                  PCCabalFile{} -> Bool
    True
                  PCHpack{} -> Bool
    False
            }
        Nothing -> Bool -> RIO env CompletePackageLocation
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Bool -> RIO env CompletePackageLocation
    byThirdParty (Maybe Package -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Package
    mpackage)
      where
        byThirdParty :: Bool -> RIO env CompletePackageLocation
    byThirdParty warnAboutMissingSizeSha :: Bool
    warnAboutMissingSizeSha = do
          (sha :: SHA256
    sha, size :: FileSize
    size, package :: Package
    package) <- RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package)
    getArchive RawPackageLocationImmutable
    pl RawArchive
    archive RawPackageMetadata
    rpm
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    warnAboutMissingSizeSha (SHA256 -> FileSize -> RIO env ()
    forall (m :: * -> *) env a a.
    (MonadIO m, MonadReader env m, HasLogFunc env, Display a,
     Display a) =>
    a -> a -> m ()
    warnWith SHA256
    sha FileSize
    size)
          -- (getArchive checks archive and package metadata)
          let RawArchive loc :: ArchiveLocation
    loc _ _ subdir :: Text
    subdir = RawArchive
    archive
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (FilePath -> Utf8Builder) -> FilePath -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ (RawPackageLocationImmutable, SHA256, FileSize, Package)
    -> FilePath
    forall a. Show a => a -> FilePath
    show (RawPackageLocationImmutable
    pl, SHA256
    sha, FileSize
    size, Package
    package)
          CompletePackageLocation -> RIO env CompletePackageLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WCompletePackageLocation :: PackageLocationImmutable -> Bool -> CompletePackageLocation
    CompletePackageLocation
            { cplComplete :: PackageLocationImmutable
    cplComplete = Archive -> PackageMetadata -> PackageLocationImmutable
    PLIArchive (ArchiveLocation -> SHA256 -> FileSize -> Text -> Archive
    Archive ArchiveLocation
    loc SHA256
    sha FileSize
    size Text
    subdir) (Package -> PackageMetadata
    packagePM Package
    package)
            , cplHasCabalFile :: Bool
    cplHasCabalFile =
                case Package -> PackageCabal
    packageCabalEntry Package
    package of
                  PCCabalFile{} -> Bool
    True
                  PCHpack{} -> Bool
    False
            }
        warnWith :: a -> a -> m ()
    warnWith sha :: a
    sha size :: a
    size =
          Utf8Builder -> m ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn
            ([Utf8Builder] -> Utf8Builder
    forall a. Monoid a => [a] -> a
    mconcat
               [ "The package "
               , RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    pl
               , " is available from the local content-addressable storage database, \n"
               , "but we can't use it unless you specify the size and hash for this package.\n"
               , "Add the following to your package description:\n"
               , "\nsize: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> a -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display a
    size
               , "\nsha256: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> a -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display a
    sha
               ])
    completePackageLocation pl :: RawPackageLocationImmutable
    pl@(RPLIRepo repo :: Repo
    repo rpm :: RawPackageMetadata
    rpm) = do
      Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Bool
    isSHA1 (Repo -> Text
    repoCommit Repo
    repo)) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Repo -> PantryException
    CannotCompleteRepoNonSHA1 Repo
    repo
      Repo
    -> RawPackageLocationImmutable
    -> RawPackageMetadata
    -> RIO env CompletePackageLocation
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo
    -> RawPackageLocationImmutable
    -> RawPackageMetadata
    -> RIO env CompletePackageLocation
    completePM Repo
    repo RawPackageLocationImmutable
    pl RawPackageMetadata
    rpm
      where
        isSHA1 :: Text -> Bool
    isSHA1 t :: Text
    t = Text -> Int
    T.length Text
    t Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 40 Bool -> Bool -> Bool
    && (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isHexDigit Text
    t

    completePM
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Repo
      -> RawPackageLocationImmutable
      -> RawPackageMetadata
      -> RIO env CompletePackageLocation
    completePM :: Repo
    -> RawPackageLocationImmutable
    -> RawPackageMetadata
    -> RIO env CompletePackageLocation
    completePM repo :: Repo
    repo plOrig :: RawPackageLocationImmutable
    plOrig rpm :: RawPackageMetadata
    rpm@(RawPackageMetadata mn :: Maybe PackageName
    mn mv :: Maybe Version
    mv mtk :: Maybe TreeKey
    mtk)
      | Just n :: PackageName
    n <- Maybe PackageName
    mn, Just v :: Version
    v <- Maybe Version
    mv, Just tk :: TreeKey
    tk <- Maybe TreeKey
    mtk = do
          let pm :: PackageMetadata
    pm = PackageIdentifier -> TreeKey -> PackageMetadata
    PackageMetadata (PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    n Version
    v) TreeKey
    tk
          CompletePackageLocation -> RIO env CompletePackageLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WCompletePackageLocation :: PackageLocationImmutable -> Bool -> CompletePackageLocation
    CompletePackageLocation
            { cplComplete :: PackageLocationImmutable
    cplComplete = Repo -> PackageMetadata -> PackageLocationImmutable
    PLIRepo Repo
    repo PackageMetadata
    pm
            -- This next bit is a hack: we don't know for certain that this is the case.
            -- However, for the use case where complete package metadata has been supplied,
            -- we'll assume there's a cabal file for purposes of generating a deprecation warning.
            , cplHasCabalFile :: Bool
    cplHasCabalFile = Bool
    True
            }
      | Bool
    otherwise = do
          Package
    package <- RawPackageLocationImmutable -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env Package
    loadPackageRaw RawPackageLocationImmutable
    plOrig
          let pm :: PackageMetadata
    pm = Package -> PackageMetadata
    packagePM Package
    package
          let isSame :: a -> Maybe a -> Bool
    isSame x :: a
    x (Just y :: a
    y) = a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    y
              isSame _ _ = Bool
    True

              allSame :: Bool
    allSame =
                PackageName -> Maybe PackageName -> Bool
    forall a. Eq a => a -> Maybe a -> Bool
    isSame (PackageIdentifier -> PackageName
    pkgName (PackageIdentifier -> PackageName)
    -> PackageIdentifier -> PackageName
    forall a b. (a -> b) -> a -> b
    $ PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm) (RawPackageMetadata -> Maybe PackageName
    rpmName RawPackageMetadata
    rpm) Bool -> Bool -> Bool
    &&
                Version -> Maybe Version -> Bool
    forall a. Eq a => a -> Maybe a -> Bool
    isSame (PackageIdentifier -> Version
    pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
    forall a b. (a -> b) -> a -> b
    $ PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm) (RawPackageMetadata -> Maybe Version
    rpmVersion RawPackageMetadata
    rpm) Bool -> Bool -> Bool
    &&
                TreeKey -> Maybe TreeKey -> Bool
    forall a. Eq a => a -> Maybe a -> Bool
    isSame (PackageMetadata -> TreeKey
    pmTreeKey PackageMetadata
    pm) (RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    rpm)
          if Bool
    allSame
            then CompletePackageLocation -> RIO env CompletePackageLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WCompletePackageLocation :: PackageLocationImmutable -> Bool -> CompletePackageLocation
    CompletePackageLocation
                   { cplComplete :: PackageLocationImmutable
    cplComplete = Repo -> PackageMetadata -> PackageLocationImmutable
    PLIRepo Repo
    repo PackageMetadata
    pm
                   , cplHasCabalFile :: Bool
    cplHasCabalFile =
                       case Package -> PackageCabal
    packageCabalEntry Package
    package of
                         PCCabalFile{} -> Bool
    True
                         PCHpack{} -> Bool
    False
                   }
            else PantryException -> RIO env CompletePackageLocation
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env CompletePackageLocation)
    -> PantryException -> RIO env CompletePackageLocation
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable -> PackageMetadata -> PantryException
    CompletePackageMetadataMismatch RawPackageLocationImmutable
    plOrig PackageMetadata
    pm

    packagePM :: Package -> PackageMetadata
    packagePM :: Package -> PackageMetadata
    packagePM package :: Package
    package = $WPackageMetadata :: PackageIdentifier -> TreeKey -> PackageMetadata
    PackageMetadata
      { pmIdent :: PackageIdentifier
    pmIdent = Package -> PackageIdentifier
    packageIdent Package
    package
      , pmTreeKey :: TreeKey
    pmTreeKey = Package -> TreeKey
    packageTreeKey Package
    package
      }

    -- | Add in hashes to make a 'SnapshotLocation' reproducible.
    --
    -- @since 0.1.0.0
    completeSnapshotLocation
      :: (HasPantryConfig env, HasLogFunc env)
      => RawSnapshotLocation
      -> RIO env SnapshotLocation
    completeSnapshotLocation :: RawSnapshotLocation -> RIO env SnapshotLocation
    completeSnapshotLocation (RSLCompiler c :: WantedCompiler
    c) = SnapshotLocation -> RIO env SnapshotLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SnapshotLocation -> RIO env SnapshotLocation)
    -> SnapshotLocation -> RIO env SnapshotLocation
    forall a b. (a -> b) -> a -> b
    $ WantedCompiler -> SnapshotLocation
    SLCompiler WantedCompiler
    c
    completeSnapshotLocation (RSLFilePath f :: ResolvedPath File
    f) = SnapshotLocation -> RIO env SnapshotLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SnapshotLocation -> RIO env SnapshotLocation)
    -> SnapshotLocation -> RIO env SnapshotLocation
    forall a b. (a -> b) -> a -> b
    $ ResolvedPath File -> SnapshotLocation
    SLFilePath ResolvedPath File
    f
    completeSnapshotLocation (RSLUrl url :: Text
    url (Just blobKey :: BlobKey
    blobKey)) = SnapshotLocation -> RIO env SnapshotLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SnapshotLocation -> RIO env SnapshotLocation)
    -> SnapshotLocation -> RIO env SnapshotLocation
    forall a b. (a -> b) -> a -> b
    $ Text -> BlobKey -> SnapshotLocation
    SLUrl Text
    url BlobKey
    blobKey
    completeSnapshotLocation (RSLUrl url :: Text
    url Nothing) = do
      ByteString
    bs <- Text -> Maybe BlobKey -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> Maybe BlobKey -> RIO env ByteString
    loadFromURL Text
    url Maybe BlobKey
    forall a. Maybe a
    Nothing
      SnapshotLocation -> RIO env SnapshotLocation
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SnapshotLocation -> RIO env SnapshotLocation)
    -> SnapshotLocation -> RIO env SnapshotLocation
    forall a b. (a -> b) -> a -> b
    $ Text -> BlobKey -> SnapshotLocation
    SLUrl Text
    url (ByteString -> BlobKey
    bsToBlobKey ByteString
    bs)

    traverseConcurrently_
      :: (Foldable f, HasPantryConfig env)
      => (a -> RIO env ()) -- ^ action to perform
      -> f a -- ^ input values
      -> RIO env ()
    traverseConcurrently_ :: (a -> RIO env ()) -> f a -> RIO env ()
    traverseConcurrently_ f :: a -> RIO env ()
    f t0 :: f a
    t0 = do
      Int
    cnt <- Getting Int env Int -> RIO env Int
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting Int env Int -> RIO env Int)
    -> Getting Int env Int -> RIO env Int
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig -> Const Int PantryConfig) -> env -> Const Int env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    pantryConfigL((PantryConfig -> Const Int PantryConfig) -> env -> Const Int env)
    -> ((Int -> Const Int Int)
        -> PantryConfig -> Const Int PantryConfig)
    -> Getting Int env Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig -> Int) -> SimpleGetter PantryConfig Int
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig -> Int
    pcConnectionCount
      Int -> (a -> RIO env ()) -> f a -> RIO env ()
    forall (m :: * -> *) (f :: * -> *) a.
    (MonadUnliftIO m, Foldable f) =>
    Int -> (a -> m ()) -> f a -> m ()
    traverseConcurrentlyWith_ Int
    cnt a -> RIO env ()
    f f a
    t0

    traverseConcurrentlyWith_
      :: (MonadUnliftIO m, Foldable f)
      => Int -- ^ concurrent workers
      -> (a -> m ()) -- ^ action to perform
      -> f a -- ^ input values
      -> m ()
    traverseConcurrentlyWith_ :: Int -> (a -> m ()) -> f a -> m ()
    traverseConcurrentlyWith_ count :: Int
    count f :: a -> m ()
    f t0 :: f a
    t0 = do
      TVar [a]
    queue <- [a] -> m (TVar [a])
    forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
    newTVarIO ([a] -> m (TVar [a])) -> [a] -> m (TVar [a])
    forall a b. (a -> b) -> a -> b
    $ f a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList f a
    t0

      Int -> m () -> m ()
    forall (m :: * -> *) a.
    (Applicative m, MonadUnliftIO m) =>
    Int -> m a -> m ()
    replicateConcurrently_ Int
    count (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
        (m () -> m ()) -> m ()
    forall a. (a -> a) -> a
    fix ((m () -> m ()) -> m ()) -> (m () -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \loop :: m ()
    loop -> m (m ()) -> m ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (m (m ()) -> m ()) -> m (m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ STM (m ()) -> m (m ())
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
    atomically (STM (m ()) -> m (m ())) -> STM (m ()) -> m (m ())
    forall a b. (a -> b) -> a -> b
    $ do
          [a]
    toProcess <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    queue
          case [a]
    toProcess of
            [] -> m () -> STM (m ())
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (() -> m ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
            (x :: a
    x:rest :: [a]
    rest) -> do
              TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    queue [a]
    rest
              m () -> STM (m ())
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (m () -> STM (m ())) -> m () -> STM (m ())
    forall a b. (a -> b) -> a -> b
    $ do
                a -> m ()
    f a
    x
                m ()
    loop

    -- | Parse a 'RawSnapshot' (all layers) from a 'RawSnapshotLocation'.
    --
    -- @since 0.1.0.0
    loadSnapshotRaw
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawSnapshotLocation
      -> RIO env RawSnapshot
    loadSnapshotRaw :: RawSnapshotLocation -> RIO env RawSnapshot
    loadSnapshotRaw loc :: RawSnapshotLocation
    loc = do
      Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    eres <- RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    loadRawSnapshotLayer RawSnapshotLocation
    loc
      case Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    eres of
        Left wc :: WantedCompiler
    wc ->
          RawSnapshot -> RIO env RawSnapshot
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WRawSnapshot :: WantedCompiler
    -> Map PackageName RawSnapshotPackage
    -> Set PackageName
    -> RawSnapshot
    RawSnapshot
            { rsCompiler :: WantedCompiler
    rsCompiler = WantedCompiler
    wc
            , rsPackages :: Map PackageName RawSnapshotPackage
    rsPackages = Map PackageName RawSnapshotPackage
    forall a. Monoid a => a
    mempty
            , rsDrop :: Set PackageName
    rsDrop = Set PackageName
    forall a. Monoid a => a
    mempty
            }
        Right (rsl :: RawSnapshotLayer
    rsl, _) -> do
          RawSnapshot
    snap0 <- RawSnapshotLocation -> RIO env RawSnapshot
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawSnapshotLocation -> RIO env RawSnapshot
    loadSnapshotRaw (RawSnapshotLocation -> RIO env RawSnapshot)
    -> RawSnapshotLocation -> RIO env RawSnapshot
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLayer -> RawSnapshotLocation
    rslParent RawSnapshotLayer
    rsl
          (packages :: Map PackageName RawSnapshotPackage
    packages, unused :: AddPackagesConfig
    unused) <-
            Utf8Builder
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName RawSnapshotPackage
    -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Utf8Builder
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName RawSnapshotPackage
    -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    addPackagesToSnapshot
              (RawSnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawSnapshotLocation
    loc)
              (RawSnapshotLayer -> [RawPackageLocationImmutable]
    rslLocations RawSnapshotLayer
    rsl)
              $WAddPackagesConfig :: Set PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map PackageName Bool
    -> Map PackageName [Text]
    -> AddPackagesConfig
    AddPackagesConfig
                { apcDrop :: Set PackageName
    apcDrop = RawSnapshotLayer -> Set PackageName
    rslDropPackages RawSnapshotLayer
    rsl
                , apcFlags :: Map PackageName (Map FlagName Bool)
    apcFlags = RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
    rslFlags RawSnapshotLayer
    rsl
                , apcHiddens :: Map PackageName Bool
    apcHiddens = RawSnapshotLayer -> Map PackageName Bool
    rslHidden RawSnapshotLayer
    rsl
                , apcGhcOptions :: Map PackageName [Text]
    apcGhcOptions = RawSnapshotLayer -> Map PackageName [Text]
    rslGhcOptions RawSnapshotLayer
    rsl
                }
              (RawSnapshot -> Map PackageName RawSnapshotPackage
    rsPackages RawSnapshot
    snap0)
          Utf8Builder -> AddPackagesConfig -> RIO env ()
    forall env.
    HasLogFunc env =>
    Utf8Builder -> AddPackagesConfig -> RIO env ()
    warnUnusedAddPackagesConfig (RawSnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawSnapshotLocation
    loc) AddPackagesConfig
    unused
          RawSnapshot -> RIO env RawSnapshot
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WRawSnapshot :: WantedCompiler
    -> Map PackageName RawSnapshotPackage
    -> Set PackageName
    -> RawSnapshot
    RawSnapshot
            { rsCompiler :: WantedCompiler
    rsCompiler = WantedCompiler -> Maybe WantedCompiler -> WantedCompiler
    forall a. a -> Maybe a -> a
    fromMaybe (RawSnapshot -> WantedCompiler
    rsCompiler RawSnapshot
    snap0) (RawSnapshotLayer -> Maybe WantedCompiler
    rslCompiler RawSnapshotLayer
    rsl)
            , rsPackages :: Map PackageName RawSnapshotPackage
    rsPackages = Map PackageName RawSnapshotPackage
    packages
            , rsDrop :: Set PackageName
    rsDrop = AddPackagesConfig -> Set PackageName
    apcDrop AddPackagesConfig
    unused
            }

    -- | Parse a 'RawSnapshot' (all layers) from a 'SnapshotLocation'.
    --
    -- @since 0.1.0.0
    loadSnapshot
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => SnapshotLocation
      -> RIO env RawSnapshot
    loadSnapshot :: SnapshotLocation -> RIO env RawSnapshot
    loadSnapshot loc :: SnapshotLocation
    loc = do
      Either WantedCompiler RawSnapshotLayer
    eres <- SnapshotLocation
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    SnapshotLocation
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    loadSnapshotLayer SnapshotLocation
    loc
      case Either WantedCompiler RawSnapshotLayer
    eres of
        Left wc :: WantedCompiler
    wc ->
          RawSnapshot -> RIO env RawSnapshot
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WRawSnapshot :: WantedCompiler
    -> Map PackageName RawSnapshotPackage
    -> Set PackageName
    -> RawSnapshot
    RawSnapshot
            { rsCompiler :: WantedCompiler
    rsCompiler = WantedCompiler
    wc
            , rsPackages :: Map PackageName RawSnapshotPackage
    rsPackages = Map PackageName RawSnapshotPackage
    forall a. Monoid a => a
    mempty
            , rsDrop :: Set PackageName
    rsDrop = Set PackageName
    forall a. Monoid a => a
    mempty
            }
        Right rsl :: RawSnapshotLayer
    rsl -> do
          RawSnapshot
    snap0 <- RawSnapshotLocation -> RIO env RawSnapshot
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawSnapshotLocation -> RIO env RawSnapshot
    loadSnapshotRaw (RawSnapshotLocation -> RIO env RawSnapshot)
    -> RawSnapshotLocation -> RIO env RawSnapshot
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLayer -> RawSnapshotLocation
    rslParent RawSnapshotLayer
    rsl
          (packages :: Map PackageName RawSnapshotPackage
    packages, unused :: AddPackagesConfig
    unused) <-
            Utf8Builder
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName RawSnapshotPackage
    -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Utf8Builder
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName RawSnapshotPackage
    -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    addPackagesToSnapshot
              (SnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SnapshotLocation
    loc)
              (RawSnapshotLayer -> [RawPackageLocationImmutable]
    rslLocations RawSnapshotLayer
    rsl)
              $WAddPackagesConfig :: Set PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map PackageName Bool
    -> Map PackageName [Text]
    -> AddPackagesConfig
    AddPackagesConfig
                { apcDrop :: Set PackageName
    apcDrop = RawSnapshotLayer -> Set PackageName
    rslDropPackages RawSnapshotLayer
    rsl
                , apcFlags :: Map PackageName (Map FlagName Bool)
    apcFlags = RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
    rslFlags RawSnapshotLayer
    rsl
                , apcHiddens :: Map PackageName Bool
    apcHiddens = RawSnapshotLayer -> Map PackageName Bool
    rslHidden RawSnapshotLayer
    rsl
                , apcGhcOptions :: Map PackageName [Text]
    apcGhcOptions = RawSnapshotLayer -> Map PackageName [Text]
    rslGhcOptions RawSnapshotLayer
    rsl
                }
              (RawSnapshot -> Map PackageName RawSnapshotPackage
    rsPackages RawSnapshot
    snap0)
          Utf8Builder -> AddPackagesConfig -> RIO env ()
    forall env.
    HasLogFunc env =>
    Utf8Builder -> AddPackagesConfig -> RIO env ()
    warnUnusedAddPackagesConfig (SnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SnapshotLocation
    loc) AddPackagesConfig
    unused
          RawSnapshot -> RIO env RawSnapshot
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure $WRawSnapshot :: WantedCompiler
    -> Map PackageName RawSnapshotPackage
    -> Set PackageName
    -> RawSnapshot
    RawSnapshot
            { rsCompiler :: WantedCompiler
    rsCompiler = WantedCompiler -> Maybe WantedCompiler -> WantedCompiler
    forall a. a -> Maybe a -> a
    fromMaybe (RawSnapshot -> WantedCompiler
    rsCompiler RawSnapshot
    snap0) (RawSnapshotLayer -> Maybe WantedCompiler
    rslCompiler RawSnapshotLayer
    rsl)
            , rsPackages :: Map PackageName RawSnapshotPackage
    rsPackages = Map PackageName RawSnapshotPackage
    packages
            , rsDrop :: Set PackageName
    rsDrop = AddPackagesConfig -> Set PackageName
    apcDrop AddPackagesConfig
    unused
            }

    -- | A completed package location, including the original raw and completed information.
    --
    -- @since 0.1.0.0
    data CompletedPLI = CompletedPLI !RawPackageLocationImmutable !PackageLocationImmutable

    -- | A completed snapshot location, including the original raw and completed information.
    --
    -- @since 0.1.0.0
    data CompletedSL = CompletedSL !RawSnapshotLocation !SnapshotLocation

    -- | Parse a 'Snapshot' (all layers) from a 'SnapshotLocation' noting
    -- any incomplete package locations
    --
    -- @since 0.1.0.0
    loadAndCompleteSnapshot
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => SnapshotLocation
      -> Map RawSnapshotLocation SnapshotLocation -- ^ Cached snapshot locations from lock file
      -> Map RawPackageLocationImmutable PackageLocationImmutable -- ^ Cached locations from lock file
      -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshot :: SnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshot loc :: SnapshotLocation
    loc cachedSL :: Map RawSnapshotLocation SnapshotLocation
    cachedSL cachedPL :: Map RawPackageLocationImmutable PackageLocationImmutable
    cachedPL =
      RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw (SnapshotLocation -> RawSnapshotLocation
    toRawSL SnapshotLocation
    loc) Map RawSnapshotLocation SnapshotLocation
    cachedSL Map RawPackageLocationImmutable PackageLocationImmutable
    cachedPL

    -- | Parse a 'Snapshot' (all layers) from a 'RawSnapshotLocation' completing
    -- any incomplete package locations
    --
    -- @since 0.1.0.0
    loadAndCompleteSnapshotRaw
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawSnapshotLocation
      -> Map RawSnapshotLocation SnapshotLocation -- ^ Cached snapshot locations from lock file
      -> Map RawPackageLocationImmutable PackageLocationImmutable -- ^ Cached locations from lock file
      -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw :: RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw rawLoc :: RawSnapshotLocation
    rawLoc cacheSL :: Map RawSnapshotLocation SnapshotLocation
    cacheSL cachePL :: Map RawPackageLocationImmutable PackageLocationImmutable
    cachePL = do
      Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    eres <- case RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Maybe SnapshotLocation
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup RawSnapshotLocation
    rawLoc Map RawSnapshotLocation SnapshotLocation
    cacheSL of
        Just loc :: SnapshotLocation
    loc -> (RawSnapshotLayer -> (RawSnapshotLayer, CompletedSL))
    -> Either WantedCompiler RawSnapshotLayer
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either d b) (Either d c)
    right (\rsl :: RawSnapshotLayer
    rsl -> (RawSnapshotLayer
    rsl, (RawSnapshotLocation -> SnapshotLocation -> CompletedSL
    CompletedSL RawSnapshotLocation
    rawLoc SnapshotLocation
    loc))) (Either WantedCompiler RawSnapshotLayer
     -> Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SnapshotLocation
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    SnapshotLocation
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    loadSnapshotLayer SnapshotLocation
    loc
        Nothing -> RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    loadRawSnapshotLayer RawSnapshotLocation
    rawLoc
      case Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    eres of
        Left wc :: WantedCompiler
    wc ->
          let snapshot :: Snapshot
    snapshot = $WSnapshot :: WantedCompiler
    -> Map PackageName SnapshotPackage -> Set PackageName -> Snapshot
    Snapshot
                { snapshotCompiler :: WantedCompiler
    snapshotCompiler = WantedCompiler
    wc
                , snapshotPackages :: Map PackageName SnapshotPackage
    snapshotPackages = Map PackageName SnapshotPackage
    forall a. Monoid a => a
    mempty
                , snapshotDrop :: Set PackageName
    snapshotDrop = Set PackageName
    forall a. Monoid a => a
    mempty
                }
          in (Snapshot, [CompletedSL], [CompletedPLI])
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Snapshot
    snapshot, [RawSnapshotLocation -> SnapshotLocation -> CompletedSL
    CompletedSL (WantedCompiler -> RawSnapshotLocation
    RSLCompiler WantedCompiler
    wc) (WantedCompiler -> SnapshotLocation
    SLCompiler WantedCompiler
    wc)], [])
        Right (rsl :: RawSnapshotLayer
    rsl, sloc :: CompletedSL
    sloc) -> do
          (snap0 :: Snapshot
    snap0, slocs :: [CompletedSL]
    slocs, completed0 :: [CompletedPLI]
    completed0) <- RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw (RawSnapshotLayer -> RawSnapshotLocation
    rslParent RawSnapshotLayer
    rsl) Map RawSnapshotLocation SnapshotLocation
    cacheSL Map RawPackageLocationImmutable PackageLocationImmutable
    cachePL
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (FilePath -> Utf8Builder) -> FilePath -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLayer -> FilePath
    forall a. Show a => a -> FilePath
    show RawSnapshotLayer
    rsl
          (packages :: Map PackageName SnapshotPackage
    packages, completed :: [CompletedPLI]
    completed, unused :: AddPackagesConfig
    unused) <-
            RawSnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName SnapshotPackage
    -> RIO
         env
         (Map PackageName SnapshotPackage, [CompletedPLI],
          AddPackagesConfig)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawSnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName SnapshotPackage
    -> RIO
         env
         (Map PackageName SnapshotPackage, [CompletedPLI],
          AddPackagesConfig)
    addAndCompletePackagesToSnapshot
              RawSnapshotLocation
    rawLoc
              Map RawPackageLocationImmutable PackageLocationImmutable
    cachePL
              (RawSnapshotLayer -> [RawPackageLocationImmutable]
    rslLocations RawSnapshotLayer
    rsl)
              $WAddPackagesConfig :: Set PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map PackageName Bool
    -> Map PackageName [Text]
    -> AddPackagesConfig
    AddPackagesConfig
                { apcDrop :: Set PackageName
    apcDrop = RawSnapshotLayer -> Set PackageName
    rslDropPackages RawSnapshotLayer
    rsl
                , apcFlags :: Map PackageName (Map FlagName Bool)
    apcFlags = RawSnapshotLayer -> Map PackageName (Map FlagName Bool)
    rslFlags RawSnapshotLayer
    rsl
                , apcHiddens :: Map PackageName Bool
    apcHiddens = RawSnapshotLayer -> Map PackageName Bool
    rslHidden RawSnapshotLayer
    rsl
                , apcGhcOptions :: Map PackageName [Text]
    apcGhcOptions = RawSnapshotLayer -> Map PackageName [Text]
    rslGhcOptions RawSnapshotLayer
    rsl
                }
              (Snapshot -> Map PackageName SnapshotPackage
    snapshotPackages Snapshot
    snap0)
          Utf8Builder -> AddPackagesConfig -> RIO env ()
    forall env.
    HasLogFunc env =>
    Utf8Builder -> AddPackagesConfig -> RIO env ()
    warnUnusedAddPackagesConfig (RawSnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawSnapshotLocation
    rawLoc) AddPackagesConfig
    unused
          let snapshot :: Snapshot
    snapshot = $WSnapshot :: WantedCompiler
    -> Map PackageName SnapshotPackage -> Set PackageName -> Snapshot
    Snapshot
                { snapshotCompiler :: WantedCompiler
    snapshotCompiler = WantedCompiler -> Maybe WantedCompiler -> WantedCompiler
    forall a. a -> Maybe a -> a
    fromMaybe (Snapshot -> WantedCompiler
    snapshotCompiler Snapshot
    snap0) (RawSnapshotLayer -> Maybe WantedCompiler
    rslCompiler RawSnapshotLayer
    rsl)
                , snapshotPackages :: Map PackageName SnapshotPackage
    snapshotPackages = Map PackageName SnapshotPackage
    packages
                , snapshotDrop :: Set PackageName
    snapshotDrop = AddPackagesConfig -> Set PackageName
    apcDrop AddPackagesConfig
    unused
                }
          (Snapshot, [CompletedSL], [CompletedPLI])
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Snapshot
    snapshot, CompletedSL
    sloc CompletedSL -> [CompletedSL] -> [CompletedSL]
    forall a. a -> [a] -> [a]
    : [CompletedSL]
    slocs,[CompletedPLI]
    completed0 [CompletedPLI] -> [CompletedPLI] -> [CompletedPLI]
    forall a. [a] -> [a] -> [a]
    ++ [CompletedPLI]
    completed)

    data SingleOrNot a
      = Single !a
      | Multiple !a !a !([a] -> [a])
    instance Semigroup (SingleOrNot a) where
      Single a :: a
    a <> :: SingleOrNot a -> SingleOrNot a -> SingleOrNot a
    <> Single b :: a
    b = a -> a -> ([a] -> [a]) -> SingleOrNot a
    forall a. a -> a -> ([a] -> [a]) -> SingleOrNot a
    Multiple a
    a a
    b [a] -> [a]
    forall a. a -> a
    id
      Single a :: a
    a <> Multiple b :: a
    b c :: a
    c d :: [a] -> [a]
    d = a -> a -> ([a] -> [a]) -> SingleOrNot a
    forall a. a -> a -> ([a] -> [a]) -> SingleOrNot a
    Multiple a
    a a
    b ((a
    ca -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    d)
      Multiple a :: a
    a b :: a
    b c :: [a] -> [a]
    c <> Single d :: a
    d = a -> a -> ([a] -> [a]) -> SingleOrNot a
    forall a. a -> a -> ([a] -> [a]) -> SingleOrNot a
    Multiple a
    a a
    b ([a] -> [a]
    c ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a
    da -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :))
      Multiple a :: a
    a b :: a
    b c :: [a] -> [a]
    c <> Multiple d :: a
    d e :: a
    e f :: [a] -> [a]
    f =
        a -> a -> ([a] -> [a]) -> SingleOrNot a
    forall a. a -> a -> ([a] -> [a]) -> SingleOrNot a
    Multiple a
    a a
    b ([a] -> [a]
    c ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a
    da -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a
    ea -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    f)

    sonToEither :: (k, SingleOrNot a) -> Either (k, a) (k, [a])
    sonToEither :: (k, SingleOrNot a) -> Either (k, a) (k, [a])
    sonToEither (k :: k
    k, Single a :: a
    a) = (k, a) -> Either (k, a) (k, [a])
    forall a b. a -> Either a b
    Left (k
    k, a
    a)
    sonToEither (k :: k
    k, Multiple a :: a
    a b :: a
    b c :: [a] -> [a]
    c) = (k, [a]) -> Either (k, a) (k, [a])
    forall a b. b -> Either a b
    Right (k
    k, (a
    a a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : a
    b a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a]
    c []))

    -- | Package settings to be passed to 'addPackagesToSnapshot'.
    --
    -- @since 0.1.0.0
    data AddPackagesConfig = AddPackagesConfig
      { AddPackagesConfig -> Set PackageName
    apcDrop :: !(Set PackageName)
      , AddPackagesConfig -> Map PackageName (Map FlagName Bool)
    apcFlags :: !(Map PackageName (Map FlagName Bool))
      , AddPackagesConfig -> Map PackageName Bool
    apcHiddens :: !(Map PackageName Bool)
      , AddPackagesConfig -> Map PackageName [Text]
    apcGhcOptions :: !(Map PackageName [Text])
      }

    -- | Does not warn about drops, those are allowed in order to ignore global
    -- packages.
    warnUnusedAddPackagesConfig
      :: HasLogFunc env
      => Utf8Builder -- ^ source
      -> AddPackagesConfig
      -> RIO env ()
    warnUnusedAddPackagesConfig :: Utf8Builder -> AddPackagesConfig -> RIO env ()
    warnUnusedAddPackagesConfig source :: Utf8Builder
    source (AddPackagesConfig _drops :: Set PackageName
    _drops flags :: Map PackageName (Map FlagName Bool)
    flags hiddens :: Map PackageName Bool
    hiddens options :: Map PackageName [Text]
    options) = do
      Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Utf8Builder] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Utf8Builder]
    ls) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ do
        Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Some warnings discovered when adding packages to snapshot (" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    source Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> ")"
        (Utf8Builder -> RIO env ()) -> [Utf8Builder] -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn [Utf8Builder]
    ls
      where
        ls :: [Utf8Builder]
    ls = [[Utf8Builder]] -> [Utf8Builder]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Utf8Builder]
    flags', [Utf8Builder]
    hiddens', [Utf8Builder]
    options']

        flags' :: [Utf8Builder]
    flags' =
          (PackageName -> Utf8Builder) -> [PackageName] -> [Utf8Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map
            (\pn :: PackageName
    pn ->
              "Setting flags for non-existent package: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
              FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (PackageName -> FilePath
    packageNameString PackageName
    pn))
            (Map PackageName (Map FlagName Bool) -> [PackageName]
    forall k a. Map k a -> [k]
    Map.keys Map PackageName (Map FlagName Bool)
    flags)

        hiddens' :: [Utf8Builder]
    hiddens' =
          (PackageName -> Utf8Builder) -> [PackageName] -> [Utf8Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map
            (\pn :: PackageName
    pn ->
              "Hiding non-existent package: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
              FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (PackageName -> FilePath
    packageNameString PackageName
    pn))
            (Map PackageName Bool -> [PackageName]
    forall k a. Map k a -> [k]
    Map.keys Map PackageName Bool
    hiddens)

        options' :: [Utf8Builder]
    options' =
          (PackageName -> Utf8Builder) -> [PackageName] -> [Utf8Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map
            (\pn :: PackageName
    pn ->
              "Setting options for non-existent package: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
              FilePath -> Utf8Builder
    forall a. IsString a => FilePath -> a
    fromString (PackageName -> FilePath
    packageNameString PackageName
    pn))
            (Map PackageName [Text] -> [PackageName]
    forall k a. Map k a -> [k]
    Map.keys Map PackageName [Text]
    options)

    -- | Add more packages to a snapshot
    --
    -- Note that any settings on a parent flag which is being replaced will be
    -- ignored. For example, if package @foo@ is in the parent and has flag @bar@
    -- set, and @foo@ also appears in new packages, then @bar@ will no longer be
    -- set.
    --
    -- Returns any of the 'AddPackagesConfig' values not used.
    --
    -- @since 0.1.0.0
    addPackagesToSnapshot
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Utf8Builder
      -- ^ Text description of where these new packages are coming from, for error
      -- messages only
      -> [RawPackageLocationImmutable] -- ^ new packages
      -> AddPackagesConfig
      -> Map PackageName RawSnapshotPackage -- ^ packages from parent
      -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    addPackagesToSnapshot :: Utf8Builder
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName RawSnapshotPackage
    -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    addPackagesToSnapshot source :: Utf8Builder
    source newPackages :: [RawPackageLocationImmutable]
    newPackages (AddPackagesConfig drops :: Set PackageName
    drops flags :: Map PackageName (Map FlagName Bool)
    flags hiddens :: Map PackageName Bool
    hiddens options :: Map PackageName [Text]
    options) old :: Map PackageName RawSnapshotPackage
    old = do
      [(PackageName, RawSnapshotPackage)]
    new' <- [RawPackageLocationImmutable]
    -> (RawPackageLocationImmutable
        -> RIO env (PackageName, RawSnapshotPackage))
    -> RIO env [(PackageName, RawSnapshotPackage)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [RawPackageLocationImmutable]
    newPackages ((RawPackageLocationImmutable
      -> RIO env (PackageName, RawSnapshotPackage))
     -> RIO env [(PackageName, RawSnapshotPackage)])
    -> (RawPackageLocationImmutable
        -> RIO env (PackageName, RawSnapshotPackage))
    -> RIO env [(PackageName, RawSnapshotPackage)]
    forall a b. (a -> b) -> a -> b
    $ \loc :: RawPackageLocationImmutable
    loc -> do
        PackageName
    name <- RawPackageLocationImmutable -> RIO env PackageName
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env PackageName
    getPackageLocationName RawPackageLocationImmutable
    loc
        (PackageName, RawSnapshotPackage)
    -> RIO env (PackageName, RawSnapshotPackage)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageName
    name, $WRawSnapshotPackage :: RawPackageLocationImmutable
    -> Map FlagName Bool -> Bool -> [Text] -> RawSnapshotPackage
    RawSnapshotPackage
          { rspLocation :: RawPackageLocationImmutable
    rspLocation = RawPackageLocationImmutable
    loc
          , rspFlags :: Map FlagName Bool
    rspFlags = Map FlagName Bool
    -> PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map FlagName Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault Map FlagName Bool
    forall a. Monoid a => a
    mempty PackageName
    name Map PackageName (Map FlagName Bool)
    flags
          , rspHidden :: Bool
    rspHidden = Bool -> PackageName -> Map PackageName Bool -> Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault Bool
    False PackageName
    name Map PackageName Bool
    hiddens
          , rspGhcOptions :: [Text]
    rspGhcOptions = [Text] -> PackageName -> Map PackageName [Text] -> [Text]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault [] PackageName
    name Map PackageName [Text]
    options
          })
      let (newSingles :: [(PackageName, RawSnapshotPackage)]
    newSingles, newMultiples :: [(PackageName, [RawSnapshotPackage])]
    newMultiples)
            = [Either
       (PackageName, RawSnapshotPackage)
       (PackageName, [RawSnapshotPackage])]
    -> ([(PackageName, RawSnapshotPackage)],
        [(PackageName, [RawSnapshotPackage])])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers
            ([Either
        (PackageName, RawSnapshotPackage)
        (PackageName, [RawSnapshotPackage])]
     -> ([(PackageName, RawSnapshotPackage)],
         [(PackageName, [RawSnapshotPackage])]))
    -> [Either
          (PackageName, RawSnapshotPackage)
          (PackageName, [RawSnapshotPackage])]
    -> ([(PackageName, RawSnapshotPackage)],
        [(PackageName, [RawSnapshotPackage])])
    forall a b. (a -> b) -> a -> b
    $ ((PackageName, SingleOrNot RawSnapshotPackage)
     -> Either
          (PackageName, RawSnapshotPackage)
          (PackageName, [RawSnapshotPackage]))
    -> [(PackageName, SingleOrNot RawSnapshotPackage)]
    -> [Either
          (PackageName, RawSnapshotPackage)
          (PackageName, [RawSnapshotPackage])]
    forall a b. (a -> b) -> [a] -> [b]
    map (PackageName, SingleOrNot RawSnapshotPackage)
    -> Either
         (PackageName, RawSnapshotPackage)
         (PackageName, [RawSnapshotPackage])
    forall k a. (k, SingleOrNot a) -> Either (k, a) (k, [a])
    sonToEither
            ([(PackageName, SingleOrNot RawSnapshotPackage)]
     -> [Either
           (PackageName, RawSnapshotPackage)
           (PackageName, [RawSnapshotPackage])])
    -> [(PackageName, SingleOrNot RawSnapshotPackage)]
    -> [Either
          (PackageName, RawSnapshotPackage)
          (PackageName, [RawSnapshotPackage])]
    forall a b. (a -> b) -> a -> b
    $ Map PackageName (SingleOrNot RawSnapshotPackage)
    -> [(PackageName, SingleOrNot RawSnapshotPackage)]
    forall k a. Map k a -> [(k, a)]
    Map.toList
            (Map PackageName (SingleOrNot RawSnapshotPackage)
     -> [(PackageName, SingleOrNot RawSnapshotPackage)])
    -> Map PackageName (SingleOrNot RawSnapshotPackage)
    -> [(PackageName, SingleOrNot RawSnapshotPackage)]
    forall a b. (a -> b) -> a -> b
    $ (SingleOrNot RawSnapshotPackage
     -> SingleOrNot RawSnapshotPackage
     -> SingleOrNot RawSnapshotPackage)
    -> [(PackageName, SingleOrNot RawSnapshotPackage)]
    -> Map PackageName (SingleOrNot RawSnapshotPackage)
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith SingleOrNot RawSnapshotPackage
    -> SingleOrNot RawSnapshotPackage -> SingleOrNot RawSnapshotPackage
    forall a. Semigroup a => a -> a -> a
    (<>)
            ([(PackageName, SingleOrNot RawSnapshotPackage)]
     -> Map PackageName (SingleOrNot RawSnapshotPackage))
    -> [(PackageName, SingleOrNot RawSnapshotPackage)]
    -> Map PackageName (SingleOrNot RawSnapshotPackage)
    forall a b. (a -> b) -> a -> b
    $ ((PackageName, RawSnapshotPackage)
     -> (PackageName, SingleOrNot RawSnapshotPackage))
    -> [(PackageName, RawSnapshotPackage)]
    -> [(PackageName, SingleOrNot RawSnapshotPackage)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((RawSnapshotPackage -> SingleOrNot RawSnapshotPackage)
    -> (PackageName, RawSnapshotPackage)
    -> (PackageName, SingleOrNot RawSnapshotPackage)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second RawSnapshotPackage -> SingleOrNot RawSnapshotPackage
    forall a. a -> SingleOrNot a
    Single) [(PackageName, RawSnapshotPackage)]
    new'
      Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(PackageName, [RawSnapshotPackage])] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([(PackageName, [RawSnapshotPackage])] -> Bool)
    -> [(PackageName, [RawSnapshotPackage])] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(PackageName, [RawSnapshotPackage])]
    newMultiples) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
        Utf8Builder
    -> [(PackageName, [RawPackageLocationImmutable])]
    -> PantryException
    DuplicatePackageNames Utf8Builder
    source ([(PackageName, [RawPackageLocationImmutable])] -> PantryException)
    -> [(PackageName, [RawPackageLocationImmutable])]
    -> PantryException
    forall a b. (a -> b) -> a -> b
    $ ((PackageName, [RawSnapshotPackage])
     -> (PackageName, [RawPackageLocationImmutable]))
    -> [(PackageName, [RawSnapshotPackage])]
    -> [(PackageName, [RawPackageLocationImmutable])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([RawSnapshotPackage] -> [RawPackageLocationImmutable])
    -> (PackageName, [RawSnapshotPackage])
    -> (PackageName, [RawPackageLocationImmutable])
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second ((RawSnapshotPackage -> RawPackageLocationImmutable)
    -> [RawSnapshotPackage] -> [RawPackageLocationImmutable]
    forall a b. (a -> b) -> [a] -> [b]
    map RawSnapshotPackage -> RawPackageLocationImmutable
    rspLocation)) [(PackageName, [RawSnapshotPackage])]
    newMultiples
      let new :: Map PackageName RawSnapshotPackage
    new = [(PackageName, RawSnapshotPackage)]
    -> Map PackageName RawSnapshotPackage
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(PackageName, RawSnapshotPackage)]
    newSingles
          allPackages0 :: Map PackageName RawSnapshotPackage
    allPackages0 = Map PackageName RawSnapshotPackage
    new Map PackageName RawSnapshotPackage
    -> Map PackageName RawSnapshotPackage
    -> Map PackageName RawSnapshotPackage
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `Map.union` (Map PackageName RawSnapshotPackage
    old Map PackageName RawSnapshotPackage
    -> Map PackageName () -> Map PackageName RawSnapshotPackage
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` (PackageName -> ()) -> Set PackageName -> Map PackageName ()
    forall k a. (k -> a) -> Set k -> Map k a
    Map.fromSet (() -> PackageName -> ()
    forall a b. a -> b -> a
    const ()) Set PackageName
    drops)
          allPackages :: Map PackageName RawSnapshotPackage
    allPackages = ((PackageName -> RawSnapshotPackage -> RawSnapshotPackage)
     -> Map PackageName RawSnapshotPackage
     -> Map PackageName RawSnapshotPackage)
    -> Map PackageName RawSnapshotPackage
    -> (PackageName -> RawSnapshotPackage -> RawSnapshotPackage)
    -> Map PackageName RawSnapshotPackage
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (PackageName -> RawSnapshotPackage -> RawSnapshotPackage)
    -> Map PackageName RawSnapshotPackage
    -> Map PackageName RawSnapshotPackage
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
    Map.mapWithKey Map PackageName RawSnapshotPackage
    allPackages0 ((PackageName -> RawSnapshotPackage -> RawSnapshotPackage)
     -> Map PackageName RawSnapshotPackage)
    -> (PackageName -> RawSnapshotPackage -> RawSnapshotPackage)
    -> Map PackageName RawSnapshotPackage
    forall a b. (a -> b) -> a -> b
    $ \name :: PackageName
    name rsp :: RawSnapshotPackage
    rsp ->
            RawSnapshotPackage
    rsp
              { rspFlags :: Map FlagName Bool
    rspFlags = Map FlagName Bool
    -> PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map FlagName Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault (RawSnapshotPackage -> Map FlagName Bool
    rspFlags RawSnapshotPackage
    rsp) PackageName
    name Map PackageName (Map FlagName Bool)
    flags
              , rspHidden :: Bool
    rspHidden = Bool -> PackageName -> Map PackageName Bool -> Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault (RawSnapshotPackage -> Bool
    rspHidden RawSnapshotPackage
    rsp) PackageName
    name Map PackageName Bool
    hiddens
              , rspGhcOptions :: [Text]
    rspGhcOptions = [Text] -> PackageName -> Map PackageName [Text] -> [Text]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault (RawSnapshotPackage -> [Text]
    rspGhcOptions RawSnapshotPackage
    rsp) PackageName
    name Map PackageName [Text]
    options
              }

          unused :: AddPackagesConfig
    unused = Set PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map PackageName Bool
    -> Map PackageName [Text]
    -> AddPackagesConfig
    AddPackagesConfig
            (Set PackageName
    drops Set PackageName -> Set PackageName -> Set PackageName
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Map PackageName RawSnapshotPackage -> Set PackageName
    forall k a. Map k a -> Set k
    Map.keysSet Map PackageName RawSnapshotPackage
    old)
            (Map PackageName (Map FlagName Bool)
    flags Map PackageName (Map FlagName Bool)
    -> Map PackageName RawSnapshotPackage
    -> Map PackageName (Map FlagName Bool)
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` Map PackageName RawSnapshotPackage
    allPackages)
            (Map PackageName Bool
    hiddens Map PackageName Bool
    -> Map PackageName RawSnapshotPackage -> Map PackageName Bool
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` Map PackageName RawSnapshotPackage
    allPackages)
            (Map PackageName [Text]
    options Map PackageName [Text]
    -> Map PackageName RawSnapshotPackage -> Map PackageName [Text]
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` Map PackageName RawSnapshotPackage
    allPackages)

      (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PackageName RawSnapshotPackage
    allPackages, AddPackagesConfig
    unused)

    cachedSnapshotCompletePackageLocation :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Map RawPackageLocationImmutable PackageLocationImmutable
      -> RawPackageLocationImmutable
      -> RIO env (Maybe PackageLocationImmutable)
    cachedSnapshotCompletePackageLocation :: Map RawPackageLocationImmutable PackageLocationImmutable
    -> RawPackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    cachedSnapshotCompletePackageLocation cachePackages :: Map RawPackageLocationImmutable PackageLocationImmutable
    cachePackages rpli :: RawPackageLocationImmutable
    rpli = do
      let xs :: Maybe PackageLocationImmutable
    xs = RawPackageLocationImmutable
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> Maybe PackageLocationImmutable
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup RawPackageLocationImmutable
    rpli Map RawPackageLocationImmutable PackageLocationImmutable
    cachePackages
      case Maybe PackageLocationImmutable
    xs of
        Nothing -> do
          CompletePackageLocation
    cpl <- RawPackageLocationImmutable -> RIO env CompletePackageLocation
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env CompletePackageLocation
    completePackageLocation RawPackageLocationImmutable
    rpli
          Maybe PackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe PackageLocationImmutable
     -> RIO env (Maybe PackageLocationImmutable))
    -> Maybe PackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    forall a b. (a -> b) -> a -> b
    $ if CompletePackageLocation -> Bool
    cplHasCabalFile CompletePackageLocation
    cpl then PackageLocationImmutable -> Maybe PackageLocationImmutable
    forall a. a -> Maybe a
    Just (CompletePackageLocation -> PackageLocationImmutable
    cplComplete CompletePackageLocation
    cpl) else Maybe PackageLocationImmutable
    forall a. Maybe a
    Nothing
        Just x :: PackageLocationImmutable
    x -> Maybe PackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe PackageLocationImmutable
     -> RIO env (Maybe PackageLocationImmutable))
    -> Maybe PackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    forall a b. (a -> b) -> a -> b
    $ PackageLocationImmutable -> Maybe PackageLocationImmutable
    forall a. a -> Maybe a
    Just PackageLocationImmutable
    x

    -- | Add more packages to a snapshot completing their locations if needed
    --
    -- Note that any settings on a parent flag which is being replaced will be
    -- ignored. For example, if package @foo@ is in the parent and has flag @bar@
    -- set, and @foo@ also appears in new packages, then @bar@ will no longer be
    -- set.
    --
    -- Returns any of the 'AddPackagesConfig' values not used and also all
    -- non-trivial package location completions.
    --
    -- @since 0.1.0.0
    addAndCompletePackagesToSnapshot
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawSnapshotLocation
      -- ^ Text description of where these new packages are coming from, for error
      -- messages only
      -> Map RawPackageLocationImmutable PackageLocationImmutable -- ^ Cached data from snapshot lock file
      -> [RawPackageLocationImmutable] -- ^ new packages
      -> AddPackagesConfig
      -> Map PackageName SnapshotPackage -- ^ packages from parent
      -> RIO env (Map PackageName SnapshotPackage, [CompletedPLI], AddPackagesConfig)
    addAndCompletePackagesToSnapshot :: RawSnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName SnapshotPackage
    -> RIO
         env
         (Map PackageName SnapshotPackage, [CompletedPLI],
          AddPackagesConfig)
    addAndCompletePackagesToSnapshot loc :: RawSnapshotLocation
    loc cachedPL :: Map RawPackageLocationImmutable PackageLocationImmutable
    cachedPL newPackages :: [RawPackageLocationImmutable]
    newPackages (AddPackagesConfig drops :: Set PackageName
    drops flags :: Map PackageName (Map FlagName Bool)
    flags hiddens :: Map PackageName Bool
    hiddens options :: Map PackageName [Text]
    options) old :: Map PackageName SnapshotPackage
    old = do
      let source :: Utf8Builder
    source = RawSnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawSnapshotLocation
    loc
          addPackage :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
                     => ([(PackageName, SnapshotPackage)],[CompletedPLI])
                     -> RawPackageLocationImmutable
                     -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
          addPackage :: ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> RawPackageLocationImmutable
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    addPackage (ps :: [(PackageName, SnapshotPackage)]
    ps, completed :: [CompletedPLI]
    completed) rawLoc :: RawPackageLocationImmutable
    rawLoc = do
            Maybe PackageLocationImmutable
    mcomplLoc <- Map RawPackageLocationImmutable PackageLocationImmutable
    -> RawPackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Map RawPackageLocationImmutable PackageLocationImmutable
    -> RawPackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    cachedSnapshotCompletePackageLocation Map RawPackageLocationImmutable PackageLocationImmutable
    cachedPL RawPackageLocationImmutable
    rawLoc
            case Maybe PackageLocationImmutable
    mcomplLoc of
              Nothing -> do
                RawPackageLocationImmutable -> RIO env ()
    forall env.
    HasLogFunc env =>
    RawPackageLocationImmutable -> RIO env ()
    warnMissingCabalFile RawPackageLocationImmutable
    rawLoc
                ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([(PackageName, SnapshotPackage)]
    ps, [CompletedPLI]
    completed)
              Just complLoc :: PackageLocationImmutable
    complLoc -> do
                let PackageIdentifier name :: PackageName
    name _ = PackageLocationImmutable -> PackageIdentifier
    packageLocationIdent PackageLocationImmutable
    complLoc
                    p :: (PackageName, SnapshotPackage)
    p = (PackageName
    name, $WSnapshotPackage :: PackageLocationImmutable
    -> Map FlagName Bool -> Bool -> [Text] -> SnapshotPackage
    SnapshotPackage
                      { spLocation :: PackageLocationImmutable
    spLocation = PackageLocationImmutable
    complLoc
                      , spFlags :: Map FlagName Bool
    spFlags = Map FlagName Bool
    -> PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map FlagName Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault Map FlagName Bool
    forall a. Monoid a => a
    mempty PackageName
    name Map PackageName (Map FlagName Bool)
    flags
                      , spHidden :: Bool
    spHidden = Bool -> PackageName -> Map PackageName Bool -> Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault Bool
    False PackageName
    name Map PackageName Bool
    hiddens
                      , spGhcOptions :: [Text]
    spGhcOptions = [Text] -> PackageName -> Map PackageName [Text] -> [Text]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault [] PackageName
    name Map PackageName [Text]
    options
                      })
                    completed' :: [CompletedPLI]
    completed' = if PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI PackageLocationImmutable
    complLoc RawPackageLocationImmutable -> RawPackageLocationImmutable -> Bool
    forall a. Eq a => a -> a -> Bool
    == RawPackageLocationImmutable
    rawLoc
                                 then [CompletedPLI]
    completed
                                 else RawPackageLocationImmutable
    -> PackageLocationImmutable -> CompletedPLI
    CompletedPLI RawPackageLocationImmutable
    rawLoc PackageLocationImmutable
    complLocCompletedPLI -> [CompletedPLI] -> [CompletedPLI]
    forall a. a -> [a] -> [a]
    :[CompletedPLI]
    completed
                ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((PackageName, SnapshotPackage)
    p(PackageName, SnapshotPackage)
    -> [(PackageName, SnapshotPackage)]
    -> [(PackageName, SnapshotPackage)]
    forall a. a -> [a] -> [a]
    :[(PackageName, SnapshotPackage)]
    ps, [CompletedPLI]
    completed')
      (revNew :: [(PackageName, SnapshotPackage)]
    revNew, revCompleted :: [CompletedPLI]
    revCompleted) <- (([(PackageName, SnapshotPackage)], [CompletedPLI])
     -> RawPackageLocationImmutable
     -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI]))
    -> ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> [RawPackageLocationImmutable]
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> RawPackageLocationImmutable
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> RawPackageLocationImmutable
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    addPackage ([], []) [RawPackageLocationImmutable]
    newPackages
      let (newSingles :: [(PackageName, SnapshotPackage)]
    newSingles, newMultiples :: [(PackageName, [SnapshotPackage])]
    newMultiples)
            = [Either
       (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage])]
    -> ([(PackageName, SnapshotPackage)],
        [(PackageName, [SnapshotPackage])])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers
            ([Either
        (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage])]
     -> ([(PackageName, SnapshotPackage)],
         [(PackageName, [SnapshotPackage])]))
    -> [Either
          (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage])]
    -> ([(PackageName, SnapshotPackage)],
        [(PackageName, [SnapshotPackage])])
    forall a b. (a -> b) -> a -> b
    $ ((PackageName, SingleOrNot SnapshotPackage)
     -> Either
          (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage]))
    -> [(PackageName, SingleOrNot SnapshotPackage)]
    -> [Either
          (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage])]
    forall a b. (a -> b) -> [a] -> [b]
    map (PackageName, SingleOrNot SnapshotPackage)
    -> Either
         (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage])
    forall k a. (k, SingleOrNot a) -> Either (k, a) (k, [a])
    sonToEither
            ([(PackageName, SingleOrNot SnapshotPackage)]
     -> [Either
           (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage])])
    -> [(PackageName, SingleOrNot SnapshotPackage)]
    -> [Either
          (PackageName, SnapshotPackage) (PackageName, [SnapshotPackage])]
    forall a b. (a -> b) -> a -> b
    $ Map PackageName (SingleOrNot SnapshotPackage)
    -> [(PackageName, SingleOrNot SnapshotPackage)]
    forall k a. Map k a -> [(k, a)]
    Map.toList
            (Map PackageName (SingleOrNot SnapshotPackage)
     -> [(PackageName, SingleOrNot SnapshotPackage)])
    -> Map PackageName (SingleOrNot SnapshotPackage)
    -> [(PackageName, SingleOrNot SnapshotPackage)]
    forall a b. (a -> b) -> a -> b
    $ (SingleOrNot SnapshotPackage
     -> SingleOrNot SnapshotPackage -> SingleOrNot SnapshotPackage)
    -> [(PackageName, SingleOrNot SnapshotPackage)]
    -> Map PackageName (SingleOrNot SnapshotPackage)
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith SingleOrNot SnapshotPackage
    -> SingleOrNot SnapshotPackage -> SingleOrNot SnapshotPackage
    forall a. Semigroup a => a -> a -> a
    (<>)
            ([(PackageName, SingleOrNot SnapshotPackage)]
     -> Map PackageName (SingleOrNot SnapshotPackage))
    -> [(PackageName, SingleOrNot SnapshotPackage)]
    -> Map PackageName (SingleOrNot SnapshotPackage)
    forall a b. (a -> b) -> a -> b
    $ ((PackageName, SnapshotPackage)
     -> (PackageName, SingleOrNot SnapshotPackage))
    -> [(PackageName, SnapshotPackage)]
    -> [(PackageName, SingleOrNot SnapshotPackage)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((SnapshotPackage -> SingleOrNot SnapshotPackage)
    -> (PackageName, SnapshotPackage)
    -> (PackageName, SingleOrNot SnapshotPackage)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second SnapshotPackage -> SingleOrNot SnapshotPackage
    forall a. a -> SingleOrNot a
    Single) ([(PackageName, SnapshotPackage)]
    -> [(PackageName, SnapshotPackage)]
    forall a. [a] -> [a]
    reverse [(PackageName, SnapshotPackage)]
    revNew)
      Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(PackageName, [SnapshotPackage])] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([(PackageName, [SnapshotPackage])] -> Bool)
    -> [(PackageName, [SnapshotPackage])] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(PackageName, [SnapshotPackage])]
    newMultiples) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ()) -> PantryException -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
        Utf8Builder
    -> [(PackageName, [RawPackageLocationImmutable])]
    -> PantryException
    DuplicatePackageNames Utf8Builder
    source ([(PackageName, [RawPackageLocationImmutable])] -> PantryException)
    -> [(PackageName, [RawPackageLocationImmutable])]
    -> PantryException
    forall a b. (a -> b) -> a -> b
    $ ((PackageName, [SnapshotPackage])
     -> (PackageName, [RawPackageLocationImmutable]))
    -> [(PackageName, [SnapshotPackage])]
    -> [(PackageName, [RawPackageLocationImmutable])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([SnapshotPackage] -> [RawPackageLocationImmutable])
    -> (PackageName, [SnapshotPackage])
    -> (PackageName, [RawPackageLocationImmutable])
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second ((SnapshotPackage -> RawPackageLocationImmutable)
    -> [SnapshotPackage] -> [RawPackageLocationImmutable]
    forall a b. (a -> b) -> [a] -> [b]
    map (PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI (PackageLocationImmutable -> RawPackageLocationImmutable)
    -> (SnapshotPackage -> PackageLocationImmutable)
    -> SnapshotPackage
    -> RawPackageLocationImmutable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SnapshotPackage -> PackageLocationImmutable
    spLocation))) [(PackageName, [SnapshotPackage])]
    newMultiples
      let new :: Map PackageName SnapshotPackage
    new = [(PackageName, SnapshotPackage)] -> Map PackageName SnapshotPackage
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(PackageName, SnapshotPackage)]
    newSingles
          allPackages0 :: Map PackageName SnapshotPackage
    allPackages0 = Map PackageName SnapshotPackage
    new Map PackageName SnapshotPackage
    -> Map PackageName SnapshotPackage
    -> Map PackageName SnapshotPackage
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `Map.union` (Map PackageName SnapshotPackage
    old Map PackageName SnapshotPackage
    -> Map PackageName () -> Map PackageName SnapshotPackage
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` (PackageName -> ()) -> Set PackageName -> Map PackageName ()
    forall k a. (k -> a) -> Set k -> Map k a
    Map.fromSet (() -> PackageName -> ()
    forall a b. a -> b -> a
    const ()) Set PackageName
    drops)
          allPackages :: Map PackageName SnapshotPackage
    allPackages = ((PackageName -> SnapshotPackage -> SnapshotPackage)
     -> Map PackageName SnapshotPackage
     -> Map PackageName SnapshotPackage)
    -> Map PackageName SnapshotPackage
    -> (PackageName -> SnapshotPackage -> SnapshotPackage)
    -> Map PackageName SnapshotPackage
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (PackageName -> SnapshotPackage -> SnapshotPackage)
    -> Map PackageName SnapshotPackage
    -> Map PackageName SnapshotPackage
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
    Map.mapWithKey Map PackageName SnapshotPackage
    allPackages0 ((PackageName -> SnapshotPackage -> SnapshotPackage)
     -> Map PackageName SnapshotPackage)
    -> (PackageName -> SnapshotPackage -> SnapshotPackage)
    -> Map PackageName SnapshotPackage
    forall a b. (a -> b) -> a -> b
    $ \name :: PackageName
    name sp :: SnapshotPackage
    sp ->
            SnapshotPackage
    sp
              { spFlags :: Map FlagName Bool
    spFlags = Map FlagName Bool
    -> PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map FlagName Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault (SnapshotPackage -> Map FlagName Bool
    spFlags SnapshotPackage
    sp) PackageName
    name Map PackageName (Map FlagName Bool)
    flags
              , spHidden :: Bool
    spHidden = Bool -> PackageName -> Map PackageName Bool -> Bool
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault (SnapshotPackage -> Bool
    spHidden SnapshotPackage
    sp) PackageName
    name Map PackageName Bool
    hiddens
              , spGhcOptions :: [Text]
    spGhcOptions = [Text] -> PackageName -> Map PackageName [Text] -> [Text]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault (SnapshotPackage -> [Text]
    spGhcOptions SnapshotPackage
    sp) PackageName
    name Map PackageName [Text]
    options
              }

          unused :: AddPackagesConfig
    unused = Set PackageName
    -> Map PackageName (Map FlagName Bool)
    -> Map PackageName Bool
    -> Map PackageName [Text]
    -> AddPackagesConfig
    AddPackagesConfig
            (Set PackageName
    drops Set PackageName -> Set PackageName -> Set PackageName
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Map PackageName SnapshotPackage -> Set PackageName
    forall k a. Map k a -> Set k
    Map.keysSet Map PackageName SnapshotPackage
    old)
            (Map PackageName (Map FlagName Bool)
    flags Map PackageName (Map FlagName Bool)
    -> Map PackageName SnapshotPackage
    -> Map PackageName (Map FlagName Bool)
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` Map PackageName SnapshotPackage
    allPackages)
            (Map PackageName Bool
    hiddens Map PackageName Bool
    -> Map PackageName SnapshotPackage -> Map PackageName Bool
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` Map PackageName SnapshotPackage
    allPackages)
            (Map PackageName [Text]
    options Map PackageName [Text]
    -> Map PackageName SnapshotPackage -> Map PackageName [Text]
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    `Map.difference` Map PackageName SnapshotPackage
    allPackages)

      (Map PackageName SnapshotPackage, [CompletedPLI],
     AddPackagesConfig)
    -> RIO
         env
         (Map PackageName SnapshotPackage, [CompletedPLI],
          AddPackagesConfig)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PackageName SnapshotPackage
    allPackages, [CompletedPLI] -> [CompletedPLI]
    forall a. [a] -> [a]
    reverse [CompletedPLI]
    revCompleted, AddPackagesConfig
    unused)

    -- | Parse a 'SnapshotLayer' value from a 'SnapshotLocation'.
    --
    -- Returns a 'Left' value if provided an 'SLCompiler'
    -- constructor. Otherwise, returns a 'Right' value providing both the
    -- 'Snapshot' and a hash of the input configuration file.
    --
    -- @since 0.1.0.0
    loadRawSnapshotLayer
      :: (HasPantryConfig env, HasLogFunc env)
      => RawSnapshotLocation
      -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    loadRawSnapshotLayer :: RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    loadRawSnapshotLayer (RSLCompiler compiler :: WantedCompiler
    compiler) = Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either WantedCompiler (RawSnapshotLayer, CompletedSL)
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall a b. (a -> b) -> a -> b
    $ WantedCompiler
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    forall a b. a -> Either a b
    Left WantedCompiler
    compiler
    loadRawSnapshotLayer rsl :: RawSnapshotLocation
    rsl@(RSLUrl url :: Text
    url blob :: Maybe BlobKey
    blob) =
      (SomeException
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny (PantryException
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> (SomeException -> PantryException)
    -> SomeException
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawSnapshotLocation -> SomeException -> PantryException
    InvalidSnapshot RawSnapshotLocation
    rsl) (RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall a b. (a -> b) -> a -> b
    $ do
        ByteString
    bs <- Text -> Maybe BlobKey -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> Maybe BlobKey -> RIO env ByteString
    loadFromURL Text
    url Maybe BlobKey
    blob
        Value
    value <- ByteString -> RIO env Value
    forall (m :: * -> *) a.
    (MonadThrow m, FromJSON a) =>
    ByteString -> m a
    Yaml.decodeThrow ByteString
    bs
        RawSnapshotLayer
    snapshot <- RawSnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    forall env.
    HasLogFunc env =>
    RawSnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelperRaw RawSnapshotLocation
    rsl Value
    value Maybe (Path Abs Dir)
    forall a. Maybe a
    Nothing
        Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either WantedCompiler (RawSnapshotLayer, CompletedSL)
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall a b. (a -> b) -> a -> b
    $ (RawSnapshotLayer, CompletedSL)
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    forall a b. b -> Either a b
    Right (RawSnapshotLayer
    snapshot, (RawSnapshotLocation -> SnapshotLocation -> CompletedSL
    CompletedSL RawSnapshotLocation
    rsl (Text -> BlobKey -> SnapshotLocation
    SLUrl Text
    url (ByteString -> BlobKey
    bsToBlobKey ByteString
    bs))))
    loadRawSnapshotLayer rsl :: RawSnapshotLocation
    rsl@(RSLFilePath fp :: ResolvedPath File
    fp) =
      (SomeException
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny (PantryException
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> (SomeException -> PantryException)
    -> SomeException
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawSnapshotLocation -> SomeException -> PantryException
    InvalidSnapshot RawSnapshotLocation
    rsl) (RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall a b. (a -> b) -> a -> b
    $ do
        Value
    value <- FilePath -> RIO env Value
    forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
    Yaml.decodeFileThrow (FilePath -> RIO env Value) -> FilePath -> RIO env Value
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath (Path Abs File -> FilePath) -> Path Abs File -> FilePath
    forall a b. (a -> b) -> a -> b
    $ ResolvedPath File -> Path Abs File
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath File
    fp
        RawSnapshotLayer
    snapshot <- RawSnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    forall env.
    HasLogFunc env =>
    RawSnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelperRaw RawSnapshotLocation
    rsl Value
    value (Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer)
    -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> Maybe (Path Abs Dir)
    forall a. a -> Maybe a
    Just (Path Abs Dir -> Maybe (Path Abs Dir))
    -> Path Abs Dir -> Maybe (Path Abs Dir)
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> Path Abs Dir
    forall b t. Path b t -> Path b Dir
    parent (Path Abs File -> Path Abs Dir) -> Path Abs File -> Path Abs Dir
    forall a b. (a -> b) -> a -> b
    $ ResolvedPath File -> Path Abs File
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath File
    fp
        Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either WantedCompiler (RawSnapshotLayer, CompletedSL)
     -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL)))
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall a b. (a -> b) -> a -> b
    $ (RawSnapshotLayer, CompletedSL)
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    forall a b. b -> Either a b
    Right (RawSnapshotLayer
    snapshot, RawSnapshotLocation -> SnapshotLocation -> CompletedSL
    CompletedSL RawSnapshotLocation
    rsl (ResolvedPath File -> SnapshotLocation
    SLFilePath ResolvedPath File
    fp))

    -- | Parse a 'SnapshotLayer' value from a 'SnapshotLocation'.
    --
    -- Returns a 'Left' value if provided an 'SLCompiler'
    -- constructor. Otherwise, returns a 'Right' value providing both the
    -- 'Snapshot' and a hash of the input configuration file.
    --
    -- @since 0.1.0.0
    loadSnapshotLayer
      :: (HasPantryConfig env, HasLogFunc env)
      => SnapshotLocation
      -> RIO env (Either WantedCompiler RawSnapshotLayer)
    loadSnapshotLayer :: SnapshotLocation
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    loadSnapshotLayer (SLCompiler compiler :: WantedCompiler
    compiler) = Either WantedCompiler RawSnapshotLayer
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either WantedCompiler RawSnapshotLayer
     -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> Either WantedCompiler RawSnapshotLayer
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall a b. (a -> b) -> a -> b
    $ WantedCompiler -> Either WantedCompiler RawSnapshotLayer
    forall a b. a -> Either a b
    Left WantedCompiler
    compiler
    loadSnapshotLayer sl :: SnapshotLocation
    sl@(SLUrl url :: Text
    url blob :: BlobKey
    blob) =
      (SomeException -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny (PantryException -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException
     -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> (SomeException -> PantryException)
    -> SomeException
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawSnapshotLocation -> SomeException -> PantryException
    InvalidSnapshot (SnapshotLocation -> RawSnapshotLocation
    toRawSL SnapshotLocation
    sl)) (RIO env (Either WantedCompiler RawSnapshotLayer)
     -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall a b. (a -> b) -> a -> b
    $ do
        ByteString
    bs <- Text -> Maybe BlobKey -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> Maybe BlobKey -> RIO env ByteString
    loadFromURL Text
    url (BlobKey -> Maybe BlobKey
    forall a. a -> Maybe a
    Just BlobKey
    blob)
        Value
    value <- ByteString -> RIO env Value
    forall (m :: * -> *) a.
    (MonadThrow m, FromJSON a) =>
    ByteString -> m a
    Yaml.decodeThrow ByteString
    bs
        RawSnapshotLayer
    snapshot <- SnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    forall env.
    HasLogFunc env =>
    SnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelper SnapshotLocation
    sl Value
    value Maybe (Path Abs Dir)
    forall a. Maybe a
    Nothing
        Either WantedCompiler RawSnapshotLayer
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either WantedCompiler RawSnapshotLayer
     -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> Either WantedCompiler RawSnapshotLayer
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLayer -> Either WantedCompiler RawSnapshotLayer
    forall a b. b -> Either a b
    Right RawSnapshotLayer
    snapshot
    loadSnapshotLayer sl :: SnapshotLocation
    sl@(SLFilePath fp :: ResolvedPath File
    fp) =
      (SomeException -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny (PantryException -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException
     -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> (SomeException -> PantryException)
    -> SomeException
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawSnapshotLocation -> SomeException -> PantryException
    InvalidSnapshot (SnapshotLocation -> RawSnapshotLocation
    toRawSL SnapshotLocation
    sl)) (RIO env (Either WantedCompiler RawSnapshotLayer)
     -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall a b. (a -> b) -> a -> b
    $ do
        Value
    value <- FilePath -> RIO env Value
    forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
    Yaml.decodeFileThrow (FilePath -> RIO env Value) -> FilePath -> RIO env Value
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath (Path Abs File -> FilePath) -> Path Abs File -> FilePath
    forall a b. (a -> b) -> a -> b
    $ ResolvedPath File -> Path Abs File
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath File
    fp
        RawSnapshotLayer
    snapshot <- SnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    forall env.
    HasLogFunc env =>
    SnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelper SnapshotLocation
    sl Value
    value (Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer)
    -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> Maybe (Path Abs Dir)
    forall a. a -> Maybe a
    Just (Path Abs Dir -> Maybe (Path Abs Dir))
    -> Path Abs Dir -> Maybe (Path Abs Dir)
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> Path Abs Dir
    forall b t. Path b t -> Path b Dir
    parent (Path Abs File -> Path Abs Dir) -> Path Abs File -> Path Abs Dir
    forall a b. (a -> b) -> a -> b
    $ ResolvedPath File -> Path Abs File
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath File
    fp
        Either WantedCompiler RawSnapshotLayer
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either WantedCompiler RawSnapshotLayer
     -> RIO env (Either WantedCompiler RawSnapshotLayer))
    -> Either WantedCompiler RawSnapshotLayer
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLayer -> Either WantedCompiler RawSnapshotLayer
    forall a b. b -> Either a b
    Right RawSnapshotLayer
    snapshot

    loadFromURL
      :: (HasPantryConfig env, HasLogFunc env)
      => Text -- ^ url
      -> Maybe BlobKey
      -> RIO env ByteString
    loadFromURL :: Text -> Maybe BlobKey -> RIO env ByteString
    loadFromURL url :: Text
    url Nothing = do
      Maybe ByteString
    mcached <- ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe ByteString)
     -> RIO env (Maybe ByteString))
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ Text -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env. Text -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadURLBlob Text
    url
      case Maybe ByteString
    mcached of
        Just bs :: ByteString
    bs -> ByteString -> RIO env ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs
        Nothing -> Text -> Maybe BlobKey -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> Maybe BlobKey -> RIO env ByteString
    loadWithCheck Text
    url Maybe BlobKey
    forall a. Maybe a
    Nothing
    loadFromURL url :: Text
    url (Just bkey :: BlobKey
    bkey) = do
      Maybe ByteString
    mcached <- ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe ByteString)
     -> RIO env (Maybe ByteString))
    -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    -> RIO env (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob BlobKey
    bkey
      case Maybe ByteString
    mcached of
        Just bs :: ByteString
    bs -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug "Loaded snapshot from Pantry database."
          ByteString -> RIO env ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs
        Nothing -> Text -> BlobKey -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> BlobKey -> RIO env ByteString
    loadUrlViaCasaOrWithCheck Text
    url BlobKey
    bkey

    loadUrlViaCasaOrWithCheck
      :: (HasPantryConfig env, HasLogFunc env)
      => Text -- ^ url
      -> BlobKey
      -> RIO env ByteString
    loadUrlViaCasaOrWithCheck :: Text -> BlobKey -> RIO env ByteString
    loadUrlViaCasaOrWithCheck url :: Text
    url blobKey :: BlobKey
    blobKey = do
      Maybe ByteString
    mblobFromCasa <- BlobKey -> RIO env (Maybe ByteString)
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    BlobKey -> RIO env (Maybe ByteString)
    casaLookupKey BlobKey
    blobKey
      case Maybe ByteString
    mblobFromCasa of
        Just blob :: ByteString
    blob -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug
            ("Loaded snapshot from Casa (" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> BlobKey -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display BlobKey
    blobKey Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> ") for URL: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
             Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    url)
          ByteString -> RIO env ByteString
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    blob
        Nothing -> Text -> Maybe BlobKey -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> Maybe BlobKey -> RIO env ByteString
    loadWithCheck Text
    url (BlobKey -> Maybe BlobKey
    forall a. a -> Maybe a
    Just BlobKey
    blobKey)

    loadWithCheck
      :: (HasPantryConfig env, HasLogFunc env)
      => Text -- ^ url
      -> Maybe BlobKey
      -> RIO env ByteString
    loadWithCheck :: Text -> Maybe BlobKey -> RIO env ByteString
    loadWithCheck url :: Text
    url mblobkey :: Maybe BlobKey
    mblobkey = do
      let (msha :: Maybe SHA256
    msha, msize :: Maybe FileSize
    msize) =
            case Maybe BlobKey
    mblobkey of
              Nothing -> (Maybe SHA256
    forall a. Maybe a
    Nothing, Maybe FileSize
    forall a. Maybe a
    Nothing)
              Just (BlobKey sha :: SHA256
    sha size :: FileSize
    size) -> (SHA256 -> Maybe SHA256
    forall a. a -> Maybe a
    Just SHA256
    sha, FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size)
      (_, _, bss :: [ByteString]
    bss) <- Text
    -> Maybe SHA256
    -> Maybe FileSize
    -> ConduitT ByteString Void (RIO env) [ByteString]
    -> RIO env (SHA256, FileSize, [ByteString])
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    Text
    -> Maybe SHA256
    -> Maybe FileSize
    -> ConduitT ByteString Void m a
    -> m (SHA256, FileSize, a)
    httpSinkChecked Text
    url Maybe SHA256
    msha Maybe FileSize
    msize ConduitT ByteString Void (RIO env) [ByteString]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    sinkList
      let bs :: ByteString
    bs = [ByteString] -> ByteString
    B.concat [ByteString]
    bss
      ReaderT SqlBackend (RIO env) () -> RIO env ()
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) () -> RIO env ())
    -> ReaderT SqlBackend (RIO env) () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString -> ReaderT SqlBackend (RIO env) ()
    forall env. Text -> ByteString -> ReaderT SqlBackend (RIO env) ()
    storeURLBlob Text
    url ByteString
    bs
      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug ("Loaded snapshot from third party: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    url)
      ByteString -> RIO env ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs

    warningsParserHelperRaw
      :: HasLogFunc env
      => RawSnapshotLocation
      -> Value
      -> Maybe (Path Abs Dir)
      -> RIO env RawSnapshotLayer
    warningsParserHelperRaw :: RawSnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelperRaw rsl :: RawSnapshotLocation
    rsl val :: Value
    val mdir :: Maybe (Path Abs Dir)
    mdir =
      case (Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer)))
    -> Value
    -> Either FilePath (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a b. (a -> Parser b) -> a -> Either FilePath b
    parseEither Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a. FromJSON a => Value -> Parser a
    Yaml.parseJSON Value
    val of
        Left e :: FilePath
    e -> PantryException -> RIO env RawSnapshotLayer
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env RawSnapshotLayer)
    -> PantryException -> RIO env RawSnapshotLayer
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLocation -> FilePath -> PantryException
    Couldn'tParseSnapshot RawSnapshotLocation
    rsl FilePath
    e
        Right (WithJSONWarnings x :: Unresolved RawSnapshotLayer
    x ws :: [JSONWarning]
    ws) -> do
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([JSONWarning] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [JSONWarning]
    ws) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ do
            Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Warnings when parsing snapshot " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> RawSnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawSnapshotLocation
    rsl
            [JSONWarning] -> (JSONWarning -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [JSONWarning]
    ws ((JSONWarning -> RIO env ()) -> RIO env ())
    -> (JSONWarning -> RIO env ()) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ())
    -> (JSONWarning -> Utf8Builder) -> JSONWarning -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . JSONWarning -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display
          Maybe (Path Abs Dir)
    -> Unresolved RawSnapshotLayer -> RIO env RawSnapshotLayer
    forall (m :: * -> *) a.
    MonadIO m =>
    Maybe (Path Abs Dir) -> Unresolved a -> m a
    resolvePaths Maybe (Path Abs Dir)
    mdir Unresolved RawSnapshotLayer
    x

    warningsParserHelper
      :: HasLogFunc env
      => SnapshotLocation
      -> Value
      -> Maybe (Path Abs Dir)
      -> RIO env RawSnapshotLayer
    warningsParserHelper :: SnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelper sl :: SnapshotLocation
    sl val :: Value
    val mdir :: Maybe (Path Abs Dir)
    mdir =
      case (Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer)))
    -> Value
    -> Either FilePath (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a b. (a -> Parser b) -> a -> Either FilePath b
    parseEither Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a. FromJSON a => Value -> Parser a
    Yaml.parseJSON Value
    val of
        Left e :: FilePath
    e -> PantryException -> RIO env RawSnapshotLayer
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env RawSnapshotLayer)
    -> PantryException -> RIO env RawSnapshotLayer
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLocation -> FilePath -> PantryException
    Couldn'tParseSnapshot (SnapshotLocation -> RawSnapshotLocation
    toRawSL SnapshotLocation
    sl) FilePath
    e
        Right (WithJSONWarnings x :: Unresolved RawSnapshotLayer
    x ws :: [JSONWarning]
    ws) -> do
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([JSONWarning] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [JSONWarning]
    ws) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ do
            Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Warnings when parsing snapshot " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SnapshotLocation -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display SnapshotLocation
    sl
            [JSONWarning] -> (JSONWarning -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [JSONWarning]
    ws ((JSONWarning -> RIO env ()) -> RIO env ())
    -> (JSONWarning -> RIO env ()) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ())
    -> (JSONWarning -> Utf8Builder) -> JSONWarning -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . JSONWarning -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display
          Maybe (Path Abs Dir)
    -> Unresolved RawSnapshotLayer -> RIO env RawSnapshotLayer
    forall (m :: * -> *) a.
    MonadIO m =>
    Maybe (Path Abs Dir) -> Unresolved a -> m a
    resolvePaths Maybe (Path Abs Dir)
    mdir Unresolved RawSnapshotLayer
    x

    -- | Get the 'PackageName' of the package at the given location.
    --
    -- @since 0.1.0.0
    getPackageLocationName
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RIO env PackageName
    getPackageLocationName :: RawPackageLocationImmutable -> RIO env PackageName
    getPackageLocationName = (PackageIdentifier -> PackageName)
    -> RIO env PackageIdentifier -> RIO env PackageName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PackageIdentifier -> PackageName
    pkgName (RIO env PackageIdentifier -> RIO env PackageName)
    -> (RawPackageLocationImmutable -> RIO env PackageIdentifier)
    -> RawPackageLocationImmutable
    -> RIO env PackageName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RawPackageLocationImmutable -> RIO env PackageIdentifier
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env PackageIdentifier
    getRawPackageLocationIdent

    -- | Get the 'PackageIdentifier' of the package at the given location.
    --
    -- @since 0.1.0.0
    packageLocationIdent
      :: PackageLocationImmutable
      -> PackageIdentifier
    packageLocationIdent :: PackageLocationImmutable -> PackageIdentifier
    packageLocationIdent (PLIHackage ident :: PackageIdentifier
    ident _ _) = PackageIdentifier
    ident
    packageLocationIdent (PLIRepo _ pm :: PackageMetadata
    pm) = PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm
    packageLocationIdent (PLIArchive _ pm :: PackageMetadata
    pm) = PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm

    -- | Get version of the package at the given location.
    --
    -- @since 0.1.0.0
    packageLocationVersion
      :: PackageLocationImmutable
      -> Version
    packageLocationVersion :: PackageLocationImmutable -> Version
    packageLocationVersion (PLIHackage pident :: PackageIdentifier
    pident _ _) = PackageIdentifier -> Version
    pkgVersion PackageIdentifier
    pident
    packageLocationVersion (PLIRepo _ pm :: PackageMetadata
    pm) = PackageIdentifier -> Version
    pkgVersion (PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm)
    packageLocationVersion (PLIArchive _ pm :: PackageMetadata
    pm) = PackageIdentifier -> Version
    pkgVersion (PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm)

    -- | Get the 'PackageIdentifier' of the package at the given location.
    --
    -- @since 0.1.0.0
    getRawPackageLocationIdent
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RIO env PackageIdentifier
    getRawPackageLocationIdent :: RawPackageLocationImmutable -> RIO env PackageIdentifier
    getRawPackageLocationIdent (RPLIHackage (PackageIdentifierRevision name :: PackageName
    name version :: Version
    version _) _) = PackageIdentifier -> RIO env PackageIdentifier
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageIdentifier -> RIO env PackageIdentifier)
    -> PackageIdentifier -> RIO env PackageIdentifier
    forall a b. (a -> b) -> a -> b
    $ PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    version
    getRawPackageLocationIdent (RPLIRepo _ RawPackageMetadata { rpmName :: RawPackageMetadata -> Maybe PackageName
    rpmName = Just name :: PackageName
    name, rpmVersion :: RawPackageMetadata -> Maybe Version
    rpmVersion = Just version :: Version
    version }) = PackageIdentifier -> RIO env PackageIdentifier
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageIdentifier -> RIO env PackageIdentifier)
    -> PackageIdentifier -> RIO env PackageIdentifier
    forall a b. (a -> b) -> a -> b
    $ PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    version
    getRawPackageLocationIdent (RPLIArchive _ RawPackageMetadata { rpmName :: RawPackageMetadata -> Maybe PackageName
    rpmName = Just name :: PackageName
    name, rpmVersion :: RawPackageMetadata -> Maybe Version
    rpmVersion = Just version :: Version
    version }) = PackageIdentifier -> RIO env PackageIdentifier
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageIdentifier -> RIO env PackageIdentifier)
    -> PackageIdentifier -> RIO env PackageIdentifier
    forall a b. (a -> b) -> a -> b
    $ PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    version
    getRawPackageLocationIdent rpli :: RawPackageLocationImmutable
    rpli = Package -> PackageIdentifier
    packageIdent (Package -> PackageIdentifier)
    -> RIO env Package -> RIO env PackageIdentifier
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawPackageLocationImmutable -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env Package
    loadPackageRaw RawPackageLocationImmutable
    rpli

    -- | Get the 'TreeKey' of the package at the given location.
    --
    -- @since 0.1.0.0
    getRawPackageLocationTreeKey
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => RawPackageLocationImmutable
      -> RIO env TreeKey
    getRawPackageLocationTreeKey :: RawPackageLocationImmutable -> RIO env TreeKey
    getRawPackageLocationTreeKey pl :: RawPackageLocationImmutable
    pl =
      case RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey RawPackageLocationImmutable
    pl of
        Just treeKey' :: TreeKey
    treeKey' -> TreeKey -> RIO env TreeKey
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TreeKey
    treeKey'
        Nothing ->
          case RawPackageLocationImmutable
    pl of
            RPLIHackage pir :: PackageIdentifierRevision
    pir _ -> PackageIdentifierRevision -> RIO env TreeKey
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision -> RIO env TreeKey
    getHackageTarballKey PackageIdentifierRevision
    pir
            RPLIArchive archive :: RawArchive
    archive pm :: RawPackageMetadata
    pm -> RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env TreeKey
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env TreeKey
    getArchiveKey RawPackageLocationImmutable
    pl RawArchive
    archive RawPackageMetadata
    pm
            RPLIRepo repo :: Repo
    repo pm :: RawPackageMetadata
    pm -> Repo -> RawPackageMetadata -> RIO env TreeKey
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env TreeKey
    getRepoKey Repo
    repo RawPackageMetadata
    pm

    -- | Get the 'TreeKey' of the package at the given location.
    --
    -- @since 0.1.0.0
    getPackageLocationTreeKey
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => PackageLocationImmutable
      -> RIO env TreeKey
    getPackageLocationTreeKey :: PackageLocationImmutable -> RIO env TreeKey
    getPackageLocationTreeKey pl :: PackageLocationImmutable
    pl = TreeKey -> RIO env TreeKey
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TreeKey -> RIO env TreeKey) -> TreeKey -> RIO env TreeKey
    forall a b. (a -> b) -> a -> b
    $ PackageLocationImmutable -> TreeKey
    getTreeKey PackageLocationImmutable
    pl

    getRawTreeKey :: RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey :: RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey (RPLIHackage _ mtree :: Maybe TreeKey
    mtree) = Maybe TreeKey
    mtree
    getRawTreeKey (RPLIArchive _ rpm :: RawPackageMetadata
    rpm) = RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    rpm
    getRawTreeKey (RPLIRepo _ rpm :: RawPackageMetadata
    rpm) = RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    rpm

    getTreeKey :: PackageLocationImmutable -> TreeKey
    getTreeKey :: PackageLocationImmutable -> TreeKey
    getTreeKey (PLIHackage _ _ tree :: TreeKey
    tree) = TreeKey
    tree
    getTreeKey (PLIArchive _ pm :: PackageMetadata
    pm) = PackageMetadata -> TreeKey
    pmTreeKey PackageMetadata
    pm
    getTreeKey (PLIRepo _ pm :: PackageMetadata
    pm) = PackageMetadata -> TreeKey
    pmTreeKey PackageMetadata
    pm

    -- | Convenient data type that allows you to work with pantry more
    -- easily than using 'withPantryConfig' directly. Uses basically sane
    -- settings, like sharing a pantry directory with Stack.
    --
    -- You can use 'runPantryApp' to use this.
    --
    -- @since 0.1.0.0
    data PantryApp = PantryApp
      { PantryApp -> SimpleApp
    paSimpleApp :: !SimpleApp
      , PantryApp -> PantryConfig
    paPantryConfig :: !PantryConfig
      , PantryApp -> Bool
    paUseColor :: !Bool
      , PantryApp -> Int
    paTermWidth :: !Int
      , PantryApp -> StylesUpdate
    paStylesUpdate :: !StylesUpdate
      }

    simpleAppL :: Lens' PantryApp SimpleApp
    simpleAppL :: (SimpleApp -> f SimpleApp) -> PantryApp -> f PantryApp
    simpleAppL = (PantryApp -> SimpleApp)
    -> (PantryApp -> SimpleApp -> PantryApp)
    -> Lens PantryApp PantryApp SimpleApp SimpleApp
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens PantryApp -> SimpleApp
    paSimpleApp (\x :: PantryApp
    x y :: SimpleApp
    y -> PantryApp
    x { paSimpleApp :: SimpleApp
    paSimpleApp = SimpleApp
    y })

    -- | Lens to view or modify the 'HpackExecutable' of a 'PantryConfig'
    --
    -- @since 0.1.0.0
    hpackExecutableL :: Lens' PantryConfig HpackExecutable
    hpackExecutableL :: (HpackExecutable -> f HpackExecutable)
    -> PantryConfig -> f PantryConfig
    hpackExecutableL k :: HpackExecutable -> f HpackExecutable
    k pconfig :: PantryConfig
    pconfig = (HpackExecutable -> PantryConfig)
    -> f HpackExecutable -> f PantryConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\hpExe :: HpackExecutable
    hpExe -> PantryConfig
    pconfig { pcHpackExecutable :: HpackExecutable
    pcHpackExecutable = HpackExecutable
    hpExe }) (HpackExecutable -> f HpackExecutable
    k (PantryConfig -> HpackExecutable
    pcHpackExecutable PantryConfig
    pconfig))

    instance HasLogFunc PantryApp where
      logFuncL :: (LogFunc -> f LogFunc) -> PantryApp -> f PantryApp
    logFuncL = (SimpleApp -> f SimpleApp) -> PantryApp -> f PantryApp
    Lens PantryApp PantryApp SimpleApp SimpleApp
    simpleAppL((SimpleApp -> f SimpleApp) -> PantryApp -> f PantryApp)
    -> ((LogFunc -> f LogFunc) -> SimpleApp -> f SimpleApp)
    -> (LogFunc -> f LogFunc)
    -> PantryApp
    -> f PantryApp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(LogFunc -> f LogFunc) -> SimpleApp -> f SimpleApp
    forall env. HasLogFunc env => Lens' env LogFunc
    logFuncL
    instance HasPantryConfig PantryApp where
      pantryConfigL :: (PantryConfig -> f PantryConfig) -> PantryApp -> f PantryApp
    pantryConfigL = (PantryApp -> PantryConfig)
    -> (PantryApp -> PantryConfig -> PantryApp)
    -> Lens' PantryApp PantryConfig
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens PantryApp -> PantryConfig
    paPantryConfig (\x :: PantryApp
    x y :: PantryConfig
    y -> PantryApp
    x { paPantryConfig :: PantryConfig
    paPantryConfig = PantryConfig
    y })
    instance HasProcessContext PantryApp where
      processContextL :: (ProcessContext -> f ProcessContext) -> PantryApp -> f PantryApp
    processContextL = (SimpleApp -> f SimpleApp) -> PantryApp -> f PantryApp
    Lens PantryApp PantryApp SimpleApp SimpleApp
    simpleAppL((SimpleApp -> f SimpleApp) -> PantryApp -> f PantryApp)
    -> ((ProcessContext -> f ProcessContext)
        -> SimpleApp -> f SimpleApp)
    -> (ProcessContext -> f ProcessContext)
    -> PantryApp
    -> f PantryApp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(ProcessContext -> f ProcessContext) -> SimpleApp -> f SimpleApp
    forall env. HasProcessContext env => Lens' env ProcessContext
    processContextL
    instance HasStylesUpdate PantryApp where
      stylesUpdateL :: (StylesUpdate -> f StylesUpdate) -> PantryApp -> f PantryApp
    stylesUpdateL = (PantryApp -> StylesUpdate)
    -> (PantryApp -> StylesUpdate -> PantryApp)
    -> Lens' PantryApp StylesUpdate
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens PantryApp -> StylesUpdate
    paStylesUpdate (\x :: PantryApp
    x y :: StylesUpdate
    y -> PantryApp
    x { paStylesUpdate :: StylesUpdate
    paStylesUpdate = StylesUpdate
    y })
    instance HasTerm PantryApp where
      useColorL :: (Bool -> f Bool) -> PantryApp -> f PantryApp
    useColorL = (PantryApp -> Bool)
    -> (PantryApp -> Bool -> PantryApp) -> Lens' PantryApp Bool
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens PantryApp -> Bool
    paUseColor (\x :: PantryApp
    x y :: Bool
    y -> PantryApp
    x { paUseColor :: Bool
    paUseColor = Bool
    y })
      termWidthL :: (Int -> f Int) -> PantryApp -> f PantryApp
    termWidthL = (PantryApp -> Int)
    -> (PantryApp -> Int -> PantryApp) -> Lens' PantryApp Int
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens PantryApp -> Int
    paTermWidth  (\x :: PantryApp
    x y :: Int
    y -> PantryApp
    x { paTermWidth :: Int
    paTermWidth = Int
    y })

    -- | Run some code against pantry using basic sane settings.
    --
    -- For testing, see 'runPantryAppClean'.
    --
    -- @since 0.1.0.0
    runPantryApp :: MonadIO m => RIO PantryApp a -> m a
    runPantryApp :: RIO PantryApp a -> m a
    runPantryApp = Int -> CasaRepoPrefix -> Int -> RIO PantryApp a -> m a
    forall (m :: * -> *) a.
    MonadIO m =>
    Int -> CasaRepoPrefix -> Int -> RIO PantryApp a -> m a
    runPantryAppWith 8 CasaRepoPrefix
    defaultCasaRepoPrefix Int
    defaultCasaMaxPerRequest

    -- | Run some code against pantry using basic sane settings.
    --
    -- For testing, see 'runPantryAppClean'.
    --
    -- @since 0.1.1.1
    runPantryAppWith :: MonadIO m => Int -> CasaRepoPrefix -> Int -> RIO PantryApp a -> m a
    runPantryAppWith :: Int -> CasaRepoPrefix -> Int -> RIO PantryApp a -> m a
    runPantryAppWith maxConnCount :: Int
    maxConnCount casaRepoPrefix :: CasaRepoPrefix
    casaRepoPrefix casaMaxPerRequest :: Int
    casaMaxPerRequest f :: RIO PantryApp a
    f = RIO SimpleApp a -> m a
    forall (m :: * -> *) a. MonadIO m => RIO SimpleApp a -> m a
    runSimpleApp (RIO SimpleApp a -> m a) -> RIO SimpleApp a -> m a
    forall a b. (a -> b) -> a -> b
    $ do
      SimpleApp
    sa <- RIO SimpleApp SimpleApp
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      FilePath
    stack <- FilePath -> RIO SimpleApp FilePath
    forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
    getAppUserDataDirectory "stack"
      Path Abs Dir
    root <- FilePath -> RIO SimpleApp (Path Abs Dir)
    forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
    parseAbsDir (FilePath -> RIO SimpleApp (Path Abs Dir))
    -> FilePath -> RIO SimpleApp (Path Abs Dir)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    stack FilePath -> FilePath -> FilePath
    FilePath.</> "pantry"
      Path Abs Dir
    -> HackageSecurityConfig
    -> HpackExecutable
    -> Int
    -> CasaRepoPrefix
    -> Int
    -> (PantryConfig -> RIO SimpleApp a)
    -> RIO SimpleApp a
    forall env a.
    HasLogFunc env =>
    Path Abs Dir
    -> HackageSecurityConfig
    -> HpackExecutable
    -> Int
    -> CasaRepoPrefix
    -> Int
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig
        Path Abs Dir
    root
        HackageSecurityConfig
    defaultHackageSecurityConfig
        HpackExecutable
    HpackBundled
        Int
    maxConnCount
        CasaRepoPrefix
    casaRepoPrefix
        Int
    casaMaxPerRequest
        ((PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a)
    -> (PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a
    forall a b. (a -> b) -> a -> b
    $ \pc :: PantryConfig
    pc ->
          PantryApp -> RIO PantryApp a -> RIO SimpleApp a
    forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
    runRIO
            $WPantryApp :: SimpleApp
    -> PantryConfig -> Bool -> Int -> StylesUpdate -> PantryApp
    PantryApp
              { paSimpleApp :: SimpleApp
    paSimpleApp = SimpleApp
    sa
              , paPantryConfig :: PantryConfig
    paPantryConfig = PantryConfig
    pc
              , paTermWidth :: Int
    paTermWidth = 100
              , paUseColor :: Bool
    paUseColor = Bool
    True
              , paStylesUpdate :: StylesUpdate
    paStylesUpdate = StylesUpdate
    forall a. Monoid a => a
    mempty
              }
            RIO PantryApp a
    f

    -- | Like 'runPantryApp', but uses an empty pantry directory instead
    -- of sharing with Stack. Useful for testing.
    --
    -- @since 0.1.0.0
    runPantryAppClean :: MonadIO m => RIO PantryApp a -> m a
    runPantryAppClean :: RIO PantryApp a -> m a
    runPantryAppClean f :: RIO PantryApp a
    f = IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (FilePath -> IO a) -> IO a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> (FilePath -> m a) -> m a
    withSystemTempDirectory "pantry-clean" ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \dir :: FilePath
    dir -> RIO SimpleApp a -> IO a
    forall (m :: * -> *) a. MonadIO m => RIO SimpleApp a -> m a
    runSimpleApp (RIO SimpleApp a -> IO a) -> RIO SimpleApp a -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
      SimpleApp
    sa <- RIO SimpleApp SimpleApp
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      Path Abs Dir
    root <- FilePath -> RIO SimpleApp (Path Abs Dir)
    forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs Dir)
    resolveDir' FilePath
    dir
      Path Abs Dir
    -> HackageSecurityConfig
    -> HpackExecutable
    -> Int
    -> CasaRepoPrefix
    -> Int
    -> (PantryConfig -> RIO SimpleApp a)
    -> RIO SimpleApp a
    forall env a.
    HasLogFunc env =>
    Path Abs Dir
    -> HackageSecurityConfig
    -> HpackExecutable
    -> Int
    -> CasaRepoPrefix
    -> Int
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig
        Path Abs Dir
    root
        HackageSecurityConfig
    defaultHackageSecurityConfig
        HpackExecutable
    HpackBundled
        8
        CasaRepoPrefix
    defaultCasaRepoPrefix
        Int
    defaultCasaMaxPerRequest
        ((PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a)
    -> (PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a
    forall a b. (a -> b) -> a -> b
    $ \pc :: PantryConfig
    pc ->
          PantryApp -> RIO PantryApp a -> RIO SimpleApp a
    forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
    runRIO
            $WPantryApp :: SimpleApp
    -> PantryConfig -> Bool -> Int -> StylesUpdate -> PantryApp
    PantryApp
              { paSimpleApp :: SimpleApp
    paSimpleApp = SimpleApp
    sa
              , paPantryConfig :: PantryConfig
    paPantryConfig = PantryConfig
    pc
              , paTermWidth :: Int
    paTermWidth = 100
              , paUseColor :: Bool
    paUseColor = Bool
    True
              , paStylesUpdate :: StylesUpdate
    paStylesUpdate = StylesUpdate
    forall a. Monoid a => a
    mempty
              }
            RIO PantryApp a
    f

    -- | Load the global hints from Github.
    --
    -- @since 0.1.0.0
    loadGlobalHints
      :: (HasTerm env, HasPantryConfig env)
      => WantedCompiler
      -> RIO env (Maybe (Map PackageName Version))
    loadGlobalHints :: WantedCompiler -> RIO env (Maybe (Map PackageName Version))
    loadGlobalHints wc :: WantedCompiler
    wc =
        Bool -> RIO env (Maybe (Map PackageName Version))
    forall b a env.
    (IsCabalString b, IsCabalString a, Ord a, HasPantryConfig env,
     HasTerm env) =>
    Bool -> RIO env (Maybe (Map a b))
    inner Bool
    False
      where
        inner :: Bool -> RIO env (Maybe (Map a b))
    inner alreadyDownloaded :: Bool
    alreadyDownloaded = do
          Path Abs File
    dest <- RIO env (Path Abs File)
    forall env. HasPantryConfig env => RIO env (Path Abs File)
    getGlobalHintsFile
          Request
    req <- FilePath -> RIO env Request
    forall (m :: * -> *). MonadThrow m => FilePath -> m Request
    parseRequest "https://raw.githubusercontent.com/fpco/stackage-content/master/stack/global-hints.yaml"
          Bool
    downloaded <- Request -> Path Abs File -> RIO env Bool
    forall env. HasTerm env => Request -> Path Abs File -> RIO env Bool
    download Request
    req Path Abs File
    dest
          Either SomeException (Maybe (Map a b))
    eres <- RIO env (Maybe (Map a b))
    -> RIO env (Either SomeException (Maybe (Map a b)))
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    m a -> m (Either SomeException a)
    tryAny (Path Abs File -> RIO env (Maybe (Map a b))
    forall (m :: * -> *) a b b t.
    (MonadIO m, Ord a, IsCabalString a, IsCabalString b) =>
    Path b t -> m (Maybe (Map a b))
    inner2 Path Abs File
    dest)
          Maybe (Map a b)
    mres <-
            case Either SomeException (Maybe (Map a b))
    eres of
              Left e :: SomeException
    e -> Maybe (Map a b)
    forall a. Maybe a
    Nothing Maybe (Map a b) -> RIO env () -> RIO env (Maybe (Map a b))
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logError ("Error when parsing global hints: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> SomeException -> Utf8Builder
    forall a. Show a => a -> Utf8Builder
    displayShow SomeException
    e)
              Right x :: Maybe (Map a b)
    x -> Maybe (Map a b) -> RIO env (Maybe (Map a b))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Map a b)
    x
          case Maybe (Map a b)
    mres of
            Nothing | Bool -> Bool
    not Bool
    alreadyDownloaded Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    downloaded -> do
              Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                "Could not find local global hints for " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                WantedCompiler -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    RIO.display WantedCompiler
    wc Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                ", forcing a redownload"
              Bool
    x <- Request -> Path Abs File -> RIO env Bool
    forall env. HasTerm env => Request -> Path Abs File -> RIO env Bool
    redownload Request
    req Path Abs File
    dest
              if Bool
    x
                then Bool -> RIO env (Maybe (Map a b))
    inner Bool
    True
                else do
                  Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logInfo "Redownload didn't happen"
                  Maybe (Map a b) -> RIO env (Maybe (Map a b))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Map a b)
    forall a. Maybe a
    Nothing
            _ -> Maybe (Map a b) -> RIO env (Maybe (Map a b))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Map a b)
    mres

        inner2 :: Path b t -> m (Maybe (Map a b))
    inner2 dest :: Path b t
    dest
               = IO (Maybe (Map a b)) -> m (Maybe (Map a b))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO
               (IO (Maybe (Map a b)) -> m (Maybe (Map a b)))
    -> IO (Maybe (Map a b)) -> m (Maybe (Map a b))
    forall a b. (a -> b) -> a -> b
    $ WantedCompiler -> Map WantedCompiler (Map a b) -> Maybe (Map a b)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup WantedCompiler
    wc (Map WantedCompiler (Map a b) -> Maybe (Map a b))
    -> (Map WantedCompiler (Map (CabalString a) (CabalString b))
        -> Map WantedCompiler (Map a b))
    -> Map WantedCompiler (Map (CabalString a) (CabalString b))
    -> Maybe (Map a b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map (CabalString a) (CabalString b) -> Map a b)
    -> Map WantedCompiler (Map (CabalString a) (CabalString b))
    -> Map WantedCompiler (Map a b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((CabalString b -> b) -> Map a (CabalString b) -> Map a b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CabalString b -> b
    forall a. CabalString a -> a
    unCabalString (Map a (CabalString b) -> Map a b)
    -> (Map (CabalString a) (CabalString b) -> Map a (CabalString b))
    -> Map (CabalString a) (CabalString b)
    -> Map a b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map (CabalString a) (CabalString b) -> Map a (CabalString b)
    forall a v. Map (CabalString a) v -> Map a v
    unCabalStringMap)
             (Map WantedCompiler (Map (CabalString a) (CabalString b))
     -> Maybe (Map a b))
    -> IO (Map WantedCompiler (Map (CabalString a) (CabalString b)))
    -> IO (Maybe (Map a b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath
    -> IO (Map WantedCompiler (Map (CabalString a) (CabalString b)))
    forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
    Yaml.decodeFileThrow (Path b t -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath Path b t
    dest)

    -- | Partition a map of global packages with its versions into a Set of
    -- replaced packages and its dependencies and a map of remaining (untouched) packages.
    --
    -- @since 0.1.0.0
    partitionReplacedDependencies ::
           Ord id
        => Map PackageName a -- ^ global packages
        -> (a -> PackageName) -- ^ package name getter
        -> (a -> id) -- ^ returns unique package id used for dependency pruning
        -> (a -> [id]) -- ^ returns unique package ids of direct package dependencies
        -> Set PackageName -- ^ overrides which global dependencies should get pruned
        -> (Map PackageName [PackageName], Map PackageName a)
    partitionReplacedDependencies :: Map PackageName a
    -> (a -> PackageName)
    -> (a -> id)
    -> (a -> [id])
    -> Set PackageName
    -> (Map PackageName [PackageName], Map PackageName a)
    partitionReplacedDependencies globals :: Map PackageName a
    globals getName :: a -> PackageName
    getName getId :: a -> id
    getId getDeps :: a -> [id]
    getDeps overrides :: Set PackageName
    overrides =
      (State (Map PackageName [PackageName], Map PackageName a) [Bool]
     -> (Map PackageName [PackageName], Map PackageName a)
     -> (Map PackageName [PackageName], Map PackageName a))
    -> (Map PackageName [PackageName], Map PackageName a)
    -> State (Map PackageName [PackageName], Map PackageName a) [Bool]
    -> (Map PackageName [PackageName], Map PackageName a)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip State (Map PackageName [PackageName], Map PackageName a) [Bool]
    -> (Map PackageName [PackageName], Map PackageName a)
    -> (Map PackageName [PackageName], Map PackageName a)
    forall s a. State s a -> s -> s
    execState (Map PackageName [PackageName]
    forall a. Map PackageName [a]
    replaced, Map PackageName a
    forall a. Monoid a => a
    mempty) (State (Map PackageName [PackageName], Map PackageName a) [Bool]
     -> (Map PackageName [PackageName], Map PackageName a))
    -> State (Map PackageName [PackageName], Map PackageName a) [Bool]
    -> (Map PackageName [PackageName], Map PackageName a)
    forall a b. (a -> b) -> a -> b
    $
        [(PackageName, a)]
    -> ((PackageName, a)
        -> StateT
             (Map PackageName [PackageName], Map PackageName a) Identity Bool)
    -> State (Map PackageName [PackageName], Map PackageName a) [Bool]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for (Map PackageName a -> [(PackageName, a)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PackageName a
    globals) (((PackageName, a)
      -> StateT
           (Map PackageName [PackageName], Map PackageName a) Identity Bool)
     -> State (Map PackageName [PackageName], Map PackageName a) [Bool])
    -> ((PackageName, a)
        -> StateT
             (Map PackageName [PackageName], Map PackageName a) Identity Bool)
    -> State (Map PackageName [PackageName], Map PackageName a) [Bool]
    forall a b. (a -> b) -> a -> b
    $ Map id a
    -> (a -> PackageName)
    -> (a -> [id])
    -> (PackageName, a)
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity Bool
    forall id a.
    Ord id =>
    Map id a
    -> (a -> PackageName)
    -> (a -> [id])
    -> (PackageName, a)
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    prunePackageWithDeps Map id a
    globals' a -> PackageName
    getName a -> [id]
    getDeps
      where
        globals' :: Map id a
    globals' = [(id, a)] -> Map id a
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(id, a)] -> Map id a) -> [(id, a)] -> Map id a
    forall a b. (a -> b) -> a -> b
    $ (a -> (id, a)) -> [a] -> [(id, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (a -> id
    getId (a -> id) -> (a -> a) -> a -> (id, a)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& a -> a
    forall a. a -> a
    id) (Map PackageName a -> [a]
    forall k a. Map k a -> [a]
    Map.elems Map PackageName a
    globals)
        replaced :: Map PackageName [a]
    replaced = (a -> [a]) -> Map PackageName a -> Map PackageName [a]
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map ([a] -> a -> [a]
    forall a b. a -> b -> a
    const []) (Map PackageName a -> Map PackageName [a])
    -> Map PackageName a -> Map PackageName [a]
    forall a b. (a -> b) -> a -> b
    $ Map PackageName a -> Set PackageName -> Map PackageName a
    forall k a. Ord k => Map k a -> Set k -> Map k a
    Map.restrictKeys Map PackageName a
    globals Set PackageName
    overrides

    prunePackageWithDeps ::
           Ord id
        => Map id a
        -> (a -> PackageName)
        -> (a -> [id])
        -> (PackageName, a)
        -> State (Map PackageName [PackageName], Map PackageName a) Bool
    prunePackageWithDeps :: Map id a
    -> (a -> PackageName)
    -> (a -> [id])
    -> (PackageName, a)
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    prunePackageWithDeps pkgs :: Map id a
    pkgs getName :: a -> PackageName
    getName getDeps :: a -> [id]
    getDeps (pname :: PackageName
    pname, a :: a
    a)  = do
      (pruned :: Map PackageName [PackageName]
    pruned, kept :: Map PackageName a
    kept) <- StateT
      (Map PackageName [PackageName], Map PackageName a)
      Identity
      (Map PackageName [PackageName], Map PackageName a)
    forall s (m :: * -> *). MonadState s m => m s
    get
      if PackageName -> Map PackageName [PackageName] -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member PackageName
    pname Map PackageName [PackageName]
    pruned
      then Bool
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      else if PackageName -> Map PackageName a -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member PackageName
    pname Map PackageName a
    kept
        then Bool
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        else do
          let deps :: [a]
    deps = Map id a -> [a]
    forall k a. Map k a -> [a]
    Map.elems (Map id a -> [a]) -> Map id a -> [a]
    forall a b. (a -> b) -> a -> b
    $ Map id a -> Set id -> Map id a
    forall k a. Ord k => Map k a -> Set k -> Map k a
    Map.restrictKeys Map id a
    pkgs ([id] -> Set id
    forall a. Ord a => [a] -> Set a
    Set.fromList ([id] -> Set id) -> [id] -> Set id
    forall a b. (a -> b) -> a -> b
    $ a -> [id]
    getDeps a
    a)
          [PackageName]
    prunedDeps <- [a]
    -> (a
        -> StateT
             (Map PackageName [PackageName], Map PackageName a)
             Identity
             (Maybe PackageName))
    -> StateT
         (Map PackageName [PackageName], Map PackageName a)
         Identity
         [PackageName]
    forall (m :: * -> *) a b.
    Monad m =>
    [a] -> (a -> m (Maybe b)) -> m [b]
    forMaybeM [a]
    deps ((a
      -> StateT
           (Map PackageName [PackageName], Map PackageName a)
           Identity
           (Maybe PackageName))
     -> StateT
          (Map PackageName [PackageName], Map PackageName a)
          Identity
          [PackageName])
    -> (a
        -> StateT
             (Map PackageName [PackageName], Map PackageName a)
             Identity
             (Maybe PackageName))
    -> StateT
         (Map PackageName [PackageName], Map PackageName a)
         Identity
         [PackageName]
    forall a b. (a -> b) -> a -> b
    $ \dep :: a
    dep -> do
            let depName :: PackageName
    depName = a -> PackageName
    getName a
    dep
            Bool
    isPruned <- Map id a
    -> (a -> PackageName)
    -> (a -> [id])
    -> (PackageName, a)
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    forall id a.
    Ord id =>
    Map id a
    -> (a -> PackageName)
    -> (a -> [id])
    -> (PackageName, a)
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    prunePackageWithDeps Map id a
    pkgs a -> PackageName
    getName a -> [id]
    getDeps (PackageName
    depName, a
    dep)
            Maybe PackageName
    -> StateT
         (Map PackageName [PackageName], Map PackageName a)
         Identity
         (Maybe PackageName)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe PackageName
     -> StateT
          (Map PackageName [PackageName], Map PackageName a)
          Identity
          (Maybe PackageName))
    -> Maybe PackageName
    -> StateT
         (Map PackageName [PackageName], Map PackageName a)
         Identity
         (Maybe PackageName)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    isPruned then PackageName -> Maybe PackageName
    forall a. a -> Maybe a
    Just PackageName
    depName else Maybe PackageName
    forall a. Maybe a
    Nothing
          if [PackageName] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [PackageName]
    prunedDeps
          then do
            ((Map PackageName [PackageName], Map PackageName a)
     -> (Map PackageName [PackageName], Map PackageName a))
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify' (((Map PackageName [PackageName], Map PackageName a)
      -> (Map PackageName [PackageName], Map PackageName a))
     -> StateT
          (Map PackageName [PackageName], Map PackageName a) Identity ())
    -> ((Map PackageName [PackageName], Map PackageName a)
        -> (Map PackageName [PackageName], Map PackageName a))
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity ()
    forall a b. (a -> b) -> a -> b
    $ (Map PackageName a -> Map PackageName a)
    -> (Map PackageName [PackageName], Map PackageName a)
    -> (Map PackageName [PackageName], Map PackageName a)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second (PackageName -> a -> Map PackageName a -> Map PackageName a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert PackageName
    pname a
    a)
          else do
            ((Map PackageName [PackageName], Map PackageName a)
     -> (Map PackageName [PackageName], Map PackageName a))
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify' (((Map PackageName [PackageName], Map PackageName a)
      -> (Map PackageName [PackageName], Map PackageName a))
     -> StateT
          (Map PackageName [PackageName], Map PackageName a) Identity ())
    -> ((Map PackageName [PackageName], Map PackageName a)
        -> (Map PackageName [PackageName], Map PackageName a))
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity ()
    forall a b. (a -> b) -> a -> b
    $ (Map PackageName [PackageName] -> Map PackageName [PackageName])
    -> (Map PackageName [PackageName], Map PackageName a)
    -> (Map PackageName [PackageName], Map PackageName a)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (PackageName
    -> [PackageName]
    -> Map PackageName [PackageName]
    -> Map PackageName [PackageName]
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert PackageName
    pname [PackageName]
    prunedDeps)
          Bool
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
     -> State (Map PackageName [PackageName], Map PackageName a) Bool)
    -> Bool
    -> State (Map PackageName [PackageName], Map PackageName a) Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not ([PackageName] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [PackageName]
    prunedDeps)

    -- | Use a snapshot cache, which caches which modules are in which
    -- packages in a given snapshot. This is mostly intended for usage by
    -- Stack.
    --
    -- @since 0.1.0.0
    withSnapshotCache
      :: (HasPantryConfig env, HasLogFunc env)
      => SnapshotCacheHash
      -> RIO env (Map PackageName (Set ModuleName))
      -> ((ModuleName -> RIO env [PackageName]) -> RIO env a)
      -> RIO env a
    withSnapshotCache :: SnapshotCacheHash
    -> RIO env (Map PackageName (Set ModuleName))
    -> ((ModuleName -> RIO env [PackageName]) -> RIO env a)
    -> RIO env a
    withSnapshotCache hash :: SnapshotCacheHash
    hash getModuleMapping :: RIO env (Map PackageName (Set ModuleName))
    getModuleMapping f :: (ModuleName -> RIO env [PackageName]) -> RIO env a
    f = do
      Maybe SnapshotCacheId
    mres <- ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId)
    -> RIO env (Maybe SnapshotCacheId)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId)
     -> RIO env (Maybe SnapshotCacheId))
    -> ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId)
    -> RIO env (Maybe SnapshotCacheId)
    forall a b. (a -> b) -> a -> b
    $ SnapshotCacheHash
    -> ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId)
    forall env.
    SnapshotCacheHash
    -> ReaderT SqlBackend (RIO env) (Maybe SnapshotCacheId)
    getSnapshotCacheByHash SnapshotCacheHash
    hash
      SnapshotCacheId
    cacheId <- case Maybe SnapshotCacheId
    mres of
        Nothing -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn "Populating snapshot module name cache"
          Map PackageName (Set ModuleName)
    packageModules <- RIO env (Map PackageName (Set ModuleName))
    getModuleMapping
          ReaderT SqlBackend (RIO env) SnapshotCacheId
    -> RIO env SnapshotCacheId
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) SnapshotCacheId
     -> RIO env SnapshotCacheId)
    -> ReaderT SqlBackend (RIO env) SnapshotCacheId
    -> RIO env SnapshotCacheId
    forall a b. (a -> b) -> a -> b
    $ do
            SnapshotCacheId
    scId <- SnapshotCacheHash -> ReaderT SqlBackend (RIO env) SnapshotCacheId
    forall env.
    SnapshotCacheHash -> ReaderT SqlBackend (RIO env) SnapshotCacheId
    getSnapshotCacheId SnapshotCacheHash
    hash
            SnapshotCacheId
    -> Map PackageName (Set ModuleName)
    -> ReaderT SqlBackend (RIO env) ()
    forall env.
    SnapshotCacheId
    -> Map PackageName (Set ModuleName)
    -> ReaderT SqlBackend (RIO env) ()
    storeSnapshotModuleCache SnapshotCacheId
    scId Map PackageName (Set ModuleName)
    packageModules
            SnapshotCacheId -> ReaderT SqlBackend (RIO env) SnapshotCacheId
    forall (m :: * -> *) a. Monad m => a -> m a
    return SnapshotCacheId
    scId
        Just scId :: SnapshotCacheId
    scId -> SnapshotCacheId -> RIO env SnapshotCacheId
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SnapshotCacheId
    scId
      (ModuleName -> RIO env [PackageName]) -> RIO env a
    f ((ModuleName -> RIO env [PackageName]) -> RIO env a)
    -> (ModuleName -> RIO env [PackageName]) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ ReaderT SqlBackend (RIO env) [PackageName] -> RIO env [PackageName]
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) [PackageName]
     -> RIO env [PackageName])
    -> (ModuleName -> ReaderT SqlBackend (RIO env) [PackageName])
    -> ModuleName
    -> RIO env [PackageName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SnapshotCacheId
    -> ModuleName -> ReaderT SqlBackend (RIO env) [PackageName]
    forall env.
    SnapshotCacheId
    -> ModuleName -> ReaderT SqlBackend (RIO env) [PackageName]
    loadExposedModulePackages SnapshotCacheId
    cacheId

    -- | Add an s to the builder if n!=1.
    plural :: Int -> Utf8Builder -> Utf8Builder
    plural :: Int -> Utf8Builder -> Utf8Builder
    plural n :: Int
    n text :: Utf8Builder
    text =
      Int -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Int
    n Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> " " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    text Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
      (if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1
         then ""
         else "s")