Handle.hs

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

module Control.Process.Handle
  ( Handle,
    GetHandle (..),
    HasHandle (..),
    ReviewHandle (..),
    AsHandle (..),
  )
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 (UseHandle))

-- $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

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