-- 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 where

import Control.Monad.Hefty (
    Eff,
    interpretH,
    interpretHBy,
    interpretRecHWith,
    raiseH,
    runEff,
    type (~>),
 )
import Data.Effect.Key (KeyH (KeyH))
import Data.Effect.ShiftReset (
    Reset (Reset),
    Shift,
    Shift' (Shift),
    Shift_,
    Shift_' (Shift_'),
 )

type ShiftFix ans eh ef = Shift ans (ShiftBase ans eh ef)

newtype ShiftBase ans eh ef a
    = ShiftBase {forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
ShiftBase ans eh ef a
-> Eff (Shift ans (ShiftBase ans eh ef) : eh) ef a
unShiftBase :: Eff (Shift ans (ShiftBase ans eh ef) ': eh) ef a}
    deriving newtype ((forall a b.
 (a -> b) -> ShiftBase ans eh ef a -> ShiftBase ans eh ef b)
-> (forall a b.
    a -> ShiftBase ans eh ef b -> ShiftBase ans eh ef a)
-> Functor (ShiftBase ans eh ef)
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
a -> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
(a -> b) -> ShiftBase ans eh ef a -> ShiftBase ans eh ef b
forall a b. a -> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
forall a b.
(a -> b) -> ShiftBase ans eh ef a -> ShiftBase 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) -> ShiftBase ans eh ef a -> ShiftBase ans eh ef b
fmap :: forall a b.
(a -> b) -> ShiftBase ans eh ef a -> ShiftBase ans eh ef b
$c<$ :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
a -> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
<$ :: forall a b. a -> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
Functor, Functor (ShiftBase ans eh ef)
Functor (ShiftBase ans eh ef) =>
(forall a. a -> ShiftBase ans eh ef a)
-> (forall a b.
    ShiftBase ans eh ef (a -> b)
    -> ShiftBase ans eh ef a -> ShiftBase ans eh ef b)
-> (forall a b c.
    (a -> b -> c)
    -> ShiftBase ans eh ef a
    -> ShiftBase ans eh ef b
    -> ShiftBase ans eh ef c)
-> (forall a b.
    ShiftBase ans eh ef a
    -> ShiftBase ans eh ef b -> ShiftBase ans eh ef b)
-> (forall a b.
    ShiftBase ans eh ef a
    -> ShiftBase ans eh ef b -> ShiftBase ans eh ef a)
-> Applicative (ShiftBase ans eh ef)
forall a. a -> ShiftBase ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
Functor (ShiftBase ans eh ef)
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
a -> ShiftBase ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef (a -> b)
-> ShiftBase ans eh ef a -> ShiftBase ans eh ef b
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b c.
(a -> b -> c)
-> ShiftBase ans eh ef a
-> ShiftBase ans eh ef b
-> ShiftBase ans eh ef c
forall a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
forall a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
forall a b.
ShiftBase ans eh ef (a -> b)
-> ShiftBase ans eh ef a -> ShiftBase ans eh ef b
forall a b c.
(a -> b -> c)
-> ShiftBase ans eh ef a
-> ShiftBase ans eh ef b
-> ShiftBase 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 -> ShiftBase ans eh ef a
pure :: forall a. a -> ShiftBase ans eh ef a
$c<*> :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef (a -> b)
-> ShiftBase ans eh ef a -> ShiftBase ans eh ef b
<*> :: forall a b.
ShiftBase ans eh ef (a -> b)
-> ShiftBase ans eh ef a -> ShiftBase ans eh ef b
$cliftA2 :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b c.
(a -> b -> c)
-> ShiftBase ans eh ef a
-> ShiftBase ans eh ef b
-> ShiftBase ans eh ef c
liftA2 :: forall a b c.
(a -> b -> c)
-> ShiftBase ans eh ef a
-> ShiftBase ans eh ef b
-> ShiftBase ans eh ef c
$c*> :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
*> :: forall a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
$c<* :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
<* :: forall a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef a
Applicative, Applicative (ShiftBase ans eh ef)
Applicative (ShiftBase ans eh ef) =>
(forall a b.
 ShiftBase ans eh ef a
 -> (a -> ShiftBase ans eh ef b) -> ShiftBase ans eh ef b)
-> (forall a b.
    ShiftBase ans eh ef a
    -> ShiftBase ans eh ef b -> ShiftBase ans eh ef b)
-> (forall a. a -> ShiftBase ans eh ef a)
-> Monad (ShiftBase ans eh ef)
forall a. a -> ShiftBase ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
Applicative (ShiftBase ans eh ef)
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
a -> ShiftBase ans eh ef a
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef a
-> (a -> ShiftBase ans eh ef b) -> ShiftBase ans eh ef b
forall a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
forall a b.
ShiftBase ans eh ef a
-> (a -> ShiftBase ans eh ef b) -> ShiftBase 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.
ShiftBase ans eh ef a
-> (a -> ShiftBase ans eh ef b) -> ShiftBase ans eh ef b
>>= :: forall a b.
ShiftBase ans eh ef a
-> (a -> ShiftBase ans eh ef b) -> ShiftBase ans eh ef b
$c>> :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
>> :: forall a b.
ShiftBase ans eh ef a
-> ShiftBase ans eh ef b -> ShiftBase ans eh ef b
$creturn :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
a -> ShiftBase ans eh ef a
return :: forall a. a -> ShiftBase ans eh ef a
Monad)

evalShift :: Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans
evalShift :: forall ans (ef :: [* -> *]).
Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans
evalShift = (ans -> Eff '[] ef ans)
-> Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans
forall a (ef :: [* -> *]) ans.
(a -> Eff '[] ef ans)
-> Eff '[ShiftFix 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 '[ShiftFix ans '[] ef] ef a -> Eff '[] ef ans
runShift :: forall a (ef :: [* -> *]) ans.
(a -> Eff '[] ef ans)
-> Eff '[ShiftFix ans '[] ef] ef a -> Eff '[] ef ans
runShift a -> Eff '[] ef ans
f =
    (a -> Eff '[] ef ans)
-> Interpreter
     (ShiftFix ans '[] ef (Eff '[ShiftFix ans '[] ef] ef))
     (Eff '[] ef)
     ans
-> Eff '[ShiftFix 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 \ShiftFix ans '[] ef (Eff '[ShiftFix ans '[] ef] ef) x
e x -> Eff '[] ef ans
k ->
        Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans
forall ans (ef :: [* -> *]).
Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans
evalShift (Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans)
-> Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans
forall a b. (a -> b) -> a -> b
$ case ShiftFix ans '[] ef (Eff '[ShiftFix ans '[] ef] ef) x
e of
            KeyH (Shift (x -> ShiftBase ans '[] ef ans)
-> (forall x.
    Eff '[ShiftFix ans '[] ef] ef x -> ShiftBase ans '[] ef x)
-> ShiftBase ans '[] ef ans
g) -> ShiftBase ans '[] ef ans -> Eff '[ShiftFix ans '[] ef] ef ans
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
ShiftBase ans eh ef a
-> Eff (Shift ans (ShiftBase ans eh ef) : eh) ef a
unShiftBase (ShiftBase ans '[] ef ans -> Eff '[ShiftFix ans '[] ef] ef ans)
-> ShiftBase ans '[] ef ans -> Eff '[ShiftFix ans '[] ef] ef ans
forall a b. (a -> b) -> a -> b
$ (x -> ShiftBase ans '[] ef ans)
-> (forall x.
    Eff '[ShiftFix ans '[] ef] ef x -> ShiftBase ans '[] ef x)
-> ShiftBase ans '[] ef ans
g (Eff '[ShiftFix ans '[] ef] ef ans -> ShiftBase ans '[] ef ans
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
Eff (Shift ans (ShiftBase ans eh ef) : eh) ef a
-> ShiftBase ans eh ef a
ShiftBase (Eff '[ShiftFix ans '[] ef] ef ans -> ShiftBase ans '[] ef ans)
-> (x -> Eff '[ShiftFix ans '[] ef] ef ans)
-> x
-> ShiftBase ans '[] ef ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[] ef ans -> Eff '[ShiftFix ans '[] ef] ef ans
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]) x.
Eff eh ef x -> Eff (e : eh) ef x
raiseH (Eff '[] ef ans -> Eff '[ShiftFix ans '[] ef] ef ans)
-> (x -> Eff '[] ef ans) -> x -> Eff '[ShiftFix ans '[] ef] ef ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Eff '[] ef ans
k) Eff '[ShiftFix ans '[] ef] ef x -> ShiftBase ans '[] ef x
forall x. Eff '[ShiftFix ans '[] ef] ef x -> ShiftBase ans '[] ef x
forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]) a.
Eff (Shift ans (ShiftBase ans eh ef) : eh) ef a
-> ShiftBase ans eh ef a
ShiftBase

withShift :: Eff '[ShiftFix ans '[] '[Eff eh ef]] '[Eff eh ef] ans -> Eff eh ef ans
withShift :: forall ans (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
Eff '[ShiftFix 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 '[ShiftFix ans '[] '[Eff eh ef]] '[Eff eh ef] ans
    -> Eff '[] '[Eff eh ef] ans)
-> Eff '[ShiftFix ans '[] '[Eff eh ef]] '[Eff eh ef] ans
-> Eff eh ef ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[ShiftFix ans '[] '[Eff eh ef]] '[Eff eh ef] ans
-> Eff '[] '[Eff eh ef] ans
forall ans (ef :: [* -> *]).
Eff '[ShiftFix ans '[] ef] ef ans -> Eff '[] ef ans
evalShift

runShift_ :: forall r ef. Eff (Shift_ (Eff r ef) ': r) ef ~> Eff r ef
runShift_ :: forall (r :: [(* -> *) -> * -> *]) (ef :: [* -> *]) x.
Eff (Shift_ (Eff r ef) : r) ef x -> Eff r ef x
runShift_ = (forall ans x.
 Shift_ (Eff r ef) (Eff r ef) x
 -> (x -> Eff r ef ans) -> Eff r ef ans)
-> Eff (Shift_ (Eff r ef) : r) ef x -> Eff r 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 r.
(x -> Eff r ef r)
-> (forall x. Eff r ef x -> Eff r ef x) -> Eff r ef r
f)) x -> Eff r ef ans
k -> (x -> Eff r ef ans)
-> (forall x. Eff r ef x -> Eff r ef x) -> Eff r ef ans
forall r.
(x -> Eff r ef r)
-> (forall x. Eff r ef x -> Eff r ef x) -> Eff r ef r
f x -> Eff r ef ans
k Eff r ef x -> Eff r ef x
forall a. a -> a
forall x. Eff r ef x -> Eff r ef x
id

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