------------------------------------------------------------------------------- |
-- Module      :  Distribution.Client.Fetch
-- Copyright   :  (c) David Himmelstrup 2005
--                    Duncan Coutts 2011
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- The cabal fetch command
-----------------------------------------------------------------------------
module Distribution.Client.Fetch (
    fetch,
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.Types
import Distribution.Client.Targets
import Distribution.Client.FetchUtils hiding (fetchPackage)
import Distribution.Client.Dependency
import Distribution.Client.IndexUtils as IndexUtils
         ( getSourcePackages, getInstalledPackages )
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.Setup
         ( GlobalFlags(..), FetchFlags(..), RepoContext(..) )

import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PkgConfigDb ( PkgConfigDb, readPkgConfigDb )
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage

import Distribution.Package
         ( packageId )
import Distribution.Simple.Compiler
         ( Compiler, compilerInfo, PackageDBStack )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.Program
         ( ProgramDb )
import Distribution.Simple.Setup
         ( fromFlag, fromFlagOrDefault )
import Distribution.Simple.Utils
         ( die', notice, debug )
import Distribution.System
         ( Platform )

-- ------------------------------------------------------------
-- * The fetch command
-- ------------------------------------------------------------

--TODO:
-- * add fetch -o support
-- * support tarball URLs via ad-hoc download cache (or in -o mode?)
-- * suggest using --no-deps, unpack or fetch -o if deps cannot be satisfied
-- * Port various flags from install:
--   * --upgrade-dependencies
--   * --constraint and --preference
--   * --only-dependencies, but note it conflicts with --no-deps


-- | Fetch a list of packages and their dependencies.
--
fetch :: Verbosity
      -> PackageDBStack
      -> RepoContext
      -> Compiler
      -> Platform
      -> ProgramDb
      -> GlobalFlags
      -> FetchFlags
      -> [UserTarget]
      -> IO ()
fetch :: Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> FetchFlags
-> [UserTarget]
-> IO ()
fetch Verbosity
verbosity PackageDBStack
_ RepoContext
_ Compiler
_ Platform
_ ProgramDb
_ GlobalFlags
_ FetchFlags
_ [] =
    Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"No packages requested. Nothing to do."

fetch Verbosity
verbosity PackageDBStack
packageDBs RepoContext
repoCtxt Compiler
comp Platform
platform ProgramDb
progdb
      GlobalFlags
_ FetchFlags
fetchFlags [UserTarget]
userTargets = do

    (UserTarget -> IO ()) -> [UserTarget] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> UserTarget -> IO ()
checkTarget Verbosity
verbosity) [UserTarget]
userTargets

    InstalledPackageIndex
installedPkgIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs ProgramDb
progdb
    SourcePackageDb
sourcePkgDb       <- Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages    Verbosity
verbosity RepoContext
repoCtxt
    PkgConfigDb
pkgConfigDb       <- Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb      Verbosity
verbosity ProgramDb
progdb

    [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers <- Verbosity
-> RepoContext
-> PackageIndex UnresolvedSourcePackage
-> [UserTarget]
-> IO [PackageSpecifier UnresolvedSourcePackage]
forall pkg.
Package pkg =>
Verbosity
-> RepoContext
-> PackageIndex pkg
-> [UserTarget]
-> IO [PackageSpecifier UnresolvedSourcePackage]
resolveUserTargets Verbosity
verbosity RepoContext
repoCtxt
                       (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
sourcePkgDb)
                       [UserTarget]
userTargets

    [UnresolvedSourcePackage]
pkgs  <- Verbosity
-> Compiler
-> Platform
-> FetchFlags
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO [UnresolvedSourcePackage]
planPackages
               Verbosity
verbosity Compiler
comp Platform
platform FetchFlags
fetchFlags
               InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb PkgConfigDb
pkgConfigDb [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers

    [UnresolvedSourcePackage]
pkgs' <- (UnresolvedSourcePackage -> IO Bool)
-> [UnresolvedSourcePackage] -> IO [UnresolvedSourcePackage]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool)
-> (UnresolvedSourcePackage -> IO Bool)
-> UnresolvedSourcePackage
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedPkgLoc -> IO Bool
isFetched (UnresolvedPkgLoc -> IO Bool)
-> (UnresolvedSourcePackage -> UnresolvedPkgLoc)
-> UnresolvedSourcePackage
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedSourcePackage -> UnresolvedPkgLoc
forall loc. SourcePackage loc -> loc
srcpkgSource) [UnresolvedSourcePackage]
pkgs
    if [UnresolvedSourcePackage] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnresolvedSourcePackage]
pkgs'
      --TODO: when we add support for remote tarballs then this message
      -- will need to be changed because for remote tarballs we fetch them
      -- at the earlier phase.
      then Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No packages need to be fetched. "
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"All the requested packages are already local "
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"or cached locally."
      else if Bool
dryRun
             then Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                     String
"The following packages would be fetched:"
                   String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (UnresolvedSourcePackage -> String)
-> [UnresolvedSourcePackage] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow (PackageIdentifier -> String)
-> (UnresolvedSourcePackage -> PackageIdentifier)
-> UnresolvedSourcePackage
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedSourcePackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) [UnresolvedSourcePackage]
pkgs'

             else (UnresolvedSourcePackage -> IO ())
-> [UnresolvedSourcePackage] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> RepoContext -> UnresolvedPkgLoc -> IO ()
forall a. Verbosity -> RepoContext -> PackageLocation a -> IO ()
fetchPackage Verbosity
verbosity RepoContext
repoCtxt (UnresolvedPkgLoc -> IO ())
-> (UnresolvedSourcePackage -> UnresolvedPkgLoc)
-> UnresolvedSourcePackage
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedSourcePackage -> UnresolvedPkgLoc
forall loc. SourcePackage loc -> loc
srcpkgSource) [UnresolvedSourcePackage]
pkgs'

  where
    dryRun :: Bool
dryRun = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag Bool
fetchDryRun FetchFlags
fetchFlags)

planPackages :: Verbosity
             -> Compiler
             -> Platform
             -> FetchFlags
             -> InstalledPackageIndex
             -> SourcePackageDb
             -> PkgConfigDb
             -> [PackageSpecifier UnresolvedSourcePackage]
             -> IO [UnresolvedSourcePackage]
planPackages :: Verbosity
-> Compiler
-> Platform
-> FetchFlags
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO [UnresolvedSourcePackage]
planPackages Verbosity
verbosity Compiler
comp Platform
platform FetchFlags
fetchFlags
             InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb PkgConfigDb
pkgConfigDb [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers

  | Bool
includeDependencies = do
      Solver
solver <- Verbosity -> PreSolver -> CompilerInfo -> IO Solver
chooseSolver Verbosity
verbosity
                (Flag PreSolver -> PreSolver
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag PreSolver
fetchSolver FetchFlags
fetchFlags)) (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
      Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Resolving dependencies..."
      SolverInstallPlan
installPlan <- (String -> IO SolverInstallPlan -> IO SolverInstallPlan)
-> (String -> IO SolverInstallPlan)
-> (SolverInstallPlan -> IO SolverInstallPlan)
-> Progress String String SolverInstallPlan
-> IO SolverInstallPlan
forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress String -> IO SolverInstallPlan -> IO SolverInstallPlan
forall b. String -> IO b -> IO b
logMsg (Verbosity -> String -> IO SolverInstallPlan
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity) SolverInstallPlan -> IO SolverInstallPlan
forall (m :: * -> *) a. Monad m => a -> m a
return (Progress String String SolverInstallPlan -> IO SolverInstallPlan)
-> Progress String String SolverInstallPlan -> IO SolverInstallPlan
forall a b. (a -> b) -> a -> b
$
                       Platform
-> CompilerInfo
-> PkgConfigDb
-> Solver
-> DepResolverParams
-> Progress String String SolverInstallPlan
resolveDependencies
                         Platform
platform (Compiler -> CompilerInfo
compilerInfo Compiler
comp) PkgConfigDb
pkgConfigDb
                         Solver
solver
                         DepResolverParams
resolverParams

      -- The packages we want to fetch are those packages the 'InstallPlan'
      -- that are in the 'InstallPlan.Configured' state.
      [UnresolvedSourcePackage] -> IO [UnresolvedSourcePackage]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ SolverPackage UnresolvedPkgLoc -> UnresolvedSourcePackage
forall loc. SolverPackage loc -> SourcePackage loc
solverPkgSource SolverPackage UnresolvedPkgLoc
cpkg
        | (SolverInstallPlan.Configured SolverPackage UnresolvedPkgLoc
cpkg)
            <- SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.toList SolverInstallPlan
installPlan ]

  | Bool
