{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Setup.Clean
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the clean command-line options.
-- See: @Distribution.Simple.Setup@
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

-- ------------------------------------------------------------

-- * Clean flags

-- ------------------------------------------------------------

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