{-# LANGUAGE Trustworthy #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: experimental
-- Portability: non-portable (GHC only)
module Cleff.Input
  ( -- * Effect
    Input (..)
  , -- * Operations
    input, inputs
  , -- * Interpretations
    runInputConst, inputToListState, runInputEff
  ) where

import           Cleff
import           Cleff.State

-- * Effect

-- | An effect that is capable of reading from some input source, such as an input stream.
data Input i :: Effect where
  Input :: Input i m i

-- * Operations

makeEffect ''Input

-- | Apply a function to the result of 'input'.
inputs :: Input i :> es => (i -> i') -> Eff es i'
inputs :: (i -> i') -> Eff es i'
inputs i -> i'
f = i -> i'
f (i -> i') -> Eff es i -> Eff es i'
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es i
forall i (es :: [(Type -> Type) -> Type -> Type]).
(Input i :> es) =>
Eff es i
input

-- * Interpretations

-- | Run an 'Input' effect by giving a constant input value.
runInputConst :: i -> Eff (Input i ': es) ~> Eff es
runInputConst :: i -> Eff (Input i : es) ~> Eff es
runInputConst i
x = Handler (Input i) es -> Eff (Input i : es) ~> Eff es
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e es -> Eff (e : es) ~> Eff es
interpret \case
  Input i (Eff esSend) a
Input -> i -> Eff es i
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure i
x
{-# INLINE runInputConst #-}

-- | Run an 'Input' effect by going through a list of values.
inputToListState :: Eff (Input (Maybe i) ': es) ~> Eff (State [i] ': es)
inputToListState :: Eff (Input (Maybe i) : es) a -> Eff (State [i] : es) a
inputToListState = Handler (Input (Maybe i)) (State [i] : es)
-> Eff (Input (Maybe i) : es) ~> Eff (State [i] : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e (e' : es) -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  Input (Maybe i) (Eff esSend) a
Input -> Eff (State [i] : es) [i]
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
Eff es s
get Eff (State [i] : es) [i]
-> ([i] -> Eff (State [i] : es) (Maybe i))
-> Eff (State [i] : es) (Maybe i)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    []      -> Maybe i -> Eff (State [i] : es) (Maybe i)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe i
forall a. Maybe a
Nothing
    i
x : [i]
xs' -> i -> Maybe i
forall a. a -> Maybe a
Just i
x Maybe i
-> Eff (State [i] : es) () -> Eff (State [i] : es) (Maybe i)
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ [i] -> Eff (State [i] : es) ()
forall s (es :: [(Type -> Type) -> Type -> Type]).
(State s :> es) =>
s -> Eff es ()
put [i]
xs'
{-# INLINE inputToListState #-}

-- | Run an 'Input' effect by performing a computation for each input request.
runInputEff :: Eff es i -> Eff (Input i ': es) ~> Eff es
runInputEff :: Eff es i -> Eff (Input i : es) ~> Eff es
runInputEff Eff es i
m = Handler (Input i) es -> Eff (Input i : es) ~> Eff es
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e es -> Eff (e : es) ~> Eff es
interpret \case
  Input i (Eff esSend) a
Input -> Eff es i
Eff es a
m
{-# INLINE runInputEff #-}