    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    module Pantry.Repo
      ( fetchReposRaw
      , fetchRepos
      , getRepo
      , getRepoKey
      , createRepoArchive
      , withRepoArchive
      , withRepo
      ) where

    import Pantry.Types
    import Pantry.Archive
    import Pantry.Storage
    import RIO
    import Path.IO (resolveFile')
    import RIO.FilePath ((</>))
    import RIO.Directory (doesDirectoryExist)
    import RIO.ByteString (isInfixOf)
    import RIO.ByteString.Lazy (toStrict)
    import qualified RIO.Map as Map
    import RIO.Process
    import Database.Persist (Entity (..))
    import qualified RIO.Text as T
    import System.Console.ANSI (hSupportsANSIWithoutEmulation)
    import System.IsWindows (osIsWindows)

    data TarType = Gnu | Bsd

    getTarType :: (HasProcessContext env, HasLogFunc env) => RIO env TarType
    getTarType :: RIO env TarType
    getTarType = do
      (stdoutBS :: ByteString
    stdoutBS, _) <- 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 "tar" ["--version"] ProcessConfig () () () -> RIO env (ByteString, ByteString)
    forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
    MonadIO m =>
    ProcessConfig stdin stdoutIgnored stderrIgnored
    -> m (ByteString, ByteString)
    readProcess_
      let bs :: ByteString
    bs = ByteString -> ByteString
    toStrict ByteString
    stdoutBS
      if "GNU" ByteString -> ByteString -> Bool
    `isInfixOf` ByteString
    bs
      then TarType -> RIO env TarType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TarType
    Gnu
      else if "bsdtar" ByteString -> ByteString -> Bool
    `isInfixOf` ByteString
    bs
           then TarType -> RIO env TarType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TarType
    Bsd
           else do
             Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logError (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ "Either GNU Tar or BSD tar is required on the PATH."
             FilePath -> RIO env TarType
    forall (m :: * -> *) a.
    (MonadIO m, HasCallStack) =>
    FilePath -> m a
    throwString "Proper tar executable not found in the environment"

    fetchReposRaw
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => [(Repo, RawPackageMetadata)]
      -> RIO env ()
    fetchReposRaw :: [(Repo, RawPackageMetadata)] -> RIO env ()
    fetchReposRaw pairs :: [(Repo, RawPackageMetadata)]
    pairs = [(Repo, RawPackageMetadata)]
    -> ((Repo, RawPackageMetadata) -> RIO env Package) -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ [(Repo, RawPackageMetadata)]
    pairs (((Repo, RawPackageMetadata) -> RIO env Package) -> RIO env ())
    -> ((Repo, RawPackageMetadata) -> RIO env Package) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ (Repo -> RawPackageMetadata -> RIO env Package)
    -> (Repo, RawPackageMetadata) -> RIO env Package
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Repo -> RawPackageMetadata -> RIO env Package
    forall env.
    (HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
    Repo -> RawPackageMetadata -> RIO env Package
    getRepo

    fetchRepos
      :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
      => [(Repo, PackageMetadata)]
      -> RIO env ()
    fetchRepos :: [(Repo, PackageMetadata)] -> RIO env ()
    fetchRepos pairs :: [(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 (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 :: Repo -> RawPackageMetadata -> RIO env TreeKey
    getRepoKey repo :: Repo
    repo rpm :: 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 :: Repo -> RawPackageMetadata -> RIO env Package
    getRepo repo :: Repo
    repo pm :: RawPackageMetadata
    pm =
      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 inner :: 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 -> Text -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    forall env.
    Repo -> Text -> ReaderT SqlBackend (RIO env) (Maybe TreeId)
    loadRepoCache Repo
    repo (Repo -> Text
    repoSubdir Repo
    repo))
          case Maybe TreeId
    mtid of
            Just tid :: 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
            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
                  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
    $ "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 tid :: TreeId
    tid _) -> 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 (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' :: Repo -> RawPackageMetadata -> RIO env Package
    getRepo' repo :: Repo
    repo rpm :: RawPackageMetadata
    rpm = do
      Repo -> (FilePath -> RIO env Package) -> RIO env Package
    forall env a.
    (HasLogFunc env, HasProcessContext env) =>
    Repo -> (FilePath -> RIO env a) -> RIO env a
    withRepoArchive Repo
    repo ((FilePath -> RIO env Package) -> RIO env Package)
    -> (FilePath -> RIO env Package) -> RIO env Package
    forall a b. (a -> b) -> a -> b
    $ \tarball :: 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)
          $WRawArchive :: ArchiveLocation
    -> Maybe SHA256 -> Maybe FileSize -> Text -> RawArchive
    RawArchive
            { raLocation :: ArchiveLocation
    raLocation = ResolvedPath File -> ArchiveLocation
    ALFilePath (ResolvedPath File -> ArchiveLocation)
    -> ResolvedPath File -> ArchiveLocation
    forall a b. (a -> b) -> a -> b
    $ $WResolvedPath :: forall t. RelFilePath -> Path Abs t -> ResolvedPath t
    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 = Repo -> Text
    repoSubdir Repo
    repo
            }
          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)
      => Repo
      -> (FilePath -> RIO env a)
      -> RIO env a
    withRepoArchive :: Repo -> (FilePath -> RIO env a) -> RIO env a
    withRepoArchive repo :: Repo
    repo action :: 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 "with-repo-archive" ((FilePath -> RIO env a) -> RIO env a)
    -> (FilePath -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \tmpdir :: FilePath
    tmpdir -> do
        let tarball :: FilePath
    tarball = FilePath
    tmpdir FilePath -> FilePath -> FilePath
    </> "foo.tar"
        Repo -> FilePath -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    Repo -> FilePath -> RIO env ()
    createRepoArchive Repo
    repo 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 :: [FilePath] -> RIO env ()
    runGitCommand args :: [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 "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 "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 "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 "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 "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 "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 "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 :: FilePath -> RIO env ()
    archiveSubmodules tarball :: FilePath
    tarball = do
      TarType
    tarType <- RIO env TarType
    forall env.
    (HasProcessContext env, HasLogFunc env) =>
    RIO env TarType
    getTarType
      let forceLocal :: FilePath
    forceLocal =
              if Bool
    osIsWindows
              then " --force-local "
              else FilePath
    forall a. Monoid a => a
    mempty
      case TarType
    tarType of
        Gnu -> [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
             [ "submodule", "foreach", "--recursive"
             , "git -c core.autocrlf=false archive --prefix=$displaypath/ -o bar.tar HEAD; "
               FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> "tar" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    forceLocal FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> " -Af " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    tarball FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> " bar.tar"
             ]
        Bsd ->
           [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
              [ "submodule"
              , "foreach"
              , "--recursive"
              , "git -c core.autocrlf=false archive --prefix=$displaypath/ -o bar.tar HEAD;" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <>
                " rm -rf temp; mkdir temp; mv bar.tar temp/; tar " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <>
                " -C temp -xf temp/bar.tar; " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <>
                "rm temp/bar.tar; tar " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <>
                " -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
    <>
                " . ;"
              ]

    -- | Run an hg command
    runHgCommand
      :: (HasLogFunc env, HasProcessContext env)
      => [String] -- ^ args
      -> RIO env ()
    runHgCommand :: [FilePath] -> RIO env ()
    runHgCommand args :: [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 "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)
      => Repo
      -> FilePath -- ^ Output tar archive filename
      -> RIO env ()
    createRepoArchive :: Repo -> FilePath -> RIO env ()
    createRepoArchive repo :: Repo
    repo tarball :: FilePath
    tarball = do
      Repo -> RIO env () -> RIO env ()
    forall env a.
    (HasLogFunc env, HasProcessContext env) =>
    Repo -> RIO env a -> RIO env a
    withRepo Repo
    repo (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
        case Repo -> RepoType
    repoType Repo
    repo of
          RepoGit -> do
            [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
              ["-c", "core.autocrlf=false", "archive", "-o", FilePath
    tarball, "HEAD"]
            FilePath -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    FilePath -> RIO env ()
    archiveSubmodules FilePath
    tarball
          RepoHg -> [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runHgCommand ["archive", FilePath
    tarball, "-X", ".hg_archival.txt"]

    -- | Clone the repository 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)
      => Repo
      -> RIO env a
      -> RIO env a
    withRepo :: Repo -> RIO env a -> RIO env a
    withRepo repo :: Repo
    repo@(Repo url :: Text
    url commit :: Text
    commit repoType' :: RepoType
    repoType' _subdir :: Text
    _subdir) action :: RIO env a
    action =
      FilePath -> (FilePath -> RIO env a) -> RIO env a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    FilePath -> (FilePath -> m a) -> m a
    withSystemTempDirectory "with-repo" ((FilePath -> RIO env a) -> RIO env a)
    -> (FilePath -> RIO env a) -> RIO env a
    forall a b. (a -> b) -> a -> b
    $ \tmpDir :: FilePath
    tmpDir -> do
        -- 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.
        let dir :: FilePath
    dir = FilePath
    tmpDir FilePath -> FilePath -> FilePath
    </> "cloned"
            (runCommand :: [FilePath] -> RIO env ()
    runCommand, resetArgs :: [FilePath]
    resetArgs, submoduleArgs :: Maybe [FilePath]
    submoduleArgs) =
              case RepoType
    repoType' of
                RepoGit ->
                  ( [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runGitCommand
                  , ["reset", "--hard", Text -> FilePath
    T.unpack Text
    commit]
                  , [FilePath] -> Maybe [FilePath]
    forall a. a -> Maybe a
    Just ["submodule", "update", "--init", "--recursive"]
                  )
                RepoHg ->
                  ( [FilePath] -> RIO env ()
    forall env.
    (HasLogFunc env, HasProcessContext env) =>
    [FilePath] -> RIO env ()
    runHgCommand
                  , ["update", "-C", Text -> FilePath
    T.unpack Text
    commit]
                  , Maybe [FilePath]
    forall a. Maybe a
    Nothing
                  )
            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
              -- folowing 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 (Maybe Bool) -> RIO env ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (RIO env (Maybe Bool) -> RIO env ())
    -> RIO env (Maybe Bool) -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe Bool) -> RIO env (Maybe Bool)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe Bool) -> RIO env (Maybe Bool))
    -> IO (Maybe Bool) -> RIO env (Maybe Bool)
    forall a b. (a -> b) -> a -> b
    $ Handle -> IO (Maybe Bool)
    hSupportsANSIWithoutEmulation Handle
    stdout

        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
    $ "Cloning " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    commit Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> " from " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Utf8Builder
    forall a. Display a => a -> Utf8Builder
    display Text
    url
        [FilePath] -> RIO env ()
    runCommand ["clone", Text -> FilePath
    T.unpack Text
    url, 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
    $ Repo -> PantryException
    FailedToCloneRepo Repo
    repo

        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
          [FilePath] -> RIO env ()
    runCommand [FilePath]
    resetArgs
          ([FilePath] -> RIO env ()) -> Maybe [FilePath] -> RIO env ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ [FilePath] -> RIO env ()
    runCommand Maybe [FilePath]
    submoduleArgs
          RIO env ()
    fixANSIForWindows
          RIO env a
    action