otherwise =
      ([ResolveNoDepsError] -> IO [UnresolvedSourcePackage])
-> ([UnresolvedSourcePackage] -> IO [UnresolvedSourcePackage])
-> Either [ResolveNoDepsError] [UnresolvedSourcePackage]
-> IO [UnresolvedSourcePackage]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> String -> IO [UnresolvedSourcePackage]
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO [UnresolvedSourcePackage])
-> ([ResolveNoDepsError] -> String)
-> [ResolveNoDepsError]
-> IO [UnresolvedSourcePackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([ResolveNoDepsError] -> [String])
-> [ResolveNoDepsError]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResolveNoDepsError -> String) -> [ResolveNoDepsError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ResolveNoDepsError -> String
forall a. Show a => a -> String
show) [UnresolvedSourcePackage] -> IO [UnresolvedSourcePackage]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [ResolveNoDepsError] [UnresolvedSourcePackage]
 -> IO [UnresolvedSourcePackage])
-> Either [ResolveNoDepsError] [UnresolvedSourcePackage]
-> IO [UnresolvedSourcePackage]
forall a b. (a -> b) -> a -> b
$
        DepResolverParams
-> Either [ResolveNoDepsError] [UnresolvedSourcePackage]
resolveWithoutDependencies DepResolverParams
resolverParams

  where
    resolverParams :: DepResolverParams
    resolverParams :: DepResolverParams
resolverParams =

        Maybe Int -> DepResolverParams -> DepResolverParams
setMaxBackjumps (if Int
maxBackjumps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Maybe Int
forall a. Maybe a
Nothing
                                             else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxBackjumps)

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndependentGoals -> DepResolverParams -> DepResolverParams
setIndependentGoals IndependentGoals
independentGoals

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReorderGoals -> DepResolverParams -> DepResolverParams
setReorderGoals ReorderGoals
reorderGoals

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CountConflicts -> DepResolverParams -> DepResolverParams
setCountConflicts CountConflicts
countConflicts

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FineGrainedConflicts -> DepResolverParams -> DepResolverParams
setFineGrainedConflicts FineGrainedConflicts
fineGrainedConflicts

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinimizeConflictSet -> DepResolverParams -> DepResolverParams
setMinimizeConflictSet MinimizeConflictSet
minimizeConflictSet

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShadowPkgs -> DepResolverParams -> DepResolverParams
setShadowPkgs ShadowPkgs
shadowPkgs

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrongFlags -> DepResolverParams -> DepResolverParams
setStrongFlags StrongFlags
strongFlags

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowBootLibInstalls -> DepResolverParams -> DepResolverParams
setAllowBootLibInstalls AllowBootLibInstalls
allowBootLibInstalls

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnlyConstrained -> DepResolverParams -> DepResolverParams
setOnlyConstrained OnlyConstrained
onlyConstrained

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> DepResolverParams -> DepResolverParams
setSolverVerbosity Verbosity
verbosity

      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
          [ let pc :: PackageConstraint
pc = ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint
                     (PackageName -> ConstraintScope
scopeToplevel (PackageName -> ConstraintScope) -> PackageName -> ConstraintScope
forall a b. (a -> b) -> a -> b
$ PackageSpecifier UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget PackageSpecifier UnresolvedSourcePackage
pkgSpecifier)
                     ([OptionalStanza] -> PackageProperty
PackagePropertyStanzas [OptionalStanza]
stanzas)
            in PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint PackageConstraint
pc ConstraintSource
ConstraintSourceConfigFlagOrTarget
          | PackageSpecifier UnresolvedSourcePackage
pkgSpecifier <- [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers ]

        -- Reinstall the targets given on the command line so that the dep
        -- resolver will decide that they need fetching, even if they're
        -- already installed. Since we want to get the source packages of
        -- things we might have installed (but not have the sources for).
      (DepResolverParams -> DepResolverParams)
-> (DepResolverParams -> DepResolverParams)
-> DepResolverParams
-> DepResolverParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DepResolverParams -> DepResolverParams
reinstallTargets

      (DepResolverParams -> DepResolverParams)
-> DepResolverParams -> DepResolverParams
forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
standardInstallPolicy InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers

    includeDependencies :: Bool
includeDependencies = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag Bool
fetchDeps FetchFlags
fetchFlags)
    logMsg :: String -> IO b -> IO b
logMsg String
message IO b
rest = Verbosity -> String -> IO ()
debug Verbosity
verbosity String
message IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
rest

    stanzas :: [OptionalStanza]
stanzas           = [ OptionalStanza
TestStanzas | Bool
testsEnabled ]
                     [OptionalStanza] -> [OptionalStanza] -> [OptionalStanza]
forall a. [a] -> [a] -> [a]
++ [ OptionalStanza
BenchStanzas | Bool
benchmarksEnabled ]
    testsEnabled :: Bool
testsEnabled      = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FetchFlags -> Flag Bool
fetchTests FetchFlags
fetchFlags
    benchmarksEnabled :: Bool
benchmarksEnabled = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FetchFlags -> Flag Bool
fetchBenchmarks FetchFlags
fetchFlags

    reorderGoals :: ReorderGoals
reorderGoals     = Flag ReorderGoals -> ReorderGoals
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag ReorderGoals
fetchReorderGoals     FetchFlags
fetchFlags)
    countConflicts :: CountConflicts
countConflicts   = Flag CountConflicts -> CountConflicts
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag CountConflicts
fetchCountConflicts   FetchFlags
fetchFlags)
    fineGrainedConflicts :: FineGrainedConflicts
fineGrainedConflicts = Flag FineGrainedConflicts -> FineGrainedConflicts
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag FineGrainedConflicts
fetchFineGrainedConflicts FetchFlags
fetchFlags)
    minimizeConflictSet :: MinimizeConflictSet
minimizeConflictSet = Flag MinimizeConflictSet -> MinimizeConflictSet
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag MinimizeConflictSet
fetchMinimizeConflictSet FetchFlags
fetchFlags)
    independentGoals :: IndependentGoals
independentGoals = Flag IndependentGoals -> IndependentGoals
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag IndependentGoals
fetchIndependentGoals FetchFlags
fetchFlags)
    shadowPkgs :: ShadowPkgs
shadowPkgs       = Flag ShadowPkgs -> ShadowPkgs
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag ShadowPkgs
fetchShadowPkgs       FetchFlags
fetchFlags)
    strongFlags :: StrongFlags
strongFlags      = Flag StrongFlags -> StrongFlags
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag StrongFlags
fetchStrongFlags      FetchFlags
fetchFlags)
    maxBackjumps :: Int
maxBackjumps     = Flag Int -> Int
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag Int
fetchMaxBackjumps     FetchFlags
fetchFlags)
    allowBootLibInstalls :: AllowBootLibInstalls
allowBootLibInstalls = Flag AllowBootLibInstalls -> AllowBootLibInstalls
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag AllowBootLibInstalls
fetchAllowBootLibInstalls FetchFlags
fetchFlags)
    onlyConstrained :: OnlyConstrained
onlyConstrained  = Flag OnlyConstrained -> OnlyConstrained
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag OnlyConstrained
fetchOnlyConstrained  FetchFlags
fetchFlags)


checkTarget :: Verbosity -> UserTarget -> IO ()
checkTarget :: Verbosity -> UserTarget -> IO ()
checkTarget Verbosity
verbosity UserTarget
target = case UserTarget
target of
    UserTargetRemoteTarball URI
_uri
      -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The 'fetch' command does not yet support remote tarballs. "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"In the meantime you can use the 'unpack' commands."
    UserTarget
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

fetchPackage :: Verbosity -> RepoContext -> PackageLocation a -> IO ()
fetchPackage :: Verbosity -> RepoContext -> PackageLocation a -> IO ()
fetchPackage Verbosity
verbosity RepoContext
repoCtxt PackageLocation a
pkgsrc = case PackageLocation a
pkgsrc of
    LocalUnpackedPackage String
_dir  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    LocalTarballPackage  String
_file -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    RemoteTarballPackage URI
_uri a
_ ->
      Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The 'fetch' command does not yet support remote tarballs. "
         String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"In the meantime you can use the 'unpack' commands."

    RemoteSourceRepoPackage SourceRepoMaybe
_repo a
_ ->
      Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The 'fetch' command does not yet support remote "
         String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"source repositories."

    RepoTarballPackage Repo
repo PackageIdentifier
pkgid a
_ -> do
      String
_ <- Verbosity -> RepoContext -> Repo -> PackageIdentifier -> IO String
fetchRepoTarball Verbosity
verbosity RepoContext
repoCtxt Repo
repo PackageIdentifier
pkgid
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()