{-# LANGUAGE DeriveDataTypeable #-}
module Development.Shake.Internal.CmdOption(CmdOption(..)) where

import Data.Data
import qualified Data.ByteString.Lazy.Char8 as LBS

-- | Options passed to 'command' or 'cmd' to control how processes are executed.
data CmdOption
    = Cwd FilePath -- ^ Change the current directory in the spawned process. By default uses this processes current directory.
                   --   Successive 'Cwd' options are joined together, to change into nested directories.
    | Env [(String,String)] -- ^ Change the environment variables in the spawned process. By default uses this processes environment.
    | AddEnv String String -- ^ Add an environment variable in the child process.
    | RemEnv String -- ^ Remove an environment variable from the child process.
    | AddPath [String] [String] -- ^ Add some items to the prefix and suffix of the @$PATH@ variable.
    | Stdin String -- ^ Given as the @stdin@ of the spawned process.
    | StdinBS LBS.ByteString -- ^ Given as the @stdin@ of the spawned process.
    | FileStdin FilePath -- ^ Take the @stdin@ from a file.
    | Shell -- ^ Pass the command to the shell without escaping - any arguments will be joined with spaces. By default arguments are escaped properly.
    | BinaryPipes -- ^ Treat the @stdin@\/@stdout@\/@stderr@ messages as binary. By default 'String' results use text encoding and 'ByteString' results use binary encoding.
    | Traced String -- ^ Name to use with 'traced', or @\"\"@ for no tracing. By default traces using the name of the executable.
    | Timeout Double -- ^ Abort the computation after N seconds, will raise a failure exit code. Calls 'interruptProcessGroupOf' and 'terminateProcess', but may sometimes fail to abort the process and not timeout.
    | WithStdout Bool -- ^ Should I include the @stdout@ in the exception if the command fails? Defaults to 'False'.
    | WithStderr Bool -- ^ Should I include the @stderr@ in the exception if the command fails? Defaults to 'True'.
    | EchoStdout Bool -- ^ Should I echo the @stdout@? Defaults to 'True' unless a 'Stdout' result is required or you use 'FileStdout'.
    | EchoStderr Bool -- ^ Should I echo the @stderr@? Defaults to 'True' unless a 'Stderr' result is required or you use 'FileStderr'.
    | FileStdout FilePath -- ^ Should I put the @stdout@ to a file.
    | FileStderr FilePath -- ^ Should I put the @stderr@ to a file.
    | AutoDeps -- ^ Compute dependencies automatically. Only works if 'shakeLintInside' has been set to the files where autodeps might live.
    | UserCommand String -- ^ The command the user thinks about, before any munging. Defaults to the actual command.
    | FSAOptions String -- ^ Options to @fsatrace@, a list of strings with characters such as @\"r\"@ (reads) @\"w\"@ (writes). Defaults to @\"rwmdqt\"@ if the output of @fsatrace@ is required.
    | CloseFileHandles -- ^ Before starting the command in the child process, close all file handles except stdin, stdout, stderr in the child process. Uses @close_fds@ from package process and comes with the same caveats, i.e. runtime is linear with the maximum number of open file handles (@RLIMIT_NOFILE@, see @man 2 getrlimit@ on Linux).
    | NoProcessGroup -- ^ Don't run the process in its own group. Required when running @docker@. Will mean that process timeouts and asyncronous exceptions may not properly clean up child processes.
    | InheritStdin -- ^ Cause the stdin from the parent to be inherited. Might also require NoProcessGroup on Linux. Ignored if you explicitly pass a stdin.
      deriving (CmdOption -> CmdOption -> Bool
(CmdOption -> CmdOption -> Bool)
-> (CmdOption -> CmdOption -> Bool) -> Eq CmdOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdOption -> CmdOption -> Bool
$c/= :: CmdOption -> CmdOption -> Bool
== :: CmdOption -> CmdOption -> Bool
$c== :: CmdOption -> CmdOption -> Bool
Eq,Eq CmdOption
Eq CmdOption
-> (CmdOption -> CmdOption -> Ordering)
-> (CmdOption -> CmdOption -> Bool)
-> (CmdOption -> CmdOption -> Bool)
-> (CmdOption -> CmdOption -> Bool)
-> (CmdOption -> CmdOption -> Bool)
-> (CmdOption -> CmdOption -> CmdOption)
-> (CmdOption -> CmdOption -> CmdOption)
-> Ord CmdOption
CmdOption -> CmdOption -> Bool
CmdOption -> CmdOption -> Ordering
CmdOption -> CmdOption -> CmdOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CmdOption -> CmdOption -> CmdOption
$cmin :: CmdOption -> CmdOption -> CmdOption
max :: CmdOption -> CmdOption -> CmdOption
$cmax :: CmdOption -> CmdOption -> CmdOption
>= :: CmdOption -> CmdOption -> Bool
$c>= :: CmdOption -> CmdOption -> Bool
> :: CmdOption -> CmdOption -> Bool
$c> :: CmdOption -> CmdOption -> Bool
<= :: CmdOption -> CmdOption -> Bool
$c<= :: CmdOption -> CmdOption -> Bool
< :: CmdOption -> CmdOption -> Bool
$c< :: CmdOption -> CmdOption -> Bool
compare :: CmdOption -> CmdOption -> Ordering
$ccompare :: CmdOption -> CmdOption -> Ordering
$cp1Ord :: Eq CmdOption
Ord,Int -> CmdOption -> ShowS
[CmdOption] -> ShowS
CmdOption -> String
(Int -> CmdOption -> ShowS)
-> (CmdOption -> String)
-> ([CmdOption] -> ShowS)
-> Show CmdOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdOption] -> ShowS
$cshowList :: [CmdOption] -> ShowS
show :: CmdOption -> String
$cshow :: CmdOption -> String
showsPrec :: Int -> CmdOption -> ShowS
$cshowsPrec :: Int -> CmdOption -> ShowS
Show,Typeable CmdOption
DataType
Constr
Typeable CmdOption
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CmdOption -> c CmdOption)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CmdOption)
-> (CmdOption -> Constr)
-> (CmdOption -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CmdOption))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmdOption))
-> ((forall b. Data b => b -> b) -> CmdOption -> CmdOption)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CmdOption -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CmdOption -> r)
-> (forall u. (forall d. Data d => d -> u) -> CmdOption -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CmdOption -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption)
-> Data CmdOption
CmdOption -> DataType
CmdOption -> Constr
(forall b. Data b => b -> b) -> CmdOption -> CmdOption
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CmdOption -> c CmdOption
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CmdOption
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CmdOption -> u
forall u. (forall d. Data d => d -> u) -> CmdOption -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CmdOption -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CmdOption -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CmdOption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CmdOption -> c CmdOption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CmdOption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmdOption)
$cInheritStdin :: Constr
$cNoProcessGroup :: Constr
$cCloseFileHandles :: Constr
$cFSAOptions :: Constr
$cUserCommand :: Constr
$cAutoDeps :: Constr
$cFileStderr :: Constr
$cFileStdout :: Constr
$cEchoStderr :: Constr
$cEchoStdout :: Constr
$cWithStderr :: Constr
$cWithStdout :: Constr
$cTimeout :: Constr
$cTraced :: Constr
$cBinaryPipes :: Constr
$cShell :: Constr
$cFileStdin :: Constr
$cStdinBS :: Constr
$cStdin :: Constr
$cAddPath :: Constr
$cRemEnv :: Constr
$cAddEnv :: Constr
$cEnv :: Constr
$cCwd :: Constr
$tCmdOption :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
gmapMp :: (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
gmapM :: (forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CmdOption -> m CmdOption
gmapQi :: Int -> (forall d. Data d => d -> u) -> CmdOption -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CmdOption -> u
gmapQ :: (forall d. Data d => d -> u) -> CmdOption -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CmdOption -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CmdOption -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CmdOption -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CmdOption -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CmdOption -> r
gmapT :: (forall b. Data b => b -> b) -> CmdOption -> CmdOption
$cgmapT :: (forall b. Data b => b -> b) -> CmdOption -> CmdOption
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmdOption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CmdOption)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CmdOption)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CmdOption)
dataTypeOf :: CmdOption -> DataType
$cdataTypeOf :: CmdOption -> DataType
toConstr :: CmdOption -> Constr
$ctoConstr :: CmdOption -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CmdOption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CmdOption
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CmdOption -> c CmdOption
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CmdOption -> c CmdOption
$cp1Data :: Typeable CmdOption
Data,Typeable)