    {-# LANGUAGE NoImplicitPrelude   #-}
    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell     #-}
    {-# LANGUAGE TupleSections       #-}

    -- | 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
      , PackageIndexConfig (..)
      , HackageSecurityConfig (..)
      , defaultPackageIndexConfig
      , defaultDownloadPrefix
      , defaultHackageSecurityConfig
      , defaultCasaRepoPrefix
      , defaultCasaMaxPerRequest
      , defaultSnapshotLocation
      , HasPantryConfig (..)
      , withPantryConfig
      , withPantryConfig'
      , HpackExecutable (..)

        -- ** Convenience

      , PantryApp
      , runPantryApp
      , runPantryAppClean
      , runPantryAppWith
      , hpackExecutableL

        -- * Types

        -- ** Exceptions

      , PantryException (..)
      , Mismatch (..)
      , FuzzyResults (..)

        -- ** Cabal types

      , PackageName
      , Version
      , FlagName
      , PackageIdentifier (..)

        -- ** Files

      , FileSize (..)
      , RelFilePath (..)
      , ResolvedPath (..)
      , Unresolved
      , SafeFilePath
      , mkSafeFilePath

        -- ** Cryptography

      , SHA256
      , TreeKey (..)
      , BlobKey (..)

        -- ** Packages

      , RawPackageMetadata (..)
      , PackageMetadata (..)
      , Package (..)

        -- ** Hackage

      , CabalFileInfo (..)
      , Revision (..)
      , PackageIdentifierRevision (..)
      , UsePreferredVersions (..)

        -- ** Archives

      , RawArchive (..)
      , Archive (..)
      , ArchiveLocation (..)

        -- ** Repos

      , Repo (..)
      , RepoType (..)
      , SimpleRepo (..)
      , withRepo
      , fetchRepos
      , fetchReposRaw

        -- ** Package location

      , RawPackageLocation (..)
      , PackageLocation (..)
      , toRawPL
      , RawPackageLocationImmutable (..)
      , PackageLocationImmutable (..)

        -- ** Snapshots

      , RawSnapshotLocation (..)
      , SnapshotLocation (..)
      , toRawSL
      , RawSnapshot (..)
      , Snapshot (..)
      , RawSnapshotPackage (..)
      , SnapshotPackage (..)
      , RawSnapshotLayer (..)
      , SnapshotLayer (..)
      , toRawSnapshotLayer
      , WantedCompiler (..)
      , SnapName (..)
      , snapshotLocation

        -- * Loading values

      , resolvePaths
      , loadPackageRaw
      , tryLoadPackageRawViaCasa
      , loadPackage
      , loadRawSnapshotLayer
      , loadSnapshotLayer
      , loadSnapshot
      , loadAndCompleteSnapshot
      , loadAndCompleteSnapshot'
      , loadAndCompleteSnapshotRaw
      , loadAndCompleteSnapshotRaw'
      , CompletedSL (..)
      , CompletedPLI (..)
      , addPackagesToSnapshot
      , AddPackagesConfig (..)

        -- * Completion functions

      , CompletePackageLocation (..)
      , completePackageLocation
      , completeSnapshotLocation
      , warnMissingCabalFile

        -- * Parsers

      , parseWantedCompiler
      , parseSnapName
      , parseRawSnapshotLocation
      , parsePackageIdentifierRevision
      , parseHackageText

        -- ** Cabal values

      , parsePackageIdentifier
      , parsePackageName
      , parsePackageNameThrowing
      , parseFlagName
      , parseVersion
      , parseVersionThrowing

        -- * 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           Casa.Client ( CasaRepoPrefix, thParserCasaRepo )
    import           Conduit
    import           Control.Arrow ( right )
    import           Control.Monad.State.Strict ( State, execState, get, modify' )
    import           Data.Aeson.Types ( parseEither )
    #if !MIN_VERSION_rio(0,1,17)
    import           Data.Bifunctor ( bimap )
    #endif
    import           Data.Char ( isHexDigit )
    import           Data.Monoid ( Endo (..) )
    import           Data.Time ( diffUTCTime, getCurrentTime )
    import qualified Data.Yaml as Yaml
    import           Data.Yaml.Include ( decodeFileWithWarnings )
    import           Database.Persist ( entityKey )
    import           Distribution.PackageDescription
                       ( FlagName, GenericPackageDescription )
    import qualified Distribution.PackageDescription as D
    import           Distribution.Parsec ( PWarning (..), showPos )
    import qualified Hpack
    import qualified Hpack.Config as Hpack
    import           Hpack.Error ( formatHpackError )
    import           Hpack.Yaml ( formatWarning )
    import           Network.HTTP.Download
    import           Pantry.Archive
    import           Pantry.Casa
    import           Pantry.HTTP
    import           Pantry.Hackage
    import           Pantry.Internal.AesonExtended ( Value, WithJSONWarnings (..) )
    import           Pantry.Repo
    import qualified Pantry.SHA256 as SHA256
    import           Pantry.Storage hiding
                       ( TreeEntry, PackageName, Version, findOrGenerateCabalFile )
    import           Pantry.Tree
    import           Pantry.Types as P
    import           Path
                       ( Abs, Dir, File, Path, (</>), filename, parent, parseAbsDir
                       , parseRelFile, toFilePath
                       )
    import           Path.IO ( doesFileExist, listDir, resolveDir' )
    import           RIO
    import qualified RIO.ByteString as B
    import           RIO.Directory ( getAppUserDataDirectory )
    import qualified RIO.FilePath as FilePath
    import qualified RIO.List as List
    import qualified RIO.Map as Map
    import           RIO.PrettyPrint
    import           RIO.PrettyPrint.StylesUpdate
    import           RIO.Process
    import qualified RIO.Set as Set
    import           RIO.Text ( unpack )
    import qualified RIO.Text as T
    import           System.IO.Error ( isDoesNotExistError )

    decodeYaml :: FilePath -> IO (Either String ([String], Value))
    decodeYaml :: String -> IO (Either String ([String], Value))
    decodeYaml String
    file = do
      (ParseException -> String)
    -> (([Warning], Value) -> ([String], Value))
    -> Either ParseException ([Warning], Value)
    -> Either String ([String], Value)
    forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap ParseException -> String
    forall e. Exception e => e -> String
    displayException (([Warning] -> [String]) -> ([Warning], Value) -> ([String], Value)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first [Warning] -> [String]
    formatWarnings) (Either ParseException ([Warning], Value)
     -> Either String ([String], Value))
    -> IO (Either ParseException ([Warning], Value))
    -> IO (Either String ([String], Value))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Either ParseException ([Warning], Value))
    forall a.
    FromJSON a =>
    String -> IO (Either ParseException ([Warning], a))
    decodeFileWithWarnings String
    file
      where
        formatWarnings :: [Warning] -> [String]
    formatWarnings = (Warning -> String) -> [Warning] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Warning -> String
    formatWarning String
    file)

    formatYamlParseError :: FilePath -> Yaml.ParseException -> String
    formatYamlParseError :: String -> ParseException -> String
    formatYamlParseError String
    file ParseException
    e =
      String
    "In respect of an Hpack defaults file:\n"
      String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    file
      String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ":\n\n"
      String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> ParseException -> String
    forall e. Exception e => e -> String
    displayException ParseException
    e

    -- | Create a new 'PantryConfig' with the given settings. For a version where

    -- the use of Casa (content-addressable storage archive) is optional, see

    -- 'withPantryConfig''.

    --

    -- 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.

      -> PackageIndexConfig
         -- ^ Package index configuration. You probably want

         -- 'defaultPackageIndexConfig'.

      -> 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.

      -> (SnapName -> RawSnapshotLocation)
         -- ^ The location of snapshot synonyms

      -> (PantryConfig -> RIO env a)
         -- ^ What to do with the config

      -> RIO env a
    withPantryConfig :: forall env a.
    HasLogFunc env =>
    Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> CasaRepoPrefix
    -> Int
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig Path Abs Dir
    root PackageIndexConfig
    pic HpackExecutable
    he Int
    count CasaRepoPrefix
    pullURL Int
    maxPerRequest =
      Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> Maybe (CasaRepoPrefix, Int)
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    forall env a.
    HasLogFunc env =>
    Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> Maybe (CasaRepoPrefix, Int)
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig' Path Abs Dir
    root PackageIndexConfig
    pic HpackExecutable
    he Int
    count ((CasaRepoPrefix, Int) -> Maybe (CasaRepoPrefix, Int)
    forall a. a -> Maybe a
    Just (CasaRepoPrefix
    pullURL, Int
    maxPerRequest))

    -- | Create a new 'PantryConfig' with the given settings.

    --

    -- For something easier to use in simple cases, see 'runPantryApp'.

    --

    -- @since 0.8.3

    withPantryConfig'
      :: HasLogFunc env
      => Path Abs Dir
      -- ^ pantry root directory, where the SQLite database and Hackage

      -- downloads are kept.

      -> PackageIndexConfig
      -- ^ Package index configuration. You probably want

      -- 'defaultPackageIndexConfig'.

      -> HpackExecutable
      -- ^ When converting an hpack @package.yaml@ file to a cabal file,

      -- what version of hpack should we use?

      -> Int
      -- ^ Maximum connection count

      -> Maybe (CasaRepoPrefix, Int)
      -- ^ Optionally, the Casa pull URL e.g. @https://casa.fpcomplete.com@ and the

      -- maximum number of Casa keys to pull per request.

      -> (SnapName -> RawSnapshotLocation)
      -- ^ The location of snapshot synonyms

      -> (PantryConfig -> RIO env a)
      -- ^ What to do with the config

      -> RIO env a
    withPantryConfig' :: forall env a.
    HasLogFunc env =>
    Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> Maybe (CasaRepoPrefix, Int)
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig' Path Abs Dir
    root PackageIndexConfig
    pic HpackExecutable
    he Int
    count Maybe (CasaRepoPrefix, Int)
    mCasaConfig SnapName -> RawSnapshotLocation
    snapLoc PantryConfig -> RIO env a
    inner = do
      env
    env <- RIO env env
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      Path Rel File
    pantryRelFile <- String -> RIO env (Path Rel File)
    forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
    parseRelFile String
    "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 -> 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 PantryConfig
          { pcPackageIndex :: PackageIndexConfig
    pcPackageIndex = PackageIndexConfig
    pic
          , 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
          , pcCasaConfig :: Maybe (CasaRepoPrefix, Int)
    pcCasaConfig = Maybe (CasaRepoPrefix, Int)
    mCasaConfig
          , pcSnapshotLocation :: SnapName -> RawSnapshotLocation
    pcSnapshotLocation = SnapName -> RawSnapshotLocation
    snapLoc
          }

    -- | 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 = Int
    1280

    -- | Default 'PackageIndexConfig' value using the official Hackage server.

    --

    -- @since 0.6.0

    defaultPackageIndexConfig :: PackageIndexConfig
    defaultPackageIndexConfig :: PackageIndexConfig
    defaultPackageIndexConfig = PackageIndexConfig
      { picDownloadPrefix :: Text
    picDownloadPrefix = Text
    defaultDownloadPrefix
      , picHackageSecurityConfig :: HackageSecurityConfig
    picHackageSecurityConfig = HackageSecurityConfig
    defaultHackageSecurityConfig
      }

    -- | The download prefix for the official Hackage server.

    --

    -- @since 0.6.0

    defaultDownloadPrefix :: Text
    defaultDownloadPrefix :: Text
    defaultDownloadPrefix = Text
    "https://hackage.haskell.org/"

    -- | 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RequireHackageIndex
    -> PackageName
    -> UsePreferredVersions
    -> RIO env (Maybe PackageIdentifierRevision)
    getLatestHackageVersion RequireHackageIndex
    req PackageName
    name 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 a b. (a -> b) -> Maybe a -> Maybe b
    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, Map k BlobKey
    m) = do
          (k
    _rev, BlobKey SHA256
    sha 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 a. a -> Maybe a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RequireHackageIndex
    -> PackageName
    -> UsePreferredVersions
    -> RIO env (Maybe PackageLocationImmutable)
    getLatestHackageLocation RequireHackageIndex
    req PackageName
    name 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 a b. (a -> b) -> Maybe a -> Maybe b
    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, Map Revision BlobKey
    revisions) <- Maybe (Version, Map Revision BlobKey)
    mversion
            (Revision
    _rev, 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 a. a -> Maybe a
    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, cfKey :: BlobKey
    cfKey@(BlobKey SHA256
    sha 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 a. a -> RIO env a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RequireHackageIndex
    -> PackageName
    -> Version
    -> RIO env (Maybe (Revision, BlobKey, TreeKey))
    getLatestHackageRevision RequireHackageIndex
    req PackageName
    name 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)
    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 of
        Maybe (Revision, BlobKey)
    Nothing -> Maybe (Revision, BlobKey, TreeKey)
    -> RIO env (Maybe (Revision, BlobKey, TreeKey))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Revision, BlobKey, TreeKey)
    forall a. Maybe a
    Nothing
        Just (Revision
    revision, cfKey :: BlobKey
    cfKey@(BlobKey SHA256
    sha 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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [RawPackageLocationImmutable] -> RIO env ()
    fetchTreeKeys [RawPackageLocationImmutable]
    treeKeys = do
      -- 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 a b.
    (a -> b)
    -> ReaderT SqlBackend (RIO env) a -> ReaderT SqlBackend (RIO env) b
    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 a. a -> ReaderT SqlBackend (RIO env) a
    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 a. IO a -> RIO env a
    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 <-
        (SomeException -> RIO env (Map TreeKey Tree))
    -> RIO env (Map TreeKey Tree) -> RIO env (Map TreeKey Tree)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny (RIO env (Map TreeKey Tree)
    -> SomeException -> RIO env (Map TreeKey Tree)
    forall a b. a -> b -> a
    const RIO env (Map TreeKey Tree)
    forall a. Monoid a => a
    mempty)
        (([(TreeKey, Tree)] -> Map TreeKey Tree)
    -> RIO env [(TreeKey, Tree)] -> RIO env (Map TreeKey Tree)
    forall a b. (a -> b) -> RIO env a -> RIO env b
    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 a b. (a -> b) -> [a] -> [b]
    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)))
      ()
    -> ConduitT
         (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 =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT 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)))
      ()
    -> ConduitT
         (TreeKey, Tree)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         [(TreeKey, Tree)]
    -> ConduitT
         (BlobKey, ByteString)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         [(TreeKey, Tree)]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .|
                 ConduitT
      (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 a. IO a -> RIO env a
    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' ->
                 (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 m a. Monoid m => (a -> m) -> Map TreeKey a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap
              (\(P.TreeMap 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 a. Map SafeFilePath a -> [a]
    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 a. IO a -> RIO env a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
      Maybe Int
    mpulledBlobKeys :: Maybe Int <-
        (SomeException -> RIO env (Maybe Int))
    -> RIO env (Maybe Int) -> RIO env (Maybe Int)
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    (SomeException -> m a) -> m a -> m a
    handleAny (RIO env (Maybe Int) -> SomeException -> RIO env (Maybe Int)
    forall a b. a -> b -> a
    const (Maybe Int -> RIO env (Maybe Int)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Int
    forall a. Maybe a
    Nothing))
        ((Int -> Maybe Int) -> RIO env Int -> RIO env (Maybe Int)
    forall a b. (a -> b) -> RIO env a -> RIO env b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> Maybe Int
    forall a. a -> Maybe a
    Just (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)))
      ()
    -> ConduitT
         (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 =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT 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 Int
    1) ConduitT
      (BlobKey, ByteString)
      Int
      (ResourceT (ReaderT SqlBackend (RIO env)))
      ()
    -> ConduitT Int Void (ResourceT (ReaderT SqlBackend (RIO env))) Int
    -> ConduitT
         (BlobKey, ByteString)
         Void
         (ResourceT (ReaderT SqlBackend (RIO env)))
         Int
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT Int Void (ResourceT (ReaderT SqlBackend (RIO env))) Int
    forall (m :: * -> *) a o. (Monad m, Num a) => ConduitT a o m a
    sumC))))
      Maybe Int -> (Int -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe Int
    mpulledBlobKeys ((Int -> RIO env ()) -> RIO env ())
    -> (Int -> RIO env ()) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    pulledBlobKeys -> do
        UTCTime
    pullBlobEnd <- IO UTCTime -> RIO env UTCTime
    forall a. IO a -> RIO env a
    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
          (Utf8Builder
    "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 Utf8Builder
    ", " ((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 -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
           Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display (String -> Text
    T.pack (NominalDiffTime -> String
    forall a. Show a => a -> String
    show (UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    pullTreeEnd UTCTime
    pullTreeStart))) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
           Utf8Builder
    "), " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
           Int -> Utf8Builder -> Utf8Builder
    plural Int
    pulledBlobKeys Utf8Builder
    "file" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
           Utf8Builder
    " (" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
           Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display (String -> Text
    T.pack (NominalDiffTime -> String
    forall a. Show a => a -> String
    show (UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    pullBlobEnd UTCTime
    pullBlobStart))) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
           Utf8Builder
    ")")
      -- 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 ->
           let mkey :: Maybe TreeKey
    mkey = RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey RawPackageLocationImmutable
    rawPackageLocationImmutable
            in case Maybe TreeKey
    mkey of
                 Maybe TreeKey
    Nothing ->
                   Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug
                     (Utf8Builder
    "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
    <>
                      Utf8Builder
    ", can't look in Casa for it.")
                 Just 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
                     Maybe Tree
    Nothing ->
                       Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug
                         (Utf8Builder
    "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 -> 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
    <>
                          Utf8Builder
    ") not returned from Casa.")
                     Just 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 -> 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
    $ do
                           Either LoadCachedTreeException CachedTree
    ecachedTree <- Tree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    forall env.
    Tree
    -> ReaderT
         SqlBackend (RIO env) (Either LoadCachedTreeException CachedTree)
    loadCachedTree Tree
    tree
                           case Either LoadCachedTreeException CachedTree
    ecachedTree of
                             Left LoadCachedTreeException
    e ->
                               RIO env () -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (RIO env () -> ReaderT SqlBackend (RIO env) ())
    -> RIO env () -> ReaderT SqlBackend (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
    "Loading cached tree after download from Casa failed on " 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
    <> Utf8Builder
    ": " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
                                LoadCachedTreeException -> Utf8Builder
    forall a. Show a => a -> Utf8Builder
    displayShow LoadCachedTreeException
    e)
                             Right CachedTree
    cachedTree ->
                               ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    -> ReaderT SqlBackend (RIO env) ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
     -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> PackageIdentifier
    -> CachedTree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> PackageIdentifier
    -> CachedTree
    -> BuildFile
    -> ReaderT SqlBackend (RIO env) (TreeId, TreeKey)
    storeTree
                                 RawPackageLocationImmutable
    rawPackageLocationImmutable
                                 PackageIdentifier
    identifier
                                 CachedTree
    cachedTree
                                 BuildFile
    buildFile
                         Maybe BuildFile
    Nothing ->
                           Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn
                             (Utf8Builder
    "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

    -- | 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 :: forall env (f :: * -> *).
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     Foldable f) =>
    f PackageLocationImmutable -> RIO env ()
    fetchPackages f PackageLocationImmutable
    pls = do
      [RawPackageLocationImmutable] -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [RawPackageLocationImmutable] -> RIO env ()
    fetchTreeKeys ((PackageLocationImmutable -> RawPackageLocationImmutable)
    -> [PackageLocationImmutable] -> [RawPackageLocationImmutable]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PackageLocationImmutable -> RawPackageLocationImmutable
    toRawPLI (f PackageLocationImmutable -> [PackageLocationImmutable]
    forall a. f a -> [a]
    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 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 [a] -> [a]
    f) = [a] -> [a]
    f []
      (Endo [(PackageIdentifierRevision, Maybe TreeKey)]
    hackagesE, Endo [(Archive, PackageMetadata)]
    archivesE, 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 m a. Monoid m => (a -> m) -> f a -> m
    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 PackageIdentifier
    ident BlobKey
    cfHash 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 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 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 PackageName
    name Version
    ver) (BlobKey SHA256
    sha 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> RawPackageLocationImmutable -> RIO env ()
    unpackPackageLocationRaw Path Abs Dir
    fp 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 a b. RIO env a -> (a -> RIO env b) -> RIO env b
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Path Abs Dir -> PackageLocationImmutable -> RIO env ()
    unpackPackageLocation Path Abs Dir
    fp 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 a b. RIO env a -> (a -> RIO env b) -> RIO env b
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileImmutable 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
    $ Utf8Builder
    "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
      ([PWarning]
    _warnings, 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 PackageName
    name Version
    version) BlobKey
    _cfHash TreeKey
    mtree -> PackageMetadata
                { pmIdent :: PackageIdentifier
    pmIdent = PackageName -> Version -> PackageIdentifier
    PackageIdentifier PackageName
    name Version
    version
                , pmTreeKey :: TreeKey
    pmTreeKey = TreeKey
    mtree
                }
              PLIArchive Archive
    _ PackageMetadata
    pm' -> PackageMetadata
    pm'
              PLIRepo Repo
    _ 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 PackageName
    name 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 a. a -> RIO env a
    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 a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    gpd
     where
      withCache :: m GenericPackageDescription -> m GenericPackageDescription
    withCache 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
    Lens' s 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 GenericPackageDescription
    x -> GenericPackageDescription -> m GenericPackageDescription
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    x
          Maybe GenericPackageDescription
    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
    $ \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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileRawImmutable 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
    $ Utf8Builder
    "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
      ([PWarning]
    _warnings, 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 PackageName
    name Version
    version CabalFileInfo
    _cfi) Maybe TreeKey
    mtree -> 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 RawArchive
    _ RawPackageMetadata
    rpm' -> RawPackageMetadata
    rpm'
              RPLIRepo Repo
    _ 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 a. a -> RIO env a
    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 a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    gpd
     where
      withCache :: m GenericPackageDescription -> m GenericPackageDescription
    withCache 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
    Lens' s 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 GenericPackageDescription
    x -> GenericPackageDescription -> m GenericPackageDescription
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    x
          Maybe GenericPackageDescription
    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
    $ \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.8.0

    loadCabalFileRaw ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Maybe Text
         -- ^ The program name used by Hpack (the library), defaults to \"hpack\".

      -> RawPackageLocation
      -> RIO env GenericPackageDescription
    loadCabalFileRaw :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe Text
    -> RawPackageLocation -> RIO env GenericPackageDescription
    loadCabalFileRaw Maybe Text
    _ (RPLImmutable RawPackageLocationImmutable
    loc) = RawPackageLocationImmutable -> RIO env GenericPackageDescription
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileRawImmutable RawPackageLocationImmutable
    loc
    loadCabalFileRaw Maybe Text
    progName (RPLMutable ResolvedPath Dir
    rfp) = do
      (PrintWarnings -> IO GenericPackageDescription
    gpdio, PackageName
    _, Path Abs File
    _) <- Maybe Text
    -> Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe Text
    -> Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    loadCabalFilePath Maybe Text
    progName (ResolvedPath Dir -> Path Abs Dir
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath Dir
    rfp)
      IO GenericPackageDescription -> RIO env GenericPackageDescription
    forall a. IO a -> RIO env a
    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.8.0

    loadCabalFile ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Maybe Text
         -- ^ The program name used by Hpack (the library), defaults to \"hpack\".

      -> PackageLocation
      -> RIO env GenericPackageDescription
    loadCabalFile :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe Text -> PackageLocation -> RIO env GenericPackageDescription
    loadCabalFile Maybe Text
    _ (PLImmutable PackageLocationImmutable
    loc) = PackageLocationImmutable -> RIO env GenericPackageDescription
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env GenericPackageDescription
    loadCabalFileImmutable PackageLocationImmutable
    loc
    loadCabalFile Maybe Text
    progName (PLMutable ResolvedPath Dir
    rfp) = do
      (PrintWarnings -> IO GenericPackageDescription
    gpdio, PackageName
    _, Path Abs File
    _) <- Maybe Text
    -> Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe Text
    -> Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    loadCabalFilePath Maybe Text
    progName (ResolvedPath Dir -> Path Abs Dir
    forall t. ResolvedPath t -> Path Abs t
    resolvedAbsolute ResolvedPath Dir
    rfp)
      IO GenericPackageDescription -> RIO env GenericPackageDescription
    forall a. IO a -> RIO env a
    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.8.0

    loadCabalFilePath ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Maybe Text
         -- ^ The program name used by Hpack (the library), defaults to \"hpack\".

      -> Path Abs Dir -- ^ project directory, with a cabal file or hpack file

      -> RIO env
           ( PrintWarnings -> IO GenericPackageDescription
           , PackageName
           , Path Abs File
           )
    loadCabalFilePath :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe Text
    -> Path Abs Dir
    -> RIO
         env
         (PrintWarnings -> IO GenericPackageDescription, PackageName,
          Path Abs File)
    loadCabalFilePath Maybe Text
    progName 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
    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 (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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PrintWarnings -> IO GenericPackageDescription, PackageName,
     Path Abs File)
    triple
        Maybe
      (PrintWarnings -> IO GenericPackageDescription, PackageName,
       Path Abs File)
    Nothing -> do
          (PackageName
    name, Path Abs File
    cabalfp) <- Maybe Text -> Path Abs Dir -> RIO env (PackageName, Path Abs File)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe Text -> Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile Maybe Text
    progName 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
    $ \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 Path Abs File
    cabalfp IORef (Maybe ([PWarning], GenericPackageDescription))
    gpdRef 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
          ([PWarning]
    warnings0, GenericPackageDescription
    gpd) <-
            case Maybe ([PWarning], GenericPackageDescription)
    mpair of
              Just ([PWarning], GenericPackageDescription)
    pair -> ([PWarning], GenericPackageDescription)
    -> m ([PWarning], GenericPackageDescription)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PWarning], GenericPackageDescription)
    pair
              Maybe ([PWarning], GenericPackageDescription)
    Nothing -> do
                ByteString
    bs <- IO ByteString -> m ByteString
    forall a. IO a -> m a
    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
    $ String -> IO ByteString
    forall (m :: * -> *). MonadIO m => String -> m ByteString
    B.readFile (String -> IO ByteString) -> String -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    cabalfp
                ([PWarning]
    warnings0, 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 a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PWarning]
    warnings0, GenericPackageDescription
    gpd)
          [PWarning]
    warnings <-
            case PrintWarnings
    printWarnings of
              PrintWarnings
    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
    $> []
              PrintWarnings
    NoPrintWarnings -> [PWarning] -> m [PWarning]
    forall a. a -> m a
    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 a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GenericPackageDescription
    gpd

        toPretty :: Path Abs File -> PWarning -> Utf8Builder
        toPretty :: Path Abs File -> PWarning -> Utf8Builder
    toPretty Path Abs File
    src (PWarning PWarnType
    _type Position
    pos String
    msg) =
          Utf8Builder
    "Cabal file warning in " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
          String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    src) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "@" Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
          String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Position -> String
    showPos Position
    pos) Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    ": " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
          String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString String
    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 :: forall (m :: * -> *).
    MonadThrow m =>
    PackageName -> Path Abs File -> m ()
    checkCabalFileName PackageName
    name 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 :: String
    expected = Text -> String
    T.unpack (Text -> String) -> Text -> String
    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 (String
    expected String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Path Rel File -> String
    forall b t. Path b t -> String
    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 e a. Exception e => e -> m a
    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 file name 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.8.0

    findOrGenerateCabalFile ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Maybe Text
         -- ^ The program name used by Hpack (the library), defaults to \"hpack\".

      -> Path Abs Dir -- ^ package directory

      -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe Text -> Path Abs Dir -> RIO env (PackageName, Path Abs File)
    findOrGenerateCabalFile Maybe Text
    progName Path Abs Dir
    pkgDir = do
      let hpackProgName :: Maybe ProgramName
    hpackProgName = String -> ProgramName
    forall a. IsString a => String -> a
    fromString (String -> ProgramName) -> (Text -> String) -> Text -> ProgramName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    unpack (Text -> ProgramName) -> Maybe Text -> Maybe ProgramName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Text
    progName
      Maybe ProgramName -> Path Abs Dir -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe ProgramName -> Path Abs Dir -> RIO env ()
    hpack Maybe ProgramName
    hpackProgName Path Abs Dir
    pkgDir
      ([Path Abs Dir]
    _, [Path Abs File]
    allFiles) <- 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 RIO env ([Path Abs Dir], [Path Abs File])
    -> (IOException -> RIO env ([Path Abs Dir], [Path Abs File]))
    -> RIO env ([Path Abs Dir], [Path Abs File])
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    m a -> (IOException -> m a) -> m a
    `catchIO` \IOException
    e -> if IOException -> Bool
    isDoesNotExistError IOException
    e
        then PantryException -> RIO env ([Path Abs Dir], [Path Abs File])
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ([Path Abs Dir], [Path Abs File]))
    -> PantryException -> RIO env ([Path Abs Dir], [Path Abs File])
    forall a b. (a -> b) -> a -> b
    $ Path Abs Dir -> PantryException
    NoLocalPackageDirFound Path Abs Dir
    pkgDir
        else IOException -> RIO env ([Path Abs Dir], [Path Abs File])
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO IOException
    e
      let files :: [Path Abs File]
    files = (Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String -> String -> Bool) -> String -> String -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> String -> Bool
    hasExtension String
    "cabal" (String -> Bool)
    -> (Path Abs File -> String) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath) [Path Abs File]
    allFiles
      -- 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 :: String -> Bool
    isHidden (Char
    '.':String
    _) = Bool
    True
          isHidden String
    _ = 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
    . String -> Bool
    isHidden (String -> Bool)
    -> (Path Abs File -> String) -> Path Abs File -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path Rel File -> String
    forall b t. Path b t -> String
    toFilePath (Path Rel File -> String)
    -> (Path Abs File -> Path Rel File) -> Path Abs File -> String
    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
        [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)
          (\PackageName
    pn -> (PackageName, Path Abs File)
    -> RIO env (PackageName, Path Abs File)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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
    $
            String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    List.stripSuffix String
    ".cabal" (Path Rel File -> String
    forall b t. Path b t -> String
    toFilePath (Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename Path Abs File
    x)) Maybe String -> (String -> Maybe PackageName) -> Maybe PackageName
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            String -> Maybe PackageName
    parsePackageName
        Path Abs File
    _:[Path Abs File]
    _ -> 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 :: String -> String -> Bool
    hasExtension String
    fp String
    x = String -> String
    FilePath.takeExtension String
    fp String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x

    -- | Generate Cabal file from package.yaml, if necessary.

    hpack ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Maybe Hpack.ProgramName -- ^ The program name used by Hpack (the library).

      -> Path Abs Dir
      -> RIO env ()
    hpack :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Maybe ProgramName -> Path Abs Dir -> RIO env ()
    hpack Maybe ProgramName
    progName Path Abs Dir
    pkgDir = do
      Path Rel File
    packageConfigRelFile <- String -> RIO env (Path Rel File)
    forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
    parseRelFile String
    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
          mHpackProgName :: Options -> Options
    mHpackProgName = (Options -> Options)
    -> (ProgramName -> Options -> Options)
    -> Maybe ProgramName
    -> Options
    -> Options
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Options -> Options
    forall a. a -> a
    id ProgramName -> Options -> Options
    Hpack.setProgramName Maybe ProgramName
    progName
      Bool
    exists <- IO Bool -> RIO env Bool
    forall a. IO a -> RIO env a
    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
    $ Utf8Builder
    "Running Hpack on " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Abs File -> String
    forall b t. Path b t -> String
    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
    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
          HpackExecutable
    HpackBundled ->
                      IO (Either HpackError Result) -> RIO env (Either HpackError Result)
    forall a. IO a -> RIO env a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO
                         ( Options -> IO (Either HpackError Result)
    Hpack.hpackResultWithError
                         (Options -> IO (Either HpackError Result))
    -> Options -> IO (Either HpackError Result)
    forall a b. (a -> b) -> a -> b
    $ Options -> Options
    mHpackProgName
                         (Options -> Options) -> Options -> Options
    forall a b. (a -> b) -> a -> b
    $ (String -> IO (Either String ([String], Value)))
    -> Options -> Options
    Hpack.setDecode String -> IO (Either String ([String], Value))
    decodeYaml
                         (Options -> Options) -> Options -> Options
    forall a b. (a -> b) -> a -> b
    $ (String -> ParseException -> String) -> Options -> Options
    Hpack.setFormatYamlParseError String -> ParseException -> String
    formatYamlParseError
                         (Options -> Options) -> Options -> Options
    forall a b. (a -> b) -> a -> b
    $ String -> Options -> Options
    Hpack.setTarget
                             (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    hpackFile) Options
    Hpack.defaultOptions
                         )
                       RIO env (Either HpackError Result)
    -> (Either HpackError Result -> RIO env ()) -> RIO env ()
    forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
            Left HpackError
    err -> PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (Path Abs File -> String -> PantryException
    HpackLibraryException Path Abs File
    hpackFile (String -> PantryException) -> String -> PantryException
    forall a b. (a -> b) -> a -> b
    $ ProgramName -> HpackError -> String
    formatHpackError (ProgramName -> Maybe ProgramName -> ProgramName
    forall a. a -> Maybe a -> a
    fromMaybe ProgramName
    "hpack" Maybe ProgramName
    progName) HpackError
    err)
            Right Result
    r -> do
              [String] -> (String -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Result -> [String]
    Hpack.resultWarnings Result
    r) (Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ())
    -> (String -> Utf8Builder) -> String -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString)
              let cabalFile :: Utf8Builder
    cabalFile = String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (String -> Utf8Builder)
    -> (Result -> String) -> Result -> Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> String
    Hpack.resultCabalFile (Result -> Utf8Builder) -> Result -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ Result
    r
              case Result -> Status
    Hpack.resultStatus Result
    r of
                Status
    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
    $
                     Utf8Builder
    "Hpack generated a modified version of "
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    cabalFile
                Status
    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
    $ Utf8Builder
    "Hpack output unchanged in " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    cabalFile
                Status
    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
    <> Utf8Builder
    " was generated with a newer version of Hpack. Ignoring "
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    hpackFile)
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " in favor of the Cabal file.\n"
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "Either please upgrade and try again or, if you want to use the "
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Rel File -> String
    forall b t. Path b t -> String
    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
    <> Utf8Builder
    " file instead of the Cabal file,\n"
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "then please delete the Cabal file."
                Status
    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
    <> Utf8Builder
    " was modified manually. Ignoring "
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    hpackFile)
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " in favor of the Cabal file.\n"
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "If you want to use the "
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Rel File -> String
    forall b t. Path b t -> String
    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
    <> Utf8Builder
    " file instead of the Cabal file,\n"
                  Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "then please delete the Cabal file."
          HpackCommand String
    command -> RIO env () -> (SomeException -> RIO env ()) -> RIO env ()
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    m a -> (SomeException -> m a) -> m a
    catchAny
            ( String -> RIO env () -> RIO env ()
    forall env (m :: * -> *) a.
    (HasProcessContext env, MonadReader env m, MonadIO m) =>
    String -> m a -> m a
    withWorkingDir (Path Abs Dir -> String
    forall b t. Path b t -> String
    toFilePath Path Abs Dir
    pkgDir) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
              String
    -> [String] -> (ProcessConfig () () () -> RIO env ()) -> RIO env ()
    forall env (m :: * -> *) a.
    (HasProcessContext env, HasLogFunc env, MonadReader env m,
     MonadIO m, HasCallStack) =>
    String -> [String] -> (ProcessConfig () () () -> m a) -> m a
    proc String
    command [] ProcessConfig () () () -> RIO env ()
    forall (m :: * -> *) stdin stdout stderr.
    MonadIO m =>
    ProcessConfig stdin stdout stderr -> m ()
    runProcess_
            )
            ( PantryException -> RIO env ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> RIO env ())
    -> (SomeException -> PantryException)
    -> SomeException
    -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Path Abs Dir -> SomeException -> PantryException
    HpackExeException String
    command Path Abs Dir
    pkgDir)

    -- | 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env ByteString
    loadCabalFileBytes (PLIHackage PackageIdentifier
    pident BlobKey
    cfHash 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 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 PHpack
    pcHpack -> BlobKey -> RIO env BlobKey
    forall a. a -> RIO env a
    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 FileType
    _) -> BlobKey -> RIO env BlobKey
    forall a. a -> RIO env a
    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
        Maybe ByteString
    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 ByteString
    bs -> ByteString -> RIO env ByteString
    forall a. a -> RIO env a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env ByteString
    loadRawCabalFileBytes (RPLIHackage PackageIdentifierRevision
    pir Maybe TreeKey
    _mtree) = PackageIdentifierRevision -> RIO env ByteString
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    PackageIdentifierRevision -> RIO env ByteString
    getHackageCabalFile PackageIdentifierRevision
    pir

    loadRawCabalFileBytes 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 BlobKey
    cabalBlobKey FileType
    _ft = case Package -> PackageCabal
    packageCabalEntry Package
    package of
                                         PCCabalFile TreeEntry
    cabalTE -> TreeEntry
    cabalTE
                                         PCHpack 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
        Maybe ByteString
    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 ByteString
    bs -> ByteString -> RIO env ByteString
    forall a. a -> RIO env a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env Package
    loadPackageRaw RawPackageLocationImmutable
    rpli = do
      case RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey RawPackageLocationImmutable
    rpli of
        Just 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'
          RIO env Package
    -> (Package -> RIO env Package) -> Maybe Package -> RIO env Package
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe RIO env Package
    loadPackageRawViaThirdParty Package -> RIO env Package
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    mpackage
        Maybe TreeKey
    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 (Utf8Builder
    "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 PackageIdentifierRevision
    pir 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 RawArchive
    archive 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 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 :: forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaDbOrCasa RawPackageLocationImmutable
    rpli 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 -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder
    "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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Package -> Maybe Package
    forall a. a -> Maybe a
    Just Package
    package)
        Maybe Package
    Nothing -> do
          Maybe (CasaRepoPrefix, Int)
    mCasaConfig <- Getting
      (Maybe (CasaRepoPrefix, Int)) env (Maybe (CasaRepoPrefix, Int))
    -> RIO env (Maybe (CasaRepoPrefix, Int))
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting
       (Maybe (CasaRepoPrefix, Int)) env (Maybe (CasaRepoPrefix, Int))
     -> RIO env (Maybe (CasaRepoPrefix, Int)))
    -> Getting
         (Maybe (CasaRepoPrefix, Int)) env (Maybe (CasaRepoPrefix, Int))
    -> RIO env (Maybe (CasaRepoPrefix, Int))
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig -> Const (Maybe (CasaRepoPrefix, Int)) PantryConfig)
    -> env -> Const (Maybe (CasaRepoPrefix, Int)) env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' env PantryConfig
    pantryConfigL ((PantryConfig -> Const (Maybe (CasaRepoPrefix, Int)) PantryConfig)
     -> env -> Const (Maybe (CasaRepoPrefix, Int)) env)
    -> ((Maybe (CasaRepoPrefix, Int)
         -> Const
              (Maybe (CasaRepoPrefix, Int)) (Maybe (CasaRepoPrefix, Int)))
        -> PantryConfig
        -> Const (Maybe (CasaRepoPrefix, Int)) PantryConfig)
    -> Getting
         (Maybe (CasaRepoPrefix, Int)) env (Maybe (CasaRepoPrefix, Int))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PantryConfig -> Maybe (CasaRepoPrefix, Int))
    -> SimpleGetter PantryConfig (Maybe (CasaRepoPrefix, Int))
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig -> Maybe (CasaRepoPrefix, Int)
    pcCasaConfig
          case Maybe (CasaRepoPrefix, Int)
    mCasaConfig of
            Maybe (CasaRepoPrefix, Int)
    Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
            Just (CasaRepoPrefix, Int)
    _ -> 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 -> do
                  Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder
    "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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Package -> Maybe Package
    forall a. a -> Maybe a
    Just Package
    package)
                Maybe Package
    Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall a. a -> RIO env a
    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 :: forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaCasa RawPackageLocationImmutable
    rlpi 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
        Maybe (TreeKey, Tree)
    Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
        Just (TreeKey
    treeKey'', 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
            Maybe Package
    Nothing -> do
              Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn
                (Utf8Builder
    "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
    <>
                 Utf8Builder
    " (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
    <>
                 Utf8Builder
    ")")
              Maybe Package -> RIO env (Maybe Package)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
            Just Package
    package -> Maybe Package -> RIO env (Maybe Package)
    forall a. a -> RIO env a
    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 :: forall env.
    (HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
    RawPackageLocationImmutable -> TreeKey -> RIO env (Maybe Package)
    tryLoadPackageRawViaLocalDb RawPackageLocationImmutable
    rlpi 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
        Maybe (Entity Tree)
    Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Package
    forall a. Maybe a
    Nothing
        Just Entity Tree
    treeId ->
          (Package -> Maybe Package)
    -> RIO env Package -> RIO env (Maybe Package)
    forall a b. (a -> b) -> RIO env a -> RIO env b
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env CompletePackageLocation
    completePackageLocation (RPLIHackage (PackageIdentifierRevision PackageName
    n Version
    v (CFIHash SHA256
    sha (Just FileSize
    size))) (Just TreeKey
    tk)) =
      CompletePackageLocation -> RIO env CompletePackageLocation
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 PackageName
    name Version
    version CabalFileInfo
    cfi0) Maybe TreeKey
    _) = 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
    $ Utf8Builder
    "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
      (PackageIdentifierRevision
    pir, BlobKey
    cfKey) <-
        case CabalFileInfo
    cfi0 of
          CFIHash SHA256
    sha (Just FileSize
    size) -> (PackageIdentifierRevision, BlobKey)
    -> RIO env (PackageIdentifierRevision, BlobKey)
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageIdentifierRevision
    pir0, SHA256 -> FileSize -> BlobKey
    BlobKey SHA256
    sha FileSize
    size)
          CabalFileInfo
    _ -> 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
    $ Utf8Builder
    "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 a. a -> RIO env a
    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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 RawArchive
    archive RawPackageMetadata
    rpm) = do
      Maybe Package
    mpackage <-
        case RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    rpm of
          Just 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'
          Maybe TreeKey
    Nothing -> Maybe Package -> RIO env (Maybe Package)
    forall a. a -> RIO env a
    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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
    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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Package
    mpackage of
        Just (SHA256
    sha256, FileSize
    fileSize, Package
    package) -> do
          let RawArchive ArchiveLocation
    loc Maybe SHA256
    _ Maybe FileSize
    _ Text
    subdir = RawArchive
    archive
          CompletePackageLocation -> RIO env CompletePackageLocation
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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
            }
        Maybe (SHA256, FileSize, Package)
    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 Bool
    warnAboutMissingSizeSha = do
        (SHA256
    sha, FileSize
    size, Package
    package, CachedTree
    _cachedTree) <- RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive
    -> RawPackageMetadata
    -> RIO env (SHA256, FileSize, Package, CachedTree)
    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 ArchiveLocation
    loc Maybe SHA256
    _ Maybe FileSize
    _ 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
    $ String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (String -> Utf8Builder) -> String -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ (RawPackageLocationImmutable, SHA256, FileSize, Package) -> String
    forall a. Show a => a -> String
    show (RawPackageLocationImmutable
    pl, SHA256
    sha, FileSize
    size, Package
    package)
        CompletePackageLocation -> RIO env CompletePackageLocation
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 a
    sha 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
             [ Utf8Builder
    "The package "
             , RawPackageLocationImmutable -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display RawPackageLocationImmutable
    pl
             , Utf8Builder
    " is available from the local content-addressable storage database, \n"
             , Utf8Builder
    "but we can't use it unless you specify the size and hash for this package.\n"
             , Utf8Builder
    "Add the following to your package description:\n"
             , Utf8Builder
    "\nsize: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> a -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display a
    size
             , Utf8Builder
    "\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 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 Text
    t = Text -> Int
    T.length Text
    t Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo
    -> RawPackageLocationImmutable
    -> RawPackageMetadata
    -> RIO env CompletePackageLocation
    completePM Repo
    repo RawPackageLocationImmutable
    plOrig rpm :: RawPackageMetadata
    rpm@(RawPackageMetadata Maybe PackageName
    mn Maybe Version
    mv Maybe TreeKey
    mtk)
      | Just PackageName
    n <- Maybe PackageName
    mn, Just Version
    v <- Maybe Version
    mv, Just 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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 a
    x (Just a
    y) = a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    y
              isSame a
    _ Maybe a
    _ = 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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 = 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawSnapshotLocation -> RIO env SnapshotLocation
    completeSnapshotLocation (RSLCompiler WantedCompiler
    c) = SnapshotLocation -> RIO env SnapshotLocation
    forall a. a -> RIO env a
    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 ResolvedPath File
    f) = SnapshotLocation -> RIO env SnapshotLocation
    forall a. a -> RIO env a
    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 Text
    url (Just BlobKey
    blobKey)) = SnapshotLocation -> RIO env SnapshotLocation
    forall a. a -> RIO env a
    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 Text
    url Maybe BlobKey
    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 a. a -> RIO env a
    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)
    completeSnapshotLocation (RSLSynonym SnapName
    syn) =
      RawSnapshotLocation -> RIO env SnapshotLocation
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawSnapshotLocation -> RIO env SnapshotLocation
    completeSnapshotLocation (RawSnapshotLocation -> RIO env SnapshotLocation)
    -> RIO env RawSnapshotLocation -> RIO env SnapshotLocation
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< SnapName -> RIO env RawSnapshotLocation
    forall env.
    HasPantryConfig env =>
    SnapName -> RIO env RawSnapshotLocation
    snapshotLocation SnapName
    syn

    traverseConcurrently_ ::
         (Foldable f, HasPantryConfig env)
      => (a -> RIO env ()) -- ^ action to perform

      -> f a -- ^ input values

      -> RIO env ()
    traverseConcurrently_ :: forall (f :: * -> *) env a.
    (Foldable f, HasPantryConfig env) =>
    (a -> RIO env ()) -> f a -> RIO env ()
    traverseConcurrently_ a -> RIO env ()
    f 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
    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_ :: forall (m :: * -> *) (f :: * -> *) a.
    (MonadUnliftIO m, Foldable f) =>
    Int -> (a -> m ()) -> f a -> m ()
    traverseConcurrentlyWith_ Int
    count a -> m ()
    f 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 a. 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
    $ \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 a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (() -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
            (a
    x:[a]
    rest) -> do
              TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    queue [a]
    rest
              m () -> STM (m ())
    forall a. a -> STM a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawSnapshotLocation -> RIO env RawSnapshot
    loadSnapshotRaw 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 WantedCompiler
    wc ->
          RawSnapshot -> RIO env RawSnapshot
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 (RawSnapshotLayer
    rsl, CompletedSL
    _) -> 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
          (Map PackageName RawSnapshotPackage
    packages, 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)
              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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    SnapshotLocation -> RIO env RawSnapshot
    loadSnapshot 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 WantedCompiler
    wc ->
          RawSnapshot -> RIO env RawSnapshot
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 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
          (Map PackageName RawSnapshotPackage
    packages, 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)
              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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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. Debug output will include the raw snapshot

    -- layer.

    --

    -- @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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    SnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshot = Bool
    -> SnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Bool
    -> SnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshot' Bool
    True

    -- | As for 'loadAndCompleteSnapshot' but allows toggling of the debug output of

    -- the raw snapshot layer.

    --

    -- @since 0.5.7

    loadAndCompleteSnapshot' ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Bool -- ^ Debug output includes the raw snapshot layer

      -> SnapshotLocation
      -> Map RawSnapshotLocation SnapshotLocation
         -- ^ Cached snapshot locations from lock file

      -> Map RawPackageLocationImmutable PackageLocationImmutable
         -- ^ Cached locations from lock file

      -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshot' :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Bool
    -> SnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshot' Bool
    debugRSL SnapshotLocation
    loc =
      Bool
    -> RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Bool
    -> RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw' Bool
    debugRSL (SnapshotLocation -> RawSnapshotLocation
    toRawSL SnapshotLocation
    loc)

    -- | Parse a 'Snapshot' (all layers) from a 'RawSnapshotLocation' completing

    -- any incomplete package locations. Debug output will include the raw snapshot

    -- layer.

    --

    -- @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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw = Bool
    -> RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Bool
    -> RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw' Bool
    True

    -- | As for 'loadAndCompleteSnapshotRaw' but allows toggling of the debug output

    -- of the raw snapshot layer.

    --

    -- @since 0.5.7

    loadAndCompleteSnapshotRaw' ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Bool -- ^ Debug output includes the raw snapshot layer

      -> RawSnapshotLocation
      -> Map RawSnapshotLocation SnapshotLocation
         -- ^ Cached snapshot locations from lock file

      -> Map RawPackageLocationImmutable PackageLocationImmutable
         -- ^ Cached locations from lock file

      -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw' :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Bool
    -> RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw' Bool
    debugRSL RawSnapshotLocation
    rawLoc Map RawSnapshotLocation SnapshotLocation
    cacheSL 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 SnapshotLocation
    loc -> (RawSnapshotLayer -> (RawSnapshotLayer, CompletedSL))
    -> Either WantedCompiler RawSnapshotLayer
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    forall b c d. (b -> c) -> Either d b -> Either d c
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either d b) (Either d c)
    right (, 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
        Maybe SnapshotLocation
    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 WantedCompiler
    wc ->
          let snapshot :: Snapshot
    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 a. a -> RIO env a
    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 (RawSnapshotLayer
    rsl, CompletedSL
    sloc) -> do
          (Snapshot
    snap0, [CompletedSL]
    slocs, [CompletedPLI]
    completed0) <- Bool
    -> RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Bool
    -> RawSnapshotLocation
    -> Map RawSnapshotLocation SnapshotLocation
    -> Map RawPackageLocationImmutable PackageLocationImmutable
    -> RIO env (Snapshot, [CompletedSL], [CompletedPLI])
    loadAndCompleteSnapshotRaw' Bool
    debugRSL (RawSnapshotLayer -> RawSnapshotLocation
    rslParent RawSnapshotLayer
    rsl) Map RawSnapshotLocation SnapshotLocation
    cacheSL Map RawPackageLocationImmutable PackageLocationImmutable
    cachePL
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debugRSL (RIO env () -> RIO env ()) -> 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 ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (String -> Utf8Builder) -> String -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ RawSnapshotLayer -> String
    forall a. Show a => a -> String
    show RawSnapshotLayer
    rsl
          (Map PackageName SnapshotPackage
    packages, [CompletedPLI]
    completed, 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)
              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 = 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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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 <> :: SingleOrNot a -> SingleOrNot a -> SingleOrNot a
    <> Single 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 <> Multiple a
    b a
    c [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] -> [a]
    c <> Single 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] -> [a]
    c <> Multiple a
    d a
    e [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 :: forall k a. (k, SingleOrNot a) -> Either (k, a) (k, [a])
    sonToEither (k
    k, Single a
    a) = (k, a) -> Either (k, a) (k, [a])
    forall a b. a -> Either a b
    Left (k
    k, a
    a)
    sonToEither (k
    k, Multiple a
    a a
    b [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 :: forall env.
    HasLogFunc env =>
    Utf8Builder -> AddPackagesConfig -> RIO env ()
    warnUnusedAddPackagesConfig Utf8Builder
    source (AddPackagesConfig Set PackageName
    _drops Map PackageName (Map FlagName Bool)
    flags Map PackageName Bool
    hiddens Map PackageName [Text]
    options) = do
      Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Utf8Builder] -> Bool
    forall a. [a] -> 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
    $ Utf8Builder
    "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
    ")"
        (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
          (\PackageName
    pn ->
            Utf8Builder
    "Setting flags for nonexistent package: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
            String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (PackageName -> String
    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
          (\PackageName
    pn ->
            Utf8Builder
    "Hiding nonexistent package: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
            String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (PackageName -> String
    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
          (\PackageName
    pn ->
            Utf8Builder
    "Setting options for nonexistent package: " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <>
            String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (PackageName -> String
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Utf8Builder
    -> [RawPackageLocationImmutable]
    -> AddPackagesConfig
    -> Map PackageName RawSnapshotPackage
    -> RIO env (Map PackageName RawSnapshotPackage, AddPackagesConfig)
    addPackagesToSnapshot Utf8Builder
    source [RawPackageLocationImmutable]
    newPackages (AddPackagesConfig Set PackageName
    drops Map PackageName (Map FlagName Bool)
    flags Map PackageName Bool
    hiddens Map PackageName [Text]
    options) 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
    $ \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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PackageName
    name, 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 ([(PackageName, RawSnapshotPackage)]
    newSingles, [(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 b c a. (b -> c) -> (a, b) -> (a, c)
    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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(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 b c a. (b -> c) -> (a, b) -> (a, c)
    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
    $ \PackageName
    name 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 a. a -> RIO env a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Map RawPackageLocationImmutable PackageLocationImmutable
    -> RawPackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    cachedSnapshotCompletePackageLocation Map RawPackageLocationImmutable PackageLocationImmutable
    cachePackages 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
        Maybe PackageLocationImmutable
    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 a. a -> RIO env a
    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 PackageLocationImmutable
    x -> Maybe PackageLocationImmutable
    -> RIO env (Maybe PackageLocationImmutable)
    forall a. a -> RIO env a
    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 :: 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
    loc Map RawPackageLocationImmutable PackageLocationImmutable
    cachedPL [RawPackageLocationImmutable]
    newPackages (AddPackagesConfig Set PackageName
    drops Map PackageName (Map FlagName Bool)
    flags Map PackageName Bool
    hiddens Map PackageName [Text]
    options) 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> RawPackageLocationImmutable
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    addPackage ([(PackageName, SnapshotPackage)]
    ps, [CompletedPLI]
    completed) 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
              Maybe PackageLocationImmutable
    Nothing -> do
                RawPackageLocationImmutable -> RIO env ()
    forall env.
    HasLogFunc env =>
    RawPackageLocationImmutable -> RIO env ()
    warnMissingCabalFile RawPackageLocationImmutable
    rawLoc
                ([(PackageName, SnapshotPackage)], [CompletedPLI])
    -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([(PackageName, SnapshotPackage)]
    ps, [CompletedPLI]
    completed)
              Just PackageLocationImmutable
    complLoc -> do
                let PackageIdentifier PackageName
    name Version
    _ = PackageLocationImmutable -> PackageIdentifier
    packageLocationIdent PackageLocationImmutable
    complLoc
                    p :: (PackageName, SnapshotPackage)
    p = (PackageName
    name, 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 a. a -> RIO env a
    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')
      ([(PackageName, SnapshotPackage)]
    revNew, [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 ([(PackageName, SnapshotPackage)]
    newSingles, [(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 b c a. (b -> c) -> (a, b) -> (a, c)
    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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(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 b c a. (b -> c) -> (a, b) -> (a, c)
    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
    $ \PackageName
    name 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 a. a -> RIO env a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    loadRawSnapshotLayer (RSLCompiler WantedCompiler
    compiler) = Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall a. a -> RIO env a
    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 Text
    url 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 a. a -> RIO env a
    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 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 <- String -> RIO env Value
    forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
    Yaml.decodeFileThrow (String -> RIO env Value) -> String -> RIO env Value
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath (Path Abs File -> String) -> Path Abs File -> String
    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 a. a -> RIO env a
    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))
    loadRawSnapshotLayer rsl :: RawSnapshotLocation
    rsl@(RSLSynonym SnapName
    syn) = do
      RawSnapshotLocation
    loc <- SnapName -> RIO env RawSnapshotLocation
    forall env.
    HasPantryConfig env =>
    SnapName -> RIO env RawSnapshotLocation
    snapshotLocation SnapName
    syn
      Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    comp <- RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawSnapshotLocation
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    loadRawSnapshotLayer RawSnapshotLocation
    loc
      Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    -> RIO env (Either WantedCompiler (RawSnapshotLayer, CompletedSL))
    forall a. a -> RIO env a
    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
    $ case Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    comp of
        Left WantedCompiler
    wc -> WantedCompiler
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    forall a b. a -> Either a b
    Left WantedCompiler
    wc
        Right (RawSnapshotLayer
    l, CompletedSL RawSnapshotLocation
    _ SnapshotLocation
    n) -> (RawSnapshotLayer, CompletedSL)
    -> Either WantedCompiler (RawSnapshotLayer, CompletedSL)
    forall a b. b -> Either a b
    Right (RawSnapshotLayer
    l, RawSnapshotLocation -> SnapshotLocation -> CompletedSL
    CompletedSL RawSnapshotLocation
    rsl SnapshotLocation
    n)

    -- | 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    SnapshotLocation
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    loadSnapshotLayer (SLCompiler WantedCompiler
    compiler) = Either WantedCompiler RawSnapshotLayer
    -> RIO env (Either WantedCompiler RawSnapshotLayer)
    forall a. a -> RIO env a
    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 Text
    url 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 a. a -> RIO env a
    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 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 <- String -> RIO env Value
    forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
    Yaml.decodeFileThrow (String -> RIO env Value) -> String -> RIO env Value
    forall a b. (a -> b) -> a -> b
    $ Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath (Path Abs File -> String) -> Path Abs File -> String
    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 a. a -> RIO env a
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> Maybe BlobKey -> RIO env ByteString
    loadFromURL Text
    url Maybe BlobKey
    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 ByteString
    bs -> ByteString -> RIO env ByteString
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs
        Maybe ByteString
    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 Text
    url (Just 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 ByteString
    bs -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug Utf8Builder
    "Loaded snapshot from Pantry database."
          ByteString -> RIO env ByteString
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs
        Maybe ByteString
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> BlobKey -> RIO env ByteString
    loadUrlViaCasaOrWithCheck Text
    url 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 ByteString
    blob -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug
            (Utf8Builder
    "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
    <> Utf8Builder
    ") 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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    blob
        Maybe ByteString
    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 :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    Text -> Maybe BlobKey -> RIO env ByteString
    loadWithCheck Text
    url Maybe BlobKey
    mblobkey = do
      let (Maybe SHA256
    msha, Maybe FileSize
    msize) =
            case Maybe BlobKey
    mblobkey of
              Maybe BlobKey
    Nothing -> (Maybe SHA256
    forall a. Maybe a
    Nothing, Maybe FileSize
    forall a. Maybe a
    Nothing)
              Just (BlobKey SHA256
    sha FileSize
    size) -> (SHA256 -> Maybe SHA256
    forall a. a -> Maybe a
    Just SHA256
    sha, FileSize -> Maybe FileSize
    forall a. a -> Maybe a
    Just FileSize
    size)
      (SHA256
    _, FileSize
    _, [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 (Utf8Builder
    "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 a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    bs

    warningsParserHelperRaw ::
         HasLogFunc env
      => RawSnapshotLocation
      -> Value
      -> Maybe (Path Abs Dir)
      -> RIO env RawSnapshotLayer
    warningsParserHelperRaw :: forall env.
    HasLogFunc env =>
    RawSnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelperRaw RawSnapshotLocation
    rsl Value
    val Maybe (Path Abs Dir)
    mdir =
      case (Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer)))
    -> Value
    -> Either String (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a b. (a -> Parser b) -> a -> Either String b
    parseEither Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a. FromJSON a => Value -> Parser a
    Yaml.parseJSON Value
    val of
        Left String
    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 -> String -> PantryException
    Couldn'tParseSnapshot RawSnapshotLocation
    rsl String
    e
        Right (WithJSONWarnings Unresolved RawSnapshotLayer
    x [JSONWarning]
    ws) -> do
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([JSONWarning] -> Bool
    forall a. [a] -> 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
    $ Utf8Builder
    "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 :: forall env.
    HasLogFunc env =>
    SnapshotLocation
    -> Value -> Maybe (Path Abs Dir) -> RIO env RawSnapshotLayer
    warningsParserHelper SnapshotLocation
    sl Value
    val Maybe (Path Abs Dir)
    mdir =
      case (Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer)))
    -> Value
    -> Either String (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a b. (a -> Parser b) -> a -> Either String b
    parseEither Value -> Parser (WithJSONWarnings (Unresolved RawSnapshotLayer))
    forall a. FromJSON a => Value -> Parser a
    Yaml.parseJSON Value
    val of
        Left String
    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 -> String -> PantryException
    Couldn'tParseSnapshot (SnapshotLocation -> RawSnapshotLocation
    toRawSL SnapshotLocation
    sl) String
    e
        Right (WithJSONWarnings Unresolved RawSnapshotLayer
    x [JSONWarning]
    ws) -> do
          Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([JSONWarning] -> Bool
    forall a. [a] -> 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
    $ Utf8Builder
    "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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env PackageName
    getPackageLocationName = (PackageIdentifier -> PackageName)
    -> RIO env PackageIdentifier -> RIO env PackageName
    forall a b. (a -> b) -> RIO env a -> RIO env b
    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 PackageIdentifier
    ident BlobKey
    _ TreeKey
    _) = PackageIdentifier
    ident
    packageLocationIdent (PLIRepo Repo
    _ PackageMetadata
    pm) = PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm
    packageLocationIdent (PLIArchive Archive
    _ 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 PackageIdentifier
    pident BlobKey
    _ TreeKey
    _) = PackageIdentifier -> Version
    pkgVersion PackageIdentifier
    pident
    packageLocationVersion (PLIRepo Repo
    _ PackageMetadata
    pm) = PackageIdentifier -> Version
    pkgVersion (PackageMetadata -> PackageIdentifier
    pmIdent PackageMetadata
    pm)
    packageLocationVersion (PLIArchive Archive
    _ 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env PackageIdentifier
    getRawPackageLocationIdent (RPLIHackage (PackageIdentifierRevision PackageName
    name Version
    version CabalFileInfo
    _) Maybe TreeKey
    _) =
      PackageIdentifier -> RIO env PackageIdentifier
    forall a. a -> RIO env a
    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 Repo
    _ RawPackageMetadata { rpmName :: RawPackageMetadata -> Maybe PackageName
    rpmName = Just PackageName
    name, rpmVersion :: RawPackageMetadata -> Maybe Version
    rpmVersion = Just Version
    version }) =
      PackageIdentifier -> RIO env PackageIdentifier
    forall a. a -> RIO env a
    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 RawArchive
    _ RawPackageMetadata { rpmName :: RawPackageMetadata -> Maybe PackageName
    rpmName = Just PackageName
    name, rpmVersion :: RawPackageMetadata -> Maybe Version
    rpmVersion = Just Version
    version }) =
      PackageIdentifier -> RIO env PackageIdentifier
    forall a. a -> RIO env a
    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 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable -> RIO env TreeKey
    getRawPackageLocationTreeKey RawPackageLocationImmutable
    pl =
      case RawPackageLocationImmutable -> Maybe TreeKey
    getRawTreeKey RawPackageLocationImmutable
    pl of
        Just TreeKey
    treeKey' -> TreeKey -> RIO env TreeKey
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TreeKey
    treeKey'
        Maybe TreeKey
    Nothing ->
          case RawPackageLocationImmutable
    pl of
            RPLIHackage PackageIdentifierRevision
    pir Maybe TreeKey
    _ -> PackageIdentifierRevision -> RIO env TreeKey
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageIdentifierRevision -> RIO env TreeKey
    getHackageTarballKey PackageIdentifierRevision
    pir
            RPLIArchive RawArchive
    archive 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 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 :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    PackageLocationImmutable -> RIO env TreeKey
    getPackageLocationTreeKey PackageLocationImmutable
    pl = TreeKey -> RIO env TreeKey
    forall a. a -> RIO env a
    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 PackageIdentifierRevision
    _ Maybe TreeKey
    mtree) = Maybe TreeKey
    mtree
    getRawTreeKey (RPLIArchive RawArchive
    _ RawPackageMetadata
    rpm) = RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    rpm
    getRawTreeKey (RPLIRepo Repo
    _ RawPackageMetadata
    rpm) = RawPackageMetadata -> Maybe TreeKey
    rpmTreeKey RawPackageMetadata
    rpm

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

    -- | Convenient data type that allows you to work with pantry more easily than

    -- using 'withPantryConfig' or '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 :: Lens' PantryApp SimpleApp
    simpleAppL = (PantryApp -> SimpleApp)
    -> (PantryApp -> SimpleApp -> PantryApp)
    -> Lens' PantryApp SimpleApp
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens PantryApp -> SimpleApp
    paSimpleApp (\PantryApp
    x 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 :: Lens' PantryConfig HpackExecutable
    hpackExecutableL HpackExecutable -> f HpackExecutable
    k PantryConfig
    pconfig =
      (HpackExecutable -> PantryConfig)
    -> f HpackExecutable -> f PantryConfig
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\HpackExecutable
    hpExe -> PantryConfig
    pconfig { pcHpackExecutable :: HpackExecutable
    pcHpackExecutable = HpackExecutable
    hpExe }) (HpackExecutable -> f HpackExecutable
    k (PantryConfig -> HpackExecutable
    pcHpackExecutable PantryConfig
    pconfig))

    instance HasLogFunc PantryApp where
      logFuncL :: Lens' PantryApp LogFunc
    logFuncL = (SimpleApp -> f SimpleApp) -> PantryApp -> f PantryApp
    Lens' PantryApp 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
    Lens' SimpleApp LogFunc
    logFuncL

    instance HasPantryConfig PantryApp where
      pantryConfigL :: Lens' PantryApp PantryConfig
    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 (\PantryApp
    x PantryConfig
    y -> PantryApp
    x { paPantryConfig :: PantryConfig
    paPantryConfig = PantryConfig
    y })

    instance HasProcessContext PantryApp where
      processContextL :: Lens' PantryApp ProcessContext
    processContextL = (SimpleApp -> f SimpleApp) -> PantryApp -> f PantryApp
    Lens' PantryApp 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
    Lens' SimpleApp ProcessContext
    processContextL

    instance HasStylesUpdate PantryApp where
      stylesUpdateL :: Lens' PantryApp StylesUpdate
    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 (\PantryApp
    x StylesUpdate
    y -> PantryApp
    x { paStylesUpdate :: StylesUpdate
    paStylesUpdate = StylesUpdate
    y })

    instance HasTerm PantryApp where
      useColorL :: Lens' PantryApp Bool
    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 (\PantryApp
    x Bool
    y -> PantryApp
    x { paUseColor :: Bool
    paUseColor = Bool
    y })
      termWidthL :: Lens' PantryApp Int
    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  (\PantryApp
    x 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 :: forall (m :: * -> *) a. MonadIO m => 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 Int
    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 :: forall (m :: * -> *) a.
    MonadIO m =>
    Int -> CasaRepoPrefix -> Int -> RIO PantryApp a -> m a
    runPantryAppWith Int
    maxConnCount CasaRepoPrefix
    casaRepoPrefix Int
    casaMaxPerRequest 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
      String
    stack <- String -> RIO SimpleApp String
    forall (m :: * -> *). MonadIO m => String -> m String
    getAppUserDataDirectory String
    "stack"
      Path Abs Dir
    root <- String -> RIO SimpleApp (Path Abs Dir)
    forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
    parseAbsDir (String -> RIO SimpleApp (Path Abs Dir))
    -> String -> RIO SimpleApp (Path Abs Dir)
    forall a b. (a -> b) -> a -> b
    $ String
    stack String -> String -> String
    FilePath.</> String
    "pantry"
      Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> Maybe (CasaRepoPrefix, Int)
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO SimpleApp a)
    -> RIO SimpleApp a
    forall env a.
    HasLogFunc env =>
    Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> Maybe (CasaRepoPrefix, Int)
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig'
        Path Abs Dir
    root
        PackageIndexConfig
    defaultPackageIndexConfig
        HpackExecutable
    HpackBundled
        Int
    maxConnCount
        ((CasaRepoPrefix, Int) -> Maybe (CasaRepoPrefix, Int)
    forall a. a -> Maybe a
    Just (CasaRepoPrefix
    casaRepoPrefix, Int
    casaMaxPerRequest))
        SnapName -> RawSnapshotLocation
    defaultSnapshotLocation
        ((PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a)
    -> (PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a
    forall a b. (a -> b) -> a -> b
    $ \PantryConfig
    pc ->
          PantryApp -> RIO PantryApp a -> RIO SimpleApp a
    forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
    runRIO
            PantryApp
              { paSimpleApp :: SimpleApp
    paSimpleApp = SimpleApp
    sa
              , paPantryConfig :: PantryConfig
    paPantryConfig = PantryConfig
    pc
              , paTermWidth :: Int
    paTermWidth = Int
    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 :: forall (m :: * -> *) a. MonadIO m => RIO PantryApp a -> m a
    runPantryAppClean RIO PantryApp a
    f =
      IO a -> m a
    forall a. 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
    $ String -> (String -> IO a) -> IO a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    String -> (String -> m a) -> m a
    withSystemTempDirectory String
    "pantry-clean" ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \String
    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 <- String -> RIO SimpleApp (Path Abs Dir)
    forall (m :: * -> *). MonadIO m => String -> m (Path Abs Dir)
    resolveDir' String
    dir
        Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> Maybe (CasaRepoPrefix, Int)
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO SimpleApp a)
    -> RIO SimpleApp a
    forall env a.
    HasLogFunc env =>
    Path Abs Dir
    -> PackageIndexConfig
    -> HpackExecutable
    -> Int
    -> Maybe (CasaRepoPrefix, Int)
    -> (SnapName -> RawSnapshotLocation)
    -> (PantryConfig -> RIO env a)
    -> RIO env a
    withPantryConfig'
          Path Abs Dir
    root
          PackageIndexConfig
    defaultPackageIndexConfig
          HpackExecutable
    HpackBundled
          Int
    8
          ((CasaRepoPrefix, Int) -> Maybe (CasaRepoPrefix, Int)
    forall a. a -> Maybe a
    Just (CasaRepoPrefix
    defaultCasaRepoPrefix, Int
    defaultCasaMaxPerRequest))
          SnapName -> RawSnapshotLocation
    defaultSnapshotLocation
          ((PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a)
    -> (PantryConfig -> RIO SimpleApp a) -> RIO SimpleApp a
    forall a b. (a -> b) -> a -> b
    $ \PantryConfig
    pc ->
            PantryApp -> RIO PantryApp a -> RIO SimpleApp a
    forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
    runRIO
              PantryApp
                { paSimpleApp :: SimpleApp
    paSimpleApp = SimpleApp
    sa
                , paPantryConfig :: PantryConfig
    paPantryConfig = PantryConfig
    pc
                , paTermWidth :: Int
    paTermWidth = Int
    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 :: forall env.
    (HasTerm env, HasPantryConfig env) =>
    WantedCompiler -> RIO env (Maybe (Map PackageName Version))
    loadGlobalHints 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 Bool
    alreadyDownloaded = do
        Path Abs File
    dest <- RIO env (Path Abs File)
    forall env. HasPantryConfig env => RIO env (Path Abs File)
    getGlobalHintsFile
        Request
    req <- String -> RIO env Request
    forall (m :: * -> *). MonadThrow m => String -> m Request
    parseRequest String
    "https://raw.githubusercontent.com/commercialhaskell/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 SomeException
    e -> Maybe (Map a b)
    forall a. Maybe a
    Nothing Maybe (Map a b) -> RIO env () -> RIO env (Maybe (Map a b))
    forall a b. a -> RIO env b -> RIO env a
    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
                                   ( Utf8Builder
    "Error: [S-912]\n"
                                     Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "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 Maybe (Map a b)
    x -> Maybe (Map a b) -> RIO env (Maybe (Map a b))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Map a b)
    x
        case Maybe (Map a b)
    mres of
          Maybe (Map a b)
    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
    $
              Utf8Builder
    "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
    <>
              Utf8Builder
    ", 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 Utf8Builder
    "Redownload didn't happen"
                Maybe (Map a b) -> RIO env (Maybe (Map a b))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Map a b)
    forall a. Maybe a
    Nothing
          Maybe (Map a b)
    _ -> Maybe (Map a b) -> RIO env (Maybe (Map a b))
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Map a b)
    mres

      inner2 :: Path b t -> m (Maybe (Map a b))
    inner2 Path b t
    dest = IO (Maybe (Map a b)) -> m (Maybe (Map a b))
    forall a. IO a -> m a
    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 a b.
    (a -> b) -> Map WantedCompiler a -> Map WantedCompiler 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 a b. (a -> b) -> Map a a -> 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
    <$> String
    -> IO (Map WantedCompiler (Map (CabalString a) (CabalString b)))
    forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
    Yaml.decodeFileThrow (Path b t -> String
    forall b t. Path b t -> String
    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 :: forall id a.
    Ord id =>
    Map PackageName a
    -> (a -> PackageName)
    -> (a -> id)
    -> (a -> [id])
    -> Set PackageName
    -> (Map PackageName [PackageName], Map PackageName a)
    partitionReplacedDependencies Map PackageName a
    globals a -> PackageName
    getName a -> id
    getId a -> [id]
    getDeps 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 b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& 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 :: 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
    pname, a
    a)  = do
      (Map PackageName [PackageName]
    pruned, 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 a.
    a
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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 a.
    a
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 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
    $ \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 a.
    a
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity a
    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 a. [a] -> 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 b c a. (b -> c) -> (a, b) -> (a, c)
    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 a b c. (a -> b) -> (a, c) -> (b, c)
    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 a.
    a
    -> StateT
         (Map PackageName [PackageName], Map PackageName a) Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (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 a. [a] -> 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 :: forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    SnapshotCacheHash
    -> RIO env (Map PackageName (Set ModuleName))
    -> ((ModuleName -> RIO env [PackageName]) -> RIO env a)
    -> RIO env a
    withSnapshotCache SnapshotCacheHash
    hash RIO env (Map PackageName (Set ModuleName))
    getModuleMapping (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
        Maybe SnapshotCacheId
    Nothing -> do
          Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn Utf8Builder
    "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 a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SnapshotCacheId
    scId
        Just SnapshotCacheId
    scId -> SnapshotCacheId -> RIO env SnapshotCacheId
    forall a. a -> RIO env a
    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 Int
    n 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 -> 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
    == Int
    1
           then Utf8Builder
    ""
           else Utf8Builder
    "s")