exitcode 0.2.0.0 → 0.3.0.0

raw patch · 21 files changed

+2588/−1331 lines, 21 filesdep +comonaddep +deepseqdep +naturaldep −QuickCheckdep −checkersdep −hedgehogdep ~mtldep ~processdep ~semigroupoidssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: comonad, deepseq, natural, tasty-bench

Dependencies removed: QuickCheck, checkers, hedgehog, semigroups, tasty, tasty-hedgehog, tasty-hunit, tasty-quickcheck

Dependency ranges changed: mtl, process, semigroupoids, transformers

API changes (from Hackage documentation)

Files

• README.md +5/−0
• Setup.hs +7/−1
• benchmarks/Main.hs +36/−0
• changelog.md +19/−0
• exitcode.cabal +44/−30
• src/Control/Exitcode.hs +8/−813
• src/Control/Exitcode/Exitcode.hs +1156/−0
• src/Control/Exitcode/Optics.hs +219/−0
• src/Control/Process.hs +5/−4
• src/Control/Process/CmdSpec.hs +157/−59
• src/Control/Process/CreateProcess.hs +159/−62
• src/Control/Process/FD.hs +103/−17
• src/Control/Process/GroupID.hs +71/−11
• src/Control/Process/Handle.hs +90/−16
• src/Control/Process/Pid.hs +103/−17
• src/Control/Process/Process.hs +130/−118
• src/Control/Process/ProcessHandle.hs +34/−10
• src/Control/Process/StdStream.hs +121/−29
• src/Control/Process/UserID.hs +103/−17
• test/Main.hs +18/−0
• test/Tests.hs +0/−127

@@ -0,0 +1,5 @@+# exitcode++Monad transformer for exit codes++![System-F](https://logo.systemf.com.au/systemf-450x450.jpg)

