-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024 Sayo Koyoneda
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

Interpreters for the t'Input' effect.
-}
module Control.Monad.Hefty.Input (
    module Control.Monad.Hefty.Input,
    module Data.Effect.Input,
)
where

import Control.Arrow ((>>>))
import Control.Monad.Hefty (Eff, interpret, raiseUnder, type (~>))
import Control.Monad.Hefty.State (evalState)
import Data.Effect.Input
import Data.Effect.State (gets, put)
import Data.List (uncons)

-- | Interprets the t'Input' effect by executing the given input handler each time an input is required.
runInputEff
    :: forall i ef eh
     . Eff eh ef i
    -> Eff eh (Input i ': ef) ~> Eff eh ef
runInputEff :: forall i (ef :: [EffectF]) (eh :: [EffectH]).
Eff eh ef i -> Eff eh (Input i : ef) ~> Eff eh ef
runInputEff Eff eh ef i
a = (Input i ~> Eff eh ef) -> Eff eh (Input i : ef) ~> Eff eh ef
forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret \Input i x
Input -> Eff eh ef i
Eff eh ef x
a

-- | Interprets the t'Input' effect by providing the given constant as input.
runInputConst
    :: forall i ef eh
     . i
    -> Eff eh (Input i ': ef) ~> Eff eh ef
runInputConst :: forall i (ef :: [EffectF]) (eh :: [EffectH]).
i -> Eff eh (Input i : ef) ~> Eff eh ef
runInputConst i
i = (Input i ~> Eff eh ef) -> Eff eh (Input i : ef) ~> Eff eh ef
forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret \Input i x
Input -> x -> Eff eh ef x
forall a. a -> Eff eh ef a
forall (f :: EffectF) a. Applicative f => a -> f a
pure i
x
i

{- |
Interprets the t'Input' effect by using the given list as a series of inputs.

Each time 'input' is called, it retrieves elements from the list one by one from the beginning, and after all elements are consumed, 'Nothing' is returned indefinitely.
-}
runInputList :: forall i r. [i] -> Eff '[] (Input (Maybe i) ': r) ~> Eff '[] r
runInputList :: forall i (r :: [EffectF]).
[i] -> Eff '[] (Input (Maybe i) : r) ~> Eff '[] r
runInputList [i]
is =
    Eff '[] (Input (Maybe i) : r) x
-> Eff '[] (Input (Maybe i) : State [i] : r) x
forall (e1 :: EffectF) (e2 :: EffectF) (ef :: [EffectF])
       (eh :: [EffectH]) x.
Eff eh (e1 : ef) x -> Eff eh (e1 : e2 : ef) x
raiseUnder
        (Eff '[] (Input (Maybe i) : r) x
 -> Eff '[] (Input (Maybe i) : State [i] : r) x)
-> (Eff '[] (Input (Maybe i) : State [i] : r) x -> Eff '[] r x)
-> Eff '[] (Input (Maybe i) : r) x
-> Eff '[] r x
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Eff '[] (Input (Maybe i) : State [i] : r) x
-> Eff '[] (State [i] : r) x
int
        (Eff '[] (Input (Maybe i) : State [i] : r) x
 -> Eff '[] (State [i] : r) x)
-> (Eff '[] (State [i] : r) x -> Eff '[] r x)
-> Eff '[] (Input (Maybe i) : State [i] : r) x
-> Eff '[] r x
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [i] -> Eff '[] (State [i] : r) x -> Eff '[] r x
forall s (ef :: [EffectF]) a.
s -> Eff '[] (State s : ef) a -> Eff '[] ef a
evalState [i]
is
  where
    int :: Eff '[] (Input (Maybe i) : State [i] : r) x
-> Eff '[] (State [i] : r) x
int = (Input (Maybe i) ~> Eff '[] (State [i] : r))
-> Eff '[] (Input (Maybe i) : State [i] : r)
   ~> Eff '[] (State [i] : r)
forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret \Input (Maybe i) x
Input -> do
        Maybe (i, [i])
is' <- forall s (f :: EffectF) a.
(State s <: f, Functor f) =>
(s -> a) -> f a
gets @[i] [i] -> Maybe (i, [i])
forall a. [a] -> Maybe (a, [a])
uncons
        ((i, [i]) -> Eff '[] (State [i] : r) ())
-> Maybe (i, [i]) -> Eff '[] (State [i] : r) ()
forall (t :: EffectF) (m :: EffectF) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([i] -> Eff '[] (State [i] : r) ()
forall s (f :: EffectF). SendFOE (State s) f => s -> f ()
put ([i] -> Eff '[] (State [i] : r) ())
-> ((i, [i]) -> [i]) -> (i, [i]) -> Eff '[] (State [i] : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, [i]) -> [i]
forall a b. (a, b) -> b
snd) Maybe (i, [i])
is'
        x -> Eff '[] (State [i] : r) x
forall a. a -> Eff '[] (State [i] : r) a
forall (f :: EffectF) a. Applicative f => a -> f a
pure (x -> Eff '[] (State [i] : r) x) -> x -> Eff '[] (State [i] : r) x
forall a b. (a -> b) -> a -> b
$ (i, [i]) -> i
forall a b. (a, b) -> a
fst ((i, [i]) -> i) -> Maybe (i, [i]) -> Maybe i
forall (f :: EffectF) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (i, [i])
is'