exitcode 0.1.0.5 → 0.1.0.6

raw patch · 15 files changed

+898/−64 lines, 15 filesdep +filepathdep +processPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: filepath, process

API changes (from Hackage documentation)

Files

• changelog.md +5/−0
• exitcode.cabal +45/−29
• src/Control/Exitcode.hs +122/−11
• src/Control/Process.hs +17/−0
• src/Control/Process/CmdSpec.hs +97/−0
• src/Control/Process/CreateProcess.hs +217/−0
• src/Control/Process/FD.hs +44/−0
• src/Control/Process/GroupID.hs +28/−0
• src/Control/Process/Handle.hs +39/−0
• src/Control/Process/Pid.hs +44/−0
• src/Control/Process/Process.hs +83/−0
• src/Control/Process/ProcessHandle.hs +27/−0
• src/Control/Process/StdStream.hs +63/−0
• src/Control/Process/UserID.hs +44/−0
• test/Tests.hs +23/−24

@@ -1,3 +1,8 @@+0.1.0.6++* Implement `ExitcodeT1` which associates the same type of value+* Implement functions over `System.Process` to use exitcode+ 0.1.0.5  * Large refactor, involving an associated value with an exit failure.

@@ -1,42 +1,56 @@ -- documentation, see http://haskell.org/cabal/users-guide/ -name:                exitcode-version:             0.1.0.5-synopsis:            Monad transformer for exit codes+name:                   exitcode+version:                0.1.0.6+synopsis:               Monad transformer for exit codes description:   <<https://system-f.gitlab.io/logo/systemf-450x450.jpg>>   .   Monad transformer for exit codes-license:             BSD3-license-file:        LICENCE-author:              Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>-maintainer:          Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>-copyright:           Copyright (C) 2019-2022 Tony Morris-category:            Control-build-type:          Simple-extra-source-files:  changelog.md-cabal-version:       >=1.10-homepage:            https://github.com/system-f/exitcode-bug-reports:         https://github.com/system-f/exitcode/issues-tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1+license:                BSD3+license-file:           LICENCE+author:                 Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer:             Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright:              Copyright (C) 2019-2022 Tony Morris+category:               Control+build-type:             Simple+extra-source-files:     changelog.md+cabal-version:          >=1.10+homepage:               https://github.com/system-f/exitcode+bug-reports:            https://github.com/system-f/exitcode/issues+tested-with:             GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1 -source-repository   head-  type:             git-  location:         git@github.com:system-f/exitcode.git+source-repository       head+  type:                 git+  location:             git@github.com:system-f/exitcode.git  library-  exposed-modules:     Control.Exitcode-  build-depends:       base >= 4.8 && < 6-                     , bifunctors >= 5 && < 6-                     , lens >= 4.15 && < 6-                     , mtl >= 2.2 && < 2.3-                     , semigroupoids >= 5.1 && < 5.4-                     , semigroups >= 0.16 && < 0.19-                     , transformers >= 0.5.0 && < 5.5-  hs-source-dirs:      src-  default-language:    Haskell2010-  ghc-options:         -Wall+  exposed-modules:      Control.Exitcode+                        Control.Process+                        Control.Process.CmdSpec+                        Control.Process.CreateProcess+                        Control.Process.FD+                        Control.Process.GroupID+                        Control.Process.Handle+                        Control.Process.Pid+                        Control.Process.Process+                        Control.Process.ProcessHandle+                        Control.Process.StdStream+                        Control.Process.UserID +  build-depends:        base >= 4.8 && < 6+                      , bifunctors >= 5 && < 6+                      , filepath >= 1.4 && < 2+                      , lens >= 4.15 && < 6+                      , mtl >= 2.2 && < 2.3+                      , process >= 1.6.12.0 && < 2+                      , semigroupoids >= 5.1 && < 5.4+                      , semigroups >= 0.16 && < 0.19+                      , transformers >= 0.5.0 && < 5.5+  hs-source-dirs:       src+  default-language:     Haskell2010+  ghc-options:          -Wall+ test-suite             tests   build-depends:       QuickCheck >= 2.9.2 && < 2.13                      , base >= 4.8 && < 6@@ -45,6 +59,8 @@                      , exitcode                      , hedgehog >= 0.5 && < 0.7                      , lens >= 4.15 && < 6+                     , mtl >= 2.2 && < 2.3+                     , semigroupoids >= 5.1 && < 5.4                      , tasty >= 0.11 && < 1.3                      , tasty-hunit >= 0.9 && < 0.11                      , tasty-hedgehog >= 0.1 && < 0.3

@@ -5,6 +5,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}  module Control.Exitcode ( -- * Types@@ -12,6 +13,8 @@ , Exitcode , ExitcodeT0 , Exitcode0+, ExitcodeT1+, Exitcode1 -- * Construction , exitsuccess , exitsuccess0@@ -24,11 +27,16 @@ , liftExitcode , liftExitcodeError , liftExitcodeError0+, hoistExitcode+, embedExitcode+, exitcode1 -- * Extraction , runExitcodeT , runExitcodeT0 , runExitcode , runExitcode0+, runExitcodeT1+, runExitcode1 -- * Optics , exitCode , _ExitcodeInt@@ -36,27 +44,27 @@ , _ExitFailure , _ExitFailureError , _ExitSuccess+, _Exitcode1 ) where  import Control.Applicative     ( Applicative((<*>), pure, liftA2) ) import Control.Category ( Category((.)) ) import Control.Lens-    ( Identity(runIdentity),-      preview,+    ( preview,       view,       iso,       _Left,       prism,-      mapped,       over,       Field1(_1),       Field2(_2),       Iso,+      Lens,       Prism,-      Setter',-      Traversal )-import Control.Monad ( Monad(return, (>>=)) )+      Traversal,+      Traversal' )+import Control.Monad ( join, Monad(return, (>>=)) ) import Control.Monad.Cont.Class ( MonadCont(..) ) import Control.Monad.Error.Class ( MonadError(..) ) import Control.Monad.IO.Class ( MonadIO(..) )@@ -86,7 +94,7 @@       Ord1(..),       Show1(..) ) import Data.Functor.Extend ( Extend(..) )-import Data.Functor.Identity ( Identity(Identity) )+import Data.Functor.Identity ( Identity(Identity, runIdentity) ) import Data.Int ( Int ) import Data.Maybe ( Maybe(Nothing, Just), fromMaybe ) import Data.Monoid ( Monoid(mempty) )@@ -328,19 +336,25 @@  -- | Setter to integer. ----- >>> over _ExitcodeInt' (subtract 1) (exitsuccess0) :: ExitcodeT0 Identity+-- >>> > preview _ExitcodeInt' (exitsuccess0 :: ExitcodeT [] () ())+-- Just 0+-- >>> preview _ExitcodeInt' (exitfailure0 99 :: ExitcodeT [] () ())+-- Just 99+-- >>> preview _ExitcodeInt' (exitfailure0 0 :: ExitcodeT [] () ())+-- Just 0+-- >>> over _ExitcodeInt' (subtract 1) exitsuccess0 :: ExitcodeT0 Identity -- ExitcodeT (Identity (Left ((),-1))) -- >>> over _ExitcodeInt' (subtract 1) (exitfailure0 99) :: ExitcodeT0 Identity -- ExitcodeT (Identity (Left ((),98))) -- >>> over _ExitcodeInt' (subtract 1) (exitfailure0 1) :: ExitcodeT0 Identity -- ExitcodeT (Identity (Right ())) _ExitcodeInt' ::-  (Functor f) =>-  Setter'+  Traversable f =>+  Traversal'     (ExitcodeT0 f)     Int _ExitcodeInt' =-  _ExitcodeInt . mapped+  _ExitcodeInt . traverse  -- | A traversal to exit failure. --@@ -572,6 +586,21 @@ liftExitcodeError0 x =   liftExitcodeError (((),) <$> x) () +hoistExitcode ::+  (forall x. f x -> g x)+  -> ExitcodeT f e a+  -> ExitcodeT g e a+hoistExitcode nat (ExitcodeT x) =+  ExitcodeT (nat x)++embedExitcode ::+  Functor g =>+  (forall x. f x -> ExitcodeT g e x)+  -> ExitcodeT f e a+  -> ExitcodeT g e a+embedExitcode nat (ExitcodeT x) =+  ExitcodeT (join <$> runExitcodeT (nat x))+ instance MonadReader r f => MonadReader r (ExitcodeT f e) where   ask =     liftExitcode ask@@ -651,3 +680,85 @@ instance Traversable f => Bitraversable (ExitcodeT f) where   bitraverse f g (ExitcodeT x) =     ExitcodeT <$> traverse (bitraverse (\(a, n) -> (, n) <$> f a) g) x++type ExitcodeT1 f a =+  ExitcodeT f a a++type Exitcode1 a =+  ExitcodeT1 Identity a++-- | Construct an exitcode with an associated value.+--+-- >>> exitcode1 99 "abc" :: ExitcodeT1 Identity String+-- ExitcodeT (Identity (Left ("abc",99)))+-- >>> exitcode1 0 "abc" :: ExitcodeT1 Identity String+-- ExitcodeT (Identity (Right "abc"))+exitcode1 ::+  Applicative f =>+  Int+  -> a+  -> ExitcodeT1 f a+exitcode1 n a =+  exitcodeValue a n a++-- | Extract either the non-zero value or the success value.+--+-- >>> runExitcodeT1 exitsuccess0+-- Right ()+-- >>> runExitcodeT1 (exitfailure () 99) :: Identity (Either ((), Int) ())+-- Identity (Left ((),99))+-- >>> runExitcodeT1 (exitcode1 0 "abc") :: Identity (Either (String, Int) String)+-- Identity (Right "abc")+-- >>> runExitcodeT1 (exitcode1 99 "abc") :: Identity (Either (String, Int) String)+-- Identity (Left ("abc",99))+runExitcodeT1 ::+  ExitcodeT1 f a+  -> f (Either (a, Int) a)+runExitcodeT1 (ExitcodeT x) =+  x++-- | Extract either the non-zero value or the success value.+--+-- >>> runExitcode1 exitsuccess0+-- Right ()+-- >>> runExitcode1 (exitfailure () 99)+-- Left ((),99)+-- >>> runExitcode1 (exitcode1 0 "abc")+-- Right "abc"+-- >>> runExitcode1 (exitcode1 99 "abc")+-- Left ("abc",99)+runExitcode1 ::+  Exitcode1 a+  -> Either (a, Int) a+runExitcode1 =+  runIdentity . runExitcodeT1++-- | A lens to the value associated with an exitcode.+--+-- >>> view _Exitcode1 (exitcode1 0 "abc")+-- "abc"+-- >>> view _Exitcode1 (exitcode1 99 "abc")+-- "abc"+-- >>> view _Exitcode1 (exitcodeValue "abc" 0 "def")+-- "def"+-- >>> view _Exitcode1 (exitcodeValue "abc" 99 "def")+-- "abc"+-- >>> over _Exitcode1 reverse (exitcode1 0 "abc")+-- ExitcodeT (Identity (Right "cba"))+-- >>> over _Exitcode1 reverse (exitcode1 99 "abc")+-- ExitcodeT (Identity (Left ("cba",99)))+-- >>> over _Exitcode1 reverse (exitcodeValue "abc" 0 "def")+-- ExitcodeT (Identity (Right "fed"))+-- >>> over _Exitcode1 reverse (exitcodeValue "abc" 99 "def")+-- ExitcodeT (Identity (Left ("cba",99)))+_Exitcode1 ::+  Lens+    (Exitcode1 a)+    (Exitcode1 a')+    a+    a'+_Exitcode1 f =+  either+    (\(a, n) -> fmap (exitcode1 n) (f a))+    (fmap (exitcode1 0) . f)+    . runExitcode1

@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Control.Process(+  module P+) where++import Control.Process.CmdSpec as P+import Control.Process.CreateProcess as P+import Control.Process.FD as P+import Control.Process.GroupID as P+import Control.Process.Handle as P+import Control.Process.Pid as P+import Control.Process.Process as P+import Control.Process.ProcessHandle as P+import Control.Process.StdStream as P+import Control.Process.UserID as P

@@ -0,0 +1,97 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Control.Process.CmdSpec(+  AsCmdSpec(..)+, HasCmdSpec(..)+) where++import Control.Category ( Category(id, (.)) )+import Control.Lens+    ( Traversable(traverse),+      prism',+      Field1(_1),+      Field2(_2),+      Lens',+      Prism',+      Traversal' )+import Data.Maybe ( Maybe(Nothing, Just) )+import Data.Functor ( Functor(fmap) )+import Data.String ( String )+import Data.Tuple ( uncurry )+import System.FilePath ( FilePath )+import System.Process ( CreateProcess(..), CmdSpec(..) )++class AsCmdSpec a where+  _CmdSpec ::+    Prism' a CmdSpec+  _ShellCommand ::+    Prism' a String+  _ShellCommand =+    _CmdSpec . _ShellCommand+  _RawCommand ::+    Prism' a (FilePath, [String])+  _RawCommand =+    _CmdSpec . _RawCommand+  _RawCommandExe ::+    Traversal' a FilePath+  _RawCommandExe =+    _RawCommand . _1+  _RawCommandArgumentList ::+    Traversal' a [String]+  _RawCommandArgumentList =+    _RawCommand . _2+  _RawCommandArguments ::+    Traversal' a String+  _RawCommandArguments =+    _RawCommandArgumentList . traverse++instance AsCmdSpec CmdSpec where+  _CmdSpec = id+  _ShellCommand =+    prism'+      ShellCommand+      (\case+        ShellCommand a -> Just a+        _ -> Nothing+      )+  _RawCommand =+    prism'+      (uncurry RawCommand)+      (\case+        RawCommand a b -> Just (a, b)+        _ -> Nothing+      )++class HasCmdSpec a where+  cmdSpec ::+    Lens' a CmdSpec+  shellCommand ::+    Traversal' a String+  shellCommand =+    cmdSpec . _ShellCommand+  rawCommand ::+    Traversal' a (FilePath, [String])+  rawCommand =+    cmdSpec . _RawCommand+  rawCommandExe ::+    Traversal' a FilePath+  rawCommandExe =+    rawCommand . _1+  rawCommandArgumentList ::+    Traversal' a [String]+  rawCommandArgumentList =+    rawCommand . _2+  rawCommandArguments ::+    Traversal' a String+  rawCommandArguments =+    rawCommandArgumentList . traverse++instance HasCmdSpec CmdSpec where+  cmdSpec =+    id++instance HasCmdSpec CreateProcess where+  cmdSpec f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\csc' -> CreateProcess csc' cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) (f csc)

@@ -0,0 +1,217 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Control.Process.CreateProcess(+  HasCreateProcess(..)+, AsCreateProcess(..)+, streams+, streams1+) where++import Control.Applicative ( Applicative((<*>)) )+import Control.Category ( Category(id, (.)) )+import Control.Lens+    ( Traversable(traverse),+      _Just,+      only,+      Field1(_1),+      Field2(_2),+      Lens',+      Prism',+      Traversal',+      Traversal1' )+import Control.Process.UserID ( HasUserID(userIDWord32) )+import Data.Bool ( Bool(True) )+import Data.Functor ( Functor(fmap), (<$>) )+import Data.Functor.Apply ( Apply((<.>)) )+import Data.Maybe ( Maybe(..) )+import Data.String ( String )+import Data.Word ( Word32 )+import System.FilePath ( FilePath )+import System.Process(StdStream(..), CreateProcess(CreateProcess))+import System.Process.Internals(GroupID, UserID)++class HasCreateProcess a where+  create_process ::+    Lens' a CreateProcess+  child_group ::+    Lens' a (Maybe GroupID)+  {-# INLINE child_group #-}+  child_group =+    create_process . child_group+  child_user ::+    Lens' a (Maybe UserID)+  {-# INLINE child_user #-}+  child_user =+    create_process . child_user+  close_fds ::+    Lens' a Bool+  {-# INLINE close_fds #-}+  close_fds =+    create_process . close_fds+  create_group ::+    Lens' a Bool+  {-# INLINE create_group #-}+  create_group =+    create_process . create_group+  create_new_console ::+    Lens' a Bool+  {-# INLINE create_new_console #-}+  create_new_console =+    create_process . create_new_console+  cwd ::+    Lens' a (Maybe FilePath)+  {-# INLINE cwd #-}+  cwd =+    create_process . cwd+  delegate_ctlc ::+    Lens' a Bool+  {-# INLINE delegate_ctlc #-}+  delegate_ctlc =+    create_process . delegate_ctlc+  detach_console ::+    Lens' a Bool+  {-# INLINE detach_console #-}+  detach_console =+    create_process . detach_console+  env ::+    Lens' a (Maybe [(String, String)])+  {-# INLINE env #-}+  env =+    create_process . env+  new_session ::+    Lens' a Bool+  {-# INLINE new_session #-}+  new_session =+    create_process . new_session+  std_err ::+    Lens' a StdStream+  {-# INLINE std_err #-}+  std_err =+    create_process . std_err+  std_in ::+    Lens' a StdStream+  {-# INLINE std_in #-}+  std_in =+    create_process . std_in+  std_out ::+    Lens' a StdStream+  {-# INLINE std_out #-}+  std_out =+    create_process . std_out+  use_process_jobs ::+    Lens' a Bool+  {-# INLINE use_process_jobs #-}+  use_process_jobs =+    create_process . use_process_jobs++  cwd' ::+    Traversal' a FilePath+  cwd' =+    cwd . _Just+  envList ::+    Traversal' a [(String, String)]+  envList =+    env . _Just+  envElement ::+    Traversal' a (String, String)+  envElement =+    envList . traverse+  envElementKey ::+    Traversal' a String+  envElementKey =+    envElement . _1+  envElementValue ::+    Traversal' a String+  envElementValue =+    envElement . _2+  close_fds' ::+    Traversal' a ()+  close_fds' =+    close_fds . only True+  create_group' ::+    Traversal' a ()+  create_group' =+    create_group . only True+  delegate_ctlc' ::+    Traversal' a ()+  delegate_ctlc' =+    delegate_ctlc . only True+  detach_console' ::+    Traversal' a ()+  detach_console' =+    detach_console . only True+  create_new_console' ::+    Traversal' a ()+  create_new_console' =+    create_new_console . only True+  new_session' ::+    Traversal' a ()+  new_session' =+    new_session . only True+  child_group' ::+    Traversal' a GroupID+  child_group' =+    child_group . _Just+  child_user' ::+    Traversal' a UserID+  child_user' =+    child_user . _Just+  child_user'' ::+    Traversal' a Word32+  child_user'' =+    child_user' . userIDWord32+  use_process_jobs' ::+    Traversal' a ()+  use_process_jobs' =+    use_process_jobs . only True++instance HasCreateProcess CreateProcess where+  create_process =+    id+  child_group f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\chg' -> CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg' chu upj) (f chg)+  child_user f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\chu' -> CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu' upj) (f chu)+  close_fds f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\clf' -> CreateProcess csc cw en sti sto ste clf' crg dct dcl cnc nss chg chu upj) (f clf)+  create_group f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\crg' -> CreateProcess csc cw en sti sto ste clf crg' dct dcl cnc nss chg chu upj) (f crg)+  create_new_console f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\cnc' -> CreateProcess csc cw en sti sto ste clf crg dct dcl cnc' nss chg chu upj) (f cnc)+  cwd f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\cw' -> CreateProcess csc cw' en sti sto ste clf crg dct dcl cnc nss chg chu upj) (f cw)+  delegate_ctlc f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\dct' -> CreateProcess csc cw en sti sto ste clf crg dct' dcl cnc nss chg chu upj) (f dct)+  detach_console f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\dcl' -> CreateProcess csc cw en sti sto ste clf crg dct dcl' cnc nss chg chu upj) (f dcl)+  env f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\en' -> CreateProcess csc cw en' sti sto ste clf crg dct dcl cnc nss chg chu upj) (f en)+  new_session f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\nss' -> CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss' chg chu upj) (f nss)+  std_err f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\ste' -> CreateProcess csc cw en sti sto ste' clf crg dct dcl cnc nss chg chu upj) (f ste)+  std_in f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\sti' -> CreateProcess csc cw en sti' sto ste clf crg dct dcl cnc nss chg chu upj) (f sti)+  std_out f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\sto' -> CreateProcess csc cw en sti sto' ste clf crg dct dcl cnc nss chg chu upj) (f sto)+  use_process_jobs f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+    fmap (\upj' -> CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj') (f upj)++class AsCreateProcess a where+  _CreateProcess ::+    Prism' a CreateProcess++instance AsCreateProcess CreateProcess where+  _CreateProcess =+    id++streams ::+  Traversal' CreateProcess StdStream+streams f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+  (\sti' sto' ste' -> CreateProcess csc cw en sti' sto' ste' clf crg dct dcl cnc nss chg chu upj) <$> f sti <*> f sto <*> f ste++streams1 ::+  Traversal1' CreateProcess StdStream+streams1 f (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu upj) =+  (\sti' sto' ste' -> CreateProcess csc cw en sti' sto' ste' clf crg dct dcl cnc nss chg chu upj) <$> f sti <.> f sto <.> f ste

@@ -0,0 +1,44 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Control.Process.FD(+  HasFD(..)+, AsFD(..)+) where++import Control.Category((.), id)+import Control.Lens ( iso, Lens', Prism' )+import Data.Int ( Int32 )+import Foreign.C.Types ( CInt(CInt) )+import System.Posix.Internals ( FD )++class HasFD a where+  fd ::+    Lens' a FD+  fdInt32 ::+    Lens' a Int32+  fdInt32 =+    fd .+      iso+        (\(CInt x) -> x)+        CInt++instance HasFD FD where+  fd =+    id++class AsFD a where+  _FD ::+    Prism' a FD+  _FDInt32 ::+    Prism' a Int32+  _FDInt32 =+    _FD .+      iso+        (\(CInt x) -> x)+        CInt++instance AsFD FD where+  _FD =+    id

@@ -0,0 +1,28 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Control.Process.GroupID(+  HasGroupID(..)+, AsGroupID(..)+) where++import Control.Category(id)+import Control.Lens ( Lens', Prism' )+import System.Process.Internals ( GroupID )++class HasGroupID a where+  groupID ::+    Lens' a GroupID++instance HasGroupID GroupID where+  groupID =+    id++class AsGroupID a where+  _GroupID ::+    Prism' a GroupID++instance AsGroupID GroupID where+  _GroupID =+    id

@@ -0,0 +1,39 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Control.Process.Handle(+  HasHandle(..)+, AsHandle(..)+) where++import Control.Category(id)+import Control.Lens ( prism', Lens', Prism' )+import Data.Maybe ( Maybe(Nothing, Just) )+import System.IO ( Handle )+import System.Process ( StdStream(UseHandle) )++class HasHandle a where+  handle ::+    Lens' a Handle++instance HasHandle Handle where+  handle =+    id++class AsHandle a where+  _Handle ::+    Prism' a Handle++instance AsHandle Handle where+  _Handle =+    id++instance AsHandle StdStream where+  _Handle =+    prism'+      UseHandle+      (\case+        UseHandle a -> Just a+        _ -> Nothing+      )

@@ -0,0 +1,44 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Control.Process.Pid(+  HasPid(..)+, AsPid(..)+) where++import Control.Category((.), id)+import Control.Lens ( iso, Lens', Prism' )+import Data.Int ( Int32 )+import System.Posix.Types ( CPid(CPid) )+import System.Process ( Pid )++class HasPid a where+  pid ::+    Lens' a Pid+  pidInt32 ::+    Lens' a Int32+  pidInt32 =+    pid .+      iso+        (\(CPid x) -> x)+        CPid++instance HasPid Pid where+  pid =+    id++class AsPid a where+  _Pid ::+    Prism' a Pid+  _PidInt32 ::+    Prism' a Int32+  _PidInt32 =+    _Pid .+      iso+        (\(CPid x) -> x)+        CPid++instance AsPid Pid where+  _Pid =+    id

@@ -0,0 +1,83 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Control.Process.Process(+  module Process+, readCreateProcessWithExitCode+, readProcessWithExitCode+, waitForProcess+, getProcessExitCode+) where++import Control.Applicative ( Applicative(pure) )+import Control.Category ( Category((.)) )+import Control.Exitcode+    ( ExitcodeT0,+      fromExitCode',+      liftExitcode,+      ExitcodeT1,+      _Exitcode1,+      hoistExitcode )+import Control.Lens ( Identity(runIdentity), set )+import Control.Monad ( Monad((>>=)) )+import Data.String ( String )+import System.FilePath( FilePath )+import System.IO ( IO )+import System.Process as Process(+    createProcess+  , createProcess_+  , shell+  , proc+  , CreateProcess()+  , CmdSpec(..)+  , StdStream(..)+  , ProcessHandle+  , callProcess+  , callCommand+  , spawnProcess+  , readCreateProcess+  , readProcess+  , withCreateProcess+  , cleanupProcess+  , showCommandForUser+  , Pid+  , getPid+  , getCurrentPid+  , terminateProcess+  , interruptProcessGroupOf+  , createPipe+  , createPipeFd+  )+import qualified System.Process as P(readCreateProcessWithExitCode, readProcessWithExitCode, waitForProcess, getProcessExitCode)+import Control.Monad.Trans.Maybe ( MaybeT(MaybeT) )++readCreateProcessWithExitCode ::+  CreateProcess+  -> String+  -> ExitcodeT1 IO (String, String)+readCreateProcessWithExitCode p a =+  liftExitcode (P.readCreateProcessWithExitCode p a) >>= \(x, y, z) ->+    hoistExitcode (pure . runIdentity) (set _Exitcode1 (y, z) (fromExitCode' x))++readProcessWithExitCode ::+  FilePath+  -> [String]+  -> String+  -> ExitcodeT1 IO (String, String)+readProcessWithExitCode p a i =+  liftExitcode (P.readProcessWithExitCode p a i) >>= \(x, y, z) ->+    hoistExitcode (pure . runIdentity) (set _Exitcode1 (y, z) (fromExitCode' x))++waitForProcess ::+  ProcessHandle+  -> ExitcodeT0 IO+waitForProcess h =+  liftExitcode (P.waitForProcess h) >>= \x ->+    hoistExitcode (pure . runIdentity) (fromExitCode' x)++getProcessExitCode ::+  ProcessHandle+  -> ExitcodeT0 (MaybeT IO)+getProcessExitCode h =+  liftExitcode (MaybeT (P.getProcessExitCode h)) >>=+    hoistExitcode (pure . runIdentity) . fromExitCode'

@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Control.Process.ProcessHandle(+  HasProcessHandle(..)+, AsProcessHandle(..)+) where++import Control.Category(id)+import System.Process ( ProcessHandle )+import Control.Lens ( Lens', Prism' )++class HasProcessHandle a where+  processHandle ::+    Lens' a ProcessHandle++instance HasProcessHandle ProcessHandle where+  processHandle =+    id++class AsProcessHandle a where+  _ProcessHandle ::+    Prism' a ProcessHandle++instance AsProcessHandle ProcessHandle where+  _ProcessHandle =+    id

@@ -0,0 +1,63 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Control.Process.StdStream(+  StdStream(..)+, AsStdStream(..)+, HasStdStream(..)+) where++import Control.Category ( Category(id, (.)) )+import Control.Lens ( prism', Lens', Prism' )+import Data.Maybe ( Maybe(Nothing, Just) )+import System.Process ( StdStream(..) )++class AsStdStream a where+  _StdStream ::+    Prism' a StdStream+  _Inherit ::+    Prism' a ()+  _Inherit =+    _StdStream . _Inherit+  _CreatePipe ::+    Prism' a ()+  _CreatePipe =+    _StdStream . _CreatePipe+  _NoStream ::+    Prism' a ()+  _NoStream =+    _StdStream . _NoStream++instance AsStdStream StdStream where+  _StdStream =+    id+  _Inherit =+    prism'+      (\() -> Inherit)+      (\case+        Inherit -> Just ()+        _ -> Nothing+      )+  _CreatePipe =+    prism'+      (\() -> CreatePipe)+      (\case+        CreatePipe -> Just ()+        _ -> Nothing+      )+  _NoStream =+    prism'+      (\() -> NoStream)+      (\case+        NoStream -> Just ()+        _ -> Nothing+      )++class HasStdStream a where+  stdStream ::+    Lens' a StdStream++instance HasStdStream StdStream where+  stdStream =+    id

@@ -0,0 +1,44 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Control.Process.UserID(+  HasUserID(..)+, AsUserID(..)+) where++import Control.Category((.), id)+import Control.Lens ( iso, Lens', Prism' )+import Data.Word ( Word32 )+import System.Posix.Types ( CUid(CUid) )+import System.Process.Internals ( UserID )++class HasUserID a where+  userID ::+    Lens' a UserID+  userIDWord32 ::+    Lens' a Word32+  userIDWord32 =+    userID .+      iso+        (\(CUid x) -> x)+        CUid++instance HasUserID UserID where+  userID =+    id++class AsUserID a where+  _UserID ::+    Prism' a UserID+  _UserIDWord32 ::+    Prism' a Word32+  _UserIDWord32 =+    _UserID .+      iso+        (\(CUid x) -> x)+        CUid++instance AsUserID UserID where+  _UserID =+    id

@@ -19,26 +19,27 @@ import           Control.Exitcode          (Exitcode, ExitcodeT, exitCode,                                             exitfailure0, exitsuccess,                                             exitsuccess0, runExitcode,-                                            _ExitFailure, _ExitSuccess)+                                            runExitcodeT, _ExitFailure,+                                            _ExitSuccess, ExitcodeT0)  import           System.Exit               (ExitCode (..)) -newtype EW f a = EW { unEW :: ExitcodeT f a } deriving (Eq, Show)+newtype EW f e a = EW { unEW :: ExitcodeT f e a } deriving (Eq, Show) -instance (Monad f, Arbitrary a) => Arbitrary (EW f a) where+instance (Monad f, Arbitrary e, Arbitrary a) => Arbitrary (EW f e a) where   arbitrary = fmap (EW . pure) TQC.arbitrary -instance Functor f => Functor (EW f) where+instance Functor f => Functor (EW f e) where   fmap f = EW . fmap f . unEW -instance Monad f => Applicative (EW f) where+instance Monad f => Applicative (EW f e) where   pure = EW . pure   EW f <*> EW a = EW (f <*> a) -instance (Eq1 f, Eq a) => EqProp (EW f a) where+instance (Eq1 f, Eq e, Eq a) => EqProp (EW f e a) where   (=-=) = eq -type CheckMe = EW [] (Integer, Integer, Integer)+type CheckMe = EW [] String (Integer, Integer, Integer)  nonZero :: MonadGen m => m Int nonZero =@@ -54,7 +55,7 @@     tastyCheckersBatch $ functor (undefined :: CheckMe)   , tastyCheckersBatch $ applicative (undefined :: CheckMe)   , applicativeTest-  , exitFailurePrismTest+  , exitFailureTraversalTest   , exitSuccessPrismTest   , exitfailure0Test   , exitCodePrismTest@@ -64,29 +65,25 @@ applicativeTest =   testGroup "Applicative" [     testCase "Sticks to the Right" $-      pure (<> "bar") <*> pure "foo" @?= (exitsuccess "foobar" :: Exitcode String)+      pure (<> "bar") <*> pure "foo" @?= (exitsuccess "foobar" :: Exitcode String String)   ] -exitFailurePrismTest :: TestTree-exitFailurePrismTest =-  testGroup "_ExitFailure Prism" [-    testProperty "review non-zero input" . property $-      forAll nonZero >>= (\n -> review _ExitFailure n === exitfailure0 n)-  , testCase "review 0" $-      review _ExitFailure 0 @?= exitsuccess0-  , testProperty "view non-zero input" . property $-      forAll nonZero >>= (\n -> exitfailure0 n ^? _ExitFailure === Just n)+exitFailureTraversalTest :: TestTree+exitFailureTraversalTest =+  testGroup "_ExitFailure Traversal" [+    testProperty "view non-zero input" . property $+      forAll nonZero >>= (\n -> (exitfailure0 n :: ExitcodeT0 Identity) ^? _ExitFailure === Just ((), n))   , testCase "view 0" $-      exitfailure0 0 ^? _ExitFailure @?= Nothing+      (exitfailure0 0 :: ExitcodeT0 Identity) ^? _ExitFailure @?= Nothing   ]  exitSuccessPrismTest :: TestTree exitSuccessPrismTest =   testGroup "_ExitSuccess Prism" [     testCase "review" $-      review _ExitSuccess () @?= exitsuccess0+      review _ExitSuccess () @?= (exitsuccess0 :: ExitcodeT Identity () ())   , testCase "view exitsuccess0" $-      exitsuccess0 ^? _ExitSuccess @?= Just ()+      (exitsuccess0 :: ExitcodeT Identity () ()) ^? _ExitSuccess @?= Just ()   , testProperty "view exitfailure0 non-zero" . property $       forAll nonZero >>= (\n -> exitfailure0 n ^? _ExitSuccess === Nothing)   , testCase "view exitfailure0 0" $@@ -97,9 +94,10 @@ exitfailure0Test =   testGroup "exitfailure0" [     testProperty "non-zero input" . property $-      forAll nonZero >>= (\n -> (runIdentity . runExitcode) (exitfailure0 n) === Left n)+      forAll nonZero >>= (\n ->+        runExitcode (exitfailure0 n) === Left ((), n))   , testCase "0" $-      (runIdentity . runExitcode) (exitfailure0 0) @?= Right ()+      runExitcode (exitfailure0 0) @?= Right ()   ]  exitCodePrismTest :: TestTree@@ -114,7 +112,8 @@   , testProperty "view ExitFailure n, where n is non-zero" . property $       forAll nonZero >>= (\n -> Identity (ExitFailure n) ^? exitCode === Just (exitfailure0 n))   , testCase "view ExitFailure 0" $-      runExitcode (Identity (ExitFailure 0) ^. exitCode) @?= (MaybeT (Identity Nothing))+      let _ = ""+      in  runExitcodeT (Identity (ExitFailure 0) ^. exitCode) @?= (MaybeT (Identity Nothing))   , testCase "view ExitSuccess" $       Identity ExitSuccess ^? exitCode @?= Just exitsuccess0   ]