{-# LANGUAGE Rank2Types #-}
module System.Process.Lens.CreateProcess
(
cmdspec_
, cwd_
, env_
, stdin
, stdout
, stderr
, closefds
, creategroup
, createnewconsole
, delegatectlc
, detachconsole
, newsession
, childgroup
, childuser
, useprocessjobs
, HasStdin(..)
, HasStdout(..)
, HasStderr(..)
, closing
, inheriting
, piping
, handling
, nostreaming
) where
import Control.Lens
import qualified System.IO as H
import System.Posix.Types
import System.Process
import System.Process.Lens.StdStream
cmdspec_ :: Lens' CreateProcess CmdSpec
cmdspec_ = lens cmdspec (\t b -> t { cmdspec = b })
cwd_ :: Lens' CreateProcess (Maybe FilePath)
cwd_ = lens cwd (\t b -> t { cwd = b })
env_ :: Lens' CreateProcess (Maybe [(String, String)])
env_ = lens env (\t b -> t { env = b })
stdin :: Lens' CreateProcess StdStream
stdin = lens std_in (\t b -> t { std_in = b })
stdout :: Lens' CreateProcess StdStream
stdout = lens std_out (\t b -> t { std_out = b })
stderr :: Lens' CreateProcess StdStream
stderr = lens std_err (\t b -> t { std_err = b })
closefds :: Lens' CreateProcess Bool
closefds = lens close_fds (\t b -> t { close_fds = b })
creategroup :: Lens' CreateProcess Bool
creategroup = lens create_group (\t b -> t { create_group = b })
delegatectlc :: Lens' CreateProcess Bool
delegatectlc = lens delegate_ctlc (\t b -> t { delegate_ctlc = b })
detachconsole :: Lens' CreateProcess Bool
detachconsole = lens detach_console (\t b -> t { detach_console = b })
createnewconsole :: Lens' CreateProcess Bool
createnewconsole = lens create_new_console (\t b -> t { create_new_console = b })
newsession :: Lens' CreateProcess Bool
newsession = lens new_session (\t b -> t { new_session = b })
childgroup :: Lens' CreateProcess (Maybe CGid)
childgroup = lens child_group (\t b -> t { child_group = b })
childuser :: Lens' CreateProcess (Maybe CUid)
childuser = lens child_user (\t b -> t { child_user = b })
useprocessjobs :: Lens' CreateProcess Bool
useprocessjobs = lens use_process_jobs (\t b -> t { use_process_jobs = b })
class HasStdin a where
_Stdin :: Lens' a StdStream
instance HasStdin StdStream where
_Stdin = id
instance HasStdin CreateProcess where
_Stdin = stdin
class HasStdout a where
_Stdout :: Lens' a StdStream
instance HasStdout StdStream where
_Stdout = id
instance HasStdout CreateProcess where
_Stdout = stdout
class HasStderr a where
_Stderr :: Lens' a StdStream
instance HasStderr StdStream where
_Stderr = id
instance HasStderr CreateProcess where
_Stderr = stderr
closing :: IsUseHandle a => Getter CreateProcess a -> CreateProcess -> IO ()
closing l c = case c ^? l . _UsesHandle of
Nothing -> return ()
Just h -> go h
where
go h
| h /= H.stdin
, h /= H.stdout
, h /= H.stderr = H.hClose h
| otherwise = return ()
inheriting :: IsInherit a => Lens' a StdStream -> a -> a
inheriting l = set l Inherit
piping :: IsCreatePipe a => Lens' a StdStream -> a -> a
piping l = set l CreatePipe
handling :: IsUseHandle a => Lens' a StdStream -> H.Handle -> a -> a
handling l = set $ l . _UseHandle
nostreaming :: IsNoStream a => Lens' a StdStream -> a -> a
nostreaming l = set l NoStream