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

    module Pantry.Repo
      ( fetchReposRaw
      , fetchRepos
      , getRepo
      , getRepoKey
      , createRepoArchive
      , withRepoArchive
      , withRepo
      ) where

    import           Database.Persist.Class.PersistEntity ( Entity (..) )
    import           Pantry.Archive ( getArchivePackage )
    import           Pantry.Storage
                       ( getTreeForKey, loadPackageById, loadRepoCache
                       , storeRepoCache, withStorage
                       )
    import           Pantry.Types
                       ( AggregateRepo (..), ArchiveLocation (..), HasPantryConfig
                       , Package (..), PackageMetadata (..), PantryException (..)
                       , RawArchive (..), RawPackageLocationImmutable (..)
                       , RawPackageMetadata (..), RelFilePath (..), Repo (..)
                       , RepoType (..), ResolvedPath (..), SimpleRepo (..)
                       , TreeKey (..), arToSimpleRepo, rToSimpleRepo
                       , toAggregateRepos, toRawPM
                       )
    import           Path.IO ( resolveFile' )
    import           RIO
    import           RIO.ByteString ( isInfixOf )
    import           RIO.ByteString.Lazy ( toStrict )
    import           RIO.Directory ( doesDirectoryExist )
    import           RIO.FilePath ( (</>) )
    import qualified RIO.Map as Map
    import           RIO.Process
                       ( ExitCodeException (..), HasProcessContext, proc
                       , readProcess, readProcess_, withModifyEnvVars
                       , withWorkingDir
                       )
    import qualified RIO.Text as T
    #if MIN_VERSION_ansi_terminal(1, 0, 2)
    import           System.Console.ANSI ( hNowSupportsANSI )
    #else
    import           System.Console.ANSI ( hSupportsANSIWithoutEmulation )
    #endif
    import           System.IsWindows ( osIsWindows )

    data TarType = Gnu | Bsd

    getGitTarType :: (HasProcessContext env, HasLogFunc env) => RIO env TarType
    getGitTarType :: forall env.
    (HasProcessContext env, HasLogFunc env) =>
    RIO env TarType
    getGitTarType = if Bool
    osIsWindows
      then do
        (ExitCode
    _, ByteString
    stdoutBS, ByteString
    _) <- FilePath
    -> [FilePath]
    -> (ProcessConfig () () ()
        -> RIO env (ExitCode, ByteString, ByteString))
    -> RIO env (ExitCode, ByteString, ByteString)
    forall env (m :: * -> *) a.
    (HasProcessContext env, HasLogFunc env, MonadReader env m,
     MonadIO m, HasCallStack) =>
    FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
    proc FilePath
    "git" [FilePath
    "--version"] ProcessConfig () () ()
    -> RIO env (ExitCode, ByteString, ByteString)
    forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
    MonadIO m =>
    ProcessConfig stdin stdoutIgnored stderrIgnored
    -> m (ExitCode, ByteString, ByteString)
    readProcess
        let bs :: ByteString
    bs = ByteString -> ByteString
    toStrict ByteString
    stdoutBS
        -- If using Git for Windows, then assume that the tar type within

        -- `git submodule foreach <command>` is the Git-supplied\MSYS2-supplied

        -- GNU tar

        if ByteString
    "windows" ByteString -> ByteString -> Bool
    `isInfixOf` ByteString
    bs then TarType -> RIO env TarType
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TarType
    Gnu else RIO env TarType
    forall env.
    (HasProcessContext env, HasLogFunc env) =>
    RIO env TarType
    getTarType
      else RIO env TarType
    forall env.
    (HasProcessContext env, HasLogFunc env) =>
    RIO env TarType
    getTarType

    getTarType :: (HasProcessContext env, HasLogFunc env) => RIO env TarType
    getTarType :: forall env.
    (HasProcessContext env, HasLogFunc env) =>
    RIO env TarType
    getTarType = do
      (ExitCode
    _, ByteString
    stdoutBS, ByteString
    _) <- FilePath
    -> [FilePath]
    -> (ProcessConfig () () ()
        -> RIO env (ExitCode, ByteString, ByteString))
    -> RIO env (ExitCode, ByteString, ByteString)
    forall env (m :: * -> *) a.
    (HasProcessContext env, HasLogFunc env, MonadReader env m,
     MonadIO m, HasCallStack) =>
    FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
    proc FilePath
    "tar" [FilePath
    "--version"] ProcessConfig () () ()
    -> RIO env (ExitCode, ByteString, ByteString)
    forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
    MonadIO m =>
    ProcessConfig stdin stdoutIgnored stderrIgnored
    -> m (ExitCode, ByteString, ByteString)
    readProcess
      let bs :: ByteString
    bs = ByteString -> ByteString
    toStrict ByteString
    stdoutBS
      TarType -> RIO env TarType
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TarType -> RIO env TarType) -> TarType -> RIO env TarType
    forall a b. (a -> b) -> a -> b
    $ if ByteString
    "GNU" ByteString -> ByteString -> Bool
    `isInfixOf` ByteString
    bs then TarType
    Gnu else TarType
    Bsd

    -- | Like 'fetchRepos', except with 'RawPackageMetadata' instead of

    -- 'PackageMetadata'.

    --

    -- @since 0.5.3

    fetchReposRaw ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => [(Repo, RawPackageMetadata)]
      -> RIO env ()
    fetchReposRaw :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(Repo, RawPackageMetadata)] -> RIO env ()
    fetchReposRaw [(Repo, RawPackageMetadata)]
    pairs = do
      let repos :: [AggregateRepo]
    repos = [(Repo, RawPackageMetadata)] -> [AggregateRepo]
    toAggregateRepos [(Repo, RawPackageMetadata)]
    pairs
      Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug ([AggregateRepo] -> Utf8Builder
    forall a. Show a => a -> Utf8Builder
    displayShow [AggregateRepo]
    repos)
      [AggregateRepo]
    -> (AggregateRepo -> RIO env [Package]) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [AggregateRepo]
    repos AggregateRepo -> RIO env [Package]
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    AggregateRepo -> RIO env [Package]
    getRepos

    -- | Fetch the given repositories at once and populate the pantry database.

    --

    -- @since 0.5.3

    fetchRepos ::
         (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => [(Repo, PackageMetadata)]
      -> RIO env ()
    fetchRepos :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(Repo, PackageMetadata)] -> RIO env ()
    fetchRepos [(Repo, PackageMetadata)]
    pairs = do
      -- TODO be more efficient, group together shared archives

      [(Repo, RawPackageMetadata)] -> RIO env ()
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    [(Repo, RawPackageMetadata)] -> RIO env ()
    fetchReposRaw ([(Repo, RawPackageMetadata)] -> RIO env ())
    -> [(Repo, RawPackageMetadata)] -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ ((Repo, PackageMetadata) -> (Repo, RawPackageMetadata))
    -> [(Repo, PackageMetadata)] -> [(Repo, RawPackageMetadata)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((PackageMetadata -> RawPackageMetadata)
    -> (Repo, PackageMetadata) -> (Repo, RawPackageMetadata)
    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 PackageMetadata -> RawPackageMetadata
    toRawPM) [(Repo, PackageMetadata)]
    pairs

    getRepoKey ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Repo
      -> RawPackageMetadata
      -> RIO env TreeKey
    getRepoKey :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env TreeKey
    getRepoKey Repo
    repo RawPackageMetadata
    rpm = Package -> TreeKey
    packageTreeKey (Package -> TreeKey) -> RIO env Package -> RIO env TreeKey
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Repo -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env Package
    getRepo Repo
    repo RawPackageMetadata
    rpm -- potential optimization

    getRepo ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Repo
      -> RawPackageMetadata
      -> RIO env Package
    getRepo :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env Package
    getRepo Repo
    repo RawPackageMetadata
    pm = do
      RIO env Package -> RIO env Package
    withCache (RIO env Package -> RIO env Package)
    -> RIO env Package -> RIO env Package
    forall a b. (a -> b) -> a -> b
    $ Repo -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env Package
    getRepo' Repo
    repo RawPackageMetadata
    pm
     where
      withCache :: RIO env Package -> RIO env Package
      withCache :: RIO env Package -> RIO env Package
    withCache RIO env Package
    inner = do
        Maybe TreeId
    mtid <- ReaderT SqlBackend (RIO env) (Maybe TreeId)
    -> RIO env (Maybe TreeId)
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (Repo -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    forall env. Repo -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    loadRepoCache Repo
    repo)
        case Maybe TreeId
    mtid of
          Just TreeId
    tid -> ReaderT SqlBackend (RIO env) Package -> RIO env Package
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) Package -> RIO env Package)
    -> ReaderT SqlBackend (RIO env) Package -> RIO env Package
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    loadPackageById (Repo -> RawPackageMetadata -> RawPackageLocationImmutable
    RPLIRepo Repo
    repo RawPackageMetadata
    pm) TreeId
    tid
          Maybe TreeId
    Nothing -> do
            Package
    package <- RIO env Package
    inner
            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
              Maybe (Entity Tree)
    ment <- TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey (TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)))
    -> TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall a b. (a -> b) -> a -> b
    $ Package -> TreeKey
    packageTreeKey Package
    package
              case Maybe (Entity Tree)
    ment of
                Maybe (Entity Tree)
    Nothing ->  FilePath -> ReaderT SqlBackend (RIO env) ()
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> ReaderT SqlBackend (RIO env) ())
    -> FilePath -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $
                    FilePath
    "invariant violated, Tree not found: "
                  FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ TreeKey -> FilePath
    forall a. Show a => a -> FilePath
    show (Package -> TreeKey
    packageTreeKey Package
    package)
                Just (Entity TreeId
    tid Tree
    _) -> Repo -> Text -> TreeId -> ReaderT SqlBackend (RIO env) ()
    forall env.
    Repo -> Text -> TreeId -> ReaderT SqlBackend (RIO env) ()
    storeRepoCache Repo
    repo (Repo -> Text
    repoSubdir Repo
    repo) TreeId
    tid
            Package -> RIO env Package
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Package
    package

    getRepo' ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => Repo
      -> RawPackageMetadata
      -> RIO env Package
    getRepo' :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env Package
    getRepo' repo :: Repo
    repo@Repo{Text
    RepoType
    repoSubdir :: Repo -> Text
    repoUrl :: Text
    repoCommit :: Text
    repoType :: RepoType
    repoSubdir :: Text
    repoUrl :: Repo -> Text
    repoCommit :: Repo -> Text
    repoType :: Repo -> RepoType
    ..} RawPackageMetadata
    rpm = do
      SimpleRepo -> (FilePath -> RIO env Package) -> RIO env Package
    forall env a.
    (HasLogFunc env, HasProcessContext env) =>
    SimpleRepo -> (FilePath -> RIO env a) -> RIO env a
    withRepoArchive (Repo -> SimpleRepo
    rToSimpleRepo Repo
    repo) ((FilePath -> RIO env Package) -> RIO env Package)
    -> (FilePath -> RIO env Package) -> RIO env Package
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    tarball -> do
        Path Abs File
    abs' <- FilePath -> RIO env (Path Abs File)
    forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
    resolveFile' FilePath
    tarball
        RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    getArchivePackage
          (Repo -> RawPackageMetadata -> RawPackageLocationImmutable
    RPLIRepo Repo
    repo RawPackageMetadata
    rpm)
          RawArchive
            { raLocation :: ArchiveLocation
    raLocation = ResolvedPath File -> ArchiveLocation
    ALFilePath (ResolvedPath File -> ArchiveLocation)
    -> ResolvedPath File -> ArchiveLocation
    forall a b. (a -> b) -> a -> b
    $ ResolvedPath
                { resolvedRelative :: RelFilePath
    resolvedRelative = Text -> RelFilePath
    RelFilePath (Text -> RelFilePath) -> Text -> RelFilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack FilePath
    tarball
                , resolvedAbsolute :: Path Abs File
    resolvedAbsolute = Path Abs File
    abs'
                }
            , raHash :: Maybe SHA256
    raHash = Maybe SHA256
    forall a. Maybe a
    Nothing
            , raSize :: Maybe FileSize
    raSize = Maybe FileSize
    forall a. Maybe a
    Nothing
            , raSubdir :: Text
    raSubdir = Text
    repoSubdir
            }
          RawPackageMetadata
    rpm

    getRepos ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => AggregateRepo
      -> RIO env [Package]
    getRepos :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    AggregateRepo -> RIO env [Package]
    getRepos repo :: AggregateRepo
    repo@(AggregateRepo (SimpleRepo{Text
    RepoType
    sRepoUrl :: Text
    sRepoCommit :: Text
    sRepoType :: RepoType
    sRepoUrl :: SimpleRepo -> Text
    sRepoCommit :: SimpleRepo -> Text
    sRepoType :: SimpleRepo -> RepoType
    ..}) [(Text, RawPackageMetadata)]
    repoSubdirs) = (AggregateRepo -> RIO env [(Package, Text)]) -> RIO env [Package]
    forall {env}.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    (AggregateRepo -> RIO env [(Package, Text)]) -> RIO env [Package]
    withCache AggregateRepo -> RIO env [(Package, Text)]
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    AggregateRepo -> RIO env [(Package, Text)]
    getRepos'
     where
      withCache :: (AggregateRepo -> RIO env [(Package, Text)]) -> RIO env [Package]
    withCache AggregateRepo -> RIO env [(Package, Text)]
    inner = do
        [Either (Text, RawPackageMetadata) (Package, Text)]
    pkgs <- [(Text, RawPackageMetadata)]
    -> ((Text, RawPackageMetadata)
        -> RIO env (Either (Text, RawPackageMetadata) (Package, Text)))
    -> RIO env [Either (Text, RawPackageMetadata) (Package, Text)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Text, RawPackageMetadata)]
    repoSubdirs (((Text, RawPackageMetadata)
      -> RIO env (Either (Text, RawPackageMetadata) (Package, Text)))
     -> RIO env [Either (Text, RawPackageMetadata) (Package, Text)])
    -> ((Text, RawPackageMetadata)
        -> RIO env (Either (Text, RawPackageMetadata) (Package, Text)))
    -> RIO env [Either (Text, RawPackageMetadata) (Package, Text)]
    forall a b. (a -> b) -> a -> b
    $ \(Text
    subdir, RawPackageMetadata
    rpm) -> ReaderT
      SqlBackend
      (RIO env)
      (Either (Text, RawPackageMetadata) (Package, Text))
    -> RIO env (Either (Text, RawPackageMetadata) (Package, Text))
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT
       SqlBackend
       (RIO env)
       (Either (Text, RawPackageMetadata) (Package, Text))
     -> RIO env (Either (Text, RawPackageMetadata) (Package, Text)))
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Text, RawPackageMetadata) (Package, Text))
    -> RIO env (Either (Text, RawPackageMetadata) (Package, Text))
    forall a b. (a -> b) -> a -> b
    $ do
          Repo -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    forall env. Repo -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    loadRepoCache (Text -> Text -> RepoType -> Text -> Repo
    Repo Text
    sRepoUrl Text
    sRepoCommit RepoType
    sRepoType Text
    subdir) ReaderT SqlBackend (RIO env) (Maybe TreeId)
    -> (Maybe TreeId
        -> ReaderT
             SqlBackend
             (RIO env)
             (Either (Text, RawPackageMetadata) (Package, Text)))
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Text, RawPackageMetadata) (Package, Text))
    forall a b.
    ReaderT SqlBackend (RIO env) a
    -> (a -> ReaderT SqlBackend (RIO env) b)
    -> ReaderT SqlBackend (RIO env) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Just TreeId
    tid ->
              ((Package, Text)
     -> Either (Text, RawPackageMetadata) (Package, Text))
    -> ReaderT SqlBackend (RIO env) (Package, Text)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Text, RawPackageMetadata) (Package, Text))
    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 (Package, Text)
    -> Either (Text, RawPackageMetadata) (Package, Text)
    forall a b. b -> Either a b
    Right (ReaderT SqlBackend (RIO env) (Package, Text)
     -> ReaderT
          SqlBackend
          (RIO env)
          (Either (Text, RawPackageMetadata) (Package, Text)))
    -> ReaderT SqlBackend (RIO env) (Package, Text)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Text, RawPackageMetadata) (Package, Text))
    forall a b. (a -> b) -> a -> b
    $ (, Text
    subdir) (Package -> (Package, Text))
    -> ReaderT SqlBackend (RIO env) Package
    -> ReaderT SqlBackend (RIO env) (Package, Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    RawPackageLocationImmutable
    -> TreeId -> ReaderT SqlBackend (RIO env) Package
    loadPackageById (Repo -> RawPackageMetadata -> RawPackageLocationImmutable
    RPLIRepo (Text -> Text -> RepoType -> Text -> Repo
    Repo Text
    sRepoUrl Text
    sRepoCommit RepoType
    sRepoType Text
    subdir) RawPackageMetadata
    rpm) TreeId
    tid
            Maybe TreeId
    Nothing  -> Either (Text, RawPackageMetadata) (Package, Text)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Text, RawPackageMetadata) (Package, Text))
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Text, RawPackageMetadata) (Package, Text)
     -> ReaderT
          SqlBackend
          (RIO env)
          (Either (Text, RawPackageMetadata) (Package, Text)))
    -> Either (Text, RawPackageMetadata) (Package, Text)
    -> ReaderT
         SqlBackend
         (RIO env)
         (Either (Text, RawPackageMetadata) (Package, Text))
    forall a b. (a -> b) -> a -> b
    $ (Text, RawPackageMetadata)
    -> Either (Text, RawPackageMetadata) (Package, Text)
    forall a b. a -> Either a b
    Left (Text
    subdir, RawPackageMetadata
    rpm)
        let ([(Text, RawPackageMetadata)]
    missingPkgs, [(Package, Text)]
    cachedPkgs) = [Either (Text, RawPackageMetadata) (Package, Text)]
    -> ([(Text, RawPackageMetadata)], [(Package, Text)])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either (Text, RawPackageMetadata) (Package, Text)]
    pkgs
        [Package]
    newPkgs <-
          if [(Text, RawPackageMetadata)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Text, RawPackageMetadata)]
    missingPkgs
          then [Package] -> RIO env [Package]
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
          else do
            [(Package, Text)]
    packages <- AggregateRepo -> RIO env [(Package, Text)]
    inner AggregateRepo
    repo { aRepoSubdirs = missingPkgs }
            [(Package, Text)]
    -> ((Package, Text) -> RIO env Package) -> RIO env [Package]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Package, Text)]
    packages (((Package, Text) -> RIO env Package) -> RIO env [Package])
    -> ((Package, Text) -> RIO env Package) -> RIO env [Package]
    forall a b. (a -> b) -> a -> b
    $ \(Package
    package, Text
    subdir) -> do
              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
                Maybe (Entity Tree)
    ment <- TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall env.
    TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    getTreeForKey (TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree)))
    -> TreeKey -> ReaderT SqlBackend (RIO env) (Maybe (Entity Tree))
    forall a b. (a -> b) -> a -> b
    $ Package -> TreeKey
    packageTreeKey Package
    package
                case Maybe (Entity Tree)
    ment of
                  Maybe (Entity Tree)
    Nothing -> FilePath -> ReaderT SqlBackend (RIO env) ()
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> ReaderT SqlBackend (RIO env) ())
    -> FilePath -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $
                       FilePath
    "invariant violated, Tree not found: "
                    FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ TreeKey -> FilePath
    forall a. Show a => a -> FilePath
    show (Package -> TreeKey
    packageTreeKey Package
    package)
                  Just (Entity TreeId
    tid Tree
    _) ->
                    Repo -> Text -> TreeId -> ReaderT SqlBackend (RIO env) ()
    forall env.
    Repo -> Text -> TreeId -> ReaderT SqlBackend (RIO env) ()
    storeRepoCache (Text -> Text -> RepoType -> Text -> Repo
    Repo Text
    sRepoUrl Text
    sRepoCommit RepoType
    sRepoType Text
    subdir) Text
    subdir TreeId
    tid
              Package -> RIO env Package
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Package
    package
        [Package] -> RIO env [Package]
    forall a. a -> RIO env a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Package] -> [Package]
    forall a. Ord a => [a] -> [a]
    nubOrd (((Package, Text) -> Package
    forall a b. (a, b) -> a
    fst ((Package, Text) -> Package) -> [(Package, Text)] -> [Package]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Package, Text)]
    cachedPkgs) [Package] -> [Package] -> [Package]
    forall a. [a] -> [a] -> [a]
    ++ [Package]
    newPkgs))

    getRepos' ::
         forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => AggregateRepo
      -> RIO env [(Package, Text)] -- ^ [(package, subdir)]

    getRepos' :: forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    AggregateRepo -> RIO env [(Package, Text)]
    getRepos' ar :: AggregateRepo
    ar@(AggregateRepo (SimpleRepo{Text
    RepoType
    sRepoUrl :: SimpleRepo -> Text
    sRepoCommit :: SimpleRepo -> Text
    sRepoType :: SimpleRepo -> RepoType
    sRepoUrl :: Text
    sRepoCommit :: Text
    sRepoType :: RepoType
    ..}) [(Text, RawPackageMetadata)]
    repoSubdirs) = do
      SimpleRepo
    -> (FilePath -> RIO env [(Package, Text)])
    -> RIO env [(Package, Text)]
    forall env a.
    (HasLogFunc env, HasProcessContext env) =>
    SimpleRepo -> (FilePath -> RIO env a) -> RIO env a
    withRepoArchive (AggregateRepo -> SimpleRepo
    arToSimpleRepo AggregateRepo
    ar) ((FilePath -> RIO env [(Package, Text)])
     -> RIO env [(Package, Text)])
    -> (FilePath -> RIO env [(Package, Text)])
    -> RIO env [(Package, Text)]
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    tarball -> do
        Path Abs File
    abs' <- FilePath -> RIO env (Path Abs File)
    forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
    resolveFile' FilePath
    tarball
        [(Text, RawPackageMetadata)]
    -> ((Text, RawPackageMetadata) -> RIO env (Package, Text))
    -> RIO env [(Package, Text)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Text, RawPackageMetadata)]
    repoSubdirs (((Text, RawPackageMetadata) -> RIO env (Package, Text))
     -> RIO env [(Package, Text)])
    -> ((Text, RawPackageMetadata) -> RIO env (Package, Text))
    -> RIO env [(Package, Text)]
    forall a b. (a -> b) -> a -> b
    $ \(Text
    subdir, RawPackageMetadata
    rpm) -> do
          (,Text
    subdir) (Package -> (Package, Text))
    -> RIO env Package -> RIO env (Package, Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env,
     HasCallStack) =>
    RawPackageLocationImmutable
    -> RawArchive -> RawPackageMetadata -> RIO env Package
    getArchivePackage
            (Repo -> RawPackageMetadata -> RawPackageLocationImmutable
    RPLIRepo (Text -> Text -> RepoType -> Text -> Repo
    Repo Text
    sRepoUrl Text
    sRepoCommit RepoType
    sRepoType Text
    subdir) RawPackageMetadata
    rpm)
            RawArchive
              { raLocation :: ArchiveLocation
    raLocation = ResolvedPath File -> ArchiveLocation
    ALFilePath (ResolvedPath File -> ArchiveLocation)
    -> ResolvedPath File -> ArchiveLocation
    forall a b. (a -> b) -> a -> b
    $ ResolvedPath
                  { resolvedRelative :: RelFilePath
    resolvedRelative = Text -> RelFilePath
    RelFilePath (Text -> RelFilePath) -> Text -> RelFilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack FilePath
    tarball
                  , resolvedAbsolute :: Path Abs File
    resolvedAbsolute = Path Abs File
    abs'
                  }
              , raHash :: Maybe SHA256
    raHash = Maybe SHA256
    forall a. Maybe a
    Nothing
              , raSize :: Maybe FileSize
    raSize = Maybe FileSize
    forall a. Maybe a
    Nothing
              , raSubdir :: Text
    raSubdir = Text
    subdir
              }
            RawPackageMetadata
    rpm

    -- | Fetch a repository and create a (temporary) tar archive from it. Pass the

    -- path of the generated tarball to the given action.

    withRepoArchive ::
         forall env a. (HasLogFunc env, HasProcessContext env)
      => SimpleRepo
      -> (FilePath -> RIO env a)
      -> RIO env a
    withRepoArchive :: forall env a.
    (HasLogFunc env, HasProcessContext env) =>
    SimpleRepo -> (FilePath -> RIO env a) -> RIO env a
    withRepoArchive SimpleRepo
    sr FilePath -> RIO env a
    action =
      FilePath -> (FilePath -> RIO env a) -> RIO env a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> (FilePath -> m a) -> m a
    withSystemTempDirectory FilePath
    "with-repo-archive" ((FilePath -> RIO env a) -> RIO env a)
    -> (FilePath -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    tmpdirArchive -> do
        let tarball :: FilePath
    tarball = FilePath
    tmpdirArchive FilePath -> FilePath -> FilePath
    </> FilePath
    "foo.tar"
        SimpleRepo -> FilePath -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    SimpleRepo -> FilePath -> RIO env ()
    createRepoArchive SimpleRepo
    sr FilePath
    tarball
        FilePath -> RIO env a
    action FilePath
    tarball

    -- | Run a git command, setting appropriate environment variable settings. See

    -- <https://github.com/commercialhaskell/stack/issues/3748>.

    runGitCommand ::
         (HasLogFunc env, HasProcessContext env)
      => [String] -- ^ args

      -> RIO env ()
    runGitCommand :: forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand [FilePath]
    args =
      (EnvVars -> EnvVars) -> RIO env () -> RIO env ()
    forall env (m :: * -> *) a.
    (HasProcessContext env, MonadReader env m, MonadIO m) =>
    (EnvVars -> EnvVars) -> m a -> m a
    withModifyEnvVars EnvVars -> EnvVars
    forall {a}. Map Text a -> Map Text a
    go (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
      RIO env (ByteString, ByteString) -> RIO env ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (RIO env (ByteString, ByteString) -> RIO env ())
    -> RIO env (ByteString, ByteString) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    -> [FilePath]
    -> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
    -> RIO env (ByteString, ByteString)
    forall env (m :: * -> *) a.
    (HasProcessContext env, HasLogFunc env, MonadReader env m,
     MonadIO m, HasCallStack) =>
    FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
    proc FilePath
    "git" [FilePath]
    args ProcessConfig () () () -> RIO env (ByteString, ByteString)
    forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
    MonadIO m =>
    ProcessConfig stdin stdoutIgnored stderrIgnored
    -> m (ByteString, ByteString)
    readProcess_
     where
      go :: Map Text a -> Map Text a
    go = Text -> Map Text a -> Map Text a
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Text
    "GIT_DIR"
         (Map Text a -> Map Text a)
    -> (Map Text a -> Map Text a) -> Map Text a -> Map Text a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Map Text a -> Map Text a
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Text
    "GIT_CEILING_DIRECTORIES"
         (Map Text a -> Map Text a)
    -> (Map Text a -> Map Text a) -> Map Text a -> Map Text a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Map Text a -> Map Text a
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Text
    "GIT_WORK_TREE"
         (Map Text a -> Map Text a)
    -> (Map Text a -> Map Text a) -> Map Text a -> Map Text a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Map Text a -> Map Text a
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Text
    "GIT_INDEX_FILE"
         (Map Text a -> Map Text a)
    -> (Map Text a -> Map Text a) -> Map Text a -> Map Text a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Map Text a -> Map Text a
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Text
    "GIT_OBJECT_DIRECTORY" -- possible optimization: set this to something Pantry controls

         (Map Text a -> Map Text a)
    -> (Map Text a -> Map Text a) -> Map Text a -> Map Text a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Map Text a -> Map Text a
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Text
    "GIT_ALTERNATE_OBJECT_DIRECTORIES"

    -- Include submodules files into the archive: use `git submodule foreach` to

    -- execute `git archive` in each submodule and generate tar archive. With bsd

    -- tar, the generated archive is extracted to a temporary folder and the files

    -- in them are added to the tarball referenced by the variable tarball in the

    -- haskell code. This is done in GNU tar with -A option.

    archiveSubmodules ::
         (HasLogFunc env, HasProcessContext env)
      => FilePath
      -> RIO env ()
    archiveSubmodules :: forall env.
    (HasLogFunc env, HasProcessContext env) =>
    FilePath -> RIO env ()
    archiveSubmodules FilePath
    tarball = do
      TarType
    tarType <- RIO env TarType
    forall env.
    (HasProcessContext env, HasLogFunc env) =>
    RIO env TarType
    getGitTarType
      let forceLocal :: FilePath
    forceLocal =
              if Bool
    osIsWindows
              then FilePath
    " --force-local "
              else FilePath
    forall a. Monoid a => a
    mempty
      case TarType
    tarType of
        TarType
    Gnu -> do
          -- Single quotation marks are required around tarball because otherwise,

          -- in the foreach environment, the \ character in absolute paths on

          -- Windows will be interpreted as escaping the following character.

          let foreachCommand :: FilePath
    foreachCommand =
                FilePath
    "git -c core.autocrlf=false archive --prefix=$displaypath/ -o bar.tar HEAD; "
                FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "tar" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    forceLocal FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    " -Af '" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    tarball FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "' bar.tar"
          [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
            [ FilePath
    "submodule"
            , FilePath
    "foreach"
            , FilePath
    "--recursive"
            , FilePath
    foreachCommand
            ]
        TarType
    Bsd -> [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
          [ FilePath
    "submodule"
          , FilePath
    "foreach"
          , FilePath
    "--recursive"
          , FilePath
    "git -c core.autocrlf=false archive --prefix=$displaypath/ -o bar.tar HEAD; "
            FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "rm -rf temp; mkdir temp; mv bar.tar temp/; "
            FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "tar -C temp -xf temp/bar.tar; "
            FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "rm temp/bar.tar; "
            FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "tar -C temp -rf " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    tarball FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    " . ;"
          ]

    -- | Run an hg command

    runHgCommand ::
         (HasLogFunc env, HasProcessContext env)
      => [String] -- ^ args

      -> RIO env ()
    runHgCommand :: forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runHgCommand [FilePath]
    args = RIO env (ByteString, ByteString) -> RIO env ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (RIO env (ByteString, ByteString) -> RIO env ())
    -> RIO env (ByteString, ByteString) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    -> [FilePath]
    -> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
    -> RIO env (ByteString, ByteString)
    forall env (m :: * -> *) a.
    (HasProcessContext env, HasLogFunc env, MonadReader env m,
     MonadIO m, HasCallStack) =>
    FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
    proc FilePath
    "hg" [FilePath]
    args ProcessConfig () () () -> RIO env (ByteString, ByteString)
    forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
    MonadIO m =>
    ProcessConfig stdin stdoutIgnored stderrIgnored
    -> m (ByteString, ByteString)
    readProcess_

    -- | Create a tarball containing files from a repository

    createRepoArchive ::
         forall env. (HasLogFunc env, HasProcessContext env)
      => SimpleRepo
      -> FilePath -- ^ Output tar archive filename

      -> RIO env ()
    createRepoArchive :: forall env.
    (HasLogFunc env, HasProcessContext env) =>
    SimpleRepo -> FilePath -> RIO env ()
    createRepoArchive SimpleRepo
    sr FilePath
    tarball = do
      SimpleRepo -> RIO env () -> RIO env ()
    forall env a.
    (HasLogFunc env, HasProcessContext env) =>
    SimpleRepo -> RIO env a -> RIO env a
    withRepo SimpleRepo
    sr (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
        case SimpleRepo -> RepoType
    sRepoType SimpleRepo
    sr of
          RepoType
    RepoGit -> do
            [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
              [FilePath
    "-c", FilePath
    "core.autocrlf=false", FilePath
    "archive", FilePath
    "-o", FilePath
    tarball, FilePath
    "HEAD"]
            FilePath -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    FilePath -> RIO env ()
    archiveSubmodules FilePath
    tarball
          RepoType
    RepoHg -> [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runHgCommand [FilePath
    "archive", FilePath
    tarball, FilePath
    "-X", FilePath
    ".hg_archival.txt"]

    -- | Clone the repository (and, in the case of Git and if necessary, fetch the

    -- specific commit) and execute the action with the working directory set to the

    -- repository root.

    --

    -- @since 0.1.0.0

    withRepo ::
         forall env a. (HasLogFunc env, HasProcessContext env)
      => SimpleRepo
      -> RIO env a
      -> RIO env a
    withRepo :: forall env a.
    (HasLogFunc env, HasProcessContext env) =>
    SimpleRepo -> RIO env a -> RIO env a
    withRepo sr :: SimpleRepo
    sr@SimpleRepo{Text
    RepoType
    sRepoUrl :: SimpleRepo -> Text
    sRepoCommit :: SimpleRepo -> Text
    sRepoType :: SimpleRepo -> RepoType
    sRepoUrl :: Text
    sRepoCommit :: Text
    sRepoType :: RepoType
    ..} RIO env a
    action =
      FilePath -> (FilePath -> RIO env a) -> RIO env a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> (FilePath -> m a) -> m a
    withSystemTempDirectory FilePath
    "with-repo" ((FilePath -> RIO env a) -> RIO env a)
    -> (FilePath -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    tmpDir -> do
        let repoUrl :: FilePath
    repoUrl = Text -> FilePath
    T.unpack Text
    sRepoUrl
            repoCommit :: FilePath
    repoCommit = Text -> FilePath
    T.unpack Text
    sRepoCommit
            dir :: FilePath
    dir = FilePath
    tmpDir FilePath -> FilePath -> FilePath
    </> FilePath
    "cloned"
            ([FilePath] -> RIO env ()
    runCommand, [FilePath]
    resetArgs) =
              case RepoType
    sRepoType of
                RepoType
    RepoGit ->
                  ( [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
                  , [FilePath
    "reset", FilePath
    "--hard", FilePath
    repoCommit]
                  )
                RepoType
    RepoHg ->
                  ( [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runHgCommand
                  , [FilePath
    "update", FilePath
    "-C", FilePath
    repoCommit]
                  )
            fetchCommit :: [FilePath]
    fetchCommit = [FilePath
    "fetch", FilePath
    repoUrl, FilePath
    repoCommit]
            submoduleArgs :: [FilePath]
    submoduleArgs = [FilePath
    "submodule", FilePath
    "update", FilePath
    "--init", FilePath
    "--recursive"]
            fixANSIForWindows :: RIO env ()
    fixANSIForWindows =
              -- On Windows 10, an upstream issue with the `git clone` command means

              -- that command clears, but does not then restore, the

              -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. The

              -- following hack re-enables the lost ANSI-capability.

              Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    osIsWindows (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ RIO env Bool -> RIO env ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (RIO env Bool -> RIO env ()) -> RIO env Bool -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ 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
    $
    #if MIN_VERSION_ansi_terminal(1, 0, 2)
                Handle -> IO Bool
    hNowSupportsANSI Handle
    stdout
    #else
                hSupportsANSIWithoutEmulation stdout
    #endif
        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
    "Cloning " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    sRepoCommit Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " from " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    sRepoUrl
        [FilePath] -> RIO env ()
    runCommand [FilePath
    "clone", FilePath
    repoUrl, FilePath
    dir]
        RIO env ()
    fixANSIForWindows
        Bool
    created <- FilePath -> RIO env Bool
    forall (m :: * -> *). MonadIO m => FilePath -> m Bool
    doesDirectoryExist FilePath
    dir
        Bool -> RIO env () -> RIO env ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    created (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
    $ SimpleRepo -> PantryException
    FailedToCloneRepo SimpleRepo
    sr

        -- Note we do not immediately change directories into the new temporary

        -- directory, but instead wait until we have finished cloning the repo. This

        -- is because the repo URL may be a relative path on the local filesystem,

        -- and we should interpret it as relative to the current directory, not the

        -- temporary directory.

        FilePath -> RIO env a -> RIO env a
    forall env (m :: * -> *) a.
    (HasProcessContext env, MonadReader env m, MonadIO m) =>
    FilePath -> m a -> m a
    withWorkingDir FilePath
    dir (RIO env a -> RIO env a) -> RIO env a -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ do
          case RepoType
    sRepoType of
            RepoType
    RepoGit -> do
              RIO env () -> (ExitCodeException -> RIO env ()) -> RIO env ()
    forall (m :: * -> *) e a.
    (MonadUnliftIO m, Exception e) =>
    m a -> (e -> m a) -> m a
    catch
                -- This will result in a failure exit code if the specified commit

                -- is not in the clone of the repository.

                ([FilePath] -> RIO env ()
    runCommand [FilePath]
    resetArgs)
                ( \(ExitCodeException
    _ :: ExitCodeException) -> do
                   -- Perhaps the specified commit is not one that is brought across

                   -- by `git clone`. For example, in the case of a GitHub

                   -- repository, it may be a commit from a different repository

                   -- that is the subject of an unmerged pull request. Try to fetch

                   -- the specific commit and then try again.

                   [FilePath] -> RIO env ()
    runCommand [FilePath]
    fetchCommit
                   [FilePath] -> RIO env ()
    runCommand [FilePath]
    resetArgs
                )
              [FilePath] -> RIO env ()
    runCommand [FilePath]
    submoduleArgs
              RIO env ()
    fixANSIForWindows
            RepoType
    RepoHg -> [FilePath] -> RIO env ()
    runCommand [FilePath]
    resetArgs
          RIO env a
    action