Commit 5dc505e0 authored by Emily Pillmore's avatar Emily Pillmore

remove traces of ArchiveFormat and clean up Sdist accordingly

parent f6cd27d5
......@@ -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]
......
......@@ -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)
......
......@@ -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"
......
......@@ -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
--
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment