Add explicit fail for cabal clean. Rename CleanAction to CleanActionNotScript

Author: Vladislav Sabanov

cabal-install/src/Distribution/Client/CmdClean.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Distribution.Client.CmdClean (cleanCommand, cleanAction) where
 
@@ -13,6 +14,8 @@ import Distribution.Client.Config
 import Distribution.Client.DistDirLayout
   ( DistDirLayout (..)
   , defaultDistDirLayout
+  , ProjectRoot (ProjectRootImplicit)
+  , defaultProjectFile
   )
 import Distribution.Client.Errors
 import Distribution.Client.ProjectConfig
@@ -161,14 +164,17 @@ 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
 
   let distLayout = defaultDistDirLayout projectRoot mdistDirectory Nothing
 
   -- 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))

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]