{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

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

-- |
-- 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
      ( CleanCommonFlags
      , cleanVerbosity
      , cleanDistPref
      , cleanCabalFilePath
      , cleanWorkingDir
      , cleanTargets
      , ..
      )
  , 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.Simple.Setup.Common
import Distribution.Utils.Path
import Distribution.Verbosity

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

-- * Clean flags

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

data CleanFlags = CleanFlags
  { CleanFlags -> CommonSetupFlags
cleanCommonFlags :: !CommonSetupFlags
  , CleanFlags -> Flag Bool
cleanSaveConf :: Flag Bool
  }
  deriving (Int -> CleanFlags -> ShowS
[CleanFlags] -> ShowS
CleanFlags -> String
(Int -> CleanFlags -> ShowS)
-> (CleanFlags -> String)
-> ([CleanFlags] -> ShowS)
-> Show CleanFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CleanFlags -> ShowS
showsPrec :: Int -> CleanFlags -> ShowS
$cshow :: CleanFlags -> String
show :: CleanFlags -> String
$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)

pattern CleanCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> CleanFlags
pattern $mCleanCommonFlags :: forall {r}.
CleanFlags
-> (Flag Verbosity
    -> Flag (SymbolicPath Pkg ('Dir Dist))
    -> Flag (SymbolicPath CWD ('Dir Pkg))
    -> Flag (SymbolicPath Pkg 'File)
    -> [String]
    -> r)
-> ((# #) -> r)
-> r
CleanCommonFlags
  { CleanFlags -> Flag Verbosity
cleanVerbosity
  , CleanFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
cleanDistPref
  , CleanFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
cleanWorkingDir
  , CleanFlags -> Flag (SymbolicPath Pkg 'File)
cleanCabalFilePath
  , CleanFlags -> [String]
cleanTargets
  } <-
  ( cleanCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = cleanVerbosity
        , setupDistPref = cleanDistPref
        , setupWorkingDir = cleanWorkingDir
        , setupCabalFilePath = cleanCabalFilePath
        , setupTargets = cleanTargets
        }
    )

instance Binary CleanFlags
instance Structured CleanFlags

defaultCleanFlags :: CleanFlags
defaultCleanFlags :: CleanFlags
defaultCleanFlags =
  CleanFlags
    { cleanCommonFlags :: CommonSetupFlags
cleanCommonFlags = CommonSetupFlags
defaultCommonSetupFlags
    , cleanSaveConf :: Flag Bool
cleanSaveConf = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False
    }

cleanCommand :: CommandUI CleanFlags
cleanCommand :: CommandUI CleanFlags
cleanCommand =
  CommandUI
    { commandName :: String
commandName = String
"clean"
    , commandSynopsis :: String
commandSynopsis = String
"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
$ \String
_ ->
        String
"Removes .hi, .o, preprocessed sources, etc.\n"
    , commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
    , commandUsage :: ShowS
commandUsage = \String
pname ->
        String
"Usage: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" clean [FLAGS]\n"
    , commandDefaultFlags :: CleanFlags
commandDefaultFlags = CleanFlags
defaultCleanFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField CleanFlags]
commandOptions = \ShowOrParseArgs
showOrParseArgs ->
        (CleanFlags -> CommonSetupFlags)
-> (CommonSetupFlags -> CleanFlags -> CleanFlags)
-> ShowOrParseArgs
-> [OptionField CleanFlags]
-> [OptionField CleanFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
          CleanFlags -> CommonSetupFlags
cleanCommonFlags
          (\CommonSetupFlags
c CleanFlags
f -> CleanFlags
f{cleanCommonFlags = c})
          ShowOrParseArgs
showOrParseArgs
          [ String
-> [String]
-> String
-> (CleanFlags -> Flag Bool)
-> (Flag Bool -> CleanFlags -> CleanFlags)
-> MkOptDescr
     (CleanFlags -> Flag Bool)
     (Flag Bool -> CleanFlags -> CleanFlags)
     CleanFlags
-> OptionField CleanFlags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
              String
"s"
              [String
"save-configure"]
              String
"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