module Stack.Clean
(clean
,CleanOpts(..)
,StackCleanException(..)
) where
import Control.Exception (Exception)
import Control.Monad.Catch (MonadCatch, MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Reader (MonadReader, asks)
import Data.Foldable (forM_)
import Data.List ((\\),intercalate)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Typeable (Typeable)
import Path (Path, Abs, Dir)
import Path.IO (ignoringAbsence, removeDirRecur)
import Stack.Build.Source (getLocalPackageViews)
import Stack.Build.Target (LocalPackageView(..))
import Stack.Constants (distDirFromDir, workDirFromDir)
import Stack.Types.PackageName
import Stack.Types.Config
clean
:: (MonadCatch m, MonadIO m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> CleanOpts
-> m ()
clean cleanOpts = do
dirs <- dirsToDelete cleanOpts
forM_ dirs (ignoringAbsence . removeDirRecur)
dirsToDelete
:: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> CleanOpts
-> m [Path Abs Dir]
dirsToDelete cleanOpts = do
localPkgDirs <- asks (Map.keys . envConfigPackages . getEnvConfig)
case cleanOpts of
CleanShallow [] -> do
mapM distDirFromDir localPkgDirs
CleanShallow targets -> do
localPkgViews <- getLocalPackageViews
let localPkgNames = Map.keys localPkgViews
getPkgDir pkgName = fmap (lpvRoot . fst) (Map.lookup pkgName localPkgViews)
case targets \\ localPkgNames of
[] -> mapM distDirFromDir (mapMaybe getPkgDir targets)
xs -> throwM (NonLocalPackages xs)
CleanFull -> do
pkgWorkDirs <- mapM workDirFromDir localPkgDirs
projectWorkDir <- getProjectWorkDir
return (projectWorkDir : pkgWorkDirs)
data CleanOpts
= CleanShallow [PackageName]
| CleanFull
newtype StackCleanException
= NonLocalPackages [PackageName]
deriving (Typeable)
instance Show StackCleanException where
show (NonLocalPackages pkgs) =
"The following packages are not part of this project: " ++
intercalate ", " (map show pkgs)
instance Exception StackCleanException