1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE ConstraintKinds #-} 3{-# LANGUAGE DeriveDataTypeable #-} 4{-# LANGUAGE FlexibleContexts #-} 5{-# LANGUAGE OverloadedStrings #-} 6 7-- | Clean a project. 8module Stack.Clean 9 (clean 10 ,CleanOpts(..) 11 ,CleanCommand(..) 12 ,StackCleanException(..) 13 ) where 14 15import Stack.Prelude 16import Data.List ((\\),intercalate) 17import qualified Data.Map.Strict as Map 18import Path.IO (ignoringAbsence, removeDirRecur) 19import Stack.Constants.Config (rootDistDirFromDir, workDirFromDir) 20import Stack.Types.Config 21import Stack.Types.SourceMap 22 23-- | Deletes build artifacts in the current project. 24-- 25-- Throws 'StackCleanException'. 26clean :: HasBuildConfig env => CleanOpts -> RIO env () 27clean cleanOpts = do 28 toDelete <- dirsToDelete cleanOpts 29 logDebug $ "Need to delete: " <> fromString (show (map toFilePath toDelete)) 30 failures <- mapM cleanDir toDelete 31 when (or failures) exitFailure 32 where 33 cleanDir dir = do 34 logDebug $ "Deleting directory: " <> fromString (toFilePath dir) 35 liftIO (ignoringAbsence (removeDirRecur dir) >> return False) `catchAny` \ex -> do 36 logError $ "Exception while recursively deleting " <> fromString (toFilePath dir) <> "\n" <> displayShow ex 37 logError "Perhaps you do not have permission to delete these files or they are in use?" 38 return True 39 40dirsToDelete :: HasBuildConfig env => CleanOpts -> RIO env [Path Abs Dir] 41dirsToDelete cleanOpts = do 42 packages <- view $ buildConfigL.to (smwProject . bcSMWanted) 43 case cleanOpts of 44 CleanShallow [] -> 45 -- Filter out packages listed as extra-deps 46 mapM (rootDistDirFromDir . ppRoot) $ Map.elems packages 47 CleanShallow targets -> do 48 let localPkgNames = Map.keys packages 49 getPkgDir pkgName' = fmap ppRoot (Map.lookup pkgName' packages) 50 case targets \\ localPkgNames of 51 [] -> mapM rootDistDirFromDir (mapMaybe getPkgDir targets) 52 xs -> throwM (NonLocalPackages xs) 53 CleanFull -> do 54 pkgWorkDirs <- mapM (workDirFromDir . ppRoot) $ Map.elems packages 55 projectWorkDir <- getProjectWorkDir 56 return (projectWorkDir : pkgWorkDirs) 57 58-- | Options for @stack clean@. 59data CleanOpts 60 = CleanShallow [PackageName] 61 -- ^ Delete the "dist directories" as defined in 'Stack.Constants.Config.distRelativeDir' 62 -- for the given local packages. If no packages are given, all project packages 63 -- should be cleaned. 64 | CleanFull 65 -- ^ Delete all work directories in the project. 66 67-- | Clean commands 68data CleanCommand 69 = Clean 70 | Purge 71 72-- | Exceptions during cleanup. 73newtype StackCleanException 74 = NonLocalPackages [PackageName] 75 deriving (Typeable) 76 77instance Show StackCleanException where 78 show (NonLocalPackages pkgs) = 79 "The following packages are not part of this project: " ++ 80 intercalate ", " (map show pkgs) 81 82instance Exception StackCleanException 83