Remove support for .zip format source distributions

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
 
 --

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"

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")
+              -- ...
             ])
       ]
 

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

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)

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 <[email protected]> November 2018
 	* Add message to alert user to potential package casing errors. (#5635)