Commit e5f8dc3f authored by Alexis Williams's avatar Alexis Williams

Add cabal new-clean (closes #2957)

parent b8c4ce3d
......@@ -467,6 +467,17 @@ its ``cabal`` executable:
For libraries and local packages see
`Unsupported commands <#unsupported-commands>`__
cabal new-clean
---------------
``cabal new-clean [FLAGS]`` cleans up the temporary files and build artifacts
stored in the ``dist-newstyle`` folder.
By default, it removes the entire folder, but it can also spare the configuration
and caches if the ``--save-config`` option is given, in which case it only removes
the build artefacts (``.hi``, ``.o`` along with any other temporary files generated
by the compiler, along with the build output).
Unsupported commands
--------------------
......
{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.CmdClean (cleanCommand, cleanAction) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.DistDirLayout
( DistDirLayout(..), defaultDistDirLayout )
import Distribution.Client.ProjectConfig
( findProjectRoot )
import Distribution.Client.Setup
( GlobalFlags )
import Distribution.ReadE ( succeedReadE )
import Distribution.Simple.Setup
( Flag(..), toFlag, fromFlagOrDefault, flagToList, flagToMaybe
, optionDistPref, optionVerbosity, falseArg
)
import Distribution.Simple.Command
( CommandUI(..), option, reqArg )
import Distribution.Simple.Utils
( info, wrapText )
import Distribution.Verbosity
( Verbosity, normal )
import Control.Exception
( throwIO )
import System.Directory
( removeDirectoryRecursive, doesDirectoryExist )
data CleanFlags = CleanFlags
{ cleanSaveConfig :: Flag Bool
, cleanVerbosity :: Flag Verbosity
, cleanDistDir :: Flag FilePath
, cleanProjectFile :: Flag FilePath
} deriving (Eq)
defaultCleanFlags :: CleanFlags
defaultCleanFlags = CleanFlags
{ cleanSaveConfig = toFlag False
, cleanVerbosity = toFlag normal
, cleanDistDir = NoFlag
, cleanProjectFile = mempty
}
cleanCommand :: CommandUI CleanFlags
cleanCommand = CommandUI
{ commandName = "new-clean"
, commandSynopsis = "Clean the package store and remove temporary files."
, commandUsage = \pname ->
"Usage: " ++ pname ++ " new-clean [FLAGS]\n"
, commandDescription = Just $ \_ -> wrapText $
"Removes all temporary files created during the building process "
++ "(.hi, .o, preprocessed sources, etc.) and also empties out the "
++ "local caches (by default).\n\n"
, commandNotes = Nothing
, commandDefaultFlags = defaultCleanFlags
, commandOptions = \showOrParseArgs ->
[ optionVerbosity
cleanVerbosity (\v flags -> flags { cleanVerbosity = v })
, optionDistPref
cleanDistDir (\dd flags -> flags { cleanDistDir = dd })
showOrParseArgs
, option [] ["project-file"]
"Set the name of the cabal.project file to search for in parent directories"
cleanProjectFile (\pf flags -> flags {cleanProjectFile = pf})
(reqArg "FILE" (succeedReadE Flag) flagToList)
, option ['s'] ["save-config"]
"Save configuration, only remove build artifacts"
cleanSaveConfig (\sc flags -> flags { cleanSaveConfig = sc })
falseArg
]
}
cleanAction :: CleanFlags -> [String] -> GlobalFlags -> IO ()
cleanAction CleanFlags{..} extraArgs _ = do
let verbosity = fromFlagOrDefault normal cleanVerbosity
saveConfig = fromFlagOrDefault False cleanSaveConfig
mdistDirectory = flagToMaybe cleanDistDir
mprojectFile = flagToMaybe cleanProjectFile
unless (null extraArgs) $
die' verbosity $ "'clean' doesn't take any extra arguments: " ++ unwords extraArgs
projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile
let distLayout = defaultDistDirLayout projectRoot mdistDirectory
if saveConfig
then do
let buildRoot = distBuildRootDirectory distLayout
unpackedSrcRoot = distUnpackedSrcRootDirectory distLayout
buildRootExists <- doesDirectoryExist buildRoot
unpackedSrcRootExists <- doesDirectoryExist unpackedSrcRoot
when buildRootExists $ do
info verbosity ("Deleting build root (" ++ buildRoot ++ ")")
removeDirectoryRecursive buildRoot
when unpackedSrcRootExists $ do
info verbosity ("Deleting unpacked source root (" ++ unpackedSrcRoot ++ ")")
removeDirectoryRecursive unpackedSrcRoot
else do
let distRoot = distDirectory distLayout
info verbosity ("Deleting dist-newstyle (" ++ distRoot ++ ")")
removeDirectoryRecursive distRoot
......@@ -147,6 +147,7 @@ library
Distribution.Client.Check
Distribution.Client.CmdBench
Distribution.Client.CmdBuild
Distribution.Client.CmdClean
Distribution.Client.CmdConfigure
Distribution.Client.CmdUpdate
Distribution.Client.CmdErrorMessages
......
-*-change-log-*-
2.4.0.0 (current development version)
* Completed the 'new-clean' command (#5357). The functionality is
equivalent to old-style clean, but for nix-style builds.
* Ensure that each package selected for a build-depends dependency
contains a library (#5304).
......
......@@ -87,6 +87,7 @@ import qualified Distribution.Client.CmdRun as CmdRun
import qualified Distribution.Client.CmdTest as CmdTest
import qualified Distribution.Client.CmdBench as CmdBench
import qualified Distribution.Client.CmdExec as CmdExec
import qualified Distribution.Client.CmdClean as CmdClean
import Distribution.Client.Install (install)
import Distribution.Client.Configure (configure, writeConfigFlags)
......@@ -324,6 +325,7 @@ mainWorker args = topHandler $
, regularCmd CmdTest.testCommand CmdTest.testAction
, regularCmd CmdBench.benchCommand CmdBench.benchAction
, regularCmd CmdExec.execCommand CmdExec.execAction
, regularCmd CmdClean.cleanCommand CmdClean.cleanAction
]
type Action = GlobalFlags -> IO ()
......
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