{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
-- |
-- Module       : Sysetem.Process.Lens.CreateProcess
-- Copyright 	: (c) 2019-2021 Emily Pillmore
-- License	: BSD
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: TypeFamilies, Rank2Types
--
-- This module provides the associated optics and combinators
-- for working with 'CreateProcess' objects.
--
-- Because 'CreateProcess' was created before the `_` prefix record
-- name convention, some record accessors don't have an apparently
-- "good" name for their corresponding lens. Those that do not are
-- post-fixed with `_`. Thankfully, there are only 6 that meet the
-- criteria: 'cmdspec_', 'env_', 'cwd_', 'stdin_', 'stdout_', and 'stderr_'.
--
-- We provide classy variants of what we consider the significant portions
-- of 'CreateProcess' - namely, the `std_in`, `std_out`, and `std_err` entries.
--
--
module System.Process.Lens.CreateProcess
( -- * Lenses
  cmdspec_
, cwd_
, env_
, stdin_
, stdout_
, stderr_
, closefds
, creategroup
, delegatectlc
, newsession
#if MIN_VERSION_process(1, 3, 0)
, detachconsole
, createnewconsole
#endif
#if MIN_VERSION_process(1, 4, 0)
, childgroup
, childuser
#endif
#if MIN_VERSION_process(1, 5, 0)
, useprocessjobs
#endif
  -- * Classy Lenses
, HasStdin(..)
, HasStdout(..)
, HasStderr(..)
  -- * Defaults
, defaultCreateProcess
) where


import Control.Lens

import System.Posix.Types
import System.Process

-- ---------------------------------------------------------- --
-- Optics

-- | Lens into the 'cmdspec' entry of the 'CreateProcess' record
--
--
cmdspec_ :: Lens' CreateProcess CmdSpec
cmdspec_ :: (CmdSpec -> f CmdSpec) -> CreateProcess -> f CreateProcess
cmdspec_ = (CreateProcess -> CmdSpec)
-> (CreateProcess -> CmdSpec -> CreateProcess)
-> Lens CreateProcess CreateProcess CmdSpec CmdSpec
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> CmdSpec
cmdspec (\CreateProcess
t CmdSpec
b -> CreateProcess
t { cmdspec :: CmdSpec
cmdspec = CmdSpec
b })

-- | Lens into the 'cwd' entry of the 'CreateProcess' record
--
cwd_ :: Lens' CreateProcess (Maybe FilePath)
cwd_ :: (Maybe FilePath -> f (Maybe FilePath))
-> CreateProcess -> f CreateProcess
cwd_ = (CreateProcess -> Maybe FilePath)
-> (CreateProcess -> Maybe FilePath -> CreateProcess)
-> Lens
     CreateProcess CreateProcess (Maybe FilePath) (Maybe FilePath)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Maybe FilePath
cwd (\CreateProcess
t Maybe FilePath
b -> CreateProcess
t { cwd :: Maybe FilePath
cwd = Maybe FilePath
b })

-- | Lens into the 'env' entry of the 'CreateProcess' record
--
env_ :: Lens' CreateProcess (Maybe [(String, String)])
env_ :: (Maybe [(FilePath, FilePath)] -> f (Maybe [(FilePath, FilePath)]))
-> CreateProcess -> f CreateProcess
env_ = (CreateProcess -> Maybe [(FilePath, FilePath)])
-> (CreateProcess -> Maybe [(FilePath, FilePath)] -> CreateProcess)
-> Lens
     CreateProcess
     CreateProcess
     (Maybe [(FilePath, FilePath)])
     (Maybe [(FilePath, FilePath)])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Maybe [(FilePath, FilePath)]
env (\CreateProcess
t Maybe [(FilePath, FilePath)]
b -> CreateProcess
t { env :: Maybe [(FilePath, FilePath)]
env = Maybe [(FilePath, FilePath)]
b })

-- | Lens into the 'std_in' entry of the 'CreateProcess' record
--
stdin_ :: Lens' CreateProcess StdStream
stdin_ :: (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
stdin_ = (CreateProcess -> StdStream)
-> (CreateProcess -> StdStream -> CreateProcess)
-> Lens CreateProcess CreateProcess StdStream StdStream
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> StdStream
std_in (\CreateProcess
t StdStream
b -> CreateProcess
t { std_in :: StdStream
std_in = StdStream
b })

-- | Lens into the 'std_out' entry of the 'CreateProcess' record
--
stdout_ :: Lens' CreateProcess StdStream
stdout_ :: (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
stdout_ = (CreateProcess -> StdStream)
-> (CreateProcess -> StdStream -> CreateProcess)
-> Lens CreateProcess CreateProcess StdStream StdStream
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> StdStream
std_out (\CreateProcess
t StdStream
b -> CreateProcess
t { std_out :: StdStream
std_out = StdStream
b })

-- | Lens into the 'std_err' entry of the 'CreateProcess' record
--
stderr_ :: Lens' CreateProcess StdStream
stderr_ :: (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
stderr_ = (CreateProcess -> StdStream)
-> (CreateProcess -> StdStream -> CreateProcess)
-> Lens CreateProcess CreateProcess StdStream StdStream
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> StdStream
std_err (\CreateProcess
t StdStream
b -> CreateProcess
t { std_err :: StdStream
std_err = StdStream
b })

-- | Lens into the 'close_fds' entry of the 'CreateProcess' record
--
closefds :: Lens' CreateProcess Bool
closefds :: (Bool -> f Bool) -> CreateProcess -> f CreateProcess
closefds = (CreateProcess -> Bool)
-> (CreateProcess -> Bool -> CreateProcess)
-> Lens CreateProcess CreateProcess Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Bool
close_fds (\CreateProcess
t Bool
b -> CreateProcess
t { close_fds :: Bool
close_fds = Bool
b })

-- | Lens into the 'create_group' entry of the 'CreateProcess' record
--
creategroup :: Lens' CreateProcess Bool
creategroup :: (Bool -> f Bool) -> CreateProcess -> f CreateProcess
creategroup = (CreateProcess -> Bool)
-> (CreateProcess -> Bool -> CreateProcess)
-> Lens CreateProcess CreateProcess Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Bool
create_group (\CreateProcess
t Bool
b -> CreateProcess
t { create_group :: Bool
create_group = Bool
b })

-- | Lens into the 'delegate_ctlc' entry of the 'CreateProcess' record
--
delegatectlc :: Lens' CreateProcess Bool
delegatectlc :: (Bool -> f Bool) -> CreateProcess -> f CreateProcess
delegatectlc = (CreateProcess -> Bool)
-> (CreateProcess -> Bool -> CreateProcess)
-> Lens CreateProcess CreateProcess Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Bool
delegate_ctlc (\CreateProcess
t Bool
b -> CreateProcess
t { delegate_ctlc :: Bool
delegate_ctlc = Bool
b })

-- | Lens into the 'new_session' entry of the 'CreateProcess' record
--
newsession :: Lens' CreateProcess Bool
newsession :: (Bool -> f Bool) -> CreateProcess -> f CreateProcess
newsession = (CreateProcess -> Bool)
-> (CreateProcess -> Bool -> CreateProcess)
-> Lens CreateProcess CreateProcess Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Bool
new_session (\CreateProcess
t Bool
b -> CreateProcess
t { new_session :: Bool
new_session = Bool
b })

#if MIN_VERSION_process(1, 3, 0)
-- | Lens into the 'detach_console' entry of the 'CreateProcess' record
--
detachconsole :: Lens' CreateProcess Bool
detachconsole :: (Bool -> f Bool) -> CreateProcess -> f CreateProcess
detachconsole = (CreateProcess -> Bool)
-> (CreateProcess -> Bool -> CreateProcess)
-> Lens CreateProcess CreateProcess Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Bool
detach_console (\CreateProcess
t Bool
b -> CreateProcess
t { detach_console :: Bool
detach_console = Bool
b })

-- | Lens into the 'create_new_console' entry of the 'CreateProcess' record
--
createnewconsole :: Lens' CreateProcess Bool
createnewconsole :: (Bool -> f Bool) -> CreateProcess -> f CreateProcess
createnewconsole = (CreateProcess -> Bool)
-> (CreateProcess -> Bool -> CreateProcess)
-> Lens CreateProcess CreateProcess Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Bool
create_new_console (\CreateProcess
t Bool
b -> CreateProcess
t { create_new_console :: Bool
create_new_console = Bool
b })
#endif

#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
-- | Lens into the 'child_group' entry of the 'CreateProcess' record
--
childgroup :: Lens' CreateProcess (Maybe CGid)
childgroup :: (Maybe CGid -> f (Maybe CGid)) -> CreateProcess -> f CreateProcess
childgroup = (CreateProcess -> Maybe CGid)
-> (CreateProcess -> Maybe CGid -> CreateProcess)
-> Lens CreateProcess CreateProcess (Maybe CGid) (Maybe CGid)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Maybe CGid
child_group (\CreateProcess
t Maybe CGid
b -> CreateProcess
t { child_group :: Maybe CGid
child_group = Maybe CGid
b })

-- | Lens into the 'child_user' entry of the 'CreateProcess' record
--
childuser :: Lens' CreateProcess (Maybe CUid)
childuser :: (Maybe CUid -> f (Maybe CUid)) -> CreateProcess -> f CreateProcess
childuser = (CreateProcess -> Maybe CUid)
-> (CreateProcess -> Maybe CUid -> CreateProcess)
-> Lens CreateProcess CreateProcess (Maybe CUid) (Maybe CUid)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Maybe CUid
child_user (\CreateProcess
t Maybe CUid
b -> CreateProcess
t { child_user :: Maybe CUid
child_user = Maybe CUid
b })
#endif

#if MIN_VERSION_process(1, 5, 0)
-- | Lens into the 'use_process_jobs' entry of the 'CreateProcess' record
--
useprocessjobs :: Lens' CreateProcess Bool
useprocessjobs :: (Bool -> f Bool) -> CreateProcess -> f CreateProcess
useprocessjobs = (CreateProcess -> Bool)
-> (CreateProcess -> Bool -> CreateProcess)
-> Lens CreateProcess CreateProcess Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CreateProcess -> Bool
use_process_jobs (\CreateProcess
t Bool
b -> CreateProcess
t { use_process_jobs :: Bool
use_process_jobs = Bool
b })
#endif

-- ---------------------------------------------------------- --
-- Classes

-- | Classy lens for types with a stdin
--
class HasStdin a where
  _Stdin :: Lens' a StdStream

instance HasStdin StdStream where
  _Stdin :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_Stdin = (StdStream -> f StdStream) -> StdStream -> f StdStream
forall a. a -> a
id

instance HasStdin CreateProcess where
  _Stdin :: (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
_Stdin = (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
Lens CreateProcess CreateProcess StdStream StdStream
stdin_

-- | Classy lens for types with a stdout
--
class HasStdout a where
  _Stdout :: Lens' a StdStream

instance HasStdout StdStream where
  _Stdout :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_Stdout = (StdStream -> f StdStream) -> StdStream -> f StdStream
forall a. a -> a
id

instance HasStdout CreateProcess where
  _Stdout :: (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
_Stdout = (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
Lens CreateProcess CreateProcess StdStream StdStream
stdout_

-- | Classy lens for types with a stderr
--
class HasStderr a where
  _Stderr :: Lens' a StdStream

instance HasStderr StdStream where
  _Stderr :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_Stderr = (StdStream -> f StdStream) -> StdStream -> f StdStream
forall a. a -> a
id

instance HasStderr CreateProcess where
  _Stderr :: (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
_Stderr = (StdStream -> f StdStream) -> CreateProcess -> f CreateProcess
Lens CreateProcess CreateProcess StdStream StdStream
stderr_

-- | A default for a 'CreateProcess'
--
defaultCreateProcess :: CreateProcess
defaultCreateProcess :: CreateProcess
defaultCreateProcess =
  CreateProcess :: CmdSpec
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> StdStream
-> StdStream
-> StdStream
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe CGid
-> Maybe CUid
-> Bool
-> CreateProcess
CreateProcess
    { cmdspec :: CmdSpec
cmdspec = FilePath -> CmdSpec
ShellCommand FilePath
""
    , cwd :: Maybe FilePath
cwd = Maybe FilePath
forall a. Maybe a
Nothing
    , env :: Maybe [(FilePath, FilePath)]
env = Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
    , std_in :: StdStream
std_in = StdStream
Inherit
    , std_out :: StdStream
std_out = StdStream
Inherit
    , std_err :: StdStream
std_err = StdStream
Inherit
    , close_fds :: Bool
close_fds = Bool
False
    , create_group :: Bool
create_group = Bool
False
    , delegate_ctlc :: Bool
delegate_ctlc = Bool
False
    , new_session :: Bool
new_session = Bool
False
#if MIN_VERSION_process(1, 3, 0)
    , detach_console :: Bool
detach_console = Bool
False
    , create_new_console :: Bool
create_new_console = Bool
False
#endif
#if MIN_VERSION_process(1, 4, 0)
    , child_group :: Maybe CGid
child_group = Maybe CGid
forall a. Maybe a
Nothing
    , child_user :: Maybe CUid
child_user = Maybe CUid
forall a. Maybe a
Nothing
#endif
#if MIN_VERSION_process(1, 5, 0)
    , use_process_jobs :: Bool
use_process_jobs = Bool
False
#endif
    }