Merge pull request #6637 from phadej/remove-v1-sdist

Remove v1-sdist

cabal-install/Distribution/Client/SrcDist.hs

-{-# LANGUAGE CPP #-}
-{-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE FlexibleContexts #-}
--- Implements the \"@.\/cabal sdist@\" command, which creates a source
--- distribution for this package.  That is, packs up the source code
--- into a tarball, making use of the corresponding Cabal module.
+-- | Utilities to implemenet cabal @v2-sdist@.
 module Distribution.Client.SrcDist (
-         sdist,
-         allPackageSourceFiles
-  )  where
+    allPackageSourceFiles,
+)  where
 
 
-import Distribution.Client.SetupWrapper
-        ( SetupScriptOptions(..), defaultSetupScriptOptions, setupWrapper )
-import Distribution.Client.Tar (createTarGzFile)
+import Control.Exception (IOException, evaluate)
+import System.Directory  (getTemporaryDirectory)
+import System.FilePath   ((</>))
 
-import Distribution.Package
-         ( Package(..), packageName )
-import Distribution.PackageDescription
-         ( PackageDescription )
-import Distribution.PackageDescription.Configuration
-         ( flattenPackageDescription )
-import Distribution.PackageDescription.Parsec
-         ( readGenericPackageDescription )
-import Distribution.Simple.Utils
-         ( createDirectoryIfMissingVerbose, defaultPackageDesc
-         , warn, notice, withTempDirectory )
-import Distribution.Client.Setup
-         ( SDistFlags(..) )
-import Distribution.Simple.Setup
-         ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault
-         , defaultSDistFlags )
-import Distribution.Simple.BuildPaths ( srcPref)
-import Distribution.Deprecated.Text ( display )
-import Distribution.Verbosity (Verbosity, normal, lessVerbose)
-import Distribution.Version   (mkVersion, orLaterVersion, intersectVersionRanges)
-
-import Distribution.Client.Utils
-  (tryFindAddSourcePackageDesc)
 import Distribution.Compat.Exception                 (catchIO)
