{-# 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 :: Getter Handle Handle
getHandle = (Handle -> f Handle) -> Handle -> f Handle
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
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 :: Lens' Handle Handle
handle =
    (Handle -> f Handle) -> Handle -> f Handle
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
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 :: Review Handle Handle
reviewHandle = (Handle -> Handle) -> Optic p f Handle Handle Handle Handle
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto Handle -> Handle
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  {-# INLINE reviewHandle #-}

-- |
--
-- >>> review reviewHandle stdout :: StdStream
-- UseHandle {handle: <stdout>}
instance ReviewHandle StdStream where
  reviewHandle :: Review StdStream Handle
reviewHandle = (Handle -> StdStream)
-> Optic p f StdStream StdStream Handle Handle
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto Handle -> StdStream
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 :: Prism' Handle Handle
_Handle =
    p Handle (f Handle) -> p Handle (f Handle)
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
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' StdStream Handle
_Handle =
    (Handle -> StdStream)
-> (StdStream -> Maybe Handle) -> Prism' StdStream Handle
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      Handle -> StdStream
UseHandle
      ( \case
          UseHandle Handle
a -> Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
a
          StdStream
_ -> Maybe Handle
forall a. Maybe a
Nothing
      )