Add cabal new-clean (closes #2957)

Cabal/doc/nix-local-build.rst

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

cabal-install/Distribution/Client/CmdClean.hs

+{-# 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

cabal-install/cabal-install.cabal

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

cabal-install/changelog

 -*-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).
 

cabal-install/main/Main.hs

@@ -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 ()