-
-import System.FilePath ((</>), (<.>))
-import Control.Monad (when, unless, liftM)
-import System.Directory (getTemporaryDirectory)
-import Control.Exception                             (IOException, evaluate)
-
--- |Create a source distribution.
-sdist :: SDistFlags -> IO ()
-sdist flags = do
-  pkg <- liftM flattenPackageDescription
-    (readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity)
-  let withDir :: (FilePath -> IO a) -> IO a
-      withDir = if not needMakeArchive then \f -> f tmpTargetDir
-                else withTempDirectory verbosity tmpTargetDir "sdist."
-  -- 'withTempDir' fails if we don't create 'tmpTargetDir'...
-  when needMakeArchive $
-    createDirectoryIfMissingVerbose verbosity True tmpTargetDir
-  withDir $ \tmpDir -> do
-    let outDir = if isOutDirectory then tmpDir else tmpDir </> tarBallName pkg
-        flags' = (if not needMakeArchive then flags
-                  else flags { sDistDirectory = Flag outDir })
-    unless isListSources $
-      createDirectoryIfMissingVerbose verbosity True outDir
-
-    -- Run 'setup sdist --output-directory=tmpDir' (or
-    -- '--list-source'/'--output-directory=someOtherDir') in case we were passed
-    -- those options.
-    setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') (const [])
-
-    -- Unless we were given --list-sources or --output-directory ourselves,
-    -- create an archive.
-    when needMakeArchive $
-      createTarGzArchive verbosity pkg tmpDir distPref
-
-    when isOutDirectory $
-      notice verbosity $ "Source directory created: " ++ tmpTargetDir
-
-    when isListSources $
-      notice verbosity $ "List of package sources written to file '"
-                         ++ (fromFlag . sDistListSources $ flags) ++ "'"
-
-  where
-    flagEnabled f  = not . null . flagToList . f $ flags
-
-    isListSources   = flagEnabled sDistListSources
-    isOutDirectory  = flagEnabled sDistDirectory
-    needMakeArchive = not (isListSources || isOutDirectory)
-    verbosity       = fromFlag (sDistVerbosity flags)
-    distPref        = fromFlag (sDistDistPref flags)
-    tmpTargetDir    = fromFlagOrDefault (srcPref distPref) (sDistDirectory flags)
-    setupOpts       = defaultSetupScriptOptions {
-      useDistPref     = distPref,
-      -- The '--output-directory' sdist flag was introduced in Cabal 1.12, and
-      -- '--list-sources' in 1.17.
-      useCabalVersion = if isListSources
-                        then orLaterVersion $ mkVersion [1,17,0]
-                        else orLaterVersion $ mkVersion [1,12,0]
-      }
-
-tarBallName :: PackageDescription -> String
-tarBallName = display . packageId
-
--- | Create a tar.gz archive from a tree of source files.
-createTarGzArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath
-                    -> IO ()
-createTarGzArchive verbosity pkg tmpDir targetPref = do
-    createTarGzFile tarBallFilePath tmpDir (tarBallName pkg)
-    notice verbosity $ "Source tarball created: " ++ tarBallFilePath
-  where
-    tarBallFilePath = targetPref </> tarBallName pkg <.> "tar.gz"
+import Distribution.Package                          (packageName)
+import Distribution.PackageDescription.Configuration (flattenPackageDescription)
+import Distribution.PackageDescription.Parsec        (readGenericPackageDescription)
+import Distribution.Pretty                           (prettyShow)
+import Distribution.Simple.Setup                     (Flag (..), defaultSDistFlags, sdistCommand)
+import Distribution.Simple.Utils                     (warn, withTempDirectory)
+import Distribution.Verbosity                        (Verbosity, lessVerbose, normal)
+import Distribution.Version                          (intersectVersionRanges, mkVersion, orLaterVersion)
+
+import Distribution.Client.Setup        (SDistFlags (..))
+import Distribution.Client.SetupWrapper (SetupScriptOptions (..), setupWrapper)
+import Distribution.Client.Utils        (tryFindAddSourcePackageDesc)
 
 -- | List all source files of a given add-source dependency. Exits with error if
 -- something is wrong (e.g. there is no .cabal file in the given directory).
@@ -120,36 +33,36 @@ allPackageSourceFiles verbosity setupOpts0 packageDir = do
     flattenPackageDescription `fmap` readGenericPackageDescription verbosity desc
   globalTmp <- getTemporaryDirectory
   withTempDirectory verbosity globalTmp "cabal-list-sources." $ \tempDir -> do
