-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

module Control.Monad.Hefty.ShiftReset (
    module Control.Monad.Hefty.ShiftReset,
    module Data.Effect.ShiftReset,
)
where

import Control.Monad.Hefty (
    Eff,
    MemberHBy,
    interpret,
    interpretBy,
    interpretH,
    interpretHBy,
    interpretRecHWith,
    raiseH,
    runEff,
    send0,
    sendH,
    type (~>),
 )
import Data.Effect.Key (KeyH (KeyH))
import Data.Effect.ShiftReset (Shift' (Shift))
import Data.Effect.ShiftReset hiding (Shift)
import Data.Effect.ShiftReset qualified as D

type Shift ans eh ef = D.Shift ans (ShiftEff ans eh ef)

newtype ShiftEff ans eh ef a
    = ShiftEff {forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
ShiftEff ans eh ef a
-> Eff (Shift ans (ShiftEff ans eh ef) : eh) ef a
unShiftEff :: Eff (D.Shift ans (ShiftEff ans eh ef) ': eh) ef a}
    deriving newtype ((forall a b.
 (a -> b) -> ShiftEff ans eh ef a -> ShiftEff ans eh ef b)
-> (forall a b. a -> ShiftEff ans eh ef b -> ShiftEff ans eh ef a)
-> Functor (ShiftEff ans eh ef)
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
a -> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
(a -> b) -> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
forall a b. a -> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
forall a b.
(a -> b) -> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
(a -> b) -> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
fmap :: forall a b.
(a -> b) -> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
$c<$ :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
a -> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
<$ :: forall a b. a -> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
Functor, Functor (ShiftEff ans eh ef)
Functor (ShiftEff ans eh ef) =>
(forall a. a -> ShiftEff ans eh ef a)
-> (forall a b.
    ShiftEff ans eh ef (a -> b)
    -> ShiftEff ans eh ef a -> ShiftEff ans eh ef b)
-> (forall a b c.
    (a -> b -> c)
    -> ShiftEff ans eh ef a
    -> ShiftEff ans eh ef b
    -> ShiftEff ans eh ef c)
-> (forall a b.
    ShiftEff ans eh ef a
    -> ShiftEff ans eh ef b -> ShiftEff ans eh ef b)
-> (forall a b.
    ShiftEff ans eh ef a
    -> ShiftEff ans eh ef b -> ShiftEff ans eh ef a)
-> Applicative (ShiftEff ans eh ef)
forall a. a -> ShiftEff ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
Functor (ShiftEff ans eh ef)
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
a -> ShiftEff ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef (a -> b)
-> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b c.
(a -> b -> c)
-> ShiftEff ans eh ef a
-> ShiftEff ans eh ef b
-> ShiftEff ans eh ef c
forall a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
forall a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
forall a b.
ShiftEff ans eh ef (a -> b)
-> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
forall a b c.
(a -> b -> c)
-> ShiftEff ans eh ef a
-> ShiftEff ans eh ef b
-> ShiftEff ans eh ef c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
a -> ShiftEff ans eh ef a
pure :: forall a. a -> ShiftEff ans eh ef a
$c<*> :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef (a -> b)
-> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
<*> :: forall a b.
ShiftEff ans eh ef (a -> b)
-> ShiftEff ans eh ef a -> ShiftEff ans eh ef b
$cliftA2 :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b c.
(a -> b -> c)
-> ShiftEff ans eh ef a
-> ShiftEff ans eh ef b
-> ShiftEff ans eh ef c
liftA2 :: forall a b c.
(a -> b -> c)
-> ShiftEff ans eh ef a
-> ShiftEff ans eh ef b
-> ShiftEff ans eh ef c
$c*> :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
*> :: forall a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
$c<* :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
<* :: forall a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef a
Applicative, Applicative (ShiftEff ans eh ef)
Applicative (ShiftEff ans eh ef) =>
(forall a b.
 ShiftEff ans eh ef a
 -> (a -> ShiftEff ans eh ef b) -> ShiftEff ans eh ef b)
-> (forall a b.
    ShiftEff ans eh ef a
    -> ShiftEff ans eh ef b -> ShiftEff ans eh ef b)
-> (forall a. a -> ShiftEff ans eh ef a)
-> Monad (ShiftEff ans eh ef)
forall a. a -> ShiftEff ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
Applicative (ShiftEff ans eh ef)
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
a -> ShiftEff ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> (a -> ShiftEff ans eh ef b) -> ShiftEff ans eh ef b
forall a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
forall a b.
ShiftEff ans eh ef a
-> (a -> ShiftEff ans eh ef b) -> ShiftEff ans eh ef b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> (a -> ShiftEff ans eh ef b) -> ShiftEff ans eh ef b
>>= :: forall a b.
ShiftEff ans eh ef a
-> (a -> ShiftEff ans eh ef b) -> ShiftEff ans eh ef b
$c>> :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
>> :: forall a b.
ShiftEff ans eh ef a
-> ShiftEff ans eh ef b -> ShiftEff ans eh ef b
$creturn :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
a -> ShiftEff ans eh ef a
return :: forall a. a -> ShiftEff ans eh ef a
Monad)

evalShift :: Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans
evalShift :: forall ans (ef :: [* -> *]).
Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans
evalShift = (ans -> Eff '[] ef ans)
-> Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans
forall a (ef :: [* -> *]) ans.
(a -> Eff '[] ef ans)
-> Eff '[Shift ans '[] ef] ef a -> Eff '[] ef ans
runShift ans -> Eff '[] ef ans
forall a. a -> Eff '[] ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

runShift :: (a -> Eff '[] ef ans) -> Eff '[Shift ans '[] ef] ef a -> Eff '[] ef ans
runShift :: forall a (ef :: [* -> *]) ans.
(a -> Eff '[] ef ans)
-> Eff '[Shift ans '[] ef] ef a -> Eff '[] ef ans
runShift a -> Eff '[] ef ans
f =
    (a -> Eff '[] ef ans)
-> Interpreter
     (Shift ans '[] ef (Eff '[Shift ans '[] ef] ef)) (Eff '[] ef) ans
-> Eff '[Shift ans '[] ef] ef a
-> Eff '[] ef ans
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]) ans a.
HFunctor e =>
(a -> Eff eh ef ans)
-> Interpreter (e (Eff '[e] ef)) (Eff eh ef) ans
-> Eff '[e] ef a
-> Eff eh ef ans
interpretHBy a -> Eff '[] ef ans
f \Shift ans '[] ef (Eff '[Shift ans '[] ef] ef) x
e x -> Eff '[] ef ans
k ->
        Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans
forall ans (ef :: [* -> *]).
Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans
evalShift (Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans)
-> Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans
forall a b. (a -> b) -> a -> b
$ case Shift ans '[] ef (Eff '[Shift ans '[] ef] ef) x
e of
            KeyH (Shift (x -> ShiftEff ans '[] ef ans)
-> (forall x.
    Eff '[Shift ans '[] ef] ef x -> ShiftEff ans '[] ef x)
-> ShiftEff ans '[] ef ans
initiate) -> ShiftEff ans '[] ef ans -> Eff '[Shift ans '[] ef] ef ans
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
ShiftEff ans eh ef a
-> Eff (Shift ans (ShiftEff ans eh ef) : eh) ef a
unShiftEff (ShiftEff ans '[] ef ans -> Eff '[Shift ans '[] ef] ef ans)
-> ShiftEff ans '[] ef ans -> Eff '[Shift ans '[] ef] ef ans
forall a b. (a -> b) -> a -> b
$ (x -> ShiftEff ans '[] ef ans)
-> (forall x.
    Eff '[Shift ans '[] ef] ef x -> ShiftEff ans '[] ef x)
-> ShiftEff ans '[] ef ans
initiate (Eff '[Shift ans '[] ef] ef ans -> ShiftEff ans '[] ef ans
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
Eff (Shift ans (ShiftEff ans eh ef) : eh) ef a
-> ShiftEff ans eh ef a
ShiftEff (Eff '[Shift ans '[] ef] ef ans -> ShiftEff ans '[] ef ans)
-> (x -> Eff '[Shift ans '[] ef] ef ans)
-> x
-> ShiftEff ans '[] ef ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[] ef ans -> Eff '[Shift ans '[] ef] ef ans
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]) x.
Eff eh ef x -> Eff (e : eh) ef x
raiseH (Eff '[] ef ans -> Eff '[Shift ans '[] ef] ef ans)
-> (x -> Eff '[] ef ans) -> x -> Eff '[Shift ans '[] ef] ef ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Eff '[] ef ans
k) Eff '[Shift ans '[] ef] ef x -> ShiftEff ans '[] ef x
forall x. Eff '[Shift ans '[] ef] ef x -> ShiftEff ans '[] ef x
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
Eff (Shift ans (ShiftEff ans eh ef) : eh) ef a
-> ShiftEff ans eh ef a
ShiftEff

withShift :: Eff '[Shift ans '[] '[Eff eh ef]] '[Eff eh ef] ans -> Eff eh ef ans
withShift :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
Eff '[Shift ans '[] '[Eff eh ef]] '[Eff eh ef] ans -> Eff eh ef ans
withShift = Eff '[] '[Eff eh ef] ans -> Eff eh ef ans
Eff '[] '[Eff eh ef] ~> Eff eh ef
forall (m :: * -> *). Monad m => Eff '[] '[m] ~> m
runEff (Eff '[] '[Eff eh ef] ans -> Eff eh ef ans)
-> (Eff '[Shift ans '[] '[Eff eh ef]] '[Eff eh ef] ans
    -> Eff '[] '[Eff eh ef] ans)
-> Eff '[Shift ans '[] '[Eff eh ef]] '[Eff eh ef] ans
-> Eff eh ef ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[Shift ans '[] '[Eff eh ef]] '[Eff eh ef] ans
-> Eff '[] '[Eff eh ef] ans
forall ans (ef :: [* -> *]).
Eff '[Shift ans '[] ef] ef ans -> Eff '[] ef ans
evalShift

runShift_ :: forall eh ef. Eff (Shift_ (Eff eh ef) ': eh) ef ~> Eff eh ef
runShift_ :: forall (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) x.
Eff (Shift_ (Eff eh ef) : eh) ef x -> Eff eh ef x
runShift_ = (forall ans x.
 Shift_ (Eff eh ef) (Eff eh ef) x
 -> (x -> Eff eh ef ans) -> Eff eh ef ans)
-> Eff (Shift_ (Eff eh ef) : eh) ef x -> Eff eh ef x
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]) a.
HFunctor e =>
(forall ans x.
 e (Eff eh ef) x -> (x -> Eff eh ef ans) -> Eff eh ef ans)
-> Eff (e : eh) ef a -> Eff eh ef a
interpretRecHWith \(KeyH (Shift_' forall ans.
(x -> Eff eh ef ans)
-> (forall x. Eff eh ef x -> Eff eh ef x) -> Eff eh ef ans
initiate)) x -> Eff eh ef ans
k -> (x -> Eff eh ef ans)
-> (forall x. Eff eh ef x -> Eff eh ef x) -> Eff eh ef ans
forall ans.
(x -> Eff eh ef ans)
-> (forall x. Eff eh ef x -> Eff eh ef x) -> Eff eh ef ans
initiate x -> Eff eh ef ans
k Eff eh ef x -> Eff eh ef x
forall a. a -> a
forall x. Eff eh ef x -> Eff eh ef x
id

runReset :: forall eh ef. Eff (Reset ': eh) ef ~> Eff eh ef
runReset :: forall (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) x.
Eff (Reset : eh) ef x -> Eff eh ef x
runReset = (Reset ~~> Eff eh ef) -> Eff (Reset : eh) ef ~> Eff eh ef
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH \(Reset Eff eh ef x
a) -> Eff eh ef x
a

runShiftF :: Eff '[] (ShiftF (Eff '[] ef ans) ': ef) ans -> Eff '[] ef ans
runShiftF :: forall (ef :: [* -> *]) ans.
Eff '[] (ShiftF (Eff '[] ef ans) : ef) ans -> Eff '[] ef ans
runShiftF = (ans -> Eff '[] ef ans)
-> Interpreter (ShiftF (Eff '[] ef ans)) (Eff '[] ef) ans
-> Eff '[] (ShiftF (Eff '[] ef ans) : ef) ans
-> Eff '[] ef ans
forall (e :: * -> *) (ef :: [* -> *]) ans a.
(a -> Eff '[] ef ans)
-> Interpreter e (Eff '[] ef) ans
-> Eff '[] (e : ef) a
-> Eff '[] ef ans
interpretBy ans -> Eff '[] ef ans
forall a. a -> Eff '[] ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \(ShiftF (x -> Eff '[] ef ans) -> Eff '[] ef ans
initiate) x -> Eff '[] ef ans
resume -> (x -> Eff '[] ef ans) -> Eff '[] ef ans
initiate x -> Eff '[] ef ans
resume

runShiftEff :: (Monad n) => (a -> n ans) -> Eff '[] '[ShiftF (n ans), n] a -> n ans
runShiftEff :: forall (n :: * -> *) a ans.
Monad n =>
(a -> n ans) -> Eff '[] '[ShiftF (n ans), n] a -> n ans
runShiftEff a -> n ans
f =
    Eff '[] '[n] ans -> n ans
Eff '[] '[n] ~> n
forall (m :: * -> *). Monad m => Eff '[] '[m] ~> m
runEff
        (Eff '[] '[n] ans -> n ans)
-> (Eff '[] '[ShiftF (n ans), n] a -> Eff '[] '[n] ans)
-> Eff '[] '[ShiftF (n ans), n] a
-> n ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Eff '[] '[n] ans)
-> Interpreter (ShiftF (n ans)) (Eff '[] '[n]) ans
-> Eff '[] '[ShiftF (n ans), n] a
-> Eff '[] '[n] ans
forall (e :: * -> *) (ef :: [* -> *]) ans a.
(a -> Eff '[] ef ans)
-> Interpreter e (Eff '[] ef) ans
-> Eff '[] (e : ef) a
-> Eff '[] ef ans
interpretBy (n ans -> Eff '[] '[n] ans
forall (e :: * -> *) (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *])
       x.
e x -> Eff eh (e : ef) x
send0 (n ans -> Eff '[] '[n] ans)
-> (a -> n ans) -> a -> Eff '[] '[n] ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> n ans
f) \(ShiftF (x -> n ans) -> n ans
initiate) x -> Eff '[] '[n] ans
resume ->
            n ans -> Eff '[] '[n] ans
forall (e :: * -> *) (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *])
       x.
e x -> Eff eh (e : ef) x
send0 (n ans -> Eff '[] '[n] ans) -> n ans -> Eff '[] '[n] ans
forall a b. (a -> b) -> a -> b
$ (x -> n ans) -> n ans
initiate ((x -> n ans) -> n ans) -> (x -> n ans) -> n ans
forall a b. (a -> b) -> a -> b
$ Eff '[] '[n] ans -> n ans
Eff '[] '[n] ~> n
forall (m :: * -> *). Monad m => Eff '[] '[m] ~> m
runEff (Eff '[] '[n] ans -> n ans)
-> (x -> Eff '[] '[n] ans) -> x -> n ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Eff '[] '[n] ans
resume

runShiftAsF
    :: (MemberHBy ShiftKey (Shift' ans n) eh)
    => Eff eh (ShiftF (n ans) ': ef) ~> Eff eh ef
runShiftAsF :: forall ans (n :: * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]).
MemberHBy ShiftKey (Shift' ans n) eh =>
Eff eh (ShiftF (n ans) : ef) ~> Eff eh ef
runShiftAsF = (ShiftF (n ans) ~> Eff eh ef)
-> Eff eh (ShiftF (n ans) : ef) ~> Eff eh ef
forall (e :: * -> *) (ef :: [* -> *]) (eh :: [(* -> *) -> * -> *]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret ((ShiftF (n ans) ~> Eff eh ef)
 -> Eff eh (ShiftF (n ans) : ef) ~> Eff eh ef)
-> (ShiftF (n ans) ~> Eff eh ef)
-> Eff eh (ShiftF (n ans) : ef) ~> Eff eh ef
forall a b. (a -> b) -> a -> b
$ KeyH ShiftKey (Shift' ans n) (Eff eh ef) x -> Eff eh ef x
KeyH ShiftKey (Shift' ans n) (Eff eh ef) ~> Eff eh ef
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]).
(e <<| eh) =>
e (Eff eh ef) ~> Eff eh ef
sendH (KeyH ShiftKey (Shift' ans n) (Eff eh ef) x -> Eff eh ef x)
-> (ShiftF (n ans) x -> KeyH ShiftKey (Shift' ans n) (Eff eh ef) x)
-> ShiftF (n ans) x
-> Eff eh ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShiftF (n ans) x -> KeyH ShiftKey (Shift' ans n) (Eff eh ef) x
forall (n :: * -> *) ans (m :: * -> *) x.
ShiftF (n ans) x -> Shift ans n m x
fromShiftF