Add cabal get --only-package-description

With this option, 'cabal get' writes to the destination directory only the
package description already available locally in one of the repository
indices.

The basename of the file name written to inside the target directory is
the package-id rather than only the package name.

This is mostly based on #1977

Co-authored-by: Miëtek Bak <[email protected]>
Co-authored-by: Artem Pelenitsyn <[email protected]>

Author: 3 people

cabal-install/src/Distribution/Client/Get.hs

@@ -31,7 +31,7 @@ import Distribution.Package
 import Distribution.Simple.Setup
          ( Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe )
 import Distribution.Simple.Utils
-         ( notice, die', info, writeFileAtomic )
+         ( notice, die', info, warn, writeFileAtomic )
 import qualified Distribution.PackageDescription as PD
 import Distribution.Simple.Program
          ( programName )
@@ -49,8 +49,11 @@ import qualified Distribution.Client.Tar as Tar (extractTarGzFile)
 import Distribution.Client.IndexUtils
         ( getSourcePackagesAtIndexState, TotalIndexState, ActiveRepos )
 import Distribution.Solver.Types.SourcePackage
+import Distribution.PackageDescription.PrettyPrint
+        ( writeGenericPackageDescription )
 
 import qualified Data.Map as Map
+import Control.Monad ( mapM_ )
 import System.Directory
          ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist )
 import System.FilePath
@@ -94,16 +97,26 @@ get verbosity repoCtxt _ getFlags userTargets = do
   unless (null prefix) $
     createDirectoryIfMissing True prefix
 
-  if useSourceRepo
-    then clone  pkgs
-    else unpack pkgs
+  if onlyPkgDescr
+    then do
+      when useSourceRepo $
+        warn verbosity $
+          "Ignoring --source-repository for --only-package-description"
+
+      mapM_ (unpackOnlyPkgDescr verbosity prefix) pkgs
+    else
+      if useSourceRepo
+        then clone pkgs
+        else unpack pkgs
 
   where
     resolverParams :: SourcePackageDb -> [PackageSpecifier UnresolvedSourcePackage] -> DepResolverParams
     resolverParams sourcePkgDb pkgSpecifiers =
         --TODO: add command-line constraint and preference args for unpack
         standardInstallPolicy mempty sourcePkgDb pkgSpecifiers
 
+    onlyPkgDescr = fromFlagOrDefault False (getOnlyPkgDescr getFlags)
+
     prefix :: String
     prefix = fromFlagOrDefault "" (getDestDir getFlags)
 
@@ -189,6 +202,23 @@ unpackPackage verbosity prefix pkgid descOverride pkgPath = do
         writeFileAtomic descFilePath pkgtxt
 
 
+-- | Write a @pkgId.cabal@ file with the package description to the destination
+-- directory, unless one already exists.
+unpackOnlyPkgDescr :: Verbosity -> FilePath -> UnresolvedSourcePackage -> IO ()
+unpackOnlyPkgDescr verbosity dstDir pkg = do
+    let pkgFile = dstDir </> prettyShow (packageId pkg) <.> "cabal"
+    existsFile <- doesFileExist pkgFile
+    when existsFile $ die' verbosity $
+      "The file \"" ++ pkgFile ++ "\" already exists, not overwriting."
+    existsDir <- doesDirectoryExist (addTrailingPathSeparator pkgFile)
+    when existsDir $ die' verbosity $
+      "A directory \"" ++ pkgFile ++ "\" is in the way, not unpacking."
+    notice verbosity $ "Writing package description to " ++ pkgFile
+    case srcpkgDescrOverride pkg of
+      Just pkgTxt -> writeFileAtomic pkgFile pkgTxt
+      Nothing ->
+        writeGenericPackageDescription pkgFile (srcpkgDescription pkg)
+
 -- ------------------------------------------------------------
 -- * Cloning packages from their declared source repositories
 -- ------------------------------------------------------------

cabal-install/src/Distribution/Client/Setup.hs

@@ -1297,6 +1297,7 @@ instance Semigroup ReportFlags where
 
 data GetFlags = GetFlags {
     getDestDir          :: Flag FilePath,
+    getOnlyPkgDescr     :: Flag Bool,
     getPristine         :: Flag Bool,
     getIndexState       :: Flag TotalIndexState,
     getActiveRepos      :: Flag ActiveRepos,
@@ -1307,6 +1308,7 @@ data GetFlags = GetFlags {
 defaultGetFlags :: GetFlags
 defaultGetFlags = GetFlags {
     getDestDir          = mempty,
+    getOnlyPkgDescr     = mempty,
     getPristine         = mempty,
     getIndexState       = mempty,
     getActiveRepos      = mempty,
@@ -1352,6 +1354,16 @@ getCommand = CommandUI {
                                       (toFlag `fmap` parsec))
                           (flagToList . fmap prettyShow))
 
+       , option [] ["only-package-description"]
+           "Unpack only the package description file."
+           getOnlyPkgDescr (\v flags -> flags { getOnlyPkgDescr = v })
+           trueArg
+
+       , option [] ["package-description-only"]
+           "A synonym for --only-package-description."
+           getOnlyPkgDescr (\v flags -> flags { getOnlyPkgDescr = v })
+           trueArg
+
        , option [] ["pristine"]
            ("Unpack the original pristine tarball, rather than updating the "
            ++ ".cabal file with the latest revision from the package archive.")

changelog.d/issue-1954

@@ -0,0 +1,4 @@
+synopsis: Add `cabal get --only-package-description`
+packages: cabal-install
+prs: #1977 #5162 #8263
+issues: #1954

doc/cabal-package.rst

@@ -2865,6 +2865,9 @@ The ``get`` command supports the following options:
     ``2016-09-24T17:47:48Z``), or ``HEAD`` (default).
     This determines which package versions are available as well as which
     ``.cabal`` file revision is selected (unless ``--pristine`` is used).
+``--only-package-description``
+    Unpack only the package description file. A synonym,
+    ``package-description-only``, is provided for convenience.
 ``--pristine``
     Unpack the original pristine tarball, rather than updating the
     ``.cabal`` file with the latest revision from the package archive.