diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs index 4b10814857c..b9247a09cff 100644 --- a/cabal-install/Distribution/Client/SrcDist.hs +++ b/cabal-install/Distribution/Client/SrcDist.hs @@ -1,113 +1,26 @@ -{-# 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 diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 96e9c6e1b64..01ae5070c88 100644 --- a/cabal-install/main/Main.hs +++ b/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) diff --git a/changelog.d/issue-6635 b/changelog.d/issue-6635 new file mode 100644 index 00000000000..51e83f28023 --- /dev/null +++ b/changelog.d/issue-6635 @@ -0,0 +1,3 @@ +synopsis: Remove `v1-sdist` command. +issues: #6635 +prs: #6637