diff --git a/cabal-install/src/Distribution/Client/CmdClean.hs b/cabal-install/src/Distribution/Client/CmdClean.hs index 322eeb61f7e..4db429e8596 100644 --- a/cabal-install/src/Distribution/Client/CmdClean.hs +++ b/cabal-install/src/Distribution/Client/CmdClean.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} @@ -12,7 +13,9 @@ import Distribution.Client.Config ) import Distribution.Client.DistDirLayout ( DistDirLayout (..) + , ProjectRoot (ProjectRootImplicit) , defaultDistDirLayout + , defaultProjectFile ) import Distribution.Client.Errors import Distribution.Client.ProjectConfig @@ -161,7 +164,7 @@ cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do notScripts <- filterM (fmap not . doesFileExist) extraArgs unless (null notScripts) $ dieWithException verbosity $ - CleanAction notScripts + CleanActionNotScript notScripts projectRoot <- either throwIO return =<< findProjectRoot verbosity mprojectDir mprojectFile @@ -169,6 +172,9 @@ cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do -- Do not clean a project if just running a script in it's directory when (null extraArgs || isJust mdistDirectory) $ do + isValid <- isValidProjectRoot projectRoot + unless isValid $ dieWithException verbosity CleanActionNotPackage + if saveConfig then do let buildRoot = distBuildRootDirectory distLayout @@ -214,6 +220,16 @@ cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do info verbosity ("Deleting cache (" ++ cache ++ ") for script (" ++ script ++ ")") removeDirectoryRecursive cache +isValidProjectRoot :: ProjectRoot -> IO Bool +isValidProjectRoot = \case + (ProjectRootImplicit dir) -> do + let projectFile = dir defaultProjectFile + projectExists <- doesFileExist projectFile + contents <- listDirectory dir + let cabalFiles = filter (".cabal" `isSuffixOf`) contents + pure (projectExists || not (null cabalFiles)) + _ -> pure True + removeEnvFiles :: FilePath -> IO () removeEnvFiles dir = (traverse_ (removeFile . (dir )) . filter ((".ghc.environment" ==) . take 16)) diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 4270435b54f..0f7e3adc1d4 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -99,7 +99,7 @@ data CabalInstallException | UnknownExecutable String UnitId | MultipleMatchingExecutables String [String] | CmdRunReportTargetProblems String - | CleanAction [String] + | CleanActionNotScript [String] | ReportCannotPruneDependencies String | ReplCommandDoesn'tSupport | ReplTakesNoArguments [String] @@ -192,6 +192,7 @@ data CabalInstallException | LegacyAndParsecParseResultsDiffer FilePath String String | CabalFileParseFailure CabalFileParseError | ProjectConfigParseFailure ProjectConfigParseError + | CleanActionNotPackage deriving (Show) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -255,7 +256,7 @@ exceptionCodeCabalInstall e = case e of UnknownExecutable{} -> 7068 MultipleMatchingExecutables{} -> 7069 CmdRunReportTargetProblems{} -> 7070 - CleanAction{} -> 7071 + CleanActionNotScript{} -> 7071 ReportCannotPruneDependencies{} -> 7072 ReplCommandDoesn'tSupport{} -> 7073 ReplTakesNoArguments{} -> 7074 @@ -348,6 +349,7 @@ exceptionCodeCabalInstall e = case e of LegacyAndParsecParseResultsDiffer{} -> 7165 CabalFileParseFailure{} -> 7166 ProjectConfigParseFailure{} -> 7167 + CleanActionNotPackage{} -> 7168 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -458,7 +460,7 @@ exceptionMessageCabalInstall e = case e of ++ ":\n" ++ unlines elabUnitId CmdRunReportTargetProblems renderProb -> renderProb - CleanAction notScripts -> + CleanActionNotScript notScripts -> "'clean' extra arguments should be script files: " ++ unwords notScripts ReportCannotPruneDependencies renderCannotPruneDependencies -> renderCannotPruneDependencies @@ -885,6 +887,8 @@ exceptionMessageCabalInstall e = case e of renderCabalFileParseError cbfError ProjectConfigParseFailure pcfError -> renderProjectConfigParseError pcfError + CleanActionNotPackage -> + "Not a cabal project or package directory; skipping project cleanup." instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char]