@@ -1,2 +1,8 @@-import Distribution.Simple+{-# OPTIONS_GHC -Wall -Werror #-}++module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO () main = defaultMain

@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -Wall -Werror #-}++module Main (main) where++import Control.Exitcode (Exitcode', mkExitFailure1', mkExitSuccess', runExitcode)+import Data.Functor.Identity (runIdentity)+import Test.Tasty.Bench (bench, bgroup, defaultMain, whnf)++n :: Int+n = 1000++bindChain :: Int -> Exitcode' () Int+bindChain depth = iterate (\acc -> acc >>= \x -> mkExitSuccess' (x + 1)) (mkExitSuccess' 0) !! depth+{-# NOINLINE bindChain #-}++failShortCircuit :: Int -> Exitcode' () Int+failShortCircuit depth = iterate (\acc -> acc >>= \x -> mkExitSuccess' (x + 1)) (mkExitFailure1' () >> mkExitSuccess' 0) !! depth+{-# NOINLINE failShortCircuit #-}++failPropagation :: Int -> Exitcode' Int Int+failPropagation depth = iterate (\acc -> acc >>= \_ -> mkExitFailure1' 0) (mkExitSuccess' 0) !! depth+{-# NOINLINE failPropagation #-}++main :: IO ()+main =+  defaultMain+    [ bgroup+        "Exitcode"+        [ bgroup+            "bind"+            [ bench "success-chain" $ whnf (runIdentity . runExitcode . bindChain) n,+              bench "fail-short-circuit" $ whnf (runIdentity . runExitcode . failShortCircuit) n,+              bench "fail-propagation" $ whnf (runIdentity . runExitcode . failPropagation) n+            ]+        ]+    ]

@@ -1,3 +1,22 @@+0.3.0.0++* Replace `Int` exit code representation with `NotZero` from the `natural` package, making it impossible to construct a failure with exit code 0+* Introduce `ExitcodeBifunctor` newtype enabling `Bifunctor`, `Bifoldable`, and `Bitraversable` instances+* Add `bimapExitcode` for mapping both error and success values+* Add `toExitCode` and `toExitCode'` as inverses of `fromExitCode`/`fromExitCode'`+* Add `maybeExitcode` and `maybeExitcode'` for extracting exit code as `Maybe NotZero`+* Add `embedExitcode` for embedding natural transformations+* Add `_ExitFailureCode`, `_ExitFailureCode'`, `_ExitFailureValue`, `_ExitFailureValue'` optics+* Add four-level classy optics hierarchy (`Get`/`Has`/`Review`/`As`) for all `Control.Process` types+* Add `_UseHandle` prism to `AsStdStream`+* Add `streams` and `streams1` traversals for `CreateProcess`+* Remove `mapExitcode` (subsumed by `ExitcodeBifunctor`)+* Rename `ExitcodeT` to `Exitcode`, `ExitcodeT1` to removed+* Add `NFData` and `NFData1` instances+* Add fusion RULES for `exitcodeMap` and `exitcodeFoldMap`+* Add comprehensive doctest coverage (291 tests)+* Add benchmarks+ 0.2.0.0  * some API updates

@@ -1,31 +1,38 @@--- documentation, see http://haskell.org/cabal/users-guide/-+cabal-version:          2.4 name:                   exitcode-version:                0.2.0.0+version:                0.3.0.0 synopsis:               Monad transformer for exit codes description:   Monad transformer for exit codes   .   <<https://logo.systemf.com.au/systemf-450x450.jpg>>-license:                BSD3+license:                BSD-3-Clause 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-2025 Tony Morris category:               Control build-type:             Simple-extra-source-files:     changelog.md-cabal-version:          >=1.10+extra-doc-files:        changelog.md+                      , README.md homepage:               https://gitlab.com/system-f/code/exitcode bug-reports:            https://gitlab.com/system-f/code/exitcode/issues-tested-with:             GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1, GHC == 9.4.8, GHC == 9.6.7+tested-with:            GHC == 9.6.7 +flag dev+  description:          Enable development warnings (-Werror, -O2 for benchmarks)+  manual:               True+  default:              False+ source-repository       head   type:                 git   location:             git@gitlab.com:system-f/code/exitcode.git  library   exposed-modules:      Control.Exitcode+                        Control.Exitcode.Exitcode+                        Control.Exitcode.Optics+                        Control.Process.Process                         Control.Process                         Control.Process.CmdSpec                         Control.Process.CreateProcess@@ -33,41 +40,48 @@                         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+                      , comonad >= 5 && < 6+                      , deepseq >= 1.4 && < 2                       , filepath >= 1.4 && < 2                       , lens >= 4.15 && < 6                       , mtl >= 2.2 && < 3                       , process >= 1.6.12.0 && < 2                       , semigroupoids >= 5.1 && < 7-                      , semigroups >= 0.16 && < 1-                      , transformers >= 0.5.0 && < 1+                      , transformers >= 0.5 && < 1+                      , natural >= 0.5.0.1 && < 1+   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-                     , bifunctors >= 5 && < 6-                     , checkers >= 0.4.6 && < 0.5-                     , 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-                     , tasty-quickcheck >= 0.8.4 && < 0.11-                     , transformers >= 0.5.0 && < 5.5-  type:                exitcode-stdio-1.0-  main-is:             Tests.hs-  hs-source-dirs:      test-  default-language:    Haskell2010-  ghc-options:         -Wall+  if flag(dev)+    ghc-options:        -Werror++test-suite doctest+  type:                 exitcode-stdio-1.0+  hs-source-dirs:       test+  main-is:              Main.hs+  build-depends:        base >= 4.8 && < 6+                      , process >= 1 && < 2+  build-tool-depends:   doctest:doctest >= 0.22 && < 1+  default-language:     Haskell2010+  ghc-options:          -Wall++benchmark bench+  type:                 exitcode-stdio-1.0+  hs-source-dirs:       benchmarks+  main-is:              Main.hs+  build-depends:        base >= 4.8 && < 6+                      , tasty-bench >= 0.3 && < 1+                      , exitcode+  default-language:     Haskell2010+  ghc-options:          -Wall++  if flag(dev)+    ghc-options:        -Werror -O2

@@ -1,816 +1,11 @@-{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RankNTypes #-}--module Control.Exitcode (--- * Types-  ExitcodeT-, Exitcode-, ExitcodeT0-, Exitcode0-, ExitcodeT1-, Exitcode1--- * Construction-, exitsuccess-, exitsuccess0-, exitfailure-, exitfailure0-, exitfailureNeg1-, exitcodeValue-, exitcodeValue0-, fromExitCode-, fromExitCode'-, liftExitcode-, liftExitcodeFailure-, liftExitcodeFailure0-, liftExitFailureNeg1-, hoistExitcode-, embedExitcode-, exitcode1--- * Extraction-, runExitcodeT-, maybeExitcodeT-, runExitcode-, maybeExitcode-, runExitcodeT1-, runExitcode1--- * Exceptions-, tryExitcode-, liftTryExitcode--- * Optics-, exitCode-, _ExitcodeInt-, _ExitcodeInt'-, _ExitFailure-, _ExitFailureError-, _ExitSuccess-, _Exitcode1-) where---import Control.Applicative-    ( Applicative((<*>), pure, liftA2) )-import Control.Category ( Category((.)) )-import Control.Exception ( try, Exception )-import Control.Lens-    ( preview,-      view,-      iso,-      _Left,-      prism,-      over,-      Field1(_1),-      Field2(_2),-      Iso,-      Lens,-      Prism,-      Traversal,-      Traversal' )-import Control.Monad ( join, Monad(return, (>>=)) )-import Control.Monad.Cont.Class ( MonadCont(..) )-import Control.Monad.Error.Class ( MonadError(..) )-import Control.Monad.Except ( ExceptT(..) )-import Control.Monad.IO.Class ( MonadIO(..) )-import Control.Monad.Reader ( MonadReader(ask, local) )-import Control.Monad.RWS.Class ( MonadRWS )-import Control.Monad.State.Lazy ( MonadState(get, put) )-import Control.Monad.Trans.Maybe ( MaybeT(MaybeT) )-import Control.Monad.Writer.Class ( MonadWriter(..) )-import Data.Bifoldable ( Bifoldable(bifoldMap) )-import Data.Bifunctor ( Bifunctor(bimap) )-import Data.Bitraversable ( Bitraversable(..) )-import Data.Bool ( bool )-import Data.Either ( Either(..), either )-import Data.Eq ( Eq((==)) )-import Data.Foldable ( Foldable(foldMap) )-import Data.Function ( ($), const )-import Data.Functor ( Functor(fmap), (<$>) )-import Data.Functor.Alt ( Alt((<!>)) )-import Data.Functor.Apply ( Apply((<.>)) )-import Data.Functor.Bind ( Bind((>>-)) )-import Data.Functor.Classes-    ( compare1,-      eq1,-      showsPrec1,-      showsUnaryWith,-      Eq1(..),-      Ord1(..),-      Show1(..) )-import Data.Functor.Extend ( Extend(..) )-import Data.Functor.Identity ( Identity(Identity, runIdentity) )-import Data.Int ( Int )-import Data.Maybe ( Maybe(Nothing, Just), fromMaybe )-import Data.Monoid ( Monoid(mempty) )-import Data.Ord ( Ord(compare) )-import Data.Semigroup ( Semigroup((<>)) )-import Data.Traversable ( Traversable(traverse) )-import Data.Tuple ( uncurry )-import GHC.Show ( Show(showsPrec) )-import System.Exit ( ExitCode(..) )-import System.IO ( IO )---- $setup--- >>> import Prelude--- >>> import Control.Lens---- | An exit code status where failing with a value `0` cannot be represented.------ Transformer for either a (non-zero exit code value (`Int`) with error :: `e`) or a (value :: `a`).-newtype ExitcodeT f e a =-  ExitcodeT (f (Either (e, Int) a))--type Exitcode e a =-  ExitcodeT Identity e a--type ExitcodeT0 f =-  ExitcodeT f () ()--type Exitcode0 =-  Exitcode () ()---- | Construct a succeeding exit code with the given value.------ >>> exitsuccess "abc" :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right "abc"))-exitsuccess ::-  Applicative f =>-  a-  -> ExitcodeT f e a-exitsuccess =-  ExitcodeT . pure . Right---- | Construct a succeeding exit code with unit.------ >>> exitsuccess0 :: ExitcodeT0 Identity--- ExitcodeT (Identity (Right ()))-exitsuccess0 ::-  Applicative f =>-  ExitcodeT f e ()-exitsuccess0 =-  exitsuccess ()---- | Construct a failing exit code with the given status.------ If the given status is `0` then the exit code will succeed with unit.------ >>> exitfailure 'x' 99 :: ExitcodeT Identity Char ()--- ExitcodeT (Identity (Left ('x',99)))-exitfailure ::-  Applicative f =>-  e-  -> Int-  -> ExitcodeT f e ()-exitfailure e n =-  exitcodeValue e n ()---- | Construct a failing exit code with the given status.------ If the given status is `0` then the exit code will succeed with unit.-exitfailure0 ::-  Applicative f =>-  Int-  -> ExitcodeT0 f-exitfailure0 =-  exitfailure ()---- | Construct a failing exit code with the given status.--- If zero (0) is passed meaning success, use negative one (-1).------ >>> exitfailureNeg1 "abc" 0 :: Exitcode String ()--- ExitcodeT (Identity (Left ("abc",-1)))------ >>> exitfailureNeg1 "abc" 12 :: Exitcode String ()--- ExitcodeT (Identity (Left ("abc",12)))-exitfailureNeg1 ::-  Applicative f =>-  e-  -> Int-  -> ExitcodeT f e a-exitfailureNeg1 e n =-  liftExitFailureNeg1 (pure (e, n))---- | Construct an exit code with the given status.--- Associate a value of type `e` with a failing exit code and a value of the type `a` with a success exit code.------ If the given status is `0` then the exit code will succeed with unit.------ >>> exitcodeValue 'x' 99 "abc" :: ExitcodeT Identity Char String--- ExitcodeT (Identity (Left ('x',99)))--- >>> exitcodeValue 'x' 0 "abc" :: ExitcodeT Identity Char String--- ExitcodeT (Identity (Right "abc"))-exitcodeValue ::-  Applicative f =>-  e-  -> Int-  -> a-  -> ExitcodeT f e a-exitcodeValue e n =-  liftExitcodeFailure (pure (e, n))---- | Construct an exit code with the given status.------ If the given status is `0` then the exit code will succeed with unit.------ >>> exitcodeValue0 99 :: ExitcodeT0 Identity--- ExitcodeT (Identity (Left ((),99)))--- >>> exitcodeValue0 0 :: ExitcodeT0 Identity--- ExitcodeT (Identity (Right ()))-exitcodeValue0 ::-  Applicative f =>-  Int-  -> ExitcodeT0 f-exitcodeValue0 n =-  exitcodeValue () n ()---- | From base exitcode.------ >>> fromExitCode (Identity ExitSuccess)--- ExitcodeT (Identity (Right ()))--- >>> fromExitCode (Identity (ExitFailure 99))--- ExitcodeT (Identity (Left ((),99)))-fromExitCode ::-  Functor f =>-  f ExitCode-  -> ExitcodeT0 f-fromExitCode x =-  let ExitcodeT (MaybeT r) = view exitCode x-  in  ExitcodeT (fromMaybe (Right ()) <$> r)---- | From base exitcode.------ >>> fromExitCode' ExitSuccess--- ExitcodeT (Identity (Right ()))--- >>> fromExitCode' (ExitFailure 99)--- ExitcodeT (Identity (Left ((),99)))--- >>> fromExitCode' (ExitFailure 0)--- ExitcodeT (Identity (Right ()))-fromExitCode' ::-  ExitCode-  -> Exitcode0-fromExitCode' =-  fromExitCode . Identity---- | Isomorphism from base exitcode to underlying `Maybe (Either Int ())` where `Int` is non-zero.------ >>> view exitCode (Identity (ExitFailure 99))--- ExitcodeT (MaybeT (Identity (Just (Left ((),99)))))--- >>> view exitCode (Identity ExitSuccess)--- ExitcodeT (MaybeT (Identity (Just (Right ()))))--- >>> review exitCode (exitfailure0 99) :: Identity ExitCode--- Identity (ExitFailure 99)--- >>> review exitCode exitsuccess0 :: Identity ExitCode--- Identity ExitSuccess-exitCode ::-  (Functor f, Functor g) =>-  Iso-    (f ExitCode)-    (g ExitCode)-    (ExitcodeT0 (MaybeT f))-    (ExitcodeT0 (MaybeT g))-exitCode =-  iso-    (\x -> ExitcodeT (MaybeT ((\case-                                ExitSuccess ->-                                  Just (Right ())-                                ExitFailure 0 ->-                                  Nothing-                                ExitFailure n ->-                                  Just (Left ((), n))) <$> x)))-    (\(ExitcodeT (MaybeT x)) -> (\case-                                  Just (Right ()) ->-                                    ExitSuccess-                                  Nothing ->-                                    ExitFailure 0-                                  Just (Left ((), n)) ->-                                    ExitFailure n) <$> x)---- | Extract either the non-zero value or the success value.------ >>> runExitcodeT exitsuccess0 :: Identity (Either ((), Int) ())--- Identity (Right ())--- >>> runExitcodeT (exitfailure0 99) :: Identity (Either ((), Int) ())--- Identity (Left ((),99))-runExitcodeT ::-  ExitcodeT f e a-  -> f (Either (e, Int) a)-runExitcodeT (ExitcodeT x) =-  x---- | Extract either the non-zero value or `Nothing`.------ >>> maybeExitcodeT exitsuccess0 :: Identity (Maybe Int)--- Identity Nothing--- >>> maybeExitcodeT (exitfailure0 99) :: Identity (Maybe Int)--- Identity (Just 99)-maybeExitcodeT ::-  Functor f =>-  ExitcodeT f e a-  -> f (Maybe Int)-maybeExitcodeT x =-  preview (_Left . _2) <$> runExitcodeT x---- | Extract either the non-zero value or the success value.------ >>> runExitcode exitsuccess0 :: Either ((), Int) ()--- Right ()--- >>> runExitcode (exitfailure0 99) :: Either ((), Int) ()--- Left ((),99)-runExitcode ::-  Exitcode e a-  -> Either (e, Int) a-runExitcode =-  runIdentity . runExitcodeT---- | Extract either the non-zero value or `Nothing`.------ >>> maybeExitcode exitsuccess0 :: Maybe Int--- Nothing--- >>> maybeExitcode (exitfailure0 99) :: Maybe Int--- Just 99-maybeExitcode ::-  Exitcode0-  -> Maybe Int-maybeExitcode =-  runIdentity . maybeExitcodeT---- | Isomorphism to integer.------ >>> view _ExitcodeInt exitsuccess0 :: [Int]--- [0]--- >>> view _ExitcodeInt (exitfailure0 99) :: [Int]--- [99]--- >>> review _ExitcodeInt [0]--- ExitcodeT [Right ()]--- >>> review _ExitcodeInt [99]--- ExitcodeT [Left ((),99)]-_ExitcodeInt ::-  (Functor f, Functor f') =>-  Iso-    (ExitcodeT0 f)-    (ExitcodeT0 f')-    (f Int)-    (f' Int)-_ExitcodeInt =-  iso-    (\(ExitcodeT x) -> fmap (either (view _2) (\() -> 0)) x)-    (\x -> liftExitcodeFailure (((),) <$> x) ())---- | Setter to integer.------ >>> preview _ExitcodeInt' (exitsuccess0 :: ExitcodeT0 [])--- Just 0--- >>> preview _ExitcodeInt' (exitfailure0 99 :: ExitcodeT0 [])--- Just 99--- >>> preview _ExitcodeInt' (exitfailure0 0 :: ExitcodeT0 [])--- 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' ::-  Traversable f =>-  Traversal'-    (ExitcodeT0 f)-    Int-_ExitcodeInt' =-  _ExitcodeInt . traverse---- | A traversal to exit failure.------ >>> preview _ExitFailure (exitfailure0 99 :: ExitcodeT0 Identity)--- Just ((),99)--- >>> preview _ExitFailure (exitsuccess0 :: ExitcodeT0 Identity)--- Nothing--- >>> over _ExitFailure (\(e, n) -> (e + 1, n + 1)) (exitsuccess0 :: ExitcodeT Identity Int ())--- ExitcodeT (Identity (Right ()))--- >>> over _ExitFailure (\(e, n) -> (reverse e, n + 1)) (exitfailure "abc" 1 :: ExitcodeT Identity String ())--- ExitcodeT (Identity (Left ("cba",2)))--- >>> over _ExitFailure (\(e, n) -> (reverse e, n - 1)) (exitfailure "abc" 1 :: ExitcodeT Identity String ())--- ExitcodeT (Identity (Right ()))-_ExitFailure ::-  Traversable f =>-  Traversal-    (ExitcodeT f e ())-    (ExitcodeT f e' ())-    (e, Int)-    (e', Int)-_ExitFailure f (ExitcodeT x) =-  ExitcodeT <$> traverse (either (\z -> runExitcodeT (liftExitcodeFailure (f z) ())) (pure . pure)) x---- | A traversal over the associated failing value.------ >>> over _ExitFailureError reverse exitsuccess0 :: ExitcodeT Identity [Int] ()--- ExitcodeT (Identity (Right ()))--- >>> over _ExitFailureError reverse (exitfailure "abc" 99) :: ExitcodeT Identity String ()--- ExitcodeT (Identity (Left ("cba",99)))--- >>> over _ExitFailureError reverse (exitfailure "abc" 0) :: ExitcodeT Identity String ()--- ExitcodeT (Identity (Right ()))--- >>> preview _ExitFailureError (exitfailure0 99 :: ExitcodeT0 Identity)--- Just ()--- >>> preview _ExitFailureError (exitsuccess0 :: ExitcodeT0 Identity)--- Nothing-_ExitFailureError ::-  Traversable f =>-  Traversal-    (ExitcodeT f e a)-    (ExitcodeT f e' a)-    e-    e'-_ExitFailureError f (ExitcodeT x) =-  ExitcodeT <$> traverse (either (\(e, n) -> (\e' -> Left (e', n)) <$> f e) (pure . Right)) x---- | A prism to exit success.------ >>> over _ExitSuccess (\x -> x) (exitfailure0 99)--- ExitcodeT (Identity (Left ((),99)))--- >>> over _ExitSuccess (\x -> x) (exitfailure0 0)--- ExitcodeT (Identity (Right ()))--- >>> over _ExitSuccess (\x -> x) (exitfailure0 0)--- ExitcodeT (Identity (Right ()))--- >>> preview _ExitSuccess (exitfailure0 99)--- Nothing--- >>> preview _ExitSuccess exitsuccess0--- Just ()--- >>> review _ExitSuccess "abc" :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right "abc"))-_ExitSuccess ::-  Prism-    (Exitcode e a)-    (Exitcode e a')-    a-    a'-_ExitSuccess =-  prism-    exitsuccess-    (\(ExitcodeT (Identity x)) ->-      over _Left (ExitcodeT . Identity . Left) x-    )--instance Functor f => Functor (ExitcodeT f e) where-  fmap f (ExitcodeT x) =-    ExitcodeT (fmap (fmap f) x)--instance Monad f => Apply (ExitcodeT f e) where-  ExitcodeT f <.> ExitcodeT a =-    ExitcodeT (f >>= either (pure . Left) (\f' -> fmap (fmap f') a))--instance Monad f => Applicative (ExitcodeT f e) where-  pure =-    ExitcodeT . pure . pure-  ExitcodeT f <*> ExitcodeT a =-    ExitcodeT (f >>= either (pure . Left) (\f' -> fmap (fmap f') a))---- |------ >>> exitsuccess "abc" >>- \s -> exitsuccess (reverse s) :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right "cba"))--- >>> exitsuccess "abc" >>- \_ -> exitfailure0 99 :: ExitcodeT0 Identity--- ExitcodeT (Identity (Left ((),99)))--- >>> exitfailure 'x' 99 >>- \_ -> exitsuccess "abc" :: ExitcodeT Identity Char String--- ExitcodeT (Identity (Left ('x',99)))--- >>> exitfailure 'x' 99 >>- \_ -> exitfailure 'y' 88 :: ExitcodeT Identity Char ()--- ExitcodeT (Identity (Left ('x',99)))--- >>> let loop = loop in exitfailure0 99 >>- loop :: ExitcodeT0 Identity--- ExitcodeT (Identity (Left ((),99)))-instance Monad f => Bind (ExitcodeT f e) where-  (>>-) =-    (>>=)--instance Monad f => Monad (ExitcodeT f e) where-  return =-    pure-  ExitcodeT x >>= f =-    ExitcodeT-      (x >>= either (pure . Left) (runExitcodeT . f))---- |------ >>> exitsuccess "abc" <!> exitsuccess "def" :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right "abc"))--- >>> exitsuccess "abc" <!> exitcodeValue () 99 "def" :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right "abc"))--- >>> exitcodeValue 'x' 99 "abc" <!> exitsuccess "def" :: ExitcodeT Identity Char String--- ExitcodeT (Identity (Right "def"))--- >>> exitcodeValue 'x' 99 "abc" <!> exitcodeValue 'y' 88 "def" :: ExitcodeT Identity Char String--- ExitcodeT (Identity (Left ('y',88)))-instance Monad f => Alt (ExitcodeT f e) where-  ExitcodeT a <!> ExitcodeT b =-    ExitcodeT (a >>= either (const b) (pure a))---- |------ >>> exitsuccess "abc" <> exitsuccess "def" :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right "abcdef"))--- >>> exitsuccess "abc" <> exitcodeValue () 99 "def" :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right "abc"))--- >>> exitcodeValue 'x' 99 "abc" <> exitsuccess "def" :: ExitcodeT Identity Char String--- ExitcodeT (Identity (Right "def"))--- >>> exitcodeValue 'x' 99 "abc" <> exitcodeValue 'y' 88 "def" :: ExitcodeT Identity Char String--- ExitcodeT (Identity (Left ('y',88)))-instance (Semigroup a, Applicative f) => Semigroup (ExitcodeT f e a) where-  ExitcodeT a <> ExitcodeT b =-    let jn (Left _) x  = x-        jn x (Left _) = x-        jn (Right a1) (Right a2) = Right (a1 <> a2)-    in  ExitcodeT (liftA2 jn a b)---- |------ >>> mempty :: ExitcodeT Identity () String--- ExitcodeT (Identity (Right ""))-instance (Monoid a, Applicative f) => Monoid (ExitcodeT f e a) where-  mempty =-    ExitcodeT (pure (Right mempty))---- |------ >>> duplicated (exitfailure0 0) :: ExitcodeT Identity () (ExitcodeT0 Identity)--- ExitcodeT (Identity (Right (ExitcodeT (Identity (Right ())))))--- >>> duplicated (exitfailure0 99) :: ExitcodeT Identity () (ExitcodeT0 Identity)--- ExitcodeT (Identity (Right (ExitcodeT (Identity (Left ((),99))))))--- >>> duplicated (exitsuccess "abc") :: ExitcodeT Identity () (ExitcodeT Identity () String)--- ExitcodeT (Identity (Right (ExitcodeT (Identity (Right "abc")))))-instance Extend f => Extend (ExitcodeT f e) where-  duplicated (ExitcodeT x) =-    ExitcodeT (extended (Right . ExitcodeT) x)--instance (Eq1 f, Eq e, Eq a) => Eq (ExitcodeT f e a) where-  ExitcodeT a == ExitcodeT b =-    a `eq1` b--instance (Eq1 f, Eq e) => Eq1 (ExitcodeT f e) where-  liftEq f (ExitcodeT a) (ExitcodeT b) =-    liftEq (liftEq f) a b--instance (Ord1 f, Ord e, Ord a) => Ord (ExitcodeT f e a) where-  ExitcodeT a `compare` ExitcodeT b =-    a `compare1` b--instance (Ord1 f, Ord e) => Ord1 (ExitcodeT f e) where-  liftCompare f (ExitcodeT a) (ExitcodeT b) =-    liftCompare (liftCompare f) a b--instance (Show1 f, Show e, Show a) => Show (ExitcodeT f e a) where-  showsPrec d (ExitcodeT m) =-    showsUnaryWith showsPrec1 "ExitcodeT" d m--instance (Show1 f, Show e) => Show1 (ExitcodeT f e) where-  liftShowsPrec sp sl d (ExitcodeT fa) =-    let showsPrecF = liftA2 liftShowsPrec (uncurry liftShowsPrec) (uncurry liftShowList) (sp, sl)-    in showsUnaryWith showsPrecF "ExitcodeT" d fa--instance Foldable f => Foldable (ExitcodeT f e) where-  foldMap f (ExitcodeT x) =-    foldMap (foldMap f) x---- |------ >>> traverse (\x -> x) [exitfailure 'x' 99] :: ExitcodeT Identity Char [()]--- ExitcodeT (Identity (Left ('x',99)))--- >>> traverse (\x -> x) [exitfailure 'x' 99, exitsuccess0] :: ExitcodeT Identity Char [()]--- ExitcodeT (Identity (Left ('x',99)))--- >>> traverse (\x -> x) [exitfailure 'x' 99, exitsuccess0, exitfailure 'y' 88] :: ExitcodeT Identity Char [()]--- ExitcodeT (Identity (Left ('x',99)))--- >>> traverse (\x -> x) [exitsuccess0, exitfailure 'x' 88] :: ExitcodeT Identity Char [()]--- ExitcodeT (Identity (Left ('x',88)))--- >>> traverse (\x -> x) [exitsuccess0] :: ExitcodeT Identity () [()]--- ExitcodeT (Identity (Right [()]))-instance Traversable f => Traversable (ExitcodeT f e) where-  traverse f (ExitcodeT x) =-    ExitcodeT <$> traverse (traverse f) x--instance MonadIO f => MonadIO (ExitcodeT f e) where-  liftIO io =-    ExitcodeT (Right <$> liftIO io)--liftExitcode ::-  Functor f =>-  f a-  -> ExitcodeT f e a-liftExitcode x =-  ExitcodeT (Right <$> x)--liftExitcodeFailure ::-  Functor f =>-  f (e, Int)-  -> a-  -> ExitcodeT f e a-liftExitcodeFailure x a =-  ExitcodeT ((\(e, n) -> bool (Left (e, n)) (Right a) (n == 0)) <$> x)--liftExitcodeFailure0 ::-  Functor f =>-  f Int-  -> ExitcodeT0 f-liftExitcodeFailure0 x =-  liftExitcodeFailure (((),) <$> x) ()---- |------ If the given exitcode is success (0), return a failure and make the exitcode negative one (-1).-liftExitFailureNeg1 ::-  Functor f =>-  f (e, Int)-  -> ExitcodeT f e a-liftExitFailureNeg1 x =-  ExitcodeT ((\(e, n) -> Left (e, bool n (-1) (n == 0))) <$> 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-  local f (ExitcodeT m) =-    ExitcodeT (local f m)---- |------ >>> writer ('x', "abc") :: ExitcodeT ((,) String) () Char--- ExitcodeT ("abc",Right 'x')--- >>> listen (exitfailure 'x' 99 :: ExitcodeT ((,) String) Char ())--- ExitcodeT ("",Left ('x',99))--- >>> listen (exitsuccess 99 :: ExitcodeT ((,) String) () Int)--- ExitcodeT ("",Right (99,""))--- >>> tell "abc" :: ExitcodeT0 ((,) String)--- ExitcodeT ("abc",Right ())--- >>> pass (exitsuccess ('x', reverse)) :: ExitcodeT ((,) String) () Char--- ExitcodeT ("",Right 'x')--- >>> pass (('x', reverse) <$ (exitfailure 'x' 99 :: ExitcodeT ((,) String) Char ()))--- ExitcodeT ("",Left ('x',99))-instance MonadWriter w f => MonadWriter w (ExitcodeT f e) where-  writer t =-    ExitcodeT . fmap pure $ writer t-  listen (ExitcodeT m) =-    ExitcodeT ((\(e, w) -> (,w) <$> e) <$> listen m)-  tell =-    ExitcodeT . fmap Right . tell-  pass e =-    do  ((a, f), w) <- listen e-        tell (f w)-        pure a--instance MonadState s f => MonadState s (ExitcodeT f e) where-  get =-    ExitcodeT (fmap Right get)-  put =-    ExitcodeT . fmap Right . put---- |------ >>> throwError 99 :: ExitcodeT (Either Int) () String--- ExitcodeT (Left 99)--- >>> catchError exitsuccess0 (exitfailure 'x') :: ExitcodeT (Either Int) Char ()--- ExitcodeT (Right (Right ()))--- >>> catchError (exitfailure 'x' 99) (\_ -> exitsuccess0) :: ExitcodeT (Either Int) Char ()--- ExitcodeT (Right (Left ('x',99)))--- >>> catchError (exitfailure 'x' 99) (exitfailure 'y') :: ExitcodeT (Either Int) Char ()--- ExitcodeT (Right (Left ('x',99)))--- >>> catchError exitsuccess0 (\_ -> exitsuccess0) :: ExitcodeT0 (Either Int)--- ExitcodeT (Right (Right ()))-instance MonadError e f => MonadError e (ExitcodeT f e') where-  throwError =-    ExitcodeT . fmap Right . throwError-  catchError (ExitcodeT f) h =-     ExitcodeT (catchError f (runExitcodeT . h))--instance MonadRWS r w s f => MonadRWS r w s (ExitcodeT f e)---- Given the embedded `Either` we can only handle computations that use `Either`.--- This code taken from the ExceptT instance:---   https://hackage.haskell.org/package/transformers-0.5.4.0/docs/src/Control.Monad.Trans.Except.html#line-237-instance MonadCont f => MonadCont (ExitcodeT f e) where-  callCC =-    let liftCallCC callCC' f =-          ExitcodeT . callCC' $-            \c -> runExitcodeT (f (ExitcodeT . c . Right))-    in  liftCallCC callCC--instance Functor f => Bifunctor (ExitcodeT f) where-  bimap f g (ExitcodeT x) =-    ExitcodeT (fmap (bimap (over _1 f) g) x)--instance Foldable f => Bifoldable (ExitcodeT f) where-  bifoldMap f g (ExitcodeT x) =-    foldMap (bifoldMap (f . view _1) g) x--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 (exitfailure0 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 (exitfailure0 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---- | Try the IO action producing the exitcode, possibly throwing an exception.-tryExitcode ::-  Exception e' =>-  ExitcodeT IO e a-  -> ExitcodeT (ExceptT e' IO) e a-tryExitcode (ExitcodeT x) =-  ExitcodeT (ExceptT (try x))+{-# OPTIONS_GHC -Wall #-} --- | Try the IO action producing the exitcode, possibly throwing an exception.-liftTryExitcode ::-  Exception e' =>-  IO a-  -> ExitcodeT (ExceptT e' IO) e a-liftTryExitcode x =-  ExitcodeT (ExceptT (fmap (fmap Right) (try x)))+module Control.Exitcode+  ( module Control.Exitcode.Exitcode,+    module Control.Exitcode.Optics,+  )+where --- | 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+import Control.Exitcode.Exitcode+import Control.Exitcode.Optics

@@ -0,0 +1,1156 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+-- Required for instances like MonadReader r (Exitcode e f) where the+-- constraint MonadReader r f does not structurally decrease.+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++module Control.Exitcode.Exitcode+  ( -- * Types+    Exitcode (..),+    Exitcode',+    ExitcodeBifunctor (..),+    ExitcodeBifunctor',++    -- * Construction+    mkExitcode,+    mkExitcode',+    mkExitSuccess,+    mkExitSuccess',+    mkExitFailure,+    mkExitFailure',+    mkExitFailure1,+    mkExitFailure1',+    mkExitFailure_1,+    mkExitFailure_1',+    fromExitCode,+    fromExitCode',+    toExitCode,+    toExitCode',+    hoistExitcode,+    embedExitcode,+    bimapExitcode,++    -- * Extraction+    runExitcode,+    maybeExitcode,+    maybeExitcode',++    -- * Exceptions+    tryExitcode,+    liftTryExitcode,++    -- * Optics+    exitCode,+    _Exitcode1,+    _Exitcode1',+    _ExitFailure,+    _ExitFailure',+    _ExitFailureCode,+    _ExitFailureCode',+    _ExitFailureValue,+    _ExitFailureValue',+    _ExitSuccess,+    _ExitSuccess',+  )+where++import Control.Applicative (Applicative (pure, (<*>)))+import Control.DeepSeq (NFData (rnf), NFData1 (liftRnf))+import Control.Exception (Exception, try)+import Control.Lens (FoldableWithIndex (ifoldMap), FunctorWithIndex (imap), Iso, Lens, Prism, Prism', Traversal, Traversal', TraversableWithIndex (itraverse), iso, preview, prism, prism', review, _Wrapped)+import Control.Monad (Monad ((>>=)), join)+import Control.Monad.Cont.Class (MonadCont (..))+import Control.Monad.Error.Class (MonadError (..))+import Control.Monad.Except (ExceptT (..))+import Control.Monad.Fix (MonadFix (mfix))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.RWS.Class (MonadRWS)+import Control.Monad.Reader (MonadReader (ask, local), asks)+import Control.Monad.State.Lazy (MonadState (get, put))+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))+import Control.Monad.Writer.Class (MonadWriter (..))+import Data.Bifoldable (Bifoldable (bifoldMap))+import Data.Bifunctor (Bifunctor (bimap))+import Data.Bitraversable (Bitraversable (bitraverse))+import Data.Either (Either (..), either)+import Data.Eq (Eq ((==)))+import Data.Foldable (Foldable (foldMap, toList))+import Data.Function (const, id, ($), (.))+import Data.Functor (Functor (fmap), (<$>))+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Bind (Bind ((>>-)))+import Data.Functor.Bind.Trans (BindTrans (..))+import Data.Functor.Classes+  ( Eq1 (liftEq),+    Ord1 (liftCompare),+    Show1 (liftShowList, liftShowsPrec),+  )+import Data.Functor.Extend (Extend (duplicated, extended))+import Data.Functor.Identity (Identity (Identity, runIdentity))+import Data.Int (Int)+import Data.Maybe (Maybe (Just, Nothing))+import Data.Monoid (Monoid (mempty))+import Data.Ord (Ord (compare), (>))+import Data.Semigroup (Semigroup ((<>)))+import Data.Traversable (Traversable (traverse), mapAccumL)+import Data.Tuple (fst, snd)+import GHC.Generics (Generic)+import GHC.Show (Show (showsPrec), showParen, showString)+import Natural (NotZero, _NotZero, notZeroOr)+import Prelude (seq)+import System.Exit (ExitCode (ExitFailure, ExitSuccess))+import System.IO (IO)++-- $setup+-- >>> import Prelude+-- >>> import Control.Lens+-- >>> import Natural+-- >>> let nz1 = positiveNotZero one'+-- >>> let nz2 = positiveNotZero (successor1' one')++-- | An exit code status where failing with a value @0@ cannot be represented.+--+-- Wraps @f (Either (e, NotZero) a)@ where the @NotZero@ in the @Left@ branch+-- is a proven non-zero integer.+newtype Exitcode e f a+  = Exitcode (f (Either (e, NotZero) a))+  deriving stock (Generic)++-- | @Exitcode@ specialised to @Identity@.+type Exitcode' e a =+  Exitcode e Identity a++-- * Extraction++-- | Extract the underlying @f (Either (e, NotZero) a)@.+--+-- >>> runExitcode (mkExitSuccess' "abc")+-- Identity (Right "abc")+-- >>> runExitcode (mkExitFailure1' 'x')+-- Identity (Left ('x',NotZero True (Positive 1)))+{-# INLINE runExitcode #-}+runExitcode ::+  Exitcode e f a ->+  f (Either (e, NotZero) a)+runExitcode (Exitcode x) =+  x++-- | Extract the exit code as @Maybe NotZero@: @Nothing@ for success, @Just n@ for failure.+--+-- >>> maybeExitcode (mkExitSuccess (Identity ())) :: Identity (Maybe NotZero)+-- Identity Nothing+-- >>> maybeExitcode (mkExitFailure1 (Identity ())) :: Identity (Maybe NotZero)+-- Identity (Just (NotZero True (Positive 1)))+{-# INLINE maybeExitcode #-}+maybeExitcode ::+  (Functor f) =>+  Exitcode e f a ->+  f (Maybe NotZero)+maybeExitcode (Exitcode x) =+  fmap (either (Just . snd) (const Nothing)) x++-- | @maybeExitcode@ specialised to @Identity@.+--+-- >>> maybeExitcode' (mkExitSuccess' ())+-- Nothing+-- >>> maybeExitcode' (mkExitFailure1' ())+-- Just (NotZero True (Positive 1))+{-# INLINE maybeExitcode' #-}+maybeExitcode' ::+  Exitcode' e a ->+  Maybe NotZero+maybeExitcode' (Exitcode x) =+  either (Just . snd) (const Nothing) (runIdentity x)++-- * Optics++-- | Iso between @f ExitCode@ and @Exitcode () (MaybeT f) ()@.+--+-- @ExitFailure 0@ maps to @MaybeT Nothing@ (neither success nor failure).+-- @ExitSuccess@ maps to a success exitcode.+-- @ExitFailure n@ (where @n /= 0@) maps to a failure exitcode.+--+-- >>> import Control.Monad.Trans.Maybe+-- >>> view exitCode (Identity ExitSuccess)+-- Exitcode (MaybeT (Identity (Just (Right ()))))+-- >>> view exitCode (Identity (ExitFailure 99))+-- Exitcode (MaybeT (Identity (Just (Left ((),NotZero True (Positive 99))))))+-- >>> view exitCode (Identity (ExitFailure 0))+-- Exitcode (MaybeT (Identity Nothing))+-- >>> review exitCode (mkExitSuccess (MaybeT (Identity (Just ()))))+-- Identity ExitSuccess+-- >>> review exitCode (mkExitFailure1 (MaybeT (Identity (Just ()))))+-- Identity (ExitFailure 1)+{-# INLINE exitCode #-}+exitCode ::+  (Functor f, Functor g) =>+  Iso+    (f ExitCode)+    (g ExitCode)+    (Exitcode () (MaybeT f) ())+    (Exitcode () (MaybeT g) ())+exitCode =+  iso+    ( Exitcode+        . MaybeT+        . fmap+          ( \case+              ExitSuccess -> Just (Right ())+              ExitFailure n -> fmap (Left . ((),)) (preview _NotZero n)+          )+    )+    ( \(Exitcode (MaybeT x)) ->+        fmap+          ( \case+              Just (Right ()) -> ExitSuccess+              Nothing -> ExitFailure 0+              Just (Left ((), nz)) -> ExitFailure (review _NotZero nz)+          )+          x+    )++-- | Lens into the value of an @Exitcode' a a@, regardless of success or failure.+-- The exit code is preserved.+--+-- >>> over _Exitcode1 reverse (mkExitcode' "abc" nz1 :: Exitcode' String String)+-- Exitcode (Identity (Left ("cba",NotZero True (Positive 1))))+-- >>> over _Exitcode1 reverse (mkExitSuccess' "def")+-- Exitcode (Identity (Right "fed"))+{-# INLINE _Exitcode1 #-}+_Exitcode1 ::+  Lens+    (Exitcode' a a)+    (Exitcode' a' a')+    a+    a'+_Exitcode1 g (Exitcode (Identity x)) =+  fmap+    (\a' -> Exitcode (Identity (either (\(_, n) -> Left (a', n)) (const (Right a')) x)))+    (g (either fst id x))++-- | @_Exitcode1@ generalised to @Traversable f@.+--+-- >>> over _Exitcode1' (fmap reverse) (mkExitcode (Identity "abc") (Identity nz1) :: Exitcode String Identity String)+-- Exitcode (Identity (Left ("cba",NotZero True (Positive 1))))+-- >>> over _Exitcode1' (fmap reverse) (mkExitSuccess (Identity "def"))+-- Exitcode (Identity (Right "fed"))+{-# INLINE _Exitcode1' #-}+_Exitcode1' ::+  (Traversable f) =>+  Traversal' (Exitcode a f a) (f a)+_Exitcode1' g (Exitcode x) =+  fmap+    ( \fa' ->+        let (_, result) =+              mapAccumL+                ( \as' struct -> case as' of+                    (a' : rest) -> (rest, either (\(_, n) -> Left (a', n)) (const (Right a')) struct)+                    [] -> ([], struct)+                )+                (toList fa')+                x+         in Exitcode result+    )+    (g (fmap (either fst id) x))++-- | Prism into all-failure exitcodes.+--+-- >>> preview _ExitFailure (mkExitFailure1' 'x' :: Exitcode' Char ())+-- Just (Identity ('x',NotZero True (Positive 1)))+-- >>> preview _ExitFailure (mkExitSuccess' () :: Exitcode' Char ())+-- Nothing+{-# INLINE _ExitFailure #-}+_ExitFailure :: (Traversable f) => Prism' (Exitcode e f a) (f (e, NotZero))+_ExitFailure =+  prism'+    (Exitcode . fmap Left)+    (\(Exitcode x) -> traverse (either Just (const Nothing)) x)++-- | Type-changing prism into the failure case, specialised to @Identity@.+--+-- >>> preview _ExitFailure' (mkExitFailure1' 'x' :: Exitcode' Char ())+-- Just ('x',NotZero True (Positive 1))+-- >>> preview _ExitFailure' (mkExitSuccess' () :: Exitcode' Char ())+-- Nothing+-- >>> review _ExitFailure' ('y', nz2) :: Exitcode' Char ()+-- Exitcode (Identity (Left ('y',NotZero True (Positive 2))))+{-# INLINE _ExitFailure' #-}+_ExitFailure' :: Prism (Exitcode' e a) (Exitcode' e' a) (e, NotZero) (e', NotZero)+_ExitFailure' =+  prism+    (\(e', nz) -> Exitcode (Identity (Left (e', nz))))+    (\(Exitcode (Identity x)) -> case x of+      Left (e, nz) -> Right (e, nz)+      Right a -> Left (Exitcode (Identity (Right a))))++-- | Traversal into the @NotZero@ exit code values when all elements are failures.+--+-- >>> over _ExitFailureCode' (const nz1) (mkExitFailure' nz2 'x')+-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))+{-# INLINE _ExitFailureCode #-}+_ExitFailureCode :: (Traversable f) => Traversal' (Exitcode e f a) (f NotZero)+_ExitFailureCode g (Exitcode x) =+  case traverse (either Just (const Nothing)) x of+    Nothing -> pure (Exitcode x)+    Just pairs ->+      let rebuild newNZs =+            let (_, result) =+                  mapAccumL+                    ( \ns (e, nz) -> case ns of+                        n : rest -> (rest, (e, n))+                        [] -> ([], (e, nz))+                    )+                    (toList newNZs)+                    pairs+             in Exitcode (fmap Left result)+       in rebuild <$> g (fmap snd pairs)++-- | @_ExitFailureCode@ specialised to @Identity@.+{-# INLINE _ExitFailureCode' #-}+_ExitFailureCode' :: Traversal' (Exitcode' e a) NotZero+_ExitFailureCode' = _ExitFailureCode . _Wrapped++-- | Traversal into the error values when all elements are failures.+--+-- >>> over _ExitFailureValue' (const 'y') (mkExitFailure1' 'x')+-- Exitcode (Identity (Left ('y',NotZero True (Positive 1))))+-- >>> over _ExitFailureValue' (const 'y') (mkExitSuccess' () :: Exitcode' Char ())+-- Exitcode (Identity (Right ()))+{-# INLINE _ExitFailureValue #-}+_ExitFailureValue :: (Traversable f) => Traversal' (Exitcode e f a) (f e)+_ExitFailureValue g (Exitcode x) =+  case traverse (either Just (const Nothing)) x of+    Nothing -> pure (Exitcode x)+    Just pairs ->+      let rebuild newEs =+            let (_, result) =+                  mapAccumL+                    ( \es (e, nz) -> case es of+                        e' : rest -> (rest, (e', nz))+                        [] -> ([], (e, nz))+                    )+                    (toList newEs)+                    pairs+             in Exitcode (fmap Left result)+       in rebuild <$> g (fmap fst pairs)++-- | @_ExitFailureValue@ specialised to @Identity@.+{-# INLINE _ExitFailureValue' #-}+_ExitFailureValue' :: Traversal (Exitcode' e a) (Exitcode' e' a) e e'+_ExitFailureValue' g (Exitcode (Identity x)) =+  case x of+    Left (e, nz) -> fmap (\e' -> Exitcode (Identity (Left (e', nz)))) (g e)+    Right a -> pure (Exitcode (Identity (Right a)))++-- | Prism into all-success exitcodes.+--+-- >>> preview _ExitSuccess (mkExitSuccess' "abc" :: Exitcode' () String)+-- Just (Identity "abc")+-- >>> preview _ExitSuccess (mkExitFailure1' () :: Exitcode' () String)+-- Nothing+{-# INLINE _ExitSuccess #-}+_ExitSuccess :: (Traversable f) => Prism' (Exitcode e f a) (f a)+_ExitSuccess =+  prism'+    (Exitcode . fmap Right)+    (\(Exitcode x) -> traverse (either (const Nothing) Just) x)++-- | @_ExitSuccess@ specialised to @Identity@.+--+-- >>> preview _ExitSuccess' (mkExitSuccess' "abc" :: Exitcode' () String)+-- Just "abc"+-- >>> preview _ExitSuccess' (mkExitFailure1' () :: Exitcode' () String)+-- Nothing+{-# INLINE _ExitSuccess' #-}+_ExitSuccess' :: Prism (Exitcode' e a) (Exitcode' e a') a a'+_ExitSuccess' =+  prism+    (Exitcode . Identity . Right)+    ( \(Exitcode (Identity x)) -> case x of+        Right a -> Right a+        Left (e, i) -> Left (Exitcode (Identity (Left (e, i))))+    )++-- | Construct a failure exitcode with an error value and a non-zero exit code.+--+-- >>> mkExitcode (Identity 'x') (Identity nz1) :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))+{-# INLINE mkExitcode #-}+mkExitcode :: (Applicative f) => f e -> f NotZero -> Exitcode e f a+mkExitcode e nz = Exitcode ((\e' nz' -> Left (e', nz')) <$> e <*> nz)++-- | @mkExitcode@ specialised to @Identity@.+--+-- >>> mkExitcode' 'x' nz1 :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))+{-# INLINE mkExitcode' #-}+mkExitcode' :: e -> NotZero -> Exitcode' e a+mkExitcode' e nz = mkExitcode (Identity e) (Identity nz)++-- | Construct a success exitcode.+--+-- >>> mkExitSuccess (Identity "abc") :: Exitcode' () String+-- Exitcode (Identity (Right "abc"))+{-# INLINE mkExitSuccess #-}+mkExitSuccess :: (Functor f) => f a -> Exitcode e f a+mkExitSuccess = Exitcode . fmap Right++-- | @mkExitSuccess@ specialised to @Identity@.+--+-- >>> mkExitSuccess' "abc" :: Exitcode' () String+-- Exitcode (Identity (Right "abc"))+{-# INLINE mkExitSuccess' #-}+mkExitSuccess' :: a -> Exitcode' e a+mkExitSuccess' = mkExitSuccess . Identity++-- | Construct a failure exitcode with a proven non-zero exit code.+--+-- >>> mkExitFailure (Identity nz1) (Identity 'x') :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))+{-# INLINE mkExitFailure #-}+mkExitFailure :: (Applicative f) => f NotZero -> f e -> Exitcode e f a+mkExitFailure n e = Exitcode ((\n' e' -> Left (e', n')) <$> n <*> e)++-- | @mkExitFailure@ specialised to @Identity@.+--+-- >>> mkExitFailure' nz1 'x' :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))+{-# INLINE mkExitFailure' #-}+mkExitFailure' :: NotZero -> e -> Exitcode' e a+mkExitFailure' n e = mkExitFailure (Identity n) (Identity e)++-- | Construct a failure exitcode with exit code @1@.+--+-- >>> mkExitFailure1 (Identity 'x') :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))+{-# INLINE mkExitFailure1 #-}+mkExitFailure1 :: (Functor f) => f e -> Exitcode e f a+mkExitFailure1 = Exitcode . fmap (\e' -> Left (e', notZeroOr (1 :: Int)))++-- | @mkExitFailure1@ specialised to @Identity@.+--+-- >>> mkExitFailure1' 'x' :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero True (Positive 1))))+{-# INLINE mkExitFailure1' #-}+mkExitFailure1' :: e -> Exitcode' e a+mkExitFailure1' = mkExitFailure1 . Identity++-- | Construct a failure exitcode with exit code @-1@.+--+-- >>> mkExitFailure_1 (Identity 'x') :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero False (Positive 1))))+{-# INLINE mkExitFailure_1 #-}+mkExitFailure_1 :: (Functor f) => f e -> Exitcode e f a+mkExitFailure_1 = Exitcode . fmap (\e' -> Left (e', notZeroOr (-1 :: Int)))++-- | @mkExitFailure_1@ specialised to @Identity@.+--+-- >>> mkExitFailure_1' 'x' :: Exitcode' Char ()+-- Exitcode (Identity (Left ('x',NotZero False (Positive 1))))+{-# INLINE mkExitFailure_1' #-}+mkExitFailure_1' :: e -> Exitcode' e a+mkExitFailure_1' = mkExitFailure_1 . Identity++-- | Convert from a base @ExitCode@. @ExitFailure 0@ is treated as success.+--+-- >>> fromExitCode (Identity ExitSuccess)+-- Exitcode (Identity (Right ()))+-- >>> fromExitCode (Identity (ExitFailure 99))+-- Exitcode (Identity (Left ((),NotZero True (Positive 99))))+-- >>> fromExitCode (Identity (ExitFailure 0))+-- Exitcode (Identity (Right ()))+{-# INLINE fromExitCode #-}+fromExitCode ::+  (Functor f) =>+  f ExitCode ->+  Exitcode () f ()+fromExitCode =+  Exitcode+    . fmap+      ( \case+          ExitSuccess -> Right ()+          ExitFailure n -> case preview _NotZero n of+            Just nz -> Left ((), nz)+            Nothing -> Right ()+      )++-- | @fromExitCode@ specialised to @Identity@.+--+-- >>> fromExitCode' ExitSuccess+-- Exitcode (Identity (Right ()))+-- >>> fromExitCode' (ExitFailure 99)+-- Exitcode (Identity (Left ((),NotZero True (Positive 99))))+-- >>> fromExitCode' (ExitFailure 0)+-- Exitcode (Identity (Right ()))+{-# INLINE fromExitCode' #-}+fromExitCode' ::+  ExitCode ->+  Exitcode' () ()+fromExitCode' =+  fromExitCode . Identity++-- | Convert an exitcode back to @f ExitCode@.+--+-- >>> toExitCode (mkExitSuccess (Identity ()))+-- Identity ExitSuccess+-- >>> toExitCode (mkExitFailure1 (Identity ()))+-- Identity (ExitFailure 1)+{-# INLINE toExitCode #-}+toExitCode ::+  (Functor f) =>+  Exitcode () f () ->+  f ExitCode+toExitCode (Exitcode x) =+  fmap (either (\((), nz) -> ExitFailure (review _NotZero nz)) (const ExitSuccess)) x++-- | @toExitCode@ specialised to @Identity@.+--+-- >>> toExitCode' (mkExitSuccess' ())+-- ExitSuccess+-- >>> toExitCode' (mkExitFailure1' ())+-- ExitFailure 1+{-# INLINE toExitCode' #-}+toExitCode' ::+  Exitcode' () () ->+  ExitCode+toExitCode' =+  runIdentity . toExitCode++-- | Apply a natural transformation to the base functor.+--+-- >>> hoistExitcode (Just . runIdentity) (mkExitSuccess' "abc") :: Exitcode () Maybe String+-- Exitcode (Just (Right "abc"))+{-# INLINE hoistExitcode #-}+hoistExitcode ::+  (forall x. f x -> g x) ->+  Exitcode e f a ->+  Exitcode e g a+hoistExitcode nat (Exitcode x) =+  Exitcode (nat x)++-- | Embed a natural transformation that returns an @Exitcode@.+--+-- >>> embedExitcode (\(Identity a) -> mkExitSuccess (Just a)) (mkExitSuccess' "abc") :: Exitcode () Maybe String+-- Exitcode (Just (Right "abc"))+-- >>> embedExitcode (\(Identity a) -> mkExitSuccess (Just a)) (mkExitFailure1' ()) :: Exitcode () Maybe ()+-- Exitcode (Just (Left ((),NotZero True (Positive 1))))+{-# INLINE embedExitcode #-}+embedExitcode ::+  (Functor g) =>+  (forall x. f x -> Exitcode e g x) ->+  Exitcode e f a ->+  Exitcode e g a+embedExitcode nat (Exitcode x) =+  Exitcode (join <$> runExitcode (nat x))++-- | Map both the error and success values via @Bifunctor@ on @ExitcodeBifunctor@.+--+-- >>> bimapExitcode (+1) (+10) (mkExitFailure1' 5 :: Exitcode' Int Int)+-- Exitcode (Identity (Left (6,NotZero True (Positive 1))))+-- >>> bimapExitcode (+1) (+10) (mkExitSuccess' 5 :: Exitcode' Int Int)+-- Exitcode (Identity (Right 15))+{-# INLINE bimapExitcode #-}+bimapExitcode ::+  (Functor f) =>+  (e -> e') ->+  (a -> a') ->+  Exitcode e f a ->+  Exitcode e' f a'+bimapExitcode f g (Exitcode x) =+  Exitcode (fmap (either (\(e, n) -> Left (f e, n)) (Right . g)) x)++-- * Exceptions++-- | Try the IO action producing the exitcode, catching exceptions into @ExceptT@.+{-# INLINE tryExitcode #-}+tryExitcode ::+  (Exception e') =>+  Exitcode e IO a ->+  Exitcode e (ExceptT e' IO) a+tryExitcode (Exitcode x) =+  Exitcode (ExceptT (try x))++-- | Lift an IO action into @Exitcode (ExceptT e' IO)@, catching exceptions.+{-# INLINE liftTryExitcode #-}+liftTryExitcode ::+  (Exception e') =>+  IO a ->+  Exitcode e (ExceptT e' IO) a+liftTryExitcode x =+  Exitcode (ExceptT (fmap (fmap Right) (try x)))++-- * RULES++{-# INLINE [0] exitcodeMap #-}+exitcodeMap :: (Functor f) => (a -> b) -> Exitcode e f a -> Exitcode e f b+exitcodeMap f (Exitcode x) = Exitcode (fmap (fmap f) x)++{-# INLINE [0] exitcodeFoldMap #-}+exitcodeFoldMap :: (Foldable f, Monoid m) => (a -> m) -> Exitcode e f a -> m+exitcodeFoldMap f (Exitcode x) = foldMap (either (const mempty) f) x++{-# RULES+"exitcodeMap/exitcodeMap" [~0] forall f g xs.+  exitcodeMap f (exitcodeMap g xs) =+    exitcodeMap (f . g) xs+"exitcodeFoldMap/exitcodeMap" [~0] forall f g xs.+  exitcodeFoldMap f (exitcodeMap g xs) =+    exitcodeFoldMap (f . g) xs+  #-}++-- * Exitcode Instances++-- |+--+-- >>> fmap (+1) (mkExitSuccess' 3) :: Exitcode' () Int+-- Exitcode (Identity (Right 4))+-- >>> fmap (+1) (mkExitFailure1' ()) :: Exitcode' () Int+-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))+instance (Functor f) => Functor (Exitcode e f) where+  {-# INLINE fmap #-}+  fmap = exitcodeMap++-- |+--+-- >>> foldMap show (mkExitSuccess' 42) :: String+-- "42"+-- >>> foldMap show (mkExitFailure1' () :: Exitcode' () Int) :: String+-- ""+instance (Foldable f) => Foldable (Exitcode e f) where+  {-# INLINE foldMap #-}+  foldMap = exitcodeFoldMap++-- |+--+-- >>> traverse Just (mkExitSuccess' 42) :: Maybe (Exitcode' () Int)+-- Just (Exitcode (Identity (Right 42)))+-- >>> traverse (const Nothing) (mkExitSuccess' 42) :: Maybe (Exitcode' () Int)+-- Nothing+-- >>> traverse Just (mkExitFailure1' () :: Exitcode' () Int) :: Maybe (Exitcode' () Int)+-- Just (Exitcode (Identity (Left ((),NotZero True (Positive 1)))))+instance (Traversable f) => Traversable (Exitcode e f) where+  {-# INLINE traverse #-}+  traverse f (Exitcode x) =+    Exitcode <$> traverse (either (pure . Left) (fmap Right . f)) x++-- |+--+-- >>> imap (\_ a -> a + 1) (mkExitSuccess' 3) :: Exitcode' () Int+-- Exitcode (Identity (Right 4))+instance (FunctorWithIndex i f) => FunctorWithIndex i (Exitcode e f) where+  {-# INLINE imap #-}+  imap f (Exitcode x) = Exitcode (imap (\i -> fmap (f i)) x)++-- |+--+-- >>> ifoldMap (\_ a -> show a) (mkExitSuccess' 42) :: String+-- "42"+instance (FoldableWithIndex i f) => FoldableWithIndex i (Exitcode e f) where+  {-# INLINE ifoldMap #-}+  ifoldMap f (Exitcode x) = ifoldMap (\i -> either (const mempty) (f i)) x++-- |+--+-- >>> itraverse (\_ a -> Just (a + 1)) (mkExitSuccess' 42) :: Maybe (Exitcode' () Int)+-- Just (Exitcode (Identity (Right 43)))+instance (TraversableWithIndex i f) => TraversableWithIndex i (Exitcode e f) where+  {-# INLINE itraverse #-}+  itraverse f (Exitcode x) = Exitcode <$> itraverse (\i -> either (pure . Left) (fmap Right . f i)) x++-- |+--+-- >>> mkExitSuccess' (+1) <*> mkExitSuccess' 3 :: Exitcode' () Int+-- Exitcode (Identity (Right 4))+-- >>> mkExitFailure1' () <*> mkExitSuccess' 3 :: Exitcode' () Int+-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))+instance (Monad f) => Apply (Exitcode e f) where+  {-# INLINE (<.>) #-}+  Exitcode f <.> Exitcode a =+    Exitcode (f >>= either (pure . Left) (\f' -> fmap (fmap f') a))++-- |+--+-- >>> pure 42 :: Exitcode' () Int+-- Exitcode (Identity (Right 42))+-- >>> mkExitSuccess' (+1) <*> mkExitSuccess' 3 :: Exitcode' () Int+-- Exitcode (Identity (Right 4))+-- >>> mkExitFailure1' () <*> mkExitSuccess' 3 :: Exitcode' () Int+-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))+instance (Monad f) => Applicative (Exitcode e f) where+  {-# INLINE pure #-}+  pure = Exitcode . pure . Right+  {-# INLINE (<*>) #-}+  Exitcode f <*> Exitcode a =+    Exitcode (f >>= either (pure . Left) (\f' -> fmap (fmap f') a))++-- |+--+-- >>> mkExitSuccess' 3 >>- (\x -> mkExitSuccess' (x + 1)) :: Exitcode' () Int+-- Exitcode (Identity (Right 4))+instance (Monad f) => Bind (Exitcode e f) where+  {-# INLINE (>>-) #-}+  (>>-) = (>>=)++-- |+--+-- >>> mkExitSuccess' 3 >>= (\x -> mkExitSuccess' (x + 1)) :: Exitcode' () Int+-- Exitcode (Identity (Right 4))+-- >>> mkExitFailure1' () >>= (\x -> mkExitSuccess' (x + 1)) :: Exitcode' () Int+-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))+instance (Monad f) => Monad (Exitcode e f) where+  {-# INLINE (>>=) #-}+  Exitcode x >>= f =+    Exitcode (x >>= either (pure . Left) (runExitcode . f))++-- |+--+-- >>> import Control.Monad.Fix (mfix)+-- >>> runExitcode (mfix (const (mkExitSuccess' 42)) :: Exitcode' () Int)+-- Identity (Right 42)+-- >>> runExitcode (mfix (const (mkExitFailure1' ())) :: Exitcode' () Int)+-- Identity (Left ((),NotZero True (Positive 1)))+instance (MonadFix f) => MonadFix (Exitcode e f) where+  {-# INLINE mfix #-}+  mfix f = Exitcode (mfix (runExitcode . f . either (const (let a = a in a)) id))++-- |+--+-- >>> mkExitFailure1' () <!> mkExitSuccess' 42 :: Exitcode' () Int+-- Exitcode (Identity (Right 42))+-- >>> mkExitSuccess' 1 <!> mkExitSuccess' 2 :: Exitcode' () Int+-- Exitcode (Identity (Right 1))+instance (Monad f) => Alt (Exitcode e f) where+  {-# INLINE (<!>) #-}+  Exitcode a <!> Exitcode b =+    Exitcode (a >>= either (const b) (pure . Right))++-- |+--+-- >>> mkExitSuccess' "abc" <> mkExitSuccess' "def" :: Exitcode' () String+-- Exitcode (Identity (Right "abcdef"))+-- >>> mkExitSuccess' "abc" <> mkExitFailure1' () :: Exitcode' () String+-- Exitcode (Identity (Right "abc"))+-- >>> mkExitFailure1' () <> mkExitSuccess' "def" :: Exitcode' () String+-- Exitcode (Identity (Right "def"))+-- >>> (mkExitFailure1' () :: Exitcode' () String) <> mkExitFailure_1' ()+-- Exitcode (Identity (Left ((),NotZero False (Positive 1))))+instance (Semigroup a, Monad f) => Semigroup (Exitcode e f a) where+  {-# INLINE (<>) #-}+  Exitcode a <> Exitcode b =+    Exitcode+      ( a+          >>= either+            (\_ -> b >>= either (pure . Left) (pure . Right))+            (\a1 -> b >>= either (\_ -> pure (Right a1)) (\a2 -> pure (Right (a1 <> a2))))+      )++-- |+--+-- >>> mempty :: Exitcode' () String+-- Exitcode (Identity (Right ""))+instance (Monoid a, Monad f) => Monoid (Exitcode e f a) where+  {-# INLINE mempty #-}+  mempty = Exitcode (pure (Right mempty))++-- |+--+-- >>> duplicated (mkExitFailure1' ()) :: Exitcode' () (Exitcode' () ())+-- Exitcode (Identity (Right (Exitcode (Identity (Left ((),NotZero True (Positive 1)))))))+-- >>> duplicated (mkExitSuccess' "abc") :: Exitcode' () (Exitcode' () String)+-- Exitcode (Identity (Right (Exitcode (Identity (Right "abc")))))+instance (Extend f) => Extend (Exitcode e f) where+  {-# INLINE duplicated #-}+  duplicated (Exitcode x) =+    Exitcode (extended (Right . Exitcode) x)++-- |+--+-- >>> mkExitSuccess' 1 == mkExitSuccess' 1 :: Bool+-- True+-- >>> mkExitSuccess' 1 == (mkExitFailure1' () :: Exitcode' () Int) :: Bool+-- False+instance (Eq (f (Either (e, NotZero) a))) => Eq (Exitcode e f a) where+  {-# INLINE (==) #-}+  Exitcode a == Exitcode b = a == b++-- |+--+-- >>> liftEq (==) (mkExitSuccess' 1) (mkExitSuccess' 1 :: Exitcode' () Int)+-- True+-- >>> liftEq (==) (mkExitSuccess' 1) (mkExitSuccess' 2 :: Exitcode' () Int)+-- False+instance (Eq1 f, Eq e) => Eq1 (Exitcode e f) where+  {-# INLINE liftEq #-}+  liftEq f (Exitcode a) (Exitcode b) =+    liftEq (liftEq f) a b++-- |+--+-- >>> compare (mkExitSuccess' 1 :: Exitcode' () Int) (mkExitSuccess' 2)+-- LT+-- >>> compare (mkExitSuccess' 1 :: Exitcode' () Int) (mkExitFailure1' ())+-- GT+instance (Ord (f (Either (e, NotZero) a))) => Ord (Exitcode e f a) where+  {-# INLINE compare #-}+  Exitcode a `compare` Exitcode b = compare a b++-- |+--+-- >>> liftCompare compare (mkExitSuccess' 1) (mkExitSuccess' 2 :: Exitcode' () Int)+-- LT+instance (Ord1 f, Ord e) => Ord1 (Exitcode e f) where+  {-# INLINE liftCompare #-}+  liftCompare f (Exitcode a) (Exitcode b) =+    liftCompare (liftCompare f) a b++-- |+--+-- >>> show (mkExitSuccess' "abc" :: Exitcode' () String)+-- "Exitcode (Identity (Right \"abc\"))"+-- >>> show (mkExitFailure1' 'x' :: Exitcode' Char ())+-- "Exitcode (Identity (Left ('x',NotZero True (Positive 1))))"+instance (Show (f (Either (e, NotZero) a))) => Show (Exitcode e f a) where+  {-# INLINE showsPrec #-}+  showsPrec d (Exitcode m) =+    showParen (d > 10) $+      showString "Exitcode " . showsPrec 11 m++-- |+--+-- >>> liftShowsPrec showsPrec showList 0 (mkExitSuccess' 42 :: Exitcode' () Int) ""+-- "Exitcode (Identity (Right 42))"+instance (Show1 f, Show e) => Show1 (Exitcode e f) where+  {-# INLINE liftShowsPrec #-}+  liftShowsPrec sp sl d (Exitcode fa) =+    showParen (d > 10) $+      showString "Exitcode "+        . liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl) 11 fa++instance (NFData1 f, NFData e, NFData a) => NFData (Exitcode e f a) where+  {-# INLINE rnf #-}+  rnf = liftRnf rnf++instance (NFData1 f, NFData e) => NFData1 (Exitcode e f) where+  {-# INLINE liftRnf #-}+  liftRnf r (Exitcode x) = liftRnf rnfEither x+    where+      rnfEither (Right a) = r a+      rnfEither (Left (e, n)) = rnf e `seq` rnf (review _NotZero n :: Int)++-- |+--+-- >>> import Control.Monad.IO.Class (liftIO)+-- >>> runExitcode (liftIO (pure 42) :: Exitcode () IO Int)+-- Right 42+instance (MonadIO f) => MonadIO (Exitcode e f) where+  {-# INLINE liftIO #-}+  liftIO io = Exitcode (Right <$> liftIO io)++-- |+--+-- >>> import Control.Monad.Reader (runReader)+-- >>> runReader (runExitcode (ask :: Exitcode () (Control.Monad.Reader.Reader Int) Int)) 42+-- Right 42+-- >>> runReader (runExitcode (local (+1) ask :: Exitcode () (Control.Monad.Reader.Reader Int) Int)) 42+-- Right 43+instance (MonadReader r f) => MonadReader r (Exitcode e f) where+  {-# INLINE ask #-}+  ask = Exitcode (asks Right)+  {-# INLINE local #-}+  local f (Exitcode m) = Exitcode (local f m)++-- |+--+-- >>> import Control.Monad.Writer (runWriter)+-- >>> runWriter (runExitcode (tell "hello" :: Exitcode () (Control.Monad.Writer.Lazy.Writer String) ()))+-- (Right (),"hello")+instance (MonadWriter w f) => MonadWriter w (Exitcode e f) where+  {-# INLINE writer #-}+  writer t = Exitcode . fmap pure $ writer t+  {-# INLINE listen #-}+  listen (Exitcode m) = Exitcode ((\(e, w) -> (,w) <$> e) <$> listen m)+  {-# INLINE tell #-}+  tell = Exitcode . fmap Right . tell+  {-# INLINE pass #-}+  pass e =+    do+      ((a, f), w) <- listen e+      tell (f w)+      pure a++-- |+--+-- >>> import Control.Monad.State (runState)+-- >>> runState (runExitcode (get :: Exitcode () (Control.Monad.State.Lazy.State Int) Int)) 7+-- (Right 7,7)+-- >>> runState (runExitcode (put 99 :: Exitcode () (Control.Monad.State.Lazy.State Int) ())) 7+-- (Right (),99)+instance (MonadState s f) => MonadState s (Exitcode e f) where+  {-# INLINE get #-}+  get = Exitcode (fmap Right get)+  {-# INLINE put #-}+  put = Exitcode . fmap Right . put++-- | @throwError@ and @catchError@ operate on the error channel of the base+-- functor @f@, not on the exit code failure.+--+-- >>> import Control.Monad.Except (runExcept)+-- >>> runExcept (runExitcode (throwError "oops" :: Exitcode () (Control.Monad.Except.Except String) Int))+-- Left "oops"+instance (MonadError e f) => MonadError e (Exitcode e' f) where+  {-# INLINE throwError #-}+  throwError = Exitcode . fmap Right . throwError+  {-# INLINE catchError #-}+  catchError (Exitcode f) h = Exitcode (catchError f (runExitcode . h))++instance (MonadRWS r w s f) => MonadRWS r w s (Exitcode e f)++-- |+--+-- >>> import Control.Monad.Cont (runCont)+-- >>> runCont (runExitcode (callCC (\k -> k 42) :: Exitcode () (Control.Monad.Cont.Cont (Either ((), NotZero) Int)) Int)) id+-- Right 42+instance (MonadCont f) => MonadCont (Exitcode e f) where+  callCC f =+    Exitcode (callCC (\c -> runExitcode (f (Exitcode . c . Right))))++-- |+--+-- >>> import Control.Monad.Trans.Class (lift)+-- >>> runExitcode (lift (Identity 42) :: Exitcode' () Int)+-- Identity (Right 42)+instance MonadTrans (Exitcode e) where+  {-# INLINE lift #-}+  lift = Exitcode . fmap Right++-- |+--+-- >>> import Data.Functor.Bind.Trans (liftB)+-- >>> runExitcode (liftB (Identity 42) :: Exitcode' () Int)+-- Identity (Right 42)+instance BindTrans (Exitcode e) where+  {-# INLINE liftB #-}+  liftB = Exitcode . fmap Right++-- * ExitcodeBifunctor++-- | @ExitcodeBifunctor@ reorders the type parameters of @Exitcode@ so that+-- @e@ and @a@ are last, enabling @Bifunctor@, @Bifoldable@, and @Bitraversable@+-- instances.+newtype ExitcodeBifunctor f e a = ExitcodeBifunctor (Exitcode e f a)+  deriving stock (Generic)++-- | @ExitcodeBifunctor@ specialised to @Identity@.+type ExitcodeBifunctor' e a = ExitcodeBifunctor Identity e a++-- * ExitcodeBifunctor Instances++-- |+--+-- >>> bimap (+1) (+10) (ExitcodeBifunctor (mkExitFailure1' 5) :: ExitcodeBifunctor' Int Int)+-- ExitcodeBifunctor (Exitcode (Identity (Left (6,NotZero True (Positive 1)))))+-- >>> bimap (+1) (+10) (ExitcodeBifunctor (mkExitSuccess' 5) :: ExitcodeBifunctor' Int Int)+-- ExitcodeBifunctor (Exitcode (Identity (Right 15)))+instance (Functor f) => Bifunctor (ExitcodeBifunctor f) where+  {-# INLINE bimap #-}+  bimap f g (ExitcodeBifunctor x) = ExitcodeBifunctor (bimapExitcode f g x)++-- |+--+-- >>> bifoldMap show show (ExitcodeBifunctor (mkExitFailure1' 'x') :: ExitcodeBifunctor' Char Int)+-- "'x'"+-- >>> bifoldMap show show (ExitcodeBifunctor (mkExitSuccess' 42) :: ExitcodeBifunctor' Char Int)+-- "42"+instance (Foldable f) => Bifoldable (ExitcodeBifunctor f) where+  {-# INLINE bifoldMap #-}+  bifoldMap f g (ExitcodeBifunctor (Exitcode x)) =+    foldMap (either (\(e, _) -> f e) g) x++-- |+--+-- >>> bitraverse (Just . (+1)) (Just . (+10)) (ExitcodeBifunctor (mkExitFailure1' 5) :: ExitcodeBifunctor' Int Int)+-- Just (ExitcodeBifunctor (Exitcode (Identity (Left (6,NotZero True (Positive 1))))))+-- >>> bitraverse (Just . (+1)) (Just . (+10)) (ExitcodeBifunctor (mkExitSuccess' 5) :: ExitcodeBifunctor' Int Int)+-- Just (ExitcodeBifunctor (Exitcode (Identity (Right 15))))+instance (Traversable f) => Bitraversable (ExitcodeBifunctor f) where+  {-# INLINE bitraverse #-}+  bitraverse f g (ExitcodeBifunctor (Exitcode x)) =+    ExitcodeBifunctor . Exitcode <$> traverse (either (\(e, n) -> fmap (\e' -> Left (e', n)) (f e)) (fmap Right . g)) x++-- |+--+-- >>> fmap (+1) (ExitcodeBifunctor (mkExitSuccess' 3) :: ExitcodeBifunctor' () Int)+-- ExitcodeBifunctor (Exitcode (Identity (Right 4)))+instance (Functor f) => Functor (ExitcodeBifunctor f e) where+  {-# INLINE fmap #-}+  fmap f (ExitcodeBifunctor x) = ExitcodeBifunctor (fmap f x)++-- |+--+-- >>> foldMap show (ExitcodeBifunctor (mkExitSuccess' 42) :: ExitcodeBifunctor' () Int)+-- "42"+instance (Foldable f) => Foldable (ExitcodeBifunctor f e) where+  {-# INLINE foldMap #-}+  foldMap f (ExitcodeBifunctor x) = foldMap f x++-- |+--+-- >>> traverse Just (ExitcodeBifunctor (mkExitSuccess' 42) :: ExitcodeBifunctor' () Int)+-- Just (ExitcodeBifunctor (Exitcode (Identity (Right 42))))+instance (Traversable f) => Traversable (ExitcodeBifunctor f e) where+  {-# INLINE traverse #-}+  traverse f (ExitcodeBifunctor x) = ExitcodeBifunctor <$> traverse f x++instance (FunctorWithIndex i f) => FunctorWithIndex i (ExitcodeBifunctor f e) where+  {-# INLINE imap #-}+  imap f (ExitcodeBifunctor x) = ExitcodeBifunctor (imap f x)++instance (FoldableWithIndex i f) => FoldableWithIndex i (ExitcodeBifunctor f e) where+  {-# INLINE ifoldMap #-}+  ifoldMap f (ExitcodeBifunctor x) = ifoldMap f x++instance (TraversableWithIndex i f) => TraversableWithIndex i (ExitcodeBifunctor f e) where+  {-# INLINE itraverse #-}+  itraverse f (ExitcodeBifunctor x) = ExitcodeBifunctor <$> itraverse f x++instance (Monad f) => Apply (ExitcodeBifunctor f e) where+  {-# INLINE (<.>) #-}+  ExitcodeBifunctor f <.> ExitcodeBifunctor a = ExitcodeBifunctor (f <.> a)++-- |+--+-- >>> pure 42 :: ExitcodeBifunctor' () Int+-- ExitcodeBifunctor (Exitcode (Identity (Right 42)))+instance (Monad f) => Applicative (ExitcodeBifunctor f e) where+  {-# INLINE pure #-}+  pure = ExitcodeBifunctor . pure+  {-# INLINE (<*>) #-}+  ExitcodeBifunctor f <*> ExitcodeBifunctor a = ExitcodeBifunctor (f <*> a)++instance (Monad f) => Bind (ExitcodeBifunctor f e) where+  {-# INLINE (>>-) #-}+  (>>-) = (>>=)++instance (Monad f) => Monad (ExitcodeBifunctor f e) where+  {-# INLINE (>>=) #-}+  ExitcodeBifunctor x >>= f = ExitcodeBifunctor (x >>= (\a -> let ExitcodeBifunctor y = f a in y))++instance (MonadFix f) => MonadFix (ExitcodeBifunctor f e) where+  {-# INLINE mfix #-}+  mfix f = ExitcodeBifunctor (mfix (\a -> let ExitcodeBifunctor y = f a in y))++-- |+--+-- >>> (ExitcodeBifunctor (mkExitFailure1' ()) :: ExitcodeBifunctor' () Int) <!> ExitcodeBifunctor (mkExitSuccess' 42)+-- ExitcodeBifunctor (Exitcode (Identity (Right 42)))+instance (Monad f) => Alt (ExitcodeBifunctor f e) where+  {-# INLINE (<!>) #-}+  ExitcodeBifunctor a <!> ExitcodeBifunctor b = ExitcodeBifunctor (a <!> b)++instance (Semigroup a, Monad f) => Semigroup (ExitcodeBifunctor f e a) where+  {-# INLINE (<>) #-}+  ExitcodeBifunctor a <> ExitcodeBifunctor b = ExitcodeBifunctor (a <> b)++instance (Monoid a, Monad f) => Monoid (ExitcodeBifunctor f e a) where+  {-# INLINE mempty #-}+  mempty = ExitcodeBifunctor mempty++instance (Extend f) => Extend (ExitcodeBifunctor f e) where+  {-# INLINE duplicated #-}+  duplicated (ExitcodeBifunctor x) = ExitcodeBifunctor (fmap ExitcodeBifunctor (duplicated x))++instance (Eq (f (Either (e, NotZero) a))) => Eq (ExitcodeBifunctor f e a) where+  {-# INLINE (==) #-}+  ExitcodeBifunctor (Exitcode a) == ExitcodeBifunctor (Exitcode b) = a == b++instance (Eq1 f, Eq e) => Eq1 (ExitcodeBifunctor f e) where+  {-# INLINE liftEq #-}+  liftEq f (ExitcodeBifunctor (Exitcode a)) (ExitcodeBifunctor (Exitcode b)) =+    liftEq (liftEq f) a b++instance (Ord (f (Either (e, NotZero) a))) => Ord (ExitcodeBifunctor f e a) where+  {-# INLINE compare #-}+  ExitcodeBifunctor (Exitcode a) `compare` ExitcodeBifunctor (Exitcode b) = compare a b++instance (Ord1 f, Ord e) => Ord1 (ExitcodeBifunctor f e) where+  {-# INLINE liftCompare #-}+  liftCompare f (ExitcodeBifunctor (Exitcode a)) (ExitcodeBifunctor (Exitcode b)) =+    liftCompare (liftCompare f) a b++-- |+--+-- >>> show (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- "ExitcodeBifunctor (Exitcode (Identity (Right \"abc\")))"+-- >>> show (ExitcodeBifunctor (mkExitFailure1' 'x') :: ExitcodeBifunctor' Char ())+-- "ExitcodeBifunctor (Exitcode (Identity (Left ('x',NotZero True (Positive 1)))))"+instance (Show (f (Either (e, NotZero) a))) => Show (ExitcodeBifunctor f e a) where+  {-# INLINE showsPrec #-}+  showsPrec d (ExitcodeBifunctor (Exitcode m)) =+    showParen (d > 10) $+      showString "ExitcodeBifunctor (Exitcode " . showsPrec 11 m . showString ")"++instance (Show1 f, Show e) => Show1 (ExitcodeBifunctor f e) where+  {-# INLINE liftShowsPrec #-}+  liftShowsPrec sp sl d (ExitcodeBifunctor (Exitcode fa)) =+    showParen (d > 10) $+      showString "ExitcodeBifunctor (Exitcode "+        . liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl) 11 fa+        . showString ")"++instance (NFData1 f, NFData e, NFData a) => NFData (ExitcodeBifunctor f e a) where+  {-# INLINE rnf #-}+  rnf = liftRnf rnf++instance (NFData1 f, NFData e) => NFData1 (ExitcodeBifunctor f e) where+  {-# INLINE liftRnf #-}+  liftRnf r (ExitcodeBifunctor (Exitcode x)) = liftRnf rnfEither x+    where+      rnfEither (Right a) = r a+      rnfEither (Left (e, n)) = rnf e `seq` rnf (review _NotZero n :: Int)++instance (MonadIO f) => MonadIO (ExitcodeBifunctor f e) where+  {-# INLINE liftIO #-}+  liftIO = ExitcodeBifunctor . liftIO++instance (MonadReader r f) => MonadReader r (ExitcodeBifunctor f e) where+  {-# INLINE ask #-}+  ask = ExitcodeBifunctor ask+  {-# INLINE local #-}+  local f (ExitcodeBifunctor x) = ExitcodeBifunctor (local f x)++instance (MonadWriter w f) => MonadWriter w (ExitcodeBifunctor f e) where+  {-# INLINE writer #-}+  writer t = ExitcodeBifunctor (writer t)+  {-# INLINE listen #-}+  listen (ExitcodeBifunctor x) = ExitcodeBifunctor (listen x)+  {-# INLINE tell #-}+  tell = ExitcodeBifunctor . tell+  {-# INLINE pass #-}+  pass (ExitcodeBifunctor x) = ExitcodeBifunctor (pass x)++instance (MonadState s f) => MonadState s (ExitcodeBifunctor f e) where+  {-# INLINE get #-}+  get = ExitcodeBifunctor get+  {-# INLINE put #-}+  put = ExitcodeBifunctor . put++instance (MonadError e f) => MonadError e (ExitcodeBifunctor f e') where+  {-# INLINE throwError #-}+  throwError = ExitcodeBifunctor . throwError+  {-# INLINE catchError #-}+  catchError (ExitcodeBifunctor x) h = ExitcodeBifunctor (catchError x (\e -> let ExitcodeBifunctor y = h e in y))++instance (MonadRWS r w s f) => MonadRWS r w s (ExitcodeBifunctor f e)++instance (MonadCont f) => MonadCont (ExitcodeBifunctor f e) where+  callCC f = ExitcodeBifunctor (callCC (\c -> let ExitcodeBifunctor x = f (ExitcodeBifunctor . c) in x))+

@@ -0,0 +1,219 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++module Control.Exitcode.Optics+  ( GetExitcode (..),+    HasExitcode (..),+    ReviewExitcode (..),+    AsExitcode (..),+    GetExitcodeBifunctor (..),+    HasExitcodeBifunctor (..),+    ReviewExitcodeBifunctor (..),+    AsExitcodeBifunctor (..),+  )+where++import Control.Category (id, (.))+import Control.Exitcode.Exitcode (Exitcode, ExitcodeBifunctor (ExitcodeBifunctor))+import Control.Lens (Getter, Lens', Prism', Review, lens, prism', unto)+import Data.Maybe (Maybe (Just))++-- $setup+-- >>> import Prelude+-- >>> import Control.Lens+-- >>> import Control.Exitcode++-- * Exitcode optics++-- | Type class for values that can be viewed as an @Exitcode@.+--+-- >>> view getExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Exitcode' () String+-- Exitcode (Identity (Right "abc"))+class GetExitcode s e f a | s -> e f a where+  getExitcode :: Getter s (Exitcode e f a)++-- |+--+-- >>> view getExitcode (mkExitSuccess' "abc" :: Exitcode' () String)+-- Exitcode (Identity (Right "abc"))+instance GetExitcode (Exitcode e f a) e f a where+  getExitcode = id+  {-# INLINE getExitcode #-}++-- |+--+-- >>> view getExitcode (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- Exitcode (Identity (Right "abc"))+instance GetExitcode (ExitcodeBifunctor f e a) e f a where+  getExitcode = lens (\(ExitcodeBifunctor x) -> x) (\_ -> ExitcodeBifunctor)+  {-# INLINE getExitcode #-}++-- | Type class for values with a lens into an @Exitcode@.+--+-- >>> view exitcode (mkExitSuccess' "abc" :: Exitcode' () String)+-- Exitcode (Identity (Right "abc"))+class (GetExitcode s e f a) => HasExitcode s e f a | s -> e f a where+  exitcode :: Lens' s (Exitcode e f a)++-- |+--+-- >>> view exitcode (mkExitSuccess' "abc" :: Exitcode' () String)+-- Exitcode (Identity (Right "abc"))+instance HasExitcode (Exitcode e f a) e f a where+  exitcode = id+  {-# INLINE exitcode #-}++-- |+--+-- >>> view exitcode (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- Exitcode (Identity (Right "abc"))+-- >>> set exitcode (mkExitFailure1' ()) (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- ExitcodeBifunctor (Exitcode (Identity (Left ((),NotZero True (Positive 1)))))+instance HasExitcode (ExitcodeBifunctor f e a) e f a where+  exitcode = lens (\(ExitcodeBifunctor x) -> x) (\_ x -> ExitcodeBifunctor x)+  {-# INLINE exitcode #-}++-- | Type class for values that can be constructed from an @Exitcode@.+--+-- >>> review reviewExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Exitcode' () String+-- Exitcode (Identity (Right "abc"))+class ReviewExitcode t e f a | t -> e f a where+  reviewExitcode :: Review t (Exitcode e f a)++-- |+--+-- >>> review reviewExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Exitcode' () String+-- Exitcode (Identity (Right "abc"))+instance ReviewExitcode (Exitcode e f a) e f a where+  reviewExitcode = unto id+  {-# INLINE reviewExitcode #-}++-- |+--+-- >>> review reviewExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: ExitcodeBifunctor' () String+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+instance ReviewExitcode (ExitcodeBifunctor f e a) e f a where+  reviewExitcode = unto ExitcodeBifunctor+  {-# INLINE reviewExitcode #-}++-- | Type class for values with a prism into an @Exitcode@.+--+-- >>> preview _Exitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Maybe (Exitcode' () String)+-- Just (Exitcode (Identity (Right "abc")))+class (ReviewExitcode t e f a) => AsExitcode t e f a | t -> e f a where+  _Exitcode :: Prism' t (Exitcode e f a)++-- |+--+-- >>> preview _Exitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Maybe (Exitcode' () String)+-- Just (Exitcode (Identity (Right "abc")))+instance AsExitcode (Exitcode e f a) e f a where+  _Exitcode = id+  {-# INLINE _Exitcode #-}++-- |+--+-- >>> preview _Exitcode (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: Maybe (Exitcode' () String)+-- Just (Exitcode (Identity (Right "abc")))+instance AsExitcode (ExitcodeBifunctor f e a) e f a where+  _Exitcode = prism' ExitcodeBifunctor (\(ExitcodeBifunctor x) -> Just x)+  {-# INLINE _Exitcode #-}++-- * ExitcodeBifunctor optics++-- | Type class for values that can be viewed as an @ExitcodeBifunctor@.+--+-- >>> view getExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+class GetExitcodeBifunctor s f e a | s -> f e a where+  getExitcodeBifunctor :: Getter s (ExitcodeBifunctor f e a)++-- |+--+-- >>> view getExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+instance GetExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where+  getExitcodeBifunctor = id+  {-# INLINE getExitcodeBifunctor #-}++-- |+--+-- >>> view getExitcodeBifunctor (mkExitSuccess' "abc" :: Exitcode' () String)+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+instance GetExitcodeBifunctor (Exitcode e f a) f e a where+  getExitcodeBifunctor = lens ExitcodeBifunctor (\_ (ExitcodeBifunctor x) -> x)+  {-# INLINE getExitcodeBifunctor #-}++-- | Type class for values with a lens into an @ExitcodeBifunctor@.+--+-- >>> view exitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+class (GetExitcodeBifunctor s f e a) => HasExitcodeBifunctor s f e a | s -> f e a where+  exitcodeBifunctor :: Lens' s (ExitcodeBifunctor f e a)++-- |+--+-- >>> view exitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+instance HasExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where+  exitcodeBifunctor = id+  {-# INLINE exitcodeBifunctor #-}++-- |+--+-- >>> view exitcodeBifunctor (mkExitSuccess' "abc" :: Exitcode' () String)+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+-- >>> set exitcodeBifunctor (ExitcodeBifunctor (mkExitFailure1' ())) (mkExitSuccess' "abc" :: Exitcode' () String)+-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))+instance HasExitcodeBifunctor (Exitcode e f a) f e a where+  exitcodeBifunctor = lens ExitcodeBifunctor (\_ (ExitcodeBifunctor x) -> x)+  {-# INLINE exitcodeBifunctor #-}++-- | Type class for values that can be constructed from an @ExitcodeBifunctor@.+--+-- >>> review reviewExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: ExitcodeBifunctor' () String+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+class ReviewExitcodeBifunctor t f e a | t -> f e a where+  reviewExitcodeBifunctor :: Review t (ExitcodeBifunctor f e a)++-- |+--+-- >>> review reviewExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: ExitcodeBifunctor' () String+-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))+instance ReviewExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where+  reviewExitcodeBifunctor = unto id+  {-# INLINE reviewExitcodeBifunctor #-}++-- |+--+-- >>> review reviewExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: Exitcode' () String+-- Exitcode (Identity (Right "abc"))+instance ReviewExitcodeBifunctor (Exitcode e f a) f e a where+  reviewExitcodeBifunctor = unto (\(ExitcodeBifunctor x) -> x)+  {-# INLINE reviewExitcodeBifunctor #-}++-- | Type class for values with a prism into an @ExitcodeBifunctor@.+--+-- >>> preview _ExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- Just (ExitcodeBifunctor (Exitcode (Identity (Right "abc"))))+class (ReviewExitcodeBifunctor t f e a) => AsExitcodeBifunctor t f e a | t -> f e a where+  _ExitcodeBifunctor :: Prism' t (ExitcodeBifunctor f e a)++-- |+--+-- >>> preview _ExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)+-- Just (ExitcodeBifunctor (Exitcode (Identity (Right "abc"))))+instance AsExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where+  _ExitcodeBifunctor = id+  {-# INLINE _ExitcodeBifunctor #-}++-- |+--+-- >>> preview _ExitcodeBifunctor (mkExitSuccess' "abc" :: Exitcode' () String)+-- Just (ExitcodeBifunctor (Exitcode (Identity (Right "abc"))))+instance AsExitcodeBifunctor (Exitcode e f a) f e a where+  _ExitcodeBifunctor = prism' (\(ExitcodeBifunctor x) -> x) (Just . ExitcodeBifunctor)+  {-# INLINE _ExitcodeBifunctor #-}

@@ -1,9 +1,10 @@-{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process(-  module P-) where+module Control.Process+  ( module P,+  )+where  import Control.Process.CmdSpec as P import Control.Process.CreateProcess as P

@@ -1,97 +1,195 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.CmdSpec(-  AsCmdSpec(..)-, HasCmdSpec(..)-) where+module Control.Process.CmdSpec+  ( CmdSpec (..),+    GetCmdSpec (..),+    HasCmdSpec (..),+    ReviewCmdSpec (..),+    AsCmdSpec (..),+  )+where -import Control.Category ( Category(id, (.)) )+import Control.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(..) )+  ( Field1 (_1),+    Field2 (_2),+    Getter,+    Lens',+    Prism',+    Review,+    Traversable (traverse),+    Traversal',+    prism',+    to,+    unto,+  )+import Data.Functor (Functor (fmap))+import Data.Maybe (Maybe (Just, Nothing))+import Data.String (String)+import Data.Tuple (uncurry)+import System.FilePath (FilePath)+import System.Process (CmdSpec (..), CreateProcess)+import qualified System.Process as Process (CreateProcess (..)) -class AsCmdSpec a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens++-- | Type class for values that can be viewed as a @CmdSpec@.+--+-- >>> view getCmdSpec (ShellCommand "ls -la")+-- ShellCommand "ls -la"+class GetCmdSpec a where+  getCmdSpec ::+    Getter a CmdSpec++-- |+--+-- >>> view getCmdSpec (ShellCommand "ls -la")+-- ShellCommand "ls -la"+instance GetCmdSpec CmdSpec where+  getCmdSpec = id+  {-# INLINE getCmdSpec #-}++-- |+--+-- >>> import System.Process (proc)+-- >>> view getCmdSpec (proc "echo" ["hello"])+-- RawCommand "echo" ["hello"]+instance GetCmdSpec CreateProcess where+  getCmdSpec = to Process.cmdspec+  {-# INLINE getCmdSpec #-}++-- | Type class for values with a lens into a @CmdSpec@.+--+-- >>> view cmdSpec (ShellCommand "ls -la")+-- ShellCommand "ls -la"+class (GetCmdSpec a) => HasCmdSpec a where+  cmdSpec ::+    Lens' a CmdSpec+  {-# INLINE shellCommand #-}+  shellCommand ::+    Traversal' a String+  shellCommand =+    cmdSpec . _ShellCommand+  {-# INLINE rawCommand #-}+  rawCommand ::+    Traversal' a (FilePath, [String])+  rawCommand =+    cmdSpec . _RawCommand+  {-# INLINE rawCommandExe #-}+  rawCommandExe ::+    Traversal' a FilePath+  rawCommandExe =+    rawCommand . _1+  {-# INLINE rawCommandArgumentList #-}+  rawCommandArgumentList ::+    Traversal' a [String]+  rawCommandArgumentList =+    rawCommand . _2+  {-# INLINE rawCommandArguments #-}+  rawCommandArguments ::+    Traversal' a String+  rawCommandArguments =+    rawCommandArgumentList . traverse++-- |+--+-- >>> view cmdSpec (ShellCommand "ls")+-- ShellCommand "ls"+-- >>> set cmdSpec (RawCommand "echo" ["hi"]) (ShellCommand "ls")+-- RawCommand "echo" ["hi"]+instance HasCmdSpec CmdSpec where+  cmdSpec =+    id++-- |+--+-- >>> import System.Process (proc)+-- >>> view cmdSpec (proc "echo" ["hello"])+-- RawCommand "echo" ["hello"]+instance HasCmdSpec CreateProcess where+  cmdSpec f p =+    fmap (\x -> p {Process.cmdspec = x}) (f (Process.cmdspec p))++-- | Type class for values that can be constructed from a @CmdSpec@.+--+-- >>> review reviewCmdSpec (ShellCommand "ls") :: CmdSpec+-- ShellCommand "ls"+class ReviewCmdSpec a where+  reviewCmdSpec ::+    Review a CmdSpec++-- |+--+-- >>> review reviewCmdSpec (ShellCommand "ls") :: CmdSpec+-- ShellCommand "ls"+instance ReviewCmdSpec CmdSpec where+  reviewCmdSpec = unto id+  {-# INLINE reviewCmdSpec #-}++-- | Type class for values with a prism into a @CmdSpec@.+--+-- >>> preview _CmdSpec (ShellCommand "ls -la")+-- Just (ShellCommand "ls -la")+class (ReviewCmdSpec a) => AsCmdSpec a where   _CmdSpec ::     Prism' a CmdSpec+  {-# INLINE _ShellCommand #-}   _ShellCommand ::     Prism' a String   _ShellCommand =     _CmdSpec . _ShellCommand+  {-# INLINE _RawCommand #-}   _RawCommand ::     Prism' a (FilePath, [String])   _RawCommand =     _CmdSpec . _RawCommand+  {-# INLINE _RawCommandExe #-}   _RawCommandExe ::     Traversal' a FilePath   _RawCommandExe =     _RawCommand . _1+  {-# INLINE _RawCommandArgumentList #-}   _RawCommandArgumentList ::     Traversal' a [String]   _RawCommandArgumentList =     _RawCommand . _2+  {-# INLINE _RawCommandArguments #-}   _RawCommandArguments ::     Traversal' a String   _RawCommandArguments =     _RawCommandArgumentList . traverse +-- |+--+-- >>> preview _ShellCommand (ShellCommand "ls -la")+-- Just "ls -la"+-- >>> preview _ShellCommand (RawCommand "ls" ["-la"])+-- Nothing+-- >>> preview _RawCommand (RawCommand "ls" ["-la"])+-- Just ("ls",["-la"])+-- >>> preview _RawCommand (ShellCommand "ls -la")+-- Nothing+-- >>> review _ShellCommand "echo hello" :: CmdSpec+-- ShellCommand "echo hello"+-- >>> review _RawCommand ("/bin/ls", ["-la"]) :: CmdSpec+-- RawCommand "/bin/ls" ["-la"] instance AsCmdSpec CmdSpec where   _CmdSpec = id   _ShellCommand =     prism'       ShellCommand-      (\case-        ShellCommand a -> Just a-        _ -> Nothing+      ( \case+          ShellCommand a -> Just a+          _ -> Nothing       )   _RawCommand =     prism'       (uncurry RawCommand)-      (\case-        RawCommand a b -> Just (a, b)-        _ -> Nothing+      ( \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)

@@ -1,37 +1,71 @@-{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.CreateProcess(-  HasCreateProcess(..)-, AsCreateProcess(..)-, streams-, streams1-) where+module Control.Process.CreateProcess+  ( CreateProcess,+    GetCreateProcess (..),+    HasCreateProcess (..),+    ReviewCreateProcess (..),+    AsCreateProcess (..),+    streams,+    streams1,+  )+where -import Control.Applicative ( Applicative((<*>)) )-import Control.Category ( Category(id, (.)) )+import Control.Applicative (Applicative ((<*>)))+import Control.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)+  ( Field1 (_1),+    Field2 (_2),+    Getter,+    Lens',+    Prism',+    Review,+    Traversable (traverse),+    Traversal',+    Traversal1',+    only,+    unto,+    _Just,+  )+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 (CreateProcess, StdStream (..))+import qualified System.Process as Process (CreateProcess (..))+import System.Process.Internals (GroupID, UserID) -class HasCreateProcess a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens+-- >>> import System.Process (proc, shell)++-- | Type class for values that can be viewed as a @CreateProcess@.+--+-- >>> view getCreateProcess (proc "echo" ["hello"]) == proc "echo" ["hello"]+-- True+class GetCreateProcess a where+  getCreateProcess ::+    Getter a CreateProcess++-- |+--+-- >>> view getCreateProcess (proc "echo" ["hello"]) == proc "echo" ["hello"]+-- True+instance GetCreateProcess CreateProcess where+  getCreateProcess = id+  {-# INLINE getCreateProcess #-}++-- | Type class for values with a lens into a @CreateProcess@.+--+-- >>> view close_fds (proc "echo" ["hello"])+-- False+class (GetCreateProcess a) => HasCreateProcess a where   create_process ::     Lens' a CreateProcess   {-# INLINE child_group #-}@@ -105,113 +139,176 @@   use_process_jobs =     create_process . use_process_jobs +  {-# INLINE cwd' #-}   cwd' ::     Traversal' a FilePath   cwd' =     cwd . _Just+  {-# INLINE envList #-}   envList ::     Traversal' a [(String, String)]   envList =     env . _Just+  {-# INLINE envElement #-}   envElement ::     Traversal' a (String, String)   envElement =     envList . traverse+  {-# INLINE envElementKey #-}   envElementKey ::     Traversal' a String   envElementKey =     envElement . _1+  {-# INLINE envElementValue #-}   envElementValue ::     Traversal' a String   envElementValue =     envElement . _2+  {-# INLINE close_fds' #-}   close_fds' ::     Traversal' a ()   close_fds' =     close_fds . only True+  {-# INLINE create_group' #-}   create_group' ::     Traversal' a ()   create_group' =     create_group . only True+  {-# INLINE delegate_ctlc' #-}   delegate_ctlc' ::     Traversal' a ()   delegate_ctlc' =     delegate_ctlc . only True+  {-# INLINE detach_console' #-}   detach_console' ::     Traversal' a ()   detach_console' =     detach_console . only True+  {-# INLINE create_new_console' #-}   create_new_console' ::     Traversal' a ()   create_new_console' =     create_new_console . only True+  {-# INLINE new_session' #-}   new_session' ::     Traversal' a ()   new_session' =     new_session . only True+  {-# INLINE child_group' #-}   child_group' ::     Traversal' a GroupID   child_group' =     child_group . _Just+  {-# INLINE child_user' #-}   child_user' ::     Traversal' a UserID   child_user' =     child_user . _Just+  {-# INLINE child_user'' #-}   child_user'' ::     Traversal' a Word32   child_user'' =     child_user' . userIDWord32+  {-# INLINE use_process_jobs' #-}   use_process_jobs' ::     Traversal' a ()   use_process_jobs' =     use_process_jobs . only True +-- |+--+-- >>> view close_fds (proc "echo" ["hello"])+-- False+-- >>> view (std_in) (proc "echo" ["hello"])+-- Inherit+-- >>> view cwd (proc "echo" ["hello"])+-- Nothing 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 (CreateProcess csc cw en sti sto ste clf crg dct dcl cnc nss chg chu) (f upj)+  child_group f p =+    fmap (\x -> p {Process.child_group = x}) (f (Process.child_group p))+  child_user f p =+    fmap (\x -> p {Process.child_user = x}) (f (Process.child_user p))+  close_fds f p =+    fmap (\x -> p {Process.close_fds = x}) (f (Process.close_fds p))+  create_group f p =+    fmap (\x -> p {Process.create_group = x}) (f (Process.create_group p))+  create_new_console f p =+    fmap (\x -> p {Process.create_new_console = x}) (f (Process.create_new_console p))+  cwd f p =+    fmap (\x -> p {Process.cwd = x}) (f (Process.cwd p))+  delegate_ctlc f p =+    fmap (\x -> p {Process.delegate_ctlc = x}) (f (Process.delegate_ctlc p))+  detach_console f p =+    fmap (\x -> p {Process.detach_console = x}) (f (Process.detach_console p))+  env f p =+    fmap (\x -> p {Process.env = x}) (f (Process.env p))+  new_session f p =+    fmap (\x -> p {Process.new_session = x}) (f (Process.new_session p))+  std_err f p =+    fmap (\x -> p {Process.std_err = x}) (f (Process.std_err p))+  std_in f p =+    fmap (\x -> p {Process.std_in = x}) (f (Process.std_in p))+  std_out f p =+    fmap (\x -> p {Process.std_out = x}) (f (Process.std_out p))+  use_process_jobs f p =+    fmap (\x -> p {Process.use_process_jobs = x}) (f (Process.use_process_jobs p)) -class AsCreateProcess a where+-- | Type class for values that can be constructed from a @CreateProcess@.+--+-- >>> review reviewCreateProcess (proc "echo" ["hi"]) == proc "echo" ["hi"]+-- True+class ReviewCreateProcess a where+  reviewCreateProcess ::+    Review a CreateProcess++-- |+--+-- >>> review reviewCreateProcess (proc "echo" ["hi"]) == proc "echo" ["hi"]+-- True+instance ReviewCreateProcess CreateProcess where+  reviewCreateProcess = unto id+  {-# INLINE reviewCreateProcess #-}++-- | Type class for values with a prism into a @CreateProcess@.+--+-- >>> preview _CreateProcess (proc "echo" ["hi"]) == Just (proc "echo" ["hi"])+-- True+class (ReviewCreateProcess a) => AsCreateProcess a where   _CreateProcess ::     Prism' a CreateProcess +-- |+--+-- >>> preview _CreateProcess (proc "echo" ["hi"]) == Just (proc "echo" ["hi"])+-- True instance AsCreateProcess CreateProcess where   _CreateProcess =     id +-- |+--+-- >>> toListOf streams (proc "echo" ["hi"])+-- [Inherit,Inherit,Inherit]+-- >>> set streams CreatePipe (proc "echo" ["hi"]) ^. std_in+-- CreatePipe 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+streams f p =+  (\sti' sto' ste' -> p {Process.std_in = sti', Process.std_out = sto', Process.std_err = ste'})+    <$> f (Process.std_in p)+    <*> f (Process.std_out p)+    <*> f (Process.std_err p) +-- |+--+-- >>> toListOf streams1 (proc "echo" ["hi"])+-- [Inherit,Inherit,Inherit] 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+streams1 f p =+  (\sti' sto' ste' -> p {Process.std_in = sti', Process.std_out = sto', Process.std_err = ste'})+    <$> f (Process.std_in p)+    <.> f (Process.std_out p)+    <.> f (Process.std_err p)

@@ -1,44 +1,130 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.FD(-  HasFD(..)-, AsFD(..)-) where+module Control.Process.FD+  ( FD,+    GetFD (..),+    HasFD (..),+    ReviewFD (..),+    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 )+import Control.Category (id, (.))+import Control.Lens (Getter, Lens', Prism', Review, iso, unto)+import Data.Int (Int32)+import Foreign.C.Types (CInt (CInt))+import System.Posix.Internals (FD) -class HasFD a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens++-- | Type class for values that can be viewed as an @FD@.+--+-- >>> view getFD (3 :: FD)+-- 3+class GetFD a where+  getFD ::+    Getter a FD+  {-# INLINE getFDInt32 #-}+  getFDInt32 ::+    Getter a Int32+  getFDInt32 =+    getFD+      . iso+        (\(CInt x) -> x)+        CInt++-- |+--+-- >>> view getFD (3 :: FD)+-- 3+-- >>> view getFDInt32 (3 :: FD)+-- 3+instance GetFD FD where+  getFD = id+  {-# INLINE getFD #-}++-- | Type class for values with a lens into an @FD@.+--+-- >>> view fd (3 :: FD)+-- 3+class (GetFD a) => HasFD a where   fd ::     Lens' a FD+  {-# INLINE fdInt32 #-}   fdInt32 ::     Lens' a Int32   fdInt32 =-    fd .-      iso+    fd+      . iso         (\(CInt x) -> x)         CInt +-- |+--+-- >>> view fd (3 :: FD)+-- 3+-- >>> view fdInt32 (3 :: FD)+-- 3+-- >>> set fdInt32 7 (3 :: FD)+-- 7 instance HasFD FD where   fd =     id -class AsFD a where+-- | Type class for values that can be constructed from an @FD@.+--+-- >>> review reviewFD (3 :: FD) :: FD+-- 3+class ReviewFD a where+  reviewFD ::+    Review a FD+  {-# INLINE reviewFDInt32 #-}+  reviewFDInt32 ::+    Review a Int32+  reviewFDInt32 =+    reviewFD+      . iso+        (\(CInt x) -> x)+        CInt++-- |+--+-- >>> review reviewFD (3 :: FD) :: FD+-- 3+-- >>> review reviewFDInt32 7 :: FD+-- 7+instance ReviewFD FD where+  reviewFD = unto id+  {-# INLINE reviewFD #-}++-- | Type class for values with a prism into an @FD@.+--+-- >>> preview _FD (3 :: FD)+-- Just 3+class (ReviewFD a) => AsFD a where   _FD ::     Prism' a FD+  {-# INLINE _FDInt32 #-}   _FDInt32 ::     Prism' a Int32   _FDInt32 =-    _FD .-      iso+    _FD+      . iso         (\(CInt x) -> x)         CInt +-- |+--+-- >>> preview _FD (3 :: FD)+-- Just 3+-- >>> preview _FDInt32 (3 :: FD)+-- Just 3+-- >>> review _FDInt32 7 :: FD+-- 7 instance AsFD FD where   _FD =     id

@@ -1,28 +1,88 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.GroupID(-  HasGroupID(..)-, AsGroupID(..)-) where+module Control.Process.GroupID+  ( GroupID,+    GetGroupID (..),+    HasGroupID (..),+    ReviewGroupID (..),+    AsGroupID (..),+  )+where -import Control.Category(id)-import Control.Lens ( Lens', Prism' )-import System.Process.Internals ( GroupID )+import Control.Category (id)+import Control.Lens (Getter, Lens', Prism', Review, unto)+import System.Process.Internals (GroupID) -class HasGroupID a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens++-- | Type class for values that can be viewed as a @GroupID@.+--+-- >>> view getGroupID (42 :: GroupID)+-- 42+class GetGroupID a where+  getGroupID ::+    Getter a GroupID++-- |+--+-- >>> view getGroupID (42 :: GroupID)+-- 42+instance GetGroupID GroupID where+  getGroupID = id+  {-# INLINE getGroupID #-}++-- | Type class for values with a lens into a @GroupID@.+--+-- >>> view groupID (42 :: GroupID)+-- 42+class (GetGroupID a) => HasGroupID a where   groupID ::     Lens' a GroupID +-- |+--+-- >>> view groupID (42 :: GroupID)+-- 42+-- >>> set groupID 99 (42 :: GroupID)+-- 99 instance HasGroupID GroupID where   groupID =     id -class AsGroupID a where+-- | Type class for values that can be constructed from a @GroupID@.+--+-- >>> review reviewGroupID (42 :: GroupID) :: GroupID+-- 42+class ReviewGroupID a where+  reviewGroupID ::+    Review a GroupID++-- |+--+-- >>> review reviewGroupID (42 :: GroupID) :: GroupID+-- 42+instance ReviewGroupID GroupID where+  reviewGroupID = unto id+  {-# INLINE reviewGroupID #-}++-- | Type class for values with a prism into a @GroupID@.+--+-- >>> preview _GroupID (42 :: GroupID)+-- Just 42+class (ReviewGroupID a) => AsGroupID a where   _GroupID ::     Prism' a GroupID +-- |+--+-- >>> preview _GroupID (42 :: GroupID)+-- Just 42+-- >>> review _GroupID 42 :: GroupID+-- 42 instance AsGroupID GroupID where   _GroupID =     id

@@ -1,39 +1,113 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.Handle(-  HasHandle(..)-, AsHandle(..)-) where+module Control.Process.Handle+  ( Handle,+    GetHandle (..),+    HasHandle (..),+    ReviewHandle (..),+    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) )+import Control.Category (id)+import Control.Lens (Getter, Lens', Prism', Review, prism', unto)+import Data.Maybe (Maybe (Just, Nothing))+import System.IO (Handle)+import System.Process (StdStream (UseHandle)) -class HasHandle a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens+-- >>> import System.IO (stdin, stdout)+-- >>> import System.Process (StdStream(..))++-- | Type class for values that can be viewed as a @Handle@.+--+-- >>> view getHandle stdin+-- {handle: <stdin>}+class GetHandle a where+  getHandle ::+    Getter a Handle++-- |+--+-- >>> view getHandle stdin+-- {handle: <stdin>}+instance GetHandle Handle where+  getHandle = id+  {-# INLINE getHandle #-}++-- | Type class for values with a lens into a @Handle@.+--+-- >>> view handle stdin+-- {handle: <stdin>}+class (GetHandle a) => HasHandle a where   handle ::     Lens' a Handle +-- |+--+-- >>> view handle stdin+-- {handle: <stdin>} instance HasHandle Handle where   handle =     id -class AsHandle a where+-- | Type class for values that can be constructed from a @Handle@.+--+-- >>> review reviewHandle stdin :: Handle+-- {handle: <stdin>}+class ReviewHandle a where+  reviewHandle ::+    Review a Handle++-- |+--+-- >>> review reviewHandle stdin :: Handle+-- {handle: <stdin>}+instance ReviewHandle Handle where+  reviewHandle = unto id+  {-# INLINE reviewHandle #-}++-- |+--+-- >>> review reviewHandle stdout :: StdStream+-- UseHandle {handle: <stdout>}+instance ReviewHandle StdStream where+  reviewHandle = unto UseHandle+  {-# INLINE reviewHandle #-}++-- | Type class for values with a prism into a @Handle@.+--+-- >>> preview _Handle stdin+-- Just {handle: <stdin>}+class (ReviewHandle a) => AsHandle a where   _Handle ::     Prism' a Handle +-- |+--+-- >>> preview _Handle stdin+-- Just {handle: <stdin>} instance AsHandle Handle where   _Handle =     id +-- |+--+-- >>> preview _Handle (UseHandle stdout)+-- Just {handle: <stdout>}+-- >>> preview _Handle (Inherit :: StdStream)+-- Nothing+-- >>> review _Handle stdout :: StdStream+-- UseHandle {handle: <stdout>} instance AsHandle StdStream where   _Handle =     prism'       UseHandle-      (\case-        UseHandle a -> Just a-        _ -> Nothing+      ( \case+          UseHandle a -> Just a+          _ -> Nothing       )

@@ -1,44 +1,130 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.Pid(-  HasPid(..)-, AsPid(..)-) where+module Control.Process.Pid+  ( Pid,+    GetPid (..),+    HasPid (..),+    ReviewPid (..),+    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 )+import Control.Category (id, (.))+import Control.Lens (Getter, Lens', Prism', Review, iso, unto)+import Data.Int (Int32)+import System.Posix.Types (CPid (CPid))+import System.Process (Pid) -class HasPid a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens++-- | Type class for values that can be viewed as a @Pid@.+--+-- >>> view viewPid (CPid 42)+-- 42+class GetPid a where+  viewPid ::+    Getter a Pid+  {-# INLINE viewPidInt32 #-}+  viewPidInt32 ::+    Getter a Int32+  viewPidInt32 =+    viewPid+      . iso+        (\(CPid x) -> x)+        CPid++-- |+--+-- >>> view viewPid (CPid 42)+-- 42+-- >>> view viewPidInt32 (CPid 42)+-- 42+instance GetPid Pid where+  viewPid = id+  {-# INLINE viewPid #-}++-- | Type class for values with a lens into a @Pid@.+--+-- >>> view pid (CPid 42)+-- 42+class (GetPid a) => HasPid a where   pid ::     Lens' a Pid+  {-# INLINE pidInt32 #-}   pidInt32 ::     Lens' a Int32   pidInt32 =-    pid .-      iso+    pid+      . iso         (\(CPid x) -> x)         CPid +-- |+--+-- >>> view pid (CPid 42)+-- 42+-- >>> view pidInt32 (CPid 42)+-- 42+-- >>> set pidInt32 99 (CPid 42)+-- 99 instance HasPid Pid where   pid =     id -class AsPid a where+-- | Type class for values that can be constructed from a @Pid@.+--+-- >>> review reviewPid (CPid 42) :: Pid+-- 42+class ReviewPid a where+  reviewPid ::+    Review a Pid+  {-# INLINE reviewPidInt32 #-}+  reviewPidInt32 ::+    Review a Int32+  reviewPidInt32 =+    reviewPid+      . iso+        (\(CPid x) -> x)+        CPid++-- |+--+-- >>> review reviewPid (CPid 42) :: Pid+-- 42+-- >>> review reviewPidInt32 99 :: Pid+-- 99+instance ReviewPid Pid where+  reviewPid = unto id+  {-# INLINE reviewPid #-}++-- | Type class for values with a prism into a @Pid@.+--+-- >>> preview _Pid (CPid 42)+-- Just 42+class (ReviewPid a) => AsPid a where   _Pid ::     Prism' a Pid+  {-# INLINE _PidInt32 #-}   _PidInt32 ::     Prism' a Int32   _PidInt32 =-    _Pid .-      iso+    _Pid+      . iso         (\(CPid x) -> x)         CPid +-- |+--+-- >>> preview _Pid (CPid 42)+-- Just 42+-- >>> preview _PidInt32 (CPid 42)+-- Just 42+-- >>> review _PidInt32 99 :: Pid+-- 99 instance AsPid Pid where   _Pid =     id

@@ -1,143 +1,155 @@-{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.Process(-  module Process-, readCreateProcessWithExitCode-, readProcessWithExitCode-, waitForProcess-, getProcessExitCode-, getProcessExitCodeBool-) where+module Control.Process.Process+  ( module Process,+    readCreateProcessWithExitCode,+    readProcessWithExitCode,+    waitForProcess,+    getProcessExitCode,+    getProcessExitCodeBool,+    getPid,+  )+where -import Control.Applicative ( Applicative(pure) )-import Control.Category ( Category((.)) )-import Control.Exception ( Exception )+import Control.Applicative (Applicative (pure))+import Control.Category (Category ((.)))+import Control.Exception (Exception) import Control.Exitcode-    ( ExitcodeT,-      fromExitCode',-      liftExitcode,-      hoistExitcode,-      tryExitcode,-      _Exitcode1,-      liftTryExitcode )-import Control.Lens ( Identity(runIdentity), set )-import Control.Monad ( Monad((>>=)) )-import Control.Monad.Except ( ExceptT(..) )-import Data.Bifunctor ( Bifunctor(bimap) )-import Data.Bool ( Bool )-import Data.Maybe ( Maybe(..), isJust, maybe )-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+  ( Exitcode,+    bimapExitcode,+    fromExitCode',+    hoistExitcode,+    liftTryExitcode,+    mkExitSuccess,+    tryExitcode,   )-import qualified System.Process as P(readCreateProcessWithExitCode, readProcessWithExitCode, waitForProcess, getProcessExitCode)+import Control.Monad (Monad ((>>=)))+import Control.Monad.Except (ExceptT (..))+import Data.Bool (Bool)+import Data.Function (const)+import Data.Functor.Identity (runIdentity)+import Data.Maybe (Maybe (..), isJust, maybe)+import Data.String (String)+import System.FilePath (FilePath)+import System.IO (IO)+import System.Process as Process+  ( CmdSpec (..),+    CreateProcess (),+    Pid,+    ProcessHandle,+    StdStream (..),+    callCommand,+    callProcess,+    cleanupProcess,+    createPipe,+    createPipeFd,+    createProcess,+    createProcess_,+    getCurrentPid,+    interruptProcessGroupOf,+    proc,+    readCreateProcess,+    readProcess,+    shell,+    showCommandForUser,+    spawnProcess,+    terminateProcess,+    withCreateProcess,+  )+import qualified System.Process as P (getProcessExitCode, getPid, readCreateProcessWithExitCode, readProcessWithExitCode, waitForProcess) +getPid :: ProcessHandle -> IO (Maybe Pid)+getPid = P.getPid+ -- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it -- lets you pass 'CreateProcess' giving better flexibility. -- -- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess -- record will be ignored.+{-# INLINE readCreateProcessWithExitCode #-} readCreateProcessWithExitCode ::-  Exception e' =>-  CreateProcess-  -> String -- ^ standard input-  -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) -- ^ exitcode, stdout, stderr+  (Exception e') =>+  CreateProcess ->+  -- | standard input+  String ->+  -- | exitcode, stdout, stderr+  Exitcode (String, String) (ExceptT e' IO) (String, String) readCreateProcessWithExitCode p a =-  tryExitcode (liftExitcode (P.readCreateProcessWithExitCode p a)) >>= \(x, y, z) ->-    hoistExitcode (pure . runIdentity) (set _Exitcode1 (y, z) (fromExitCode' x))+  tryExitcode (mkExitSuccess (P.readCreateProcessWithExitCode p a)) >>= \(x, y, z) ->+    hoistExitcode (pure . runIdentity) (bimapExitcode (const (y, z)) (const (y, z)) (fromExitCode' x)) +{-# INLINE readProcessWithExitCode #-} readProcessWithExitCode ::-  Exception e' =>-  FilePath -- ^ Filename of the executable (see 'RawCommand' for details)-  -> [String] -- ^ any arguments-  -> String -- ^ standard input-  -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) -- ^ exitcode, stdout, stderr+  (Exception e') =>+  -- | Filename of the executable (see 'RawCommand' for details)+  FilePath ->+  -- | any arguments+  [String] ->+  -- | standard input+  String ->+  -- | exitcode, stdout, stderr+  Exitcode (String, String) (ExceptT e' IO) (String, String) readProcessWithExitCode p a i =-  tryExitcode (liftExitcode (P.readProcessWithExitCode p a i)) >>= \(x, y, z) ->-    hoistExitcode (pure . runIdentity) (set _Exitcode1 (y, z) (fromExitCode' x))--{- | Waits for the specified process to terminate, and returns its exit code.-On Unix systems, may throw 'UserInterrupt' when using 'delegate_ctlc'.--GHC Note: in order to call @waitForProcess@ without blocking all the-other threads in the system, you must compile the program with-@-threaded@.--Note that it is safe to call @waitForProcess@ for the same process in multiple-threads. When the process ends, threads blocking on this call will wake in-FIFO order. When using 'delegate_ctlc' and the process is interrupted, only-the first waiting thread will throw 'UserInterrupt'.--(/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@-indicates that the child was terminated by signal @/signum/@.-The signal numbers are platform-specific, so to test for a specific signal use-the constants provided by "System.Posix.Signals" in the @unix@ package.-Note: core dumps are not reported, use "System.Posix.Process" if you need this-detail.+  tryExitcode (mkExitSuccess (P.readProcessWithExitCode p a i)) >>= \(x, y, z) ->+    hoistExitcode (pure . runIdentity) (bimapExitcode (const (y, z)) (const (y, z)) (fromExitCode' x)) --}+-- | Waits for the specified process to terminate, and returns its exit code.+-- On Unix systems, may throw 'UserInterrupt' when using 'delegate_ctlc'.+--+-- GHC Note: in order to call @waitForProcess@ without blocking all the+-- other threads in the system, you must compile the program with+-- @-threaded@.+--+-- Note that it is safe to call @waitForProcess@ for the same process in multiple+-- threads. When the process ends, threads blocking on this call will wake in+-- FIFO order. When using 'delegate_ctlc' and the process is interrupted, only+-- the first waiting thread will throw 'UserInterrupt'.+--+-- (/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@+-- indicates that the child was terminated by signal @/signum/@.+-- The signal numbers are platform-specific, so to test for a specific signal use+-- the constants provided by "System.Posix.Signals" in the @unix@ package.+-- Note: core dumps are not reported, use "System.Posix.Process" if you need this+-- detail.+{-# INLINE waitForProcess #-} waitForProcess ::-  Exception e' =>-  ProcessHandle-  -> ExitcodeT (ExceptT e' IO) () ()+  (Exception e') =>+  ProcessHandle ->+  Exitcode () (ExceptT e' IO) () waitForProcess h =-  tryExitcode (liftExitcode (P.waitForProcess h)) >>= \x ->+  tryExitcode (mkExitSuccess (P.waitForProcess h)) >>= \x ->     hoistExitcode (pure . runIdentity) (fromExitCode' x) -{- |-This is a non-blocking version of 'waitForProcess'.  If the process is-still running, 'Nothing' is returned.  If the process has exited, then-@'Just' e@ is returned where @e@ is the exit code of the process.--On Unix systems, see 'waitForProcess' for the meaning of exit codes-when the process died as the result of a signal. May throw-'UserInterrupt' when using 'delegate_ctlc'.--}+-- |+-- This is a non-blocking version of 'waitForProcess'.  If the process is+-- still running, 'Nothing' is returned.  If the process has exited, then+-- @'Just' e@ is returned where @e@ is the exit code of the process.+--+-- On Unix systems, see 'waitForProcess' for the meaning of exit codes+-- when the process died as the result of a signal. May throw+-- 'UserInterrupt' when using 'delegate_ctlc'.+{-# INLINE getProcessExitCode #-} getProcessExitCode ::-  Exception e' =>-  ProcessHandle-  -> ExitcodeT (ExceptT e' IO) (Maybe ()) (Maybe ())+  (Exception e') =>+  ProcessHandle ->+  Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ()) getProcessExitCode h =-  liftTryExitcode (P.getProcessExitCode h) >>=-    maybe (pure Nothing) (hoistExitcode (pure . runIdentity) . set _Exitcode1 (Just ()) . fromExitCode')--{- |-This is a non-blocking version of 'waitForProcess'.  If the process is-still running, 'Nothing' is returned.  If the process has exited, then-@'Just' e@ is returned where @e@ is the exit code of the process.+  liftTryExitcode (P.getProcessExitCode h)+    >>= maybe (pure Nothing) (hoistExitcode (pure . runIdentity) . bimapExitcode (const (Just ())) (const (Just ())) . fromExitCode') -On Unix systems, see 'waitForProcess' for the meaning of exit codes-when the process died as the result of a signal. May throw-'UserInterrupt' when using 'delegate_ctlc'.--}+-- |+-- This is a non-blocking version of 'waitForProcess'.  If the process is+-- still running, 'Nothing' is returned.  If the process has exited, then+-- @'Just' e@ is returned where @e@ is the exit code of the process.+--+-- On Unix systems, see 'waitForProcess' for the meaning of exit codes+-- when the process died as the result of a signal. May throw+-- 'UserInterrupt' when using 'delegate_ctlc'.+{-# INLINE getProcessExitCodeBool #-} getProcessExitCodeBool ::-  Exception e' =>-  ProcessHandle-  -> ExitcodeT (ExceptT e' IO) Bool Bool-getProcessExitCodeBool =-  bimap isJust isJust . getProcessExitCode+  (Exception e') =>+  ProcessHandle ->+  Exitcode Bool (ExceptT e' IO) Bool+getProcessExitCodeBool h =+  bimapExitcode isJust isJust (getProcessExitCode h)

@@ -1,16 +1,30 @@-{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.ProcessHandle(-  HasProcessHandle(..)-, AsProcessHandle(..)-) where+module Control.Process.ProcessHandle+  ( ProcessHandle,+    GetProcessHandle (..),+    HasProcessHandle (..),+    ReviewProcessHandle (..),+    AsProcessHandle (..),+  )+where -import Control.Category(id)-import System.Process ( ProcessHandle )-import Control.Lens ( Lens', Prism' )+import Control.Category (id)+import Control.Lens (Getter, Lens', Prism', Review, unto)+import System.Process (ProcessHandle) -class HasProcessHandle a where+-- | Type class for values that can be viewed as a @ProcessHandle@.+class GetProcessHandle a where+  getProcessHandle ::+    Getter a ProcessHandle++instance GetProcessHandle ProcessHandle where+  getProcessHandle = id+  {-# INLINE getProcessHandle #-}++-- | Type class for values with a lens into a @ProcessHandle@.+class (GetProcessHandle a) => HasProcessHandle a where   processHandle ::     Lens' a ProcessHandle @@ -18,7 +32,17 @@   processHandle =     id -class AsProcessHandle a where+-- | Type class for values that can be constructed from a @ProcessHandle@.+class ReviewProcessHandle a where+  reviewProcessHandle ::+    Review a ProcessHandle++instance ReviewProcessHandle ProcessHandle where+  reviewProcessHandle = unto id+  {-# INLINE reviewProcessHandle #-}++-- | Type class for values with a prism into a @ProcessHandle@.+class (ReviewProcessHandle a) => AsProcessHandle a where   _ProcessHandle ::     Prism' a ProcessHandle 

@@ -1,63 +1,155 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.StdStream(-  StdStream(..)-, AsStdStream(..)-, HasStdStream(..)-) where+module Control.Process.StdStream+  ( StdStream (..),+    GetStdStream (..),+    HasStdStream (..),+    ReviewStdStream (..),+    AsStdStream (..),+  )+where -import Control.Category ( Category(id, (.)) )-import Control.Lens ( prism', Lens', Prism' )-import Data.Maybe ( Maybe(Nothing, Just) )-import System.Process ( StdStream(..) )+import Control.Category (id, (.))+import Control.Lens (Getter, Lens', Prism', Review, prism', unto)+import Data.Maybe (Maybe (Just, Nothing))+import System.IO (Handle)+import System.Process (StdStream (..)) -class AsStdStream a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens+-- >>> import System.IO (stdin, stdout)++-- | Type class for values that can be viewed as a @StdStream@.+--+-- >>> view getStdStream Inherit+-- Inherit+class GetStdStream a where+  getStdStream ::+    Getter a StdStream++-- |+--+-- >>> view getStdStream Inherit+-- Inherit+instance GetStdStream StdStream where+  getStdStream = id+  {-# INLINE getStdStream #-}++-- | Type class for values with a lens into a @StdStream@.+--+-- >>> view stdStream Inherit+-- Inherit+class (GetStdStream a) => HasStdStream a where+  stdStream ::+    Lens' a StdStream++-- |+--+-- >>> view stdStream Inherit+-- Inherit+-- >>> set stdStream CreatePipe Inherit+-- CreatePipe+instance HasStdStream StdStream where+  stdStream =+    id++-- | Type class for values that can be constructed from a @StdStream@.+--+-- >>> review reviewStdStream Inherit :: StdStream+-- Inherit+class ReviewStdStream a where+  reviewStdStream ::+    Review a StdStream++-- |+--+-- >>> review reviewStdStream Inherit :: StdStream+-- Inherit+instance ReviewStdStream StdStream where+  reviewStdStream = unto id+  {-# INLINE reviewStdStream #-}++-- | Type class for values with a prism into a @StdStream@.+--+-- >>> preview _StdStream Inherit+-- Just Inherit+class (ReviewStdStream a) => AsStdStream a where   _StdStream ::     Prism' a StdStream+  {-# INLINE _Inherit #-}   _Inherit ::     Prism' a ()   _Inherit =     _StdStream . _Inherit+  {-# INLINE _CreatePipe #-}   _CreatePipe ::     Prism' a ()   _CreatePipe =     _StdStream . _CreatePipe+  {-# INLINE _UseHandle #-}+  _UseHandle ::+    Prism' a Handle+  _UseHandle =+    _StdStream . _UseHandle+  {-# INLINE _NoStream #-}   _NoStream ::     Prism' a ()   _NoStream =     _StdStream . _NoStream +-- |+--+-- >>> preview _Inherit Inherit+-- Just ()+-- >>> preview _Inherit CreatePipe+-- Nothing+-- >>> preview _CreatePipe CreatePipe+-- Just ()+-- >>> preview _UseHandle (UseHandle stdout)+-- Just {handle: <stdout>}+-- >>> preview _UseHandle Inherit+-- Nothing+-- >>> preview _NoStream NoStream+-- Just ()+-- >>> review _Inherit () :: StdStream+-- Inherit+-- >>> review _CreatePipe () :: StdStream+-- CreatePipe+-- >>> review _UseHandle stdout :: StdStream+-- UseHandle {handle: <stdout>}+-- >>> review _NoStream () :: StdStream+-- NoStream instance AsStdStream StdStream where   _StdStream =     id   _Inherit =     prism'       (\() -> Inherit)-      (\case-        Inherit -> Just ()-        _ -> Nothing+      ( \case+          Inherit -> Just ()+          _ -> Nothing       )   _CreatePipe =     prism'       (\() -> CreatePipe)-      (\case-        CreatePipe -> Just ()-        _ -> Nothing+      ( \case+          CreatePipe -> Just ()+          _ -> Nothing       )+  _UseHandle =+    prism'+      UseHandle+      ( \case+          UseHandle a -> Just a+          _ -> Nothing+      )   _NoStream =     prism'       (\() -> NoStream)-      (\case-        NoStream -> Just ()-        _ -> Nothing+      ( \case+          NoStream -> Just ()+          _ -> Nothing       )--class HasStdStream a where-  stdStream ::-    Lens' a StdStream--instance HasStdStream StdStream where-  stdStream =-    id

@@ -1,44 +1,130 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Control.Process.UserID(-  HasUserID(..)-, AsUserID(..)-) where+module Control.Process.UserID+  ( UserID,+    GetUserID (..),+    HasUserID (..),+    ReviewUserID (..),+    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 )+import Control.Category (id, (.))+import Control.Lens (Getter, Lens', Prism', Review, iso, unto)+import Data.Word (Word32)+import System.Posix.Types (CUid (CUid))+import System.Process.Internals (UserID) -class HasUserID a where+-- $setup+-- >>> import Prelude+-- >>> import Control.Lens++-- | Type class for values that can be viewed as a @UserID@.+--+-- >>> view getUserID (CUid 1000)+-- 1000+class GetUserID a where+  getUserID ::+    Getter a UserID+  {-# INLINE getUserIDWord32 #-}+  getUserIDWord32 ::+    Getter a Word32+  getUserIDWord32 =+    getUserID+      . iso+        (\(CUid x) -> x)+        CUid++-- |+--+-- >>> view getUserID (CUid 1000)+-- 1000+-- >>> view getUserIDWord32 (CUid 1000)+-- 1000+instance GetUserID UserID where+  getUserID = id+  {-# INLINE getUserID #-}++-- | Type class for values with a lens into a @UserID@.+--+-- >>> view userID (CUid 1000)+-- 1000+class (GetUserID a) => HasUserID a where   userID ::     Lens' a UserID+  {-# INLINE userIDWord32 #-}   userIDWord32 ::     Lens' a Word32   userIDWord32 =-    userID .-      iso+    userID+      . iso         (\(CUid x) -> x)         CUid +-- |+--+-- >>> view userID (CUid 1000)+-- 1000+-- >>> view userIDWord32 (CUid 1000)+-- 1000+-- >>> set userIDWord32 0 (CUid 1000)+-- 0 instance HasUserID UserID where   userID =     id -class AsUserID a where+-- | Type class for values that can be constructed from a @UserID@.+--+-- >>> review reviewUserID (CUid 1000) :: UserID+-- 1000+class ReviewUserID a where+  reviewUserID ::+    Review a UserID+  {-# INLINE reviewUserIDWord32 #-}+  reviewUserIDWord32 ::+    Review a Word32+  reviewUserIDWord32 =+    reviewUserID+      . iso+        (\(CUid x) -> x)+        CUid++-- |+--+-- >>> review reviewUserID (CUid 1000) :: UserID+-- 1000+-- >>> review reviewUserIDWord32 42 :: UserID+-- 42+instance ReviewUserID UserID where+  reviewUserID = unto id+  {-# INLINE reviewUserID #-}++-- | Type class for values with a prism into a @UserID@.+--+-- >>> preview _UserID (CUid 1000)+-- Just 1000+class (ReviewUserID a) => AsUserID a where   _UserID ::     Prism' a UserID+  {-# INLINE _UserIDWord32 #-}   _UserIDWord32 ::     Prism' a Word32   _UserIDWord32 =-    _UserID .-      iso+    _UserID+      . iso         (\(CUid x) -> x)         CUid +-- |+--+-- >>> preview _UserID (CUid 1000)+-- Just 1000+-- >>> preview _UserIDWord32 (CUid 1000)+-- Just 1000+-- >>> review _UserIDWord32 42 :: UserID+-- 42 instance AsUserID UserID where   _UserID =     id

@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}++module Main (main) where++import System.Exit (exitWith)+import System.Process (rawSystem)++main :: IO ()+main =+  exitWith+    =<< rawSystem+      "cabal"+      [ "repl",+        "--with-compiler=doctest",+        "--repl-options=-w",+        "--repl-options=-Wdefault",+        "lib:exitcode"+      ]

@@ -1,127 +0,0 @@-import           Control.Lens              (review, (^.), (^?))-import           Control.Monad.Trans.Maybe (MaybeT (MaybeT))-import           Data.Functor.Classes      (Eq1)-import           Data.Functor.Identity     (Identity (..), runIdentity)-import           Data.Monoid               ((<>))--import           Hedgehog                  (forAll, property, (===))-import qualified Hedgehog.Gen              as Gen-import           Hedgehog.Internal.Gen     (MonadGen)-import qualified Hedgehog.Range            as Range-import           Test.QuickCheck           (Arbitrary)-import           Test.QuickCheck.Checkers  (EqProp (..), Test, TestBatch, eq)-import           Test.QuickCheck.Classes   (applicative, functor)-import           Test.Tasty                (TestTree, defaultMain, testGroup)-import           Test.Tasty.Hedgehog       (testProperty)-import           Test.Tasty.HUnit          (testCase, (@?=))-import qualified Test.Tasty.QuickCheck     as TQC--import           Control.Exitcode          (Exitcode, ExitcodeT, exitCode,-                                            exitfailure0, exitsuccess,-                                            exitsuccess0, runExitcode,-                                            runExitcodeT, _ExitFailure,-                                            _ExitSuccess, ExitcodeT0)--import           System.Exit               (ExitCode (..))--newtype EW f e a = EW { unEW :: ExitcodeT f e a } deriving (Eq, Show)--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 e) where-  fmap f = EW . fmap f . unEW--instance Monad f => Applicative (EW f e) where-  pure = EW . pure-  EW f <*> EW a = EW (f <*> a)--instance (Eq1 f, Eq e, Eq a) => EqProp (EW f e a) where-  (=-=) = eq--type CheckMe = EW [] String (Integer, Integer, Integer)--nonZero :: MonadGen m => m Int-nonZero =-  let allOfTheInts = Range.linear (minBound :: Int) (maxBound :: Int)-   in Gen.filter (/= 0) (Gen.int allOfTheInts)--main :: IO ()-main = defaultMain test_Exitcode--test_Exitcode :: TestTree-test_Exitcode =-  testGroup "Exitcode" [-    tastyCheckersBatch $ functor (undefined :: CheckMe)-  , tastyCheckersBatch $ applicative (undefined :: CheckMe)-  , applicativeTest-  , exitFailureTraversalTest-  , exitSuccessPrismTest-  , exitfailure0Test-  , exitCodePrismTest-  ]--applicativeTest :: TestTree-applicativeTest =-  testGroup "Applicative" [-    testCase "Sticks to the Right" $-      pure (<> "bar") <*> pure "foo" @?= (exitsuccess "foobar" :: Exitcode String String)-  ]--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 :: ExitcodeT0 Identity) ^? _ExitFailure @?= Nothing-  ]--exitSuccessPrismTest :: TestTree-exitSuccessPrismTest =-  testGroup "_ExitSuccess Prism" [-    testCase "review" $-      review _ExitSuccess () @?= (exitsuccess0 :: ExitcodeT Identity () ())-  , testCase "view exitsuccess0" $-      (exitsuccess0 :: ExitcodeT Identity () ()) ^? _ExitSuccess @?= Just ()-  , testProperty "view exitfailure0 non-zero" . property $-      forAll nonZero >>= (\n -> exitfailure0 n ^? _ExitSuccess === Nothing)-  , testCase "view exitfailure0 0" $-      exitfailure0 0 ^? _ExitSuccess @?= Just ()-  ]--exitfailure0Test :: TestTree-exitfailure0Test =-  testGroup "exitfailure0" [-    testProperty "non-zero input" . property $-      forAll nonZero >>= (\n ->-        runExitcode (exitfailure0 n) === Left ((), n))-  , testCase "0" $-      runExitcode (exitfailure0 0) @?= Right ()-  ]--exitCodePrismTest :: TestTree-exitCodePrismTest =-  testGroup "exitCode Prism" [-    testProperty "`exitfailure0 n`, where n is non-zero" . property $-      forAll nonZero >>= \n -> (review exitCode (exitfailure0 n)) === Identity (ExitFailure n)-  , testCase "review `exitfailure 0`" $-      runIdentity (review exitCode (exitfailure0 0)) @?= ExitSuccess-  , testCase "review `exitsuccess0`" $-      runIdentity (review exitCode exitsuccess0) @?= ExitSuccess-  , testProperty "view ExitFailure n, where n is non-zero" . property $-      forAll nonZero >>= (\n -> Identity (ExitFailure n) ^? exitCode === Just (exitfailure0 n))-  , testCase "view ExitFailure 0" $-      let _ = ""-      in  runExitcodeT (Identity (ExitFailure 0) ^. exitCode) @?= (MaybeT (Identity Nothing))-  , testCase "view ExitSuccess" $-      Identity ExitSuccess ^? exitCode @?= Just exitsuccess0-  ]--tastyCheckersBatch :: TestBatch -> TestTree-tastyCheckersBatch (name, tests) =-  testGroup (name <> " laws") (tastyCheckersProperty <$> tests)--tastyCheckersProperty :: Test -> TestTree-tastyCheckersProperty =-  uncurry TQC.testProperty