From 8217174d13c801d171d5f7e337f4bd77596cc530 Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Fri, 30 Nov 2018 23:06:05 -0500 Subject: [PATCH 1/8] remove zip format code, zip-archive dependency, redundant + unused imports --- cabal-install/Distribution/Client/CmdSdist.hs | 24 ++--------- .../Distribution/Client/DistDirLayout.hs | 3 +- cabal-install/Distribution/Client/Setup.hs | 5 +-- cabal-install/Distribution/Client/SrcDist.hs | 41 +------------------ cabal-install/cabal-install.cabal | 1 - 5 files changed, 8 insertions(+), 66 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index 50aae6a8eab..874d4390785 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -61,20 +61,17 @@ import Distribution.Verbosity import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar -import qualified Codec.Archive.Zip as Zip import qualified Codec.Compression.GZip as GZip import Control.Exception ( throwIO ) import Control.Monad - ( when, forM, forM_ ) + ( when, forM_ ) import Control.Monad.Trans ( liftIO ) import Control.Monad.State.Lazy ( StateT, modify, gets, evalStateT ) import Control.Monad.Writer.Lazy ( WriterT, tell, execWriterT ) -import Data.Bits - ( shiftL ) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Either @@ -122,8 +119,7 @@ sdistCommand = CommandUI (choiceOpt [ (Flag TargzFormat, ([], ["targz"]), "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - , (Flag ZipFormat, ([], ["zip"]), - "Produce a '.zip' format archive") + -- ... ] ) , option ['o'] ["output-dir", "outputdir"] @@ -191,7 +187,6 @@ sdistAction SdistFlags{..} targetStrings globalFlags = do ext = case format of SourceList _ -> "list" Archive TargzFormat -> "tar.gz" - Archive ZipFormat -> "zip" outputPath pkg = case mOutputPath' of Just path @@ -301,20 +296,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do write . normalize . GZip.compress . Tar.write $ fmap setModTime entries when (outputFile /= "-") $ notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" - Archive ZipFormat -> do - let prefix = prettyShow (packageId pkg) - entries <- forM files $ \(perm, file) -> do - let perm' = case perm of - -- -rwxr-xr-x - Exec -> 0o010755 `shiftL` 16 - -- -rw-r--r-- - NoExec -> 0o010644 `shiftL` 16 - contents <- BSL.readFile file - return $ (Zip.toEntry (prefix file) 0 contents) { Zip.eExternalFileAttributes = perm' } - let archive = foldr Zip.addEntryToArchive Zip.emptyArchive entries - write (Zip.fromArchive archive) - when (outputFile /= "-") $ - notice verbosity $ "Wrote zip sdist to " ++ outputFile ++ "\n" + setCurrentDirectory oldPwd -- diff --git a/cabal-install/Distribution/Client/DistDirLayout.hs b/cabal-install/Distribution/Client/DistDirLayout.hs index 2a27880756d..dd5652d7f6b 100644 --- a/cabal-install/Distribution/Client/DistDirLayout.hs +++ b/cabal-install/Distribution/Client/DistDirLayout.hs @@ -231,8 +231,7 @@ defaultDistDirLayout projectRoot mdistDirectory = where ext = case format of TargzFormat -> "tar.gz" - ZipFormat -> "zip" - + distSdistDirectory = distDirectory "sdist" distTempDirectory = distDirectory "tmp" diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index b6685482cee..db8f736b9f7 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -2389,7 +2389,7 @@ data SDistExFlags = SDistExFlags { } deriving (Show, Generic) -data ArchiveFormat = TargzFormat | ZipFormat -- ... +data ArchiveFormat = TargzFormat -- ... deriving (Show, Eq) defaultSDistExFlags :: SDistExFlags @@ -2416,8 +2416,7 @@ sdistCommand = Cabal.sdistCommand { (choiceOpt [ (Flag TargzFormat, ([], ["targz"]), "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - , (Flag ZipFormat, ([], ["zip"]), - "Produce a '.zip' format archive") + -- ... ]) ] diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs index 3c85fb19b37..158744c7711 100644 --- a/cabal-install/Distribution/Client/SrcDist.hs +++ b/cabal-install/Distribution/Client/SrcDist.hs @@ -24,15 +24,13 @@ import Distribution.PackageDescription.Parsec ( readGenericPackageDescription ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, defaultPackageDesc - , warn, die', notice, withTempDirectory ) + , warn, notice, withTempDirectory ) import Distribution.Client.Setup ( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) ) import Distribution.Simple.Setup ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault , defaultSDistFlags ) import Distribution.Simple.BuildPaths ( srcPref) -import Distribution.Simple.Program (requireProgram, simpleProgram, programPath) -import Distribution.Simple.Program.Db (emptyProgramDb) import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity (Verbosity, normal, lessVerbose) import Distribution.Version (mkVersion, orLaterVersion, intersectVersionRanges) @@ -43,9 +41,7 @@ import Distribution.Compat.Exception (catchIO) import System.FilePath ((), (<.>)) import Control.Monad (when, unless, liftM) -import System.Directory (doesFileExist, removeFile, canonicalizePath, getTemporaryDirectory) -import System.Process (runProcess, waitForProcess) -import System.Exit (ExitCode(..)) +import System.Directory (getTemporaryDirectory) import Control.Exception (IOException, evaluate) -- |Create a source distribution. @@ -103,7 +99,6 @@ sdist flags exflags = do format = fromFlag (sDistFormat exflags) createArchive = case format of TargzFormat -> createTarGzArchive - ZipFormat -> createZipArchive tarBallName :: PackageDescription -> String tarBallName = display . packageId @@ -117,38 +112,6 @@ createTarGzArchive verbosity pkg tmpDir targetPref = do where tarBallFilePath = targetPref tarBallName pkg <.> "tar.gz" --- | Create a zip archive from a tree of source files. -createZipArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath - -> IO () -createZipArchive verbosity pkg tmpDir targetPref = do - let dir = tarBallName pkg - zipfile = targetPref dir <.> "zip" - (zipProg, _) <- requireProgram verbosity zipProgram emptyProgramDb - - -- zip has an annoying habit of updating the target rather than creating - -- it from scratch. While that might sound like an optimisation, it doesn't - -- remove files already in the archive that are no longer present in the - -- uncompressed tree. - alreadyExists <- doesFileExist zipfile - when alreadyExists $ removeFile zipfile - - -- We call zip with a different CWD, so have to make the path - -- absolute. Can't just use 'canonicalizePath zipfile' since this function - -- requires its argument to refer to an existing file. - zipfileAbs <- fmap ( dir <.> "zip") . canonicalizePath $ targetPref - - --TODO: use runProgramInvocation, but has to be able to set CWD - hnd <- runProcess (programPath zipProg) ["-q", "-r", zipfileAbs, dir] - (Just tmpDir) - Nothing Nothing Nothing Nothing - exitCode <- waitForProcess hnd - unless (exitCode == ExitSuccess) $ - die' verbosity $ "Generating the zip file failed " - ++ "(zip returned exit code " ++ show exitCode ++ ")" - notice verbosity $ "Source zip archive created: " ++ zipfile - where - zipProgram = simpleProgram "zip" - -- | 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). allPackageSourceFiles :: Verbosity -> SetupScriptOptions -> FilePath diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 985cc2e9a1a..51d4335c6d2 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -333,7 +333,6 @@ executable cabal zlib >= 0.5.3 && < 0.7, hackage-security >= 0.5.2.2 && < 0.6, text >= 1.2.3 && < 1.3, - zip-archive >= 0.3.2.5 && < 0.4, parsec >= 3.1.13.0 && < 3.2 if flag(native-dns) From 49428cf940ad8bd94cc0591b28dcf0812ae14a57 Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Fri, 30 Nov 2018 23:21:41 -0500 Subject: [PATCH 2/8] update changelog, amend .pp instead of .cabal --- cabal-install/cabal-install.cabal | 1 + cabal-install/cabal-install.cabal.pp | 1 - cabal-install/changelog | 1 + 3 files changed, 2 insertions(+), 1 deletion(-) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 51d4335c6d2..985cc2e9a1a 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -333,6 +333,7 @@ executable cabal zlib >= 0.5.3 && < 0.7, hackage-security >= 0.5.2.2 && < 0.6, text >= 1.2.3 && < 1.3, + zip-archive >= 0.3.2.5 && < 0.4, parsec >= 3.1.13.0 && < 3.2 if flag(native-dns) diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index f8f69b509e4..f83bad117c8 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -44,7 +44,6 @@ zlib >= 0.5.3 && < 0.7, hackage-security >= 0.5.2.2 && < 0.6, text >= 1.2.3 && < 1.3, - zip-archive >= 0.3.2.5 && < 0.4, parsec >= 3.1.13.0 && < 3.2 if flag(native-dns) diff --git a/cabal-install/changelog b/cabal-install/changelog index 179984f8bac..657d523cf9c 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -4,6 +4,7 @@ * New solver flag: '--reject-unconstrained-dependencies'. (#2568) * Ported old-style test options to the new-style commands (#5455). * Improved error messages for cabal file parse errors. (#5710) + * Removed support for `.zip` format source distributions (#5755) 2.4.1.0 Mikhail Glushenkov November 2018 * Add message to alert user to potential package casing errors. (#5635) From f6cd27d5d34a99299b8a6fbba472fe94d23737d2 Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Sat, 1 Dec 2018 10:21:09 -0500 Subject: [PATCH 3/8] remove cryptic comments --- cabal-install/Distribution/Client/CmdSdist.hs | 1 - cabal-install/Distribution/Client/Setup.hs | 1 - cabal-install/cabal-install.cabal | 1 - 3 files changed, 3 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index 874d4390785..d25b22bfe41 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -119,7 +119,6 @@ sdistCommand = CommandUI (choiceOpt [ (Flag TargzFormat, ([], ["targz"]), "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - -- ... ] ) , option ['o'] ["output-dir", "outputdir"] diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index db8f736b9f7..a507e583726 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -2416,7 +2416,6 @@ sdistCommand = Cabal.sdistCommand { (choiceOpt [ (Flag TargzFormat, ([], ["targz"]), "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - -- ... ]) ] diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 985cc2e9a1a..51d4335c6d2 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -333,7 +333,6 @@ executable cabal zlib >= 0.5.3 && < 0.7, hackage-security >= 0.5.2.2 && < 0.6, text >= 1.2.3 && < 1.3, - zip-archive >= 0.3.2.5 && < 0.4, parsec >= 3.1.13.0 && < 3.2 if flag(native-dns) From 5dc505e030861e50e63f4733e31bf04246cc716c Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Sat, 1 Dec 2018 16:21:58 -0500 Subject: [PATCH 4/8] remove traces of ArchiveFormat and clean up Sdist accordingly --- .../Distribution/Client/CmdInstall.hs | 16 ++++---- cabal-install/Distribution/Client/CmdSdist.hs | 35 +++++----------- .../Distribution/Client/DistDirLayout.hs | 9 +---- cabal-install/Distribution/Client/Setup.hs | 40 ++----------------- cabal-install/Distribution/Client/SrcDist.hs | 11 ++--- cabal-install/main/Main.hs | 9 ++--- 6 files changed, 31 insertions(+), 89 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 3ab2b332edb..842aa241db6 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -323,7 +323,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags , unlines (("- " ++) . unPackageName . fst <$> xs) ] _ -> return () - + when (not . null $ errs') $ reportTargetProblems verbosity errs' let @@ -351,7 +351,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags sdistize (SpecificSourcePackage spkg@SourcePackage{..}) = SpecificSourcePackage spkg' where - sdistPath = distSdistFile localDistDirLayout packageInfoId TargzFormat + sdistPath = distSdistFile localDistDirLayout packageInfoId spkg' = spkg { packageSource = LocalTarballPackage sdistPath } sdistize named = named @@ -375,8 +375,8 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags unless (Map.null targets) $ mapM_ (\(SpecificSourcePackage pkg) -> packageToSdist verbosity - (distProjectRootDirectory localDistDirLayout) (Archive TargzFormat) - (distSdistFile localDistDirLayout (packageId pkg) TargzFormat) pkg + (distProjectRootDirectory localDistDirLayout) Tarball + (distSdistFile localDistDirLayout (packageId pkg)) pkg ) (localPackages localBaseCtx) if null targets @@ -391,9 +391,9 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags | Just (pkg :: PackageId) <- simpleParse pkgName = return pkg | otherwise = die' verbosity ("Invalid package ID: " ++ pkgName) packageIds <- mapM parsePkg targetStrings - + cabalDir <- getCabalDir - let + let projectConfig = globalConfig <> cliConfig ProjectConfigBuildOnly { @@ -413,7 +413,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags projectConfig SourcePackageDb { packageIndex } <- projectConfigWithBuilderRepoContext - verbosity buildSettings + verbosity buildSettings (getSourcePackages verbosity) for_ targetStrings $ \case @@ -724,7 +724,7 @@ entriesForLibraryComponents = Map.foldrWithKey' (\k v -> mappend (go k v)) [] hasLib :: (ComponentTarget, [TargetSelector]) -> Bool hasLib (ComponentTarget (CLibName _) _, _) = True hasLib _ = False - + go :: UnitId -> [(ComponentTarget, [TargetSelector])] -> [GhcEnvironmentFileEntry] go unitId targets | any hasLib targets = [GhcEnvFilePackageId unitId] diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index d25b22bfe41..756ee588ae5 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -7,7 +7,7 @@ module Distribution.Client.CmdSdist ( sdistCommand, sdistAction, packageToSdist , SdistFlags(..), defaultSdistFlags - , OutputFormat(..), ArchiveFormat(..) ) where + , OutputFormat(..)) where import Distribution.Client.CmdErrorMessages ( Plural(..), renderComponentKind ) @@ -19,7 +19,7 @@ import Distribution.Client.TargetSelector import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.Setup - ( ArchiveFormat(..), GlobalFlags(..) ) + ( GlobalFlags(..) ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) import Distribution.Client.Types @@ -41,7 +41,7 @@ import Distribution.Pretty import Distribution.ReadE ( succeedReadE ) import Distribution.Simple.Command - ( CommandUI(..), option, choiceOpt, reqArg ) + ( CommandUI(..), option, reqArg ) import Distribution.Simple.PreProcess ( knownSuffixHandlers ) import Distribution.Simple.Setup @@ -113,14 +113,6 @@ sdistCommand = CommandUI "Separate the source files with NUL bytes rather than newlines." sdistNulSeparated (\v flags -> flags { sdistNulSeparated = v }) trueArg - , option [] ["archive-format"] - "Choose what type of archive to create. No effect if given with '--list-only'" - sdistArchiveFormat (\v flags -> flags { sdistArchiveFormat = v }) - (choiceOpt - [ (Flag TargzFormat, ([], ["targz"]), - "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - ] - ) , option ['o'] ["output-dir", "outputdir"] "Choose the output directory of this command. '-' sends all output to stdout" sdistOutputPath (\o flags -> flags { sdistOutputPath = o }) @@ -134,7 +126,6 @@ data SdistFlags = SdistFlags , sdistProjectFile :: Flag FilePath , sdistListSources :: Flag Bool , sdistNulSeparated :: Flag Bool - , sdistArchiveFormat :: Flag ArchiveFormat , sdistOutputPath :: Flag FilePath } @@ -145,7 +136,6 @@ defaultSdistFlags = SdistFlags , sdistProjectFile = mempty , sdistListSources = toFlag False , sdistNulSeparated = toFlag False - , sdistArchiveFormat = toFlag TargzFormat , sdistOutputPath = mempty } @@ -159,7 +149,6 @@ sdistAction SdistFlags{..} targetStrings globalFlags = do globalConfig = globalConfigFile globalFlags listSources = fromFlagOrDefault False sdistListSources nulSeparated = fromFlagOrDefault False sdistNulSeparated - archiveFormat = fromFlagOrDefault TargzFormat sdistArchiveFormat mOutputPath = flagToMaybe sdistOutputPath projectRoot <- either throwIO return =<< findProjectRoot Nothing mProjectFile @@ -181,19 +170,15 @@ sdistAction SdistFlags{..} targetStrings globalFlags = do format = if | listSources, nulSeparated -> SourceList '\0' | listSources -> SourceList '\n' - | otherwise -> Archive archiveFormat - - ext = case format of - SourceList _ -> "list" - Archive TargzFormat -> "tar.gz" + | otherwise -> Tarball outputPath pkg = case mOutputPath' of Just path | path == "-" -> "-" - | otherwise -> path prettyShow (packageId pkg) <.> ext + | otherwise -> path prettyShow (packageId pkg) <.> "tar.gz" Nothing | listSources -> "-" - | otherwise -> distSdistFile distLayout (packageId pkg) archiveFormat + | otherwise -> distSdistFile distLayout (packageId pkg) createDirectoryIfMissing True (distSdistDirectory distLayout) @@ -209,7 +194,7 @@ data IsExec = Exec | NoExec deriving (Show, Eq) data OutputFormat = SourceList Char - | Archive ArchiveFormat + | Tarball deriving (Show, Eq) packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () @@ -231,10 +216,10 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do case dir0 of Left tgz -> do case format of - Archive TargzFormat -> do + Tarball -> do write =<< BSL.readFile tgz when (outputFile /= "-") $ - notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" + notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" _ -> die' verbosity ("cannot convert tarball package to " ++ show format) Right dir -> do @@ -253,7 +238,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do write (BSL.pack . (++ [nulSep]) . intercalate [nulSep] . fmap ((prefix ) . snd) $ files) when (outputFile /= "-") $ notice verbosity $ "Wrote source list to " ++ outputFile ++ "\n" - Archive TargzFormat -> do + Tarball -> do let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) () entriesM = do let prefix = prettyShow (packageId pkg) diff --git a/cabal-install/Distribution/Client/DistDirLayout.hs b/cabal-install/Distribution/Client/DistDirLayout.hs index dd5652d7f6b..4226193670f 100644 --- a/cabal-install/Distribution/Client/DistDirLayout.hs +++ b/cabal-install/Distribution/Client/DistDirLayout.hs @@ -27,8 +27,6 @@ import System.FilePath import Distribution.Package ( PackageId, ComponentId, UnitId ) -import Distribution.Client.Setup - ( ArchiveFormat(..) ) import Distribution.Compiler import Distribution.Simple.Compiler ( PackageDB(..), PackageDBStack, OptimisationLevel(..) ) @@ -115,7 +113,7 @@ data DistDirLayout = DistDirLayout { distPackageCacheDirectory :: DistDirParams -> FilePath, -- | The location that sdists are placed by default. - distSdistFile :: PackageId -> ArchiveFormat -> FilePath, + distSdistFile :: PackageId -> FilePath, distSdistDirectory :: FilePath, distTempDirectory :: FilePath, @@ -227,10 +225,7 @@ defaultDistDirLayout projectRoot mdistDirectory = distPackageCacheDirectory params = distBuildDirectory params "cache" distPackageCacheFile params name = distPackageCacheDirectory params name - distSdistFile pid format = distSdistDirectory prettyShow pid <.> ext - where - ext = case format of - TargzFormat -> "tar.gz" + distSdistFile pid = distSdistDirectory prettyShow pid <.> "tar.gz" distSdistDirectory = distDirectory "sdist" diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index a507e583726..8bb210ef8a9 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -43,7 +43,7 @@ module Distribution.Client.Setup , reportCommand, ReportFlags(..) , runCommand , initCommand, IT.InitFlags(..) - , sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) + , sdistCommand, SDistFlags(..) , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..) , actAsSetupCommand, ActAsSetupFlags(..) , sandboxCommand, defaultSandboxLocation, SandboxFlags(..) @@ -2384,47 +2384,13 @@ initCommand = CommandUI { -- | Extra flags to @sdist@ beyond runghc Setup sdist -- -data SDistExFlags = SDistExFlags { - sDistFormat :: Flag ArchiveFormat - } - deriving (Show, Generic) - -data ArchiveFormat = TargzFormat -- ... - deriving (Show, Eq) - -defaultSDistExFlags :: SDistExFlags -defaultSDistExFlags = SDistExFlags { - sDistFormat = Flag TargzFormat - } - -sdistCommand :: CommandUI (SDistFlags, SDistExFlags) +sdistCommand :: CommandUI SDistFlags sdistCommand = Cabal.sdistCommand { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-sdist [FLAGS]\n", - commandDefaultFlags = (commandDefaultFlags Cabal.sdistCommand, defaultSDistExFlags), - commandOptions = \showOrParseArgs -> - liftOptions fst setFst (commandOptions Cabal.sdistCommand showOrParseArgs) - ++ liftOptions snd setSnd sdistExOptions + commandDefaultFlags = (commandDefaultFlags Cabal.sdistCommand) } - where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) - - sdistExOptions = - [option [] ["archive-format"] "archive-format" - sDistFormat (\v flags -> flags { sDistFormat = v }) - (choiceOpt - [ (Flag TargzFormat, ([], ["targz"]), - "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - ]) - ] -instance Monoid SDistExFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup SDistExFlags where - (<>) = gmappend -- diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs index 158744c7711..4b10814857c 100644 --- a/cabal-install/Distribution/Client/SrcDist.hs +++ b/cabal-install/Distribution/Client/SrcDist.hs @@ -26,7 +26,7 @@ import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, defaultPackageDesc , warn, notice, withTempDirectory ) import Distribution.Client.Setup - ( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) ) + ( SDistFlags(..) ) import Distribution.Simple.Setup ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault , defaultSDistFlags ) @@ -45,8 +45,8 @@ import System.Directory (getTemporaryDirectory) import Control.Exception (IOException, evaluate) -- |Create a source distribution. -sdist :: SDistFlags -> SDistExFlags -> IO () -sdist flags exflags = do +sdist :: SDistFlags -> IO () +sdist flags = do pkg <- liftM flattenPackageDescription (readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity) let withDir :: (FilePath -> IO a) -> IO a @@ -70,7 +70,7 @@ sdist flags exflags = do -- Unless we were given --list-sources or --output-directory ourselves, -- create an archive. when needMakeArchive $ - createArchive verbosity pkg tmpDir distPref + createTarGzArchive verbosity pkg tmpDir distPref when isOutDirectory $ notice verbosity $ "Source directory created: " ++ tmpTargetDir @@ -96,9 +96,6 @@ sdist flags exflags = do then orLaterVersion $ mkVersion [1,17,0] else orLaterVersion $ mkVersion [1,12,0] } - format = fromFlag (sDistFormat exflags) - createArchive = case format of - TargzFormat -> createTarGzArchive tarBallName :: PackageDescription -> String tarBallName = display . packageId diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 82823120ce8..15367c2e95f 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -39,7 +39,7 @@ import Distribution.Client.Setup , ReportFlags(..), reportCommand , runCommand , InitFlags(initVerbosity, initHcPath), initCommand - , SDistFlags(..), SDistExFlags(..), sdistCommand + , SDistFlags(..), sdistCommand , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand , ActAsSetupFlags(..), actAsSetupCommand , SandboxFlags(..), sandboxCommand @@ -1066,16 +1066,15 @@ uninstallAction verbosityFlag extraArgs _globalFlags = do ++ package ++ "' or 'cabal sandbox hc-pkg -- unregister " ++ package ++ "'." -sdistAction :: (SDistFlags, SDistExFlags) -> [String] -> Action -sdistAction (sdistFlags, sdistExFlags) extraArgs globalFlags = do +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) - let sdistFlags' = sdistFlags { sDistDistPref = toFlag distPref } - sdist sdistFlags' sdistExFlags + sdist $ sdistFlags { sDistDistPref = toFlag distPref } reportAction :: ReportFlags -> [String] -> Action reportAction reportFlags extraArgs globalFlags = do From f508858cac3565187f719269ae22eeeb487be328 Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Sat, 1 Dec 2018 16:41:23 -0500 Subject: [PATCH 5/8] Tarball rename to TargzFormat --- cabal-install/Distribution/Client/CmdInstall.hs | 2 +- cabal-install/Distribution/Client/CmdSdist.hs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 842aa241db6..90ef5dd2fb0 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -375,7 +375,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags unless (Map.null targets) $ mapM_ (\(SpecificSourcePackage pkg) -> packageToSdist verbosity - (distProjectRootDirectory localDistDirLayout) Tarball + (distProjectRootDirectory localDistDirLayout) TargzFormat (distSdistFile localDistDirLayout (packageId pkg)) pkg ) (localPackages localBaseCtx) diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index 756ee588ae5..782ef4da17a 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -170,7 +170,7 @@ sdistAction SdistFlags{..} targetStrings globalFlags = do format = if | listSources, nulSeparated -> SourceList '\0' | listSources -> SourceList '\n' - | otherwise -> Tarball + | otherwise -> TargzFormat outputPath pkg = case mOutputPath' of Just path @@ -194,7 +194,7 @@ data IsExec = Exec | NoExec deriving (Show, Eq) data OutputFormat = SourceList Char - | Tarball + | TargzFormat deriving (Show, Eq) packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () @@ -216,7 +216,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do case dir0 of Left tgz -> do case format of - Tarball -> do + TargzFormat -> do write =<< BSL.readFile tgz when (outputFile /= "-") $ notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" @@ -238,7 +238,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do write (BSL.pack . (++ [nulSep]) . intercalate [nulSep] . fmap ((prefix ) . snd) $ files) when (outputFile /= "-") $ notice verbosity $ "Wrote source list to " ++ outputFile ++ "\n" - Tarball -> do + TargzFormat -> do let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) () entriesM = do let prefix = prettyShow (packageId pkg) From cce7622076486d6324f82c5526482b73ce9daacd Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Sat, 1 Dec 2018 16:50:52 -0500 Subject: [PATCH 6/8] Tarball rename to TargzFormat --- cabal-install/main/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 15367c2e95f..244a3cfc11c 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -1074,7 +1074,7 @@ sdistAction sdistFlags extraArgs globalFlags = do load <- try (loadConfigOrSandboxConfig verbosity globalFlags) let config = either (\(SomeException _) -> mempty) snd load distPref <- findSavedDistPref config (sDistDistPref sdistFlags) - sdist $ sdistFlags { sDistDistPref = toFlag distPref } + sdist sdistFlags { sDistDistPref = toFlag distPref } reportAction :: ReportFlags -> [String] -> Action reportAction reportFlags extraArgs globalFlags = do From be58af2a2853a61ac164014c49204c99ffb8c256 Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Sat, 1 Dec 2018 16:58:48 -0500 Subject: [PATCH 7/8] rename TargzFormat -> TarGzArchive --- cabal-install/Distribution/Client/CmdInstall.hs | 2 +- cabal-install/Distribution/Client/CmdSdist.hs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 90ef5dd2fb0..262ea7fb5bd 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -375,7 +375,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags unless (Map.null targets) $ mapM_ (\(SpecificSourcePackage pkg) -> packageToSdist verbosity - (distProjectRootDirectory localDistDirLayout) TargzFormat + (distProjectRootDirectory localDistDirLayout) TarGzArchive (distSdistFile localDistDirLayout (packageId pkg)) pkg ) (localPackages localBaseCtx) diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index 782ef4da17a..d79b3ff9e6f 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -170,7 +170,7 @@ sdistAction SdistFlags{..} targetStrings globalFlags = do format = if | listSources, nulSeparated -> SourceList '\0' | listSources -> SourceList '\n' - | otherwise -> TargzFormat + | otherwise -> TarGzArchive outputPath pkg = case mOutputPath' of Just path @@ -194,7 +194,7 @@ data IsExec = Exec | NoExec deriving (Show, Eq) data OutputFormat = SourceList Char - | TargzFormat + | TarGzArchive deriving (Show, Eq) packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () @@ -216,7 +216,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do case dir0 of Left tgz -> do case format of - TargzFormat -> do + TarGzArchive -> do write =<< BSL.readFile tgz when (outputFile /= "-") $ notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" @@ -238,7 +238,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do write (BSL.pack . (++ [nulSep]) . intercalate [nulSep] . fmap ((prefix ) . snd) $ files) when (outputFile /= "-") $ notice verbosity $ "Wrote source list to " ++ outputFile ++ "\n" - TargzFormat -> do + TarGzArchive -> do let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) () entriesM = do let prefix = prettyShow (packageId pkg) From 1c713689f61a963874c799788415a29d45efe8d3 Mon Sep 17 00:00:00 2001 From: Emily Pillmore Date: Sat, 1 Dec 2018 17:02:54 -0500 Subject: [PATCH 8/8] update nix-local-build documentation --- Cabal/doc/nix-local-build.rst | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/Cabal/doc/nix-local-build.rst b/Cabal/doc/nix-local-build.rst index e3685acfa20..363c8245e70 100644 --- a/Cabal/doc/nix-local-build.rst +++ b/Cabal/doc/nix-local-build.rst @@ -5,7 +5,7 @@ Quickstart Suppose that you are in a directory containing a single Cabal package which you wish to build (if you haven't set up a package yet check -out `developing packages `__ for +out `developing packages `__ for instructions). You can configure and build it using Nix-style local builds with this command (configuring is not necessary): @@ -141,8 +141,8 @@ identify the result of a build; if we compute this identifier and we find that we already have this ID built, we can just use the already built version. -The global package store is ``~/.cabal/store`` (configurable via -global `store-dir` option); if you need to clear your store for +The global package store is ``~/.cabal/store`` (configurable via +global `store-dir` option); if you need to clear your store for whatever reason (e.g., to reclaim disk space or because the global store is corrupted), deleting this directory is safe (``new-build`` will just rebuild everything it needs on its next invocation). @@ -411,7 +411,7 @@ them manually or to install them globally. This command opens a REPL with the current default target loaded, and a version of the ``vector`` package matching that specification exposed. -:: +:: $ cabal new-repl --build-depends "vector >= 0.12 && < 0.13" @@ -540,7 +540,7 @@ invocations and bringing the project's executables into scope. cabal new-install ----------------- -``cabal new-install [FLAGS] PACKAGES`` builds the specified packages and +``cabal new-install [FLAGS] PACKAGES`` builds the specified packages and symlinks their executables in ``symlink-bindir`` (usually ``~/.cabal/bin``). For example this command will build the latest ``cabal-install`` and symlink @@ -559,7 +559,7 @@ repository, this command will build cabal-install HEAD and symlink the $ cabal new-install exe:cabal -It is also possible to "install" libraries using the ``--lib`` flag. For +It is also possible to "install" libraries using the ``--lib`` flag. For example, this command will build the latest Cabal library and install it: :: @@ -630,10 +630,6 @@ and two archives of the same format built from the same source will hash to the Output is to ``stdout`` by default. The file paths are relative to the project's root directory. -- ``--targz``: Output an archive in ``.tar.gz`` format. - -- ``--zip``: Output an archive in ``.zip`` format. - - ``-o``, ``--output-dir``: Sets the output dir, if a non-default one is desired. The default is ``dist-newstyle/sdist/``. ``--output-dir -`` will send output to ``stdout`` unless multiple archives are being created. @@ -895,7 +891,7 @@ package, and thus apply globally: .. option:: --store-dir=DIR Specifies the name of the directory of the global package store. - + Solver configuration options ---------------------------- @@ -908,7 +904,7 @@ The following settings control the behavior of the dependency solver: Add extra constraints to the version bounds, flag settings, and other properties a solver can pick for a package. For example: - + :: constraints: bar == 2.1