{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
-- |
-- Module       : System.Process.Microlens.StdStream
-- Copyright 	: 2019 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 traversals for each case
--
module System.Process.Microlens.StdStream
( -- * Traversals
  _Inherit
, _UseHandle
, _CreatePipe
, _NoStream
  -- * Classy Traversals
, IsCreatePipe(..)
, IsInherit(..)
, IsUseHandle(..)
, IsNoStream(..)
  -- * Combinators
, inheriting
, piping
, handling
, nostreaming
) where


import Control.Applicative

import Lens.Micro

import System.IO (Handle)
import System.Process


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

-- ---------------------------------------------------------- --
-- Traversals

-- | A 'Traversal'' into the 'Inherit' structure of a 'StdStream'
--
_Inherit :: Traversal' StdStream StdStream
_Inherit :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_Inherit f :: StdStream -> f StdStream
f s :: StdStream
s = case StdStream
s of
  Inherit -> StdStream -> f StdStream
f StdStream
s
  _ -> StdStream -> f StdStream
forall (f :: * -> *) a. Applicative f => a -> f a
pure StdStream
s

-- | A 'Traversal'' into the 'UseHandle' structure's Handle for a 'StdStream'
--
_UseHandle :: Traversal' StdStream Handle
_UseHandle :: (Handle -> f Handle) -> StdStream -> f StdStream
_UseHandle f :: Handle -> f Handle
f s :: StdStream
s = case StdStream
s of
  UseHandle h :: Handle
h -> (Handle -> StdStream) -> f Handle -> f StdStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Handle -> StdStream
UseHandle (Handle -> f Handle
f Handle
h)
  _ -> StdStream -> f StdStream
forall (f :: * -> *) a. Applicative f => a -> f a
pure StdStream
s

-- | A 'Traversal'' into the 'CreatePipe' structure of a 'StdStream'
--
_CreatePipe :: Traversal' StdStream StdStream
_CreatePipe :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_CreatePipe f :: StdStream -> f StdStream
f s :: StdStream
s = case StdStream
s of
  CreatePipe -> StdStream -> f StdStream
f StdStream
s
  _ -> StdStream -> f StdStream
forall (f :: * -> *) a. Applicative f => a -> f a
pure StdStream
s

-- | A 'Traversal'' into the 'NoStream' structure of a 'StdStream'
--
_NoStream :: Traversal' StdStream StdStream
_NoStream :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_NoStream f :: StdStream -> f StdStream
f s :: StdStream
s = case StdStream
s of
  NoStream -> StdStream -> f StdStream
f StdStream
s
  _ -> StdStream -> f StdStream
forall (f :: * -> *) a. Applicative f => a -> f a
pure StdStream
s

-- ---------------------------------------------------------- --
-- 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 IsInherit a where
  _Inherits :: Traversal' a StdStream
  {-# MINIMAL _Inherits #-}

instance IsInherit StdStream where
  _Inherits :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_Inherits = (StdStream -> f StdStream) -> StdStream -> f StdStream
Traversal' StdStream StdStream
_Inherit

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

instance IsUseHandle StdStream where
  _UsesHandle :: (Handle -> f Handle) -> StdStream -> f StdStream
_UsesHandle = (Handle -> f Handle) -> StdStream -> f StdStream
Traversal' StdStream Handle
_UseHandle

-- | 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 IsCreatePipe a where
  _CreatesPipe :: Traversal' a StdStream
  {-# MINIMAL _CreatesPipe #-}

instance IsCreatePipe StdStream where
  _CreatesPipe :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_CreatesPipe = (StdStream -> f StdStream) -> StdStream -> f StdStream
Traversal' StdStream StdStream
_CreatePipe

-- | 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 IsNoStream a where
  _NoStreams :: Traversal' a StdStream
  {-# MINIMAL _NoStreams #-}

instance IsNoStream StdStream where
  _NoStreams :: (StdStream -> f StdStream) -> StdStream -> f StdStream
_NoStreams = (StdStream -> f StdStream) -> StdStream -> f StdStream
Traversal' StdStream StdStream
_NoStream

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

-- | Given a lens into a 'StdStream', overwrite to 'Inherit' so that
-- the stream inherits from its parent process
--
-- Examples:
--
-- >>> inheriting ($) CreatePipe
-- Inherit
--
inheriting :: Lens' a StdStream -> a -> a
inheriting :: Lens' a StdStream -> a -> a
inheriting l :: 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

-- | Given a lens into a 'StdStream', overwrite to 'CreatePipe'.
--
-- Examples:
--
-- >>> piping ($) NoStream
-- CreatePipe
--
piping :: Lens' a StdStream -> a -> a
piping :: Lens' a StdStream -> a -> a
piping l :: 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

-- | 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 ($) System.stdin $ UseHandle System.stdout
-- UseHandle {handle: <stdin>}
--
-- >>> handling ($) System.stdout Inherit
-- UseHandle {handle: <stdout>}
--
handling :: Lens' a StdStream -> Handle -> a -> a
handling :: Lens' a StdStream -> Handle -> a -> a
handling l :: Lens' a StdStream
l h :: Handle
h = 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 (Handle -> StdStream
UseHandle Handle
h)

-- | Given a lens into a 'StdStream', set to 'NoStream'
--
-- Examples:
--
-- >>> nostreaming ($) Inherit
-- NoStream
--
nostreaming :: Lens' a StdStream -> a -> a
nostreaming :: Lens' a StdStream -> a -> a
nostreaming l :: 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