module Stack.Clean
(clean
,CleanOpts(..)
,StackCleanException(..)
) where
import Control.Exception (Exception)
import Control.Monad (when)
import Control.Monad.Catch (MonadCatch, 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.IO (ignoringAbsence, removeDirRecur)
import Stack.Build.Source (getLocalPackageViews)
import Stack.Build.Target (LocalPackageView(..))
import Stack.Constants (distDirFromDir, workDirFromDir)
import Stack.Types (HasEnvConfig,PackageName, bcWorkDir, getBuildConfig)
clean
:: (MonadCatch m, MonadIO m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> CleanOpts
-> m ()
clean (CleanTargets targets) =
cleanup targets False
clean (CleanFull _ ) =
cleanup [] True
cleanup
:: (MonadCatch m, MonadIO m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> [PackageName] -> Bool
-> m()
cleanup targets doFullClean = do
locals <- getLocalPackageViews
case targets \\ Map.keys locals of
[] -> do
let lpvs =
if null targets
then Map.elems locals
else mapMaybe (`Map.lookup` locals) targets
forM_ lpvs $ \(LocalPackageView{lpvRoot = pkgDir},_) -> do
let delDir =
if doFullClean
then workDirFromDir pkgDir
else distDirFromDir pkgDir
ignoringAbsence . removeDirRecur =<< delDir
when doFullClean $ do
bconfig <- asks getBuildConfig
bcwd <- bcWorkDir bconfig
ignoringAbsence (removeDirRecur bcwd)
pkgs -> throwM (NonLocalPackages pkgs)
data CleanOpts = CleanTargets
{ cleanOptsTargets :: [PackageName]
}
| CleanFull { cleanOptsFull :: Bool }
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