{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
-- |
-- Module       : System.Process.Lens.StdStream
-- Copyright 	: (c) 2019-2021 Emily Pillmore
-- License	: BSD
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: TypeFamilies, Rank2Types
--
-- This module provides the associated optics and combinators
-- for working with 'StdStream' objects. 'StdStream' consists of four
-- cases, for which we provide prisms and classy variants.
--
module System.Process.Lens.StdStream
( -- * Prisms
  _Inherit
, _UseHandle
, _CreatePipe
, _NoStream
  -- * Classy Prisms
, AsInherit(..)
, AsUseHandle(..)
, AsCreatePipe(..)
, AsNoStream(..)
  -- * Combinators
, usehandleOf
, inheriting
, piping
, handling
, nostreaming
) where

import Control.Lens

import System.IO (Handle)
import System.Process


-- $setup
-- >>> import Control.Lens
-- >>> import qualified System.IO as System (stdin, stdout)
-- >>> import System.Process
-- >>> :set -XTypeApplications
-- >>> :set -XRank2Types

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

-- | A 'Prism'' into the 'Inherit' structure of a 'StdStream'
--
-- Examples:
--
-- >>> _Inherit # ()
-- Inherit
--
_Inherit :: Prism' StdStream ()
_Inherit :: p () (f ()) -> p StdStream (f StdStream)
_Inherit = (() -> StdStream)
-> (StdStream -> Maybe ()) -> Prism StdStream StdStream () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (StdStream -> () -> StdStream
forall a b. a -> b -> a
const StdStream
Inherit) ((StdStream -> Maybe ()) -> Prism StdStream StdStream () ())
-> (StdStream -> Maybe ()) -> Prism StdStream StdStream () ()
forall a b. (a -> b) -> a -> b
$ \case
  StdStream
Inherit -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  StdStream
_ -> Maybe ()
forall a. Maybe a
Nothing

-- | A 'Prism'' into the 'UseHandle' structure's Handle for a 'StdStream'
--
-- Examples:
--
--
-- >>> _UseHandle # System.stdin
-- UseHandle {handle: <stdin>}
--
_UseHandle :: Prism' StdStream Handle
_UseHandle :: p Handle (f Handle) -> p StdStream (f StdStream)
_UseHandle = (Handle -> StdStream)
-> (StdStream -> Maybe Handle)
-> Prism StdStream StdStream Handle Handle
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Handle -> StdStream
UseHandle ((StdStream -> Maybe Handle)
 -> Prism StdStream StdStream Handle Handle)
-> (StdStream -> Maybe Handle)
-> Prism StdStream StdStream Handle Handle
forall a b. (a -> b) -> a -> b
$ \case
  UseHandle Handle
t -> Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
t
  StdStream
_ -> Maybe Handle
forall a. Maybe a
Nothing

-- | A 'Prism'' into the 'CreatePipe' structure of a 'StdStream'
--
-- Examples:
--
-- >>> _CreatePipe # ()
-- CreatePipe
--
_CreatePipe :: Prism' StdStream ()
_CreatePipe :: p () (f ()) -> p StdStream (f StdStream)
_CreatePipe = (() -> StdStream)
-> (StdStream -> Maybe ()) -> Prism StdStream StdStream () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (StdStream -> () -> StdStream
forall a b. a -> b -> a
const StdStream
CreatePipe) ((StdStream -> Maybe ()) -> Prism StdStream StdStream () ())
-> (StdStream -> Maybe ()) -> Prism StdStream StdStream () ()
forall a b. (a -> b) -> a -> b
$ \case
  StdStream
CreatePipe -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  StdStream
_ -> Maybe ()
forall a. Maybe a
Nothing

-- | A prism into the 'NoStream' structure of a 'StdStream'
--
-- Examples:
--
-- >>> _NoStream # ()
-- NoStream
--
_NoStream :: Prism' StdStream ()
_NoStream :: p () (f ()) -> p StdStream (f StdStream)
_NoStream = (() -> StdStream)
-> (StdStream -> Maybe ()) -> Prism StdStream StdStream () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (StdStream -> () -> StdStream
forall a b. a -> b -> a
const StdStream
NoStream) ((StdStream -> Maybe ()) -> Prism StdStream StdStream () ())
-> (StdStream -> Maybe ()) -> Prism StdStream StdStream () ()
forall a b. (a -> b) -> a -> b
$ \case
  StdStream
NoStream -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  StdStream
_ -> Maybe ()
forall a. Maybe a
Nothing

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

-- | Class constraint proving a type has a prism into an 'Inherit'
-- structure. Any 'StdStream' will have a prism into `Inherit' -
-- it is just an overwrite to 'Inherit'
--
class AsInherit a where
  _Inherits :: Prism' a ()
  {-# MINIMAL _Inherits #-}

instance AsInherit StdStream where
  _Inherits :: p () (f ()) -> p StdStream (f StdStream)
_Inherits = p () (f ()) -> p StdStream (f StdStream)
Prism StdStream StdStream () ()
_Inherit
  {-# inline _Inherits #-}

-- | Class constraint proving a type has a prism into a 'Handle' via
-- a 'UseHandle' structure.
--
class AsUseHandle a where
  _UsesHandle :: Prism' a Handle
  {-# MINIMAL _UsesHandle #-}

instance AsUseHandle StdStream where
  _UsesHandle :: p Handle (f Handle) -> p StdStream (f StdStream)
_UsesHandle = p Handle (f Handle) -> p StdStream (f StdStream)
Prism StdStream StdStream Handle Handle
_UseHandle
  {-# inline _UsesHandle #-}

-- | Class constraint proving a type has a prism into a 'Handle' via
-- a 'UseHandle' structure. Any 'StdStream' will have a prism into
-- 'CreatePipe' - it is just an overwrite to 'CreatePipe'
--
class AsCreatePipe a where
  _CreatesPipe :: Prism' a ()
  {-# MINIMAL _CreatesPipe #-}

instance AsCreatePipe StdStream where
  _CreatesPipe :: p () (f ()) -> p StdStream (f StdStream)
_CreatesPipe = p () (f ()) -> p StdStream (f StdStream)
Prism StdStream StdStream () ()
_CreatePipe
  {-# inline _CreatesPipe #-}

-- | Class constraint proving a type has a prism into a 'Handle' via
-- a 'UseHandle' structure. Any 'StdStream' will have a prism into
-- 'NoStream' - it is just an overwrite to 'NoStream'.
--
class AsNoStream a where
  _NoStreams :: Prism' a ()
  {-# MINIMAL _NoStreams #-}

instance AsNoStream StdStream where
  _NoStreams :: p () (f ()) -> p StdStream (f StdStream)
_NoStreams = p () (f ()) -> p StdStream (f StdStream)
Prism StdStream StdStream () ()
_NoStream
  {-# inline _NoStreams #-}

-- ---------------------------------------------------------- --
-- Combinators

-- | Inject a handle into something with a prism into the handle
--
-- Examples:
--
-- >>> usehandleOf @StdStream System.stdin
-- UseHandle {handle: <stdin>}
--
usehandleOf :: AsUseHandle a => Handle -> a
usehandleOf :: Handle -> a
usehandleOf = AReview a Handle -> Handle -> a
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview a Handle
forall a. AsUseHandle a => Prism' a Handle
_UsesHandle
{-# inline usehandleOf #-}

-- | Given a lens into a 'StdStream', overwrite to 'Inherit' so that
-- the stream inherits from its parent process
--
-- Examples:
--
-- >>> inheriting id CreatePipe
-- Inherit
--
inheriting :: Lens' a StdStream -> a -> a
inheriting :: Lens' a StdStream -> a -> a
inheriting Lens' a StdStream
l = ASetter a a StdStream StdStream -> StdStream -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter a a StdStream StdStream
Lens' a StdStream
l StdStream
Inherit
{-# inline inheriting #-}

-- | Given a lens into a 'StdStream', overwrite to 'CreatePipe'.
--
-- Examples:
--
-- >>> piping id NoStream
-- CreatePipe
--
piping :: Lens' a StdStream -> a -> a
piping :: Lens' a StdStream -> a -> a
piping Lens' a StdStream
l = ASetter a a StdStream StdStream -> StdStream -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter a a StdStream StdStream
Lens' a StdStream
l StdStream
CreatePipe
{-# inline piping #-}

-- | Given a lens into a 'StdStream' and a handle, set the handle using
-- 'UseHandle'. Note that this is the only really interesting case for anything
-- with a lens into a handle inculding 'StdStream'.
--
-- Examples:
--
--
-- >>> handling id System.stdin $ UseHandle System.stdout
-- UseHandle {handle: <stdin>}
--
-- >>> handling id System.stdin NoStream
-- NoStream
--
-- >>> handling id System.stdin Inherit
-- Inherit
--
handling :: Lens' a StdStream -> Handle -> a -> a
handling :: Lens' a StdStream -> Handle -> a -> a
handling Lens' a StdStream
l = ASetter a a Handle Handle -> Handle -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ((StdStream -> Identity StdStream) -> a -> Identity a
Lens' a StdStream
l ((StdStream -> Identity StdStream) -> a -> Identity a)
-> ((Handle -> Identity Handle) -> StdStream -> Identity StdStream)
-> ASetter a a Handle Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> Identity Handle) -> StdStream -> Identity StdStream
Prism StdStream StdStream Handle Handle
_UseHandle)
{-# inline handling #-}

-- | Given a lens into a 'StdStream', set to 'NoStream'
--
-- Examples:
--
-- >>> nostreaming id Inherit
-- NoStream
--
nostreaming :: Lens' a StdStream -> a -> a
nostreaming :: Lens' a StdStream -> a -> a
nostreaming Lens' a StdStream
l = ASetter a a StdStream StdStream -> StdStream -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter a a StdStream StdStream
Lens' a StdStream
l StdStream
NoStream
{-# inline nostreaming #-}