StdStream.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module Control.Process.StdStream
  ( StdStream (..),
    GetStdStream (..),
    HasStdStream (..),
    ReviewStdStream (..),
    AsStdStream (..),
  )
where

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 (..))

-- $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
      )
  _CreatePipe =
    prism'
      (\() -> CreatePipe)
      ( \case
          CreatePipe -> Just ()
          _ -> Nothing
      )
  _UseHandle =
    prism'
      UseHandle
      ( \case
          UseHandle a -> Just a
          _ -> Nothing
      )
  _NoStream =
    prism'
      (\() -> NoStream)
      ( \case
          NoStream -> Just ()
          _ -> Nothing
      )