diff --git a/cabal-install/src/Distribution/Client/CmdClean.hs b/cabal-install/src/Distribution/Client/CmdClean.hs index 2ffda4dce6a..e2868e9592b 100644 --- a/cabal-install/src/Distribution/Client/CmdClean.hs +++ b/cabal-install/src/Distribution/Client/CmdClean.hs @@ -52,6 +52,10 @@ import Distribution.Simple.Utils , info , wrapText ) +import Distribution.System + ( OS (Windows) + , buildOS + ) import Distribution.Utils.Path hiding ( (<.>) , () @@ -60,6 +64,9 @@ import Distribution.Verbosity ( normal ) +import Control.Exception + ( throw + ) import Control.Monad ( forM , forM_ @@ -74,10 +81,15 @@ import System.Directory , listDirectory , removeDirectoryRecursive , removeFile + , removePathForcibly ) import System.FilePath ( () ) +import System.IO.Error + ( isPermissionError + ) +import qualified System.Process as Process data CleanFlags = CleanFlags { cleanSaveConfig :: Flag Bool @@ -168,7 +180,17 @@ cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do let distRoot = distDirectory distLayout info verbosity ("Deleting dist-newstyle (" ++ distRoot ++ ")") - handleDoesNotExist () $ removeDirectoryRecursive distRoot + handleDoesNotExist () $ do + if buildOS == Windows + then do + -- Windows can't delete some git files #10182 + void $ Process.createProcess_ "attrib" + $ Process.shell + $ "attrib -s -h -r " <> distRoot <> "\\*.* /s /d" + catch + (removePathForcibly distRoot) + (\e -> if isPermissionError e then removePathForcibly distRoot else throw e) + else removeDirectoryRecursive distRoot removeEnvFiles $ distProjectRootDirectory distLayout diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs index 2f2686c6ae2..1cbdc5dd8fb 100644 --- a/cabal-install/src/Distribution/Client/VCS.hs +++ b/cabal-install/src/Distribution/Client/VCS.hs @@ -64,6 +64,10 @@ import Distribution.Simple.Program import Distribution.Simple.Program.Db ( prependProgramSearchPath ) +import Distribution.System + ( OS (Windows) + , buildOS + ) import Distribution.Types.SourceRepo ( KnownRepoType (..) , RepoType (..) @@ -93,6 +97,7 @@ import qualified Data.Map as Map import System.Directory ( doesDirectoryExist , removeDirectoryRecursive + , removePathForcibly ) import System.FilePath ( takeDirectory @@ -100,7 +105,9 @@ import System.FilePath ) import System.IO.Error ( isDoesNotExistError + , isPermissionError ) +import qualified System.Process as Process -- | A driver for a version control system, e.g. git, darcs etc. data VCS program = VCS @@ -509,7 +516,18 @@ vcsGit = git localDir ["submodule", "deinit", "--force", "--all"] let gitModulesDir = localDir ".git" "modules" gitModulesExists <- doesDirectoryExist gitModulesDir - when gitModulesExists $ removeDirectoryRecursive gitModulesDir + when gitModulesExists $ + if buildOS == Windows + then do + -- Windows can't delete some git files #10182 + void $ Process.createProcess_ "attrib" + $ Process.shell + $ "attrib -s -h -r " <> gitModulesDir <> "\\*.* /s /d" + + catch + (removePathForcibly gitModulesDir) + (\e -> if isPermissionError e then removePathForcibly gitModulesDir else throw e) + else removeDirectoryRecursive gitModulesDir git localDir resetArgs git localDir $ ["submodule", "sync", "--recursive"] ++ verboseArg git localDir $ ["submodule", "update", "--force", "--init", "--recursive"] ++ verboseArg diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/a.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/a.cabal new file mode 100644 index 00000000000..77f47fbbcf5 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/a.cabal @@ -0,0 +1,6 @@ +cabal-version: 3.0 +name: aa +version: 0.1.0.0 +build-type: Simple + +library diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.out new file mode 100644 index 00000000000..e4f538647f6 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.out @@ -0,0 +1,6 @@ +# cabal build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following would be built: + - aa-0.1.0.0 (lib) (first run) +# cabal clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.project new file mode 100644 index 00000000000..60739ea84dd --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.project @@ -0,0 +1,5 @@ +packages: . + +source-repository-package + type: git + location: https://github.com/haskell-hvr/Only diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.test.hs new file mode 100644 index 00000000000..9e93c607ce4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanSourceRepositoryPackage/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest $ withProjectFile "cabal.project" $ do + void $ cabal' "build" ["--dry-run"] + void $ cabal' "clean" [] diff --git a/changelog.d/pr-10190 b/changelog.d/pr-10190 new file mode 100644 index 00000000000..d9e4f009b94 --- /dev/null +++ b/changelog.d/pr-10190 @@ -0,0 +1,11 @@ +synopsis: Fix `cabal clean` permissions on Windows +packages: cabal-install +prs: #10190 +issues: #10182 +significance: + +description: { + +- `cabal clean` now removes the read-only mark recursively in the `dist-newstyle` folder on Windows before attempting to delete it. + +}