{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ApplicativeDo #-}
module Stack.Options.CleanParser
( cleanOptsParser
) where
import Options.Applicative ( Parser, flag', help, idm, long, metavar )
import Options.Applicative.Builder.Extra ( boolFlags )
import Stack.Clean
( CleanCommand (..), CleanDepth (..), CleanOpts (..) )
import Stack.Prelude
import Stack.Types.PackageName ( packageNameArgument )
cleanOptsParser :: CleanCommand -> Parser CleanOpts
cleanOptsParser :: CleanCommand -> Parser CleanOpts
cleanOptsParser CleanCommand
Clean = Parser CleanOpts
shallowParser Parser CleanOpts -> Parser CleanOpts -> Parser CleanOpts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser CleanOpts
fullParser
cleanOptsParser CleanCommand
Purge = CleanOpts -> Parser CleanOpts
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CleanOpts -> Parser CleanOpts) -> CleanOpts -> Parser CleanOpts
forall a b. (a -> b) -> a -> b
$ CleanOpts
{ depth :: CleanDepth
depth = CleanDepth
CleanFull
, omitThis :: Bool
omitThis = Bool
False
}
shallowParser :: Parser CleanOpts
shallowParser :: Parser CleanOpts
shallowParser = do
[PackageName]
packages <- Parser [PackageName]
parsePackages
Bool
omitThis <- Parser Bool
parseOmitThis
pure $ CleanOpts
{ depth :: CleanDepth
depth = [PackageName] -> CleanDepth
CleanShallow [PackageName]
packages
, Bool
omitThis :: Bool
omitThis :: Bool
omitThis
}
where
parsePackages :: Parser [PackageName]
parsePackages = Parser PackageName -> Parser [PackageName]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields PackageName -> Parser PackageName
packageNameArgument
( String -> Mod ArgumentFields PackageName
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGE"
Mod ArgumentFields PackageName
-> Mod ArgumentFields PackageName -> Mod ArgumentFields PackageName
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields PackageName
forall (f :: * -> *) a. String -> Mod f a
help String
"If none specified, clean all project packages."
))
parseOmitThis :: Parser Bool
parseOmitThis = Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
False
String
"omit-this"
String
"the omission of directories currently in use"
Mod FlagFields Bool
forall m. Monoid m => m
idm
fullParser :: Parser CleanOpts
fullParser :: Parser CleanOpts
fullParser = do
CleanDepth
depth <- Parser CleanDepth
doFullClean
pure $ CleanOpts
{ CleanDepth
depth :: CleanDepth
depth :: CleanDepth
depth
, omitThis :: Bool
omitThis = Bool
False
}
where
doFullClean :: Parser CleanDepth
doFullClean = CleanDepth -> Mod FlagFields CleanDepth -> Parser CleanDepth
forall a. a -> Mod FlagFields a -> Parser a
flag' CleanDepth
CleanFull
( String -> Mod FlagFields CleanDepth
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"full"
Mod FlagFields CleanDepth
-> Mod FlagFields CleanDepth -> Mod FlagFields CleanDepth
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields CleanDepth
forall (f :: * -> *) a. String -> Mod f a
help String
"Delete the project's Stack work directories (.stack-work by \
\default)."
)