-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024 Sayo contributors
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, FOEs, interpret, raiseUnder)
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 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 a es. (FOEs es) => [i] -> Eff (Input (Maybe i) ': es) a -> Eff es a
runInputList :: forall i a (es :: [Effect]).
FOEs es =>
[i] -> Eff (Input (Maybe i) : es) a -> Eff es a
runInputList [i]
is =
    Eff (Input (Maybe i) : es) a
-> Eff Freer (Input (Maybe i) : State [i] : es) a
forall (e0 :: Effect) (e1 :: Effect) (es :: [Effect]) a
       (ff :: Effect) (c :: (* -> *) -> Constraint).
Free c ff =>
Eff ff (e0 : es) a -> Eff ff (e0 : e1 : es) a
raiseUnder
        (Eff (Input (Maybe i) : es) a
 -> Eff Freer (Input (Maybe i) : State [i] : es) a)
-> (Eff Freer (Input (Maybe i) : State [i] : es) a -> Eff es a)
-> Eff (Input (Maybe i) : es) a
-> Eff es a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Eff Freer (Input (Maybe i) : State [i] : es) a
-> Eff Freer (State [i] : es) a
int
        (Eff Freer (Input (Maybe i) : State [i] : es) a
 -> Eff Freer (State [i] : es) a)
-> (Eff Freer (State [i] : es) a -> Eff es a)
-> Eff Freer (Input (Maybe i) : State [i] : es) a
-> Eff es a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [i] -> FOEs es => Eff Freer (State [i] : es) a -> Eff es a
forall s (es :: [Effect]) a.
s -> FOEs es => Eff (State s : es) a -> Eff es a
evalState [i]
is
  where
    int :: Eff Freer (Input (Maybe i) : State [i] : es) a
-> Eff Freer (State [i] : es) a
int = (Input (Maybe i) ~~> Eff Freer (State [i] : es))
-> Eff Freer (Input (Maybe i) : State [i] : es) a
-> Eff Freer (State [i] : es) a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \Input (Maybe i) (Eff Freer (State [i] : es)) x
Input -> do
        Maybe (i, [i])
is' <- forall s (es :: [Effect]) a (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(State s :> es, Functor (Eff ff es), Free c ff) =>
(s -> a) -> Eff ff es a
gets @[i] [i] -> Maybe (i, [i])
forall a. [a] -> Maybe (a, [a])
uncons
        ((i, [i]) -> Eff Freer (State [i] : es) ())
-> Maybe (i, [i]) -> Eff Freer (State [i] : es) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([i] -> Eff Freer (State [i] : es) ()
forall s (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, State s :> es) =>
s -> a ()
put ([i] -> Eff Freer (State [i] : es) ())
-> ((i, [i]) -> [i]) -> (i, [i]) -> Eff Freer (State [i] : es) ()
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 Freer (State [i] : es) x
forall a. a -> Eff Freer (State [i] : es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> Eff Freer (State [i] : es) x)
-> x -> Eff Freer (State [i] : es) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (i, [i])
is'
{-# INLINE runInputList #-}