-  let file      = tempDir </> "cabal-sdist-list-sources"
-      flags     = defaultSDistFlags {
-        sDistVerbosity   = Flag $ if verbosity == normal
-                                  then lessVerbose verbosity else verbosity,
-        sDistListSources = Flag file
-        }
-      setupOpts = setupOpts0 {
-        -- 'sdist --list-sources' was introduced in Cabal 1.18.
-        useCabalVersion = intersectVersionRanges
-                            (orLaterVersion $ mkVersion [1,18,0])
-                            (useCabalVersion setupOpts0),
-        useWorkingDir = Just packageDir
-        }
-
-      doListSources :: IO [FilePath]
-      doListSources = do
-        setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) (const [])
-        fmap lines . readFile $ file
-
-      onFailedListSources :: IOException -> IO ()
-      onFailedListSources e = do
-        warn verbosity $
-          "Could not list sources of the package '"
-          ++ display (packageName pkg) ++ "'."
-        warn verbosity $
-          "Exception was: " ++ show e
-
-  -- Run setup sdist --list-sources=TMPFILE
-  r <- doListSources `catchIO` (\e -> onFailedListSources e >> return [])
-  -- Ensure that we've closed the 'readFile' handle before we exit the
-  -- temporary directory.
-  _ <- evaluate (length r)
-  return r
+    let file      = tempDir </> "cabal-sdist-list-sources"
+        flags     = defaultSDistFlags {
+          sDistVerbosity   = Flag $ if verbosity == normal
+                                    then lessVerbose verbosity else verbosity,
+          sDistListSources = Flag file
+          }
+        setupOpts = setupOpts0 {
+          -- 'sdist --list-sources' was introduced in Cabal 1.18.
+          useCabalVersion = intersectVersionRanges
+                              (orLaterVersion $ mkVersion [1,18,0])
+                              (useCabalVersion setupOpts0),
+          useWorkingDir = Just packageDir
+          }
+
+        doListSources :: IO [FilePath]
+        doListSources = do
+          setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) (const [])
+          fmap lines . readFile $ file
+
+        onFailedListSources :: IOException -> IO ()
+        onFailedListSources e = do
+          warn verbosity $
+            "Could not list sources of the package '"
+            ++ prettyShow (packageName pkg) ++ "'."
+          warn verbosity $
+            "Exception was: " ++ show e
+
+    -- Run setup sdist --list-sources=TMPFILE
+    r <- doListSources `catchIO` (\e -> onFailedListSources e >> return [])
+    -- Ensure that we've closed the 'readFile' handle before we exit the
+    -- temporary directory.
+    _ <- evaluate (length r)
+    return r

cabal-install/main/Main.hs

@@ -39,7 +39,6 @@ import Distribution.Client.Setup
          , ReportFlags(..), reportCommand
          , runCommand
          , InitFlags(initVerbosity, initHcPath), initCommand
-         , SDistFlags(..), sdistCommand
          , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
          , ActAsSetupFlags(..), actAsSetupCommand
          , SandboxFlags(..), sandboxCommand
@@ -107,7 +106,6 @@ import Distribution.Client.Check as Check     (check)
 --import Distribution.Client.Clean            (clean)
 import qualified Distribution.Client.Upload as Upload
 import Distribution.Client.Run                (run, splitRunArgs)
-import Distribution.Client.SrcDist            (sdist)
 import Distribution.Client.Get                (get)
 import Distribution.Client.Reconfigure        (Check(..), reconfigure)
 import Distribution.Client.Nix                (nixInstantiate
@@ -309,7 +307,6 @@ mainWorker args = do
       , legacyCmd benchmarkCommand benchmarkAction
       , legacyCmd execCommand execAction
       , legacyCmd cleanCommand cleanAction
-      , legacyCmd sdistCommand sdistAction
       , legacyCmd doctestCommand doctestAction
       , legacyWrapperCmd copyCommand copyVerbosity copyDistPref
       , legacyWrapperCmd registerCommand regVerbosity regDistPref
@@ -1050,17 +1047,6 @@ uninstallAction verbosityFlag extraArgs _globalFlags = do
     ++ "in the meantime you're advised to use either 'ghc-pkg unregister "
     ++ package ++ "' or 'cabal sandbox hc-pkg -- unregister " ++ package ++ "'."
 
-
-sdistAction :: SDistFlags -> [String] -> Action
-sdistAction sdistFlags extraArgs globalFlags = do
-  let verbosity = fromFlag (sDistVerbosity sdistFlags)
-  unless (null extraArgs) $
-    die' verbosity $ "'sdist' doesn't take any extra arguments: " ++ unwords extraArgs
-  load <- try (loadConfigOrSandboxConfig verbosity globalFlags)
-  let config = either (\(SomeException _) -> mempty) snd load
-  distPref <- findSavedDistPref config (sDistDistPref sdistFlags)
-  sdist sdistFlags { sDistDistPref = toFlag distPref }
-
 reportAction :: ReportFlags -> [String] -> Action
 reportAction reportFlags extraArgs globalFlags = do
   let verbosity = fromFlag (reportVerbosity reportFlags)

changelog.d/issue-6635

+synopsis: Remove `v1-sdist` command.
+issues: #6635
+prs: #6637