{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Setup.Clean
( CleanFlags (..)
, emptyCleanFlags
, defaultCleanFlags
, cleanCommand
) where
import Distribution.Compat.Prelude hiding (get)
import Prelude ()
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Verbosity
import Distribution.Simple.Setup.Common
data CleanFlags = CleanFlags
{ CleanFlags -> Flag Bool
cleanSaveConf :: Flag Bool
, CleanFlags -> Flag FilePath
cleanDistPref :: Flag FilePath
, CleanFlags -> Flag Verbosity
cleanVerbosity :: Flag Verbosity
, CleanFlags -> Flag FilePath
cleanCabalFilePath :: Flag FilePath
}
deriving (Int -> CleanFlags -> ShowS
[CleanFlags] -> ShowS
CleanFlags -> FilePath
(Int -> CleanFlags -> ShowS)
-> (CleanFlags -> FilePath)
-> ([CleanFlags] -> ShowS)
-> Show CleanFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CleanFlags -> ShowS
showsPrec :: Int -> CleanFlags -> ShowS
$cshow :: CleanFlags -> FilePath
show :: CleanFlags -> FilePath
$cshowList :: [CleanFlags] -> ShowS
showList :: [CleanFlags] -> ShowS
Show, (forall x. CleanFlags -> Rep CleanFlags x)
-> (forall x. Rep CleanFlags x -> CleanFlags) -> Generic CleanFlags
forall x. Rep CleanFlags x -> CleanFlags
forall x. CleanFlags -> Rep CleanFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CleanFlags -> Rep CleanFlags x
from :: forall x. CleanFlags -> Rep CleanFlags x
$cto :: forall x. Rep CleanFlags x -> CleanFlags
to :: forall x. Rep CleanFlags x -> CleanFlags
Generic, Typeable)
instance Binary CleanFlags
instance Structured CleanFlags
defaultCleanFlags :: CleanFlags
defaultCleanFlags :: CleanFlags
defaultCleanFlags =
CleanFlags
{ cleanSaveConf :: Flag Bool
cleanSaveConf = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
, cleanDistPref :: Flag FilePath
cleanDistPref = Flag FilePath
forall a. Flag a
NoFlag
, cleanVerbosity :: Flag Verbosity
cleanVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
Flag Verbosity
normal
, cleanCabalFilePath :: Flag FilePath
cleanCabalFilePath = Flag FilePath
forall a. Monoid a => a
mempty
}
cleanCommand :: CommandUI CleanFlags
cleanCommand :: CommandUI CleanFlags
cleanCommand =
CommandUI
{ commandName :: FilePath
commandName = FilePath
"clean"
, commandSynopsis :: FilePath
commandSynopsis = FilePath
"Clean up after a build."
, commandDescription :: Maybe ShowS
commandDescription = ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$ \FilePath
_ ->
FilePath
"Removes .hi, .o, preprocessed sources, etc.\n"
, commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
, commandUsage :: ShowS
commandUsage = \FilePath
pname ->
FilePath
"Usage: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
pname FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" clean [FLAGS]\n"
, commandDefaultFlags :: CleanFlags
commandDefaultFlags = CleanFlags
defaultCleanFlags
, commandOptions :: ShowOrParseArgs -> [OptionField CleanFlags]
commandOptions = \ShowOrParseArgs
showOrParseArgs ->
[ (CleanFlags -> Flag Verbosity)
-> (Flag Verbosity -> CleanFlags -> CleanFlags)
-> OptionField CleanFlags
forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity CleanFlags -> Flag Verbosity
cleanVerbosity (\Flag Verbosity
v CleanFlags
flags -> CleanFlags
flags{cleanVerbosity = v})
, (CleanFlags -> Flag FilePath)
-> (Flag FilePath -> CleanFlags -> CleanFlags)
-> ShowOrParseArgs
-> OptionField CleanFlags
forall flags.
(flags -> Flag FilePath)
-> (Flag FilePath -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref
CleanFlags -> Flag FilePath
cleanDistPref
(\Flag FilePath
d CleanFlags
flags -> CleanFlags
flags{cleanDistPref = d})
ShowOrParseArgs
showOrParseArgs
, FilePath
-> LFlags
-> FilePath
-> (CleanFlags -> Flag Bool)
-> (Flag Bool -> CleanFlags -> CleanFlags)
-> MkOptDescr
(CleanFlags -> Flag Bool)
(Flag Bool -> CleanFlags -> CleanFlags)
CleanFlags
-> OptionField CleanFlags
forall get set a.
FilePath
-> LFlags
-> FilePath
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
FilePath
"s"
[FilePath
"save-configure"]
FilePath
"Do not remove the configuration file (dist/setup-config) during cleaning. Saves need to reconfigure."
CleanFlags -> Flag Bool
cleanSaveConf
(\Flag Bool
v CleanFlags
flags -> CleanFlags
flags{cleanSaveConf = v})
MkOptDescr
(CleanFlags -> Flag Bool)
(Flag Bool -> CleanFlags -> CleanFlags)
CleanFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
]
}
emptyCleanFlags :: CleanFlags
emptyCleanFlags :: CleanFlags
emptyCleanFlags = CleanFlags
forall a. Monoid a => a
mempty
instance Monoid CleanFlags where
mempty :: CleanFlags
mempty = CleanFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
mappend :: CleanFlags -> CleanFlags -> CleanFlags
mappend = CleanFlags -> CleanFlags -> CleanFlags
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup CleanFlags where
<> :: CleanFlags -> CleanFlags -> CleanFlags
(<>) = CleanFlags -> CleanFlags -> CleanFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend