diff --git a/cabal-install/Distribution/Client/Get.hs b/cabal-install/Distribution/Client/Get.hs
new file mode 100644
index 0000000000000000000000000000000000000000..5896174e4701f018572a1a15753dc0cec38288d8
--- /dev/null
+++ b/cabal-install/Distribution/Client/Get.hs
@@ -0,0 +1,369 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Client.Get
+-- Copyright : (c) Andrea Vezzosi 2008
+-- Duncan Coutts 2011
+-- John Millikin 2012
+-- License : BSD-like
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- The 'cabal get' command.
+-----------------------------------------------------------------------------
+
+module Distribution.Client.Get (
+ get
+ ) where
+
+import Distribution.Package
+ ( PackageId, packageId, packageName )
+import Distribution.Simple.Setup
+ ( Flag(..), fromFlag, fromFlagOrDefault )
+import Distribution.Simple.Utils
+ ( notice, die, info, writeFileAtomic )
+import Distribution.Verbosity
+ ( Verbosity )
+import Distribution.Text(display)
+import qualified Distribution.PackageDescription as PD
+
+import Distribution.Client.Setup
+ ( GlobalFlags(..), GetFlags(..) )
+import Distribution.Client.Types
+import Distribution.Client.Targets
+import Distribution.Client.Dependency
+import Distribution.Client.FetchUtils
+import qualified Distribution.Client.Tar as Tar (extractTarGzFile)
+import Distribution.Client.IndexUtils as IndexUtils
+ ( getSourcePackages )
+
+import Control.Exception
+ ( finally )
+import Control.Monad
+ ( filterM, unless, when )
+import Data.List
+ ( sortBy )
+import qualified Data.Map
+import Data.Maybe
+ ( listToMaybe, mapMaybe )
+import Data.Monoid
+ ( mempty )
+import Data.Ord
+ ( comparing )
+import System.Cmd
+ ( rawSystem )
+import System.Directory
+ ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
+ , getCurrentDirectory, setCurrentDirectory
+ )
+import System.Exit
+ ( ExitCode(..) )
+import System.FilePath
+ ( (</>), (<.>), addTrailingPathSeparator )
+import System.Process
+ ( readProcessWithExitCode )
+
+
+-- | Entry point for the 'cabal get' command.
+get :: Verbosity
+ -> [Repo]
+ -> GlobalFlags
+ -> GetFlags
+ -> [UserTarget]
+ -> IO ()
+get verbosity _ _ _ [] =
+ notice verbosity "No packages requested. Nothing to do."
+
+get verbosity repos globalFlags getFlags userTargets =
+ case getSourceRepository getFlags
+ of NoFlag -> unpack verbosity
+ repos globalFlags getFlags userTargets
+
+ _ -> fork verbosity
+ repos globalFlags getFlags userTargets
+
+
+-- ------------------------------------------------------------
+-- * Unpacking the source tarball
+-- ------------------------------------------------------------
+
+unpack :: Verbosity
+ -> [Repo]
+ -> GlobalFlags
+ -> GetFlags
+ -> [UserTarget]
+ -> IO ()
+unpack verbosity repos globalFlags getFlags userTargets = do
+ mapM_ checkTarget userTargets
+
+ sourcePkgDb <- getSourcePackages verbosity repos
+
+ pkgSpecifiers <- resolveUserTargets verbosity
+ (fromFlag $ globalWorldFile globalFlags)
+ (packageIndex sourcePkgDb)
+ userTargets
+
+ pkgs <- either (die . unlines . map show) return $
+ resolveWithoutDependencies
+ (resolverParams sourcePkgDb pkgSpecifiers)
+
+ unless (null prefix) $
+ createDirectoryIfMissing True prefix
+
+ flip mapM_ pkgs $ \pkg -> do
+ location <- fetchPackage verbosity (packageSource pkg)
+ let pkgid = packageId pkg
+ descOverride | usePristine = Nothing
+ | otherwise = packageDescrOverride pkg
+ case location of
+ LocalTarballPackage tarballPath ->
+ unpackPackage verbosity prefix pkgid descOverride tarballPath
+
+ RemoteTarballPackage _tarballURL tarballPath ->
+ unpackPackage verbosity prefix pkgid descOverride tarballPath
+
+ RepoTarballPackage _repo _pkgid tarballPath ->
+ unpackPackage verbosity prefix pkgid descOverride tarballPath
+
+ LocalUnpackedPackage _ ->
+ error "Distribution.Client.Get.unpack: the impossible happened."
+
+ where
+ resolverParams sourcePkgDb pkgSpecifiers =
+ --TODO: add commandline constraint and preference args for unpack
+
+ standardInstallPolicy mempty sourcePkgDb pkgSpecifiers
+
+ prefix = fromFlagOrDefault "" (getDestDir getFlags)
+ usePristine = fromFlagOrDefault False (getPristine getFlags)
+
+checkTarget :: UserTarget -> IO ()
+checkTarget target = case target of
+ UserTargetLocalDir dir -> die (notTarball dir)
+ UserTargetLocalCabalFile file -> die (notTarball file)
+ _ -> return ()
+ where
+ notTarball t =
+ "The 'get' command is for tarball packages. "
+ ++ "The target '" ++ t ++ "' is not a tarball."
+
+unpackPackage :: Verbosity -> FilePath -> PackageId
+ -> PackageDescriptionOverride
+ -> FilePath -> IO ()
+unpackPackage verbosity prefix pkgid descOverride pkgPath = do
+ let pkgdirname = display pkgid
+ pkgdir = prefix </> pkgdirname
+ pkgdir' = addTrailingPathSeparator pkgdir
+ existsDir <- doesDirectoryExist pkgdir
+ when existsDir $ die $
+ "The directory \"" ++ pkgdir' ++ "\" already exists, not unpacking."
+ existsFile <- doesFileExist pkgdir
+ when existsFile $ die $
+ "A file \"" ++ pkgdir ++ "\" is in the way, not unpacking."
+ notice verbosity $ "Unpacking to " ++ pkgdir'
+ Tar.extractTarGzFile prefix pkgdirname pkgPath
+
+ case descOverride of
+ Nothing -> return ()
+ Just pkgtxt -> do
+ let descFilePath = pkgdir </> display (packageName pkgid) <.> "cabal"
+ info verbosity $
+ "Updating " ++ descFilePath
+ ++ " with the latest revision from the index."
+ writeFileAtomic descFilePath pkgtxt
+
+
+-- ------------------------------------------------------------
+-- * Forking the source repository
+-- ------------------------------------------------------------
+
+fork :: Verbosity
+ -> [Repo]
+ -> GlobalFlags
+ -> GetFlags
+ -> [UserTarget]
+ -> IO ()
+fork verbosity repos globalFlags getFlags userTargets = do
+ let prefix = fromFlagOrDefault "" (getDestDir getFlags)
+
+ --TODO: add commandline constraint and preference args?
+ let resolverParams sourcePkgDb pkgSpecifiers =
+ standardInstallPolicy mempty sourcePkgDb pkgSpecifiers
+
+ sourcePkgDb <- getSourcePackages verbosity repos
+
+ pkgSpecifiers <- resolveUserTargets
+ verbosity
+ (fromFlag $ globalWorldFile globalFlags)
+ (packageIndex sourcePkgDb)
+ userTargets
+
+ pkgs <- case resolveWithoutDependencies (resolverParams sourcePkgDb pkgSpecifiers) of
+ Right pkgs -> return pkgs
+ Left errors -> die (unlines (map show errors))
+
+ unless (null prefix) $
+ createDirectoryIfMissing True prefix
+
+ branchers <- findUsableBranchers
+ mapM_ (forkPackage verbosity branchers prefix) pkgs
+
+data BranchCmd = BranchCmd (Verbosity -> FilePath -> IO ExitCode)
+
+data Brancher = Brancher
+ { brancherBinary :: String
+ , brancherBuildCmd :: PD.SourceRepo -> Maybe BranchCmd
+ }
+
+-- | The set of all supported branch drivers.
+allBranchers :: [(PD.RepoType, Brancher)]
+allBranchers =
+ [ (PD.Bazaar, branchBzr)
+ , (PD.Darcs, branchDarcs)
+ , (PD.Git, branchGit)
+ , (PD.Mercurial, branchHg)
+ , (PD.SVN, branchSvn)
+ ]
+
+-- | Find which usable branch drivers (selected from 'allBranchers') are
+-- available and usable on the local machine.
+--
+-- Each driver's main command is run with @--help@, and if the child process
+-- exits successfully, that brancher is considered usable.
+findUsableBranchers :: IO (Data.Map.Map PD.RepoType Brancher)
+findUsableBranchers = do
+ let usable (_, brancher) = do
+ let cmd = brancherBinary brancher
+ (exitCode, _, _) <- readProcessWithExitCode cmd ["--help"] ""
+ return (exitCode == ExitSuccess)
+ pairs <- filterM usable allBranchers
+ return (Data.Map.fromList pairs)
+
+-- | Fork a single package from a remote source repository to the local
+-- filesystem.
+forkPackage :: Verbosity
+ -> Data.Map.Map PD.RepoType Brancher
+ -- ^ Branchers supported by the local machine.
+ -> FilePath
+ -- ^ The directory in which new branches or repositories will
+ -- be created.
+ -> SourcePackage
+ -- ^ The package to fork.
+ -> IO ()
+forkPackage verbosity branchers prefix src = do
+ let desc = PD.packageDescription (packageDescription src)
+ let pkgname = display (packageId src)
+ let destdir = prefix </> pkgname
+
+ destDirExists <- doesDirectoryExist destdir
+ when destDirExists $ do
+ die ("The directory " ++ show destdir ++ " already exists, not forking.")
+
+ destFileExists <- doesFileExist destdir
+ when destFileExists $ do
+ die ("A file " ++ show destdir ++ " is in the way, not forking.")
+
+ let repos = PD.sourceRepos desc
+ case findBranchCmd branchers repos of
+ Just (BranchCmd io) -> do
+ exitCode <- io verbosity destdir
+ case exitCode of
+ ExitSuccess -> return ()
+ ExitFailure _ -> die ("Couldn't fork package " ++ pkgname)
+ Nothing -> case repos of
+ [] -> die ("Package " ++ pkgname ++ " does not have any source repositories.")
+ _ -> die ("Package " ++ pkgname ++ " does not have any usable source repositories.")
+
+-- | Given a set of possible branchers, and a set of possible source
+-- repositories, find a repository that is both 1) likely to be specific to
+-- this source version and 2) is supported by the local machine.
+findBranchCmd :: Data.Map.Map PD.RepoType Brancher -> [PD.SourceRepo] -> Maybe BranchCmd
+findBranchCmd branchers allRepos = cmd where
+ -- Sort repositories by kind, from This to Head to Unknown. Repositories
+ -- with equivalent kinds are selected based on the order they appear in
+ -- the Cabal description file.
+ repos = sortBy (comparing thisFirst) allRepos
+ thisFirst r = case PD.repoKind r of
+ PD.RepoThis -> 0 :: Int
+ PD.RepoHead -> case PD.repoTag r of
+ -- If the type is 'head' but the author specified a tag, they
+ -- probably meant to create a 'this' repository but screwed up.
+ Just _ -> 0
+ Nothing -> 1
+ PD.RepoKindUnknown _ -> 2
+
+ repoBranchCmd repo = do
+ t <- PD.repoType repo
+ brancher <- Data.Map.lookup t branchers
+ brancherBuildCmd brancher repo
+
+ cmd = listToMaybe (mapMaybe repoBranchCmd repos)
+
+-- | Branch driver for Bazaar.
+branchBzr :: Brancher
+branchBzr = Brancher "bzr" $ \repo -> do
+ src <- PD.repoLocation repo
+ let args dst = case PD.repoTag repo of
+ Just tag -> ["branch", src, dst, "-r", "tag:" ++ tag]
+ Nothing -> ["branch", src, dst]
+ return $ BranchCmd $ \verbosity dst -> do
+ notice verbosity ("bzr: branch " ++ show src)
+ rawSystem "bzr" (args dst)
+
+-- | Branch driver for Darcs.
+branchDarcs :: Brancher
+branchDarcs = Brancher "darcs" $ \repo -> do
+ src <- PD.repoLocation repo
+ let args dst = case PD.repoTag repo of
+ Just tag -> ["get", src, dst, "-t", tag]
+ Nothing -> ["get", src, dst]
+ return $ BranchCmd $ \verbosity dst -> do
+ notice verbosity ("darcs: get " ++ show src)
+ rawSystem "darcs" (args dst)
+
+-- | Branch driver for Git.
+branchGit :: Brancher
+branchGit = Brancher "git" $ \repo -> do
+ src <- PD.repoLocation repo
+ let branchArgs = case PD.repoBranch repo of
+ Just b -> ["--branch", b]
+ Nothing -> []
+ let postClone dst = case PD.repoTag repo of
+ Just t -> do
+ cwd <- getCurrentDirectory
+ setCurrentDirectory dst
+ finally
+ (rawSystem "git" (["checkout", t] ++ branchArgs))
+ (setCurrentDirectory cwd)
+ Nothing -> return ExitSuccess
+ return $ BranchCmd $ \verbosity dst -> do
+ notice verbosity ("git: clone " ++ show src)
+ code <- rawSystem "git" (["clone", src, dst] ++ branchArgs)
+ case code of
+ ExitFailure _ -> return code
+ ExitSuccess -> postClone dst
+
+-- | Branch driver for Mercurial.
+branchHg :: Brancher
+branchHg = Brancher "hg" $ \repo -> do
+ src <- PD.repoLocation repo
+ let branchArgs = case PD.repoBranch repo of
+ Just b -> ["--branch", b]
+ Nothing -> []
+ let tagArgs = case PD.repoTag repo of
+ Just t -> ["--rev", t]
+ Nothing -> []
+ let args dst = ["clone", src, dst] ++ branchArgs ++ tagArgs
+ return $ BranchCmd $ \verbosity dst -> do
+ notice verbosity ("hg: clone " ++ show src)
+ rawSystem "hg" (args dst)
+
+-- | Branch driver for Subversion.
+branchSvn :: Brancher
+branchSvn = Brancher "svn" $ \repo -> do
+ src <- PD.repoLocation repo
+ let args dst = ["checkout", src, dst]
+ return $ BranchCmd $ \verbosity dst -> do
+ notice verbosity ("svn: checkout " ++ show src)
+ rawSystem "svn" (args dst)
diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
index f12410345ec1f3a1c8718198e0ec44d4345cfeb7..3cbd2eb25f1655531fcf64dc2b62541c06cf9de5 100644
--- a/cabal-install/Distribution/Client/Setup.hs
+++ b/cabal-install/Distribution/Client/Setup.hs
@@ -22,11 +22,11 @@ module Distribution.Client.Setup
, upgradeCommand
, infoCommand, InfoFlags(..)
, fetchCommand, FetchFlags(..)
+ , getCommand, GetFlags(..)
, checkCommand
, uploadCommand, UploadFlags(..)
, reportCommand, ReportFlags(..)
, runCommand
- , unpackCommand, UnpackFlags(..)
, initCommand, IT.InitFlags(..)
, sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
, win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
@@ -67,6 +67,8 @@ import Distribution.Version
( Version(Version), anyVersion, thisVersion )
import Distribution.Package
( PackageIdentifier, packageName, packageVersion, Dependency(..) )
+import Distribution.PackageDescription
+ ( RepoKind(..) )
import Distribution.Text
( Text(..), display )
import Distribution.ReadE
@@ -511,51 +513,62 @@ instance Monoid ReportFlags where
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
--- * Unpack flags
+-- * Get flags
-- ------------------------------------------------------------
-data UnpackFlags = UnpackFlags {
- unpackDestDir :: Flag FilePath,
- unpackVerbosity :: Flag Verbosity,
- unpackPristine :: Flag Bool
- }
+data GetFlags = GetFlags {
+ getDestDir :: Flag FilePath,
+ getPristine :: Flag Bool,
+ getSourceRepository :: Flag (Maybe RepoKind),
+ getVerbosity :: Flag Verbosity
+ }
-defaultUnpackFlags :: UnpackFlags
-defaultUnpackFlags = UnpackFlags {
- unpackDestDir = mempty,
- unpackVerbosity = toFlag normal,
- unpackPristine = toFlag False
+defaultGetFlags :: GetFlags
+defaultGetFlags = GetFlags {
+ getDestDir = mempty,
+ getPristine = mempty,
+ getSourceRepository = mempty,
+ getVerbosity = toFlag normal
}
-unpackCommand :: CommandUI UnpackFlags
-unpackCommand = CommandUI {
- commandName = "unpack",
- commandSynopsis = "Unpacks packages for user inspection.",
+getCommand :: CommandUI GetFlags
+getCommand = CommandUI {
+ commandName = "get",
+ commandSynopsis = "Gets a package's source code.",
commandDescription = Nothing,
- commandUsage = usagePackages "unpack",
+ commandUsage = usagePackages "get",
commandDefaultFlags = mempty,
commandOptions = \_ -> [
- optionVerbosity unpackVerbosity (\v flags -> flags { unpackVerbosity = v })
+ optionVerbosity getVerbosity (\v flags -> flags { getVerbosity = v })
,option "d" ["destdir"]
- "where to unpack the packages, defaults to the current directory."
- unpackDestDir (\v flags -> flags { unpackDestDir = v })
+ "where to place the package source, defaults to the current directory."
+ getDestDir (\v flags -> flags { getDestDir = v })
(reqArgFlag "PATH")
+ ,option "s" ["source-repository"]
+ "fork the package's source repository."
+ getSourceRepository (\v flags -> flags { getSourceRepository = v })
+ (optArg "[head|this|...]" (readP_to_E (const "invalid source-repository")
+ (fmap (toFlag . Just) parse))
+ (Flag Nothing)
+ (map (fmap show) . flagToList))
+
, option [] ["pristine"]
("Unpack the original pristine tarball, rather than updating the "
++ ".cabal file with the latest revision from the package archive.")
- unpackPristine (\v flags -> flags { unpackPristine = v })
+ getPristine (\v flags -> flags { getPristine = v })
trueArg
]
}
-instance Monoid UnpackFlags where
- mempty = defaultUnpackFlags
- mappend a b = UnpackFlags {
- unpackDestDir = combine unpackDestDir,
- unpackVerbosity = combine unpackVerbosity,
- unpackPristine = combine unpackPristine
+instance Monoid GetFlags where
+ mempty = defaultGetFlags
+ mappend a b = GetFlags {
+ getDestDir = combine getDestDir,
+ getPristine = combine getPristine,
+ getSourceRepository = combine getSourceRepository,
+ getVerbosity = combine getVerbosity
}
where combine field = field a `mappend` field b
diff --git a/cabal-install/Distribution/Client/Unpack.hs b/cabal-install/Distribution/Client/Unpack.hs
deleted file mode 100644
index 3d4ddbdc99d0768269110112f4a7e9b445016f05..0000000000000000000000000000000000000000
--- a/cabal-install/Distribution/Client/Unpack.hs
+++ /dev/null
@@ -1,137 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Distribution.Client.Unpack
--- Copyright : (c) Andrea Vezzosi 2008
--- Duncan Coutts 2011
--- License : BSD-like
---
--- Maintainer : cabal-devel@haskell.org
--- Stability : provisional
--- Portability : portable
---
---
------------------------------------------------------------------------------
-module Distribution.Client.Unpack (
-
- -- * Commands
- unpack,
-
- ) where
-
-import Distribution.Package
- ( PackageId, packageId, packageName )
-import Distribution.Simple.Setup
- ( fromFlag, fromFlagOrDefault )
-import Distribution.Simple.Utils
- ( notice, die, info, writeFileAtomic )
-import Distribution.Verbosity
- ( Verbosity )
-import Distribution.Text(display)
-
-import Distribution.Client.Setup
- ( GlobalFlags(..), UnpackFlags(..) )
-import Distribution.Client.Types
-import Distribution.Client.Targets
-import Distribution.Client.Dependency
-import Distribution.Client.FetchUtils
-import qualified Distribution.Client.Tar as Tar (extractTarGzFile)
-import Distribution.Client.IndexUtils as IndexUtils
- ( getSourcePackages )
-
-import System.Directory
- ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist )
-import Control.Monad
- ( unless, when, forM_ )
-import Data.Monoid
- ( mempty )
-import System.FilePath
- ( (</>), (<.>), addTrailingPathSeparator )
-
-
-unpack :: Verbosity
- -> [Repo]
- -> GlobalFlags
- -> UnpackFlags
- -> [UserTarget]
- -> IO ()
-unpack verbosity _ _ _ [] =
- notice verbosity "No packages requested. Nothing to do."
-
-unpack verbosity repos globalFlags unpackFlags userTargets = do
- mapM_ checkTarget userTargets
-
- sourcePkgDb <- getSourcePackages verbosity repos
-
- pkgSpecifiers <- resolveUserTargets verbosity
- (fromFlag $ globalWorldFile globalFlags)
- (packageIndex sourcePkgDb)
- userTargets
-
- pkgs <- either (die . unlines . map show) return $
- resolveWithoutDependencies
- (resolverParams sourcePkgDb pkgSpecifiers)
-
- unless (null prefix) $
- createDirectoryIfMissing True prefix
-
- forM_ pkgs $ \pkg -> do
- location <- fetchPackage verbosity (packageSource pkg)
- let pkgid = packageId pkg
- descOverride | usePristine = Nothing
- | otherwise = packageDescrOverride pkg
- case location of
- LocalTarballPackage tarballPath ->
- unpackPackage verbosity prefix pkgid descOverride tarballPath
-
- RemoteTarballPackage _tarballURL tarballPath ->
- unpackPackage verbosity prefix pkgid descOverride tarballPath
-
- RepoTarballPackage _repo _pkgid tarballPath ->
- unpackPackage verbosity prefix pkgid descOverride tarballPath
-
- LocalUnpackedPackage _ ->
- error "Distribution.Client.Unpack.unpack: the impossible happened."
-
- where
- resolverParams sourcePkgDb pkgSpecifiers =
- --TODO: add commandline constraint and preference args for unpack
-
- standardInstallPolicy mempty sourcePkgDb pkgSpecifiers
-
- prefix = fromFlagOrDefault "" (unpackDestDir unpackFlags)
- usePristine = fromFlagOrDefault False (unpackPristine unpackFlags)
-
-checkTarget :: UserTarget -> IO ()
-checkTarget target = case target of
- UserTargetLocalDir dir -> die (notTarball dir)
- UserTargetLocalCabalFile file -> die (notTarball file)
- _ -> return ()
- where
- notTarball t =
- "The 'unpack' command is for tarball packages. "
- ++ "The target '" ++ t ++ "' is not a tarball."
-
-unpackPackage :: Verbosity -> FilePath -> PackageId
- -> PackageDescriptionOverride
- -> FilePath -> IO ()
-unpackPackage verbosity prefix pkgid descOverride pkgPath = do
- let pkgdirname = display pkgid
- pkgdir = prefix </> pkgdirname
- pkgdir' = addTrailingPathSeparator pkgdir
- existsDir <- doesDirectoryExist pkgdir
- when existsDir $ die $
- "The directory \"" ++ pkgdir' ++ "\" already exists, not unpacking."
- existsFile <- doesFileExist pkgdir
- when existsFile $ die $
- "A file \"" ++ pkgdir ++ "\" is in the way, not unpacking."
- notice verbosity $ "Unpacking to " ++ pkgdir'
- Tar.extractTarGzFile prefix pkgdirname pkgPath
-
- case descOverride of
- Nothing -> return ()
- Just pkgtxt -> do
- let descFilePath = pkgdir </> display (packageName pkgid) <.> "cabal"
- info verbosity $
- "Updating " ++ descFilePath
- ++ " with the latest revision from the index."
- writeFileAtomic descFilePath pkgtxt
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 6f506ae83fe233e496dc969e0d42c99470af94aa..c4b6852ad92bb30826bb9fb67ae3bf5e18d7a239 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -76,6 +76,7 @@ Library
Distribution.Client.Dependency.Modular.Version
Distribution.Client.Fetch
Distribution.Client.FetchUtils
+ Distribution.Client.Get
Distribution.Client.GZipUtils
Distribution.Client.Haddock
Distribution.Client.HttpUtils
@@ -102,7 +103,6 @@ Library
Distribution.Client.Tar
Distribution.Client.Targets
Distribution.Client.Types
- Distribution.Client.Unpack
Distribution.Client.Update
Distribution.Client.Upload
Distribution.Client.Utils
diff --git a/cabal-install/src/Main.hs b/cabal-install/src/Main.hs
index 04cf410344c3dc16bff436dedb422ba0aecd5241..8b942629aba07d56f8d7cbc5e0f095ca430e98e0 100644
--- a/cabal-install/src/Main.hs
+++ b/cabal-install/src/Main.hs
@@ -21,6 +21,7 @@ import Distribution.Client.Setup
, InstallFlags(..), defaultInstallFlags
, installCommand, upgradeCommand
, FetchFlags(..), fetchCommand
+ , GetFlags(..), getCommand
, checkCommand
, updateCommand
, ListFlags(..), listCommand
@@ -37,7 +38,7 @@ import Distribution.Client.Setup
, sandboxBuildCommand, sandboxInstallCommand
, dumpPkgEnvCommand
, reportCommand
- , unpackCommand, UnpackFlags(..) )
+ )
import Distribution.Simple.Setup
( HaddockFlags(..), haddockCommand
, HscolourFlags(..), hscolourCommand
@@ -65,7 +66,7 @@ import Distribution.Client.Check as Check (check)
import Distribution.Client.Upload as Upload (upload, check, report)
import Distribution.Client.Run (run)
import Distribution.Client.SrcDist (sdist)
-import Distribution.Client.Unpack (unpack)
+import Distribution.Client.Get (get)
import Distribution.Client.Index (index)
import Distribution.Client.Sandbox (sandboxInit
, sandboxDelete
@@ -149,7 +150,7 @@ mainWorker args = topHandler $
,listCommand `commandAddAction` listAction
,infoCommand `commandAddAction` infoAction
,fetchCommand `commandAddAction` fetchAction
- ,unpackCommand `commandAddAction` unpackAction
+ ,getCommand `commandAddAction` getAction
,checkCommand `commandAddAction` checkAction
,sdistCommand `commandAddAction` sdistAction
,uploadCommand `commandAddAction` uploadAction
@@ -568,17 +569,17 @@ runAction buildFlags extraArgs globalFlags = do
run verbosity buildFlags extraArgs
-unpackAction :: UnpackFlags -> [String] -> GlobalFlags -> IO ()
-unpackAction unpackFlags extraArgs globalFlags = do
- let verbosity = fromFlag (unpackVerbosity unpackFlags)
+getAction :: GetFlags -> [String] -> GlobalFlags -> IO ()
+getAction getFlags extraArgs globalFlags = do
+ let verbosity = fromFlag (getVerbosity getFlags)
targets <- readUserTargets verbosity extraArgs
config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
let globalFlags' = savedGlobalFlags config `mappend` globalFlags
- unpack verbosity
- (globalRepos (savedGlobalFlags config))
- globalFlags'
- unpackFlags
- targets
+ get verbosity
+ (globalRepos (savedGlobalFlags config))
+ globalFlags'
+ getFlags
+ targets
initAction :: InitFlags -> [String] -> GlobalFlags -> IO ()
initAction initFlags _extraArgs globalFlags = do