{-# LANGUAGE KindSignatures  #-}
{-# LANGUAGE MagicHash       #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds       #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE UnboxedTuples   #-}
module EST (
    EST,
    liftST,
    runEST,
    earlyExitEST,
) where

import GHC.Exts (PromptTag#, State#, control0#, newPromptTag#, oneShot, prompt#, runRW#, unsafeCoerce#)
import GHC.ST   (ST (..))

control0##
    :: PromptTag# a
    -> (((State# s -> (# State# s, b #)) -> State# s -> (# State# s, a #))
                                         -> State# s -> (# State# s, a #))
    -> State# s -> (# State# s, b #)
control0## :: forall a s b.
PromptTag# a
-> (((State# s -> (# State# s, b #))
     -> State# s -> (# State# s, a #))
    -> State# s -> (# State# s, a #))
-> State# s
-> (# State# s, b #)
control0## = (PromptTag# (ZonkAny 0)
 -> (((State# RealWorld -> (# State# RealWorld, ZonkAny 1 #))
      -> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
     -> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
 -> State# RealWorld
 -> (# State# RealWorld, ZonkAny 1 #))
-> PromptTag# a
-> (((State# s -> (# State# s, b #))
     -> State# s -> (# State# s, a #))
    -> State# s -> (# State# s, a #))
-> State# s
-> (# State# s, b #)
forall a b. a -> b
unsafeCoerce# PromptTag# (ZonkAny 0)
-> (((State# RealWorld -> (# State# RealWorld, ZonkAny 1 #))
     -> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
    -> State# RealWorld -> (# State# RealWorld, ZonkAny 0 #))
-> State# RealWorld
-> (# State# RealWorld, ZonkAny 1 #)
forall a b.
PromptTag# a
-> (((State# RealWorld -> (# State# RealWorld, b #))
     -> State# RealWorld -> (# State# RealWorld, a #))
    -> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, b #)
control0#

newtype EST e s a = EST_ (forall r. (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))

instance Functor (EST e s) where
    fmap :: forall a b. (a -> b) -> EST e s a -> EST e s b
fmap a -> b
f (EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
g) = (forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, b #))
-> EST e s b
forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\(# PromptTag# (Either e r), State# s #)
st -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
g (# PromptTag# (Either e r), State# s #)
st of (# State# s
s, a
a #) -> (# State# s
s, a -> b
f a
a #))

instance Applicative (EST e s) where
    pure :: forall a. a -> EST e s a
pure a
x = (forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\(# PromptTag# (Either e r)
_, State# s
s #) -> (# State# s
s, a
x #))
    EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a -> b #)
f <*> :: forall a b. EST e s (a -> b) -> EST e s a -> EST e s b
<*> EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
x = (forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, b #))
-> EST e s b
forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST
        (\(# PromptTag# (Either e r)
t, State# s
s0 #) -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a -> b #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a -> b #)
f (# PromptTag# (Either e r)
t, State# s
s0 #) of {
        (# State# s
s1, a -> b
f' #) -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
x (# PromptTag# (Either e r)
t, State# s
s1 #) of {
        (# State# s
s2, a
x' #) -> (# State# s
s2, a -> b
f' a
x' #) }})

instance Monad (EST e s) where
    EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
m >>= :: forall a b. EST e s a -> (a -> EST e s b) -> EST e s b
>>= a -> EST e s b
k = (forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, b #))
-> EST e s b
forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST
        (\(# PromptTag# (Either e r)
t, State# s
s0 #) -> case (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
m (# PromptTag# (Either e r)
t, State# s
s0 #) of {
        (# State# s
s1, a
x #) -> case a -> EST e s b
k a
x of {
        EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, b #)
f -> (# PromptTag# (Either e r), State# s #) -> (# State# s, b #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, b #)
f (# PromptTag# (Either e r)
t, State# s
s1 #) }})

pattern EST :: (forall r. (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)) -> EST e s a
pattern $mEST :: forall {r} {e} {s} {a}.
EST e s a
-> ((forall r.
     (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
    -> r)
-> ((# #) -> r)
-> r
$bEST :: forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST f <- EST_ f
  where EST forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
f = (forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST_ (((# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall a b. (a -> b) -> a -> b
oneShot (# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
forall r.
(# PromptTag# (Either e r), State# s #) -> (# State# s, a #)
f)
{-# COMPLETE EST #-}

liftST :: ST s a -> EST e s a
liftST :: forall s a e. ST s a -> EST e s a
liftST (ST STRep s a
f) = (forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\ (# PromptTag# (Either e r)
_, State# s
s #) -> STRep s a
f State# s
s)

earlyExitEST :: e -> EST e s any
earlyExitEST :: forall e s any. e -> EST e s any
earlyExitEST e
e = (forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, any #))
-> EST e s any
forall e s a.
(forall r.
 (# PromptTag# (Either e r), State# s #) -> (# State# s, a #))
-> EST e s a
EST (\(# PromptTag# (Either e r)
tag, State# s
s0 #) -> PromptTag# (Either e r)
-> (((State# s -> (# State# s, any #))
     -> State# s -> (# State# s, Either e r #))
    -> State# s -> (# State# s, Either e r #))
-> State# s
-> (# State# s, any #)
forall a s b.
PromptTag# a
-> (((State# s -> (# State# s, b #))
     -> State# s -> (# State# s, a #))
    -> State# s -> (# State# s, a #))
-> State# s
-> (# State# s, b #)
control0## PromptTag# (Either e r)
tag (\(State# s -> (# State# s, any #))
-> State# s -> (# State# s, Either e r #)
_k State# s
s -> (# State# s
s, e -> Either e r
forall a b. a -> Either a b
Left e
e #)) State# s
s0)

runEST :: forall e a. (forall s. EST e s a) -> Either e a
runEST :: forall e a. (forall s. EST e s a) -> Either e a
runEST (EST forall r.
(# PromptTag# (Either e r), State# RealWorld #)
-> (# State# RealWorld, a #)
f) = (State# RealWorld -> Either e a) -> Either e a
forall o. (State# RealWorld -> o) -> o
runRW#
    -- create tag
    (\State# RealWorld
s0 -> case State# RealWorld -> (# State# RealWorld, PromptTag# (Either e a) #)
forall a. State# RealWorld -> (# State# RealWorld, PromptTag# a #)
newPromptTag# State# RealWorld
s0 of {
    -- prompt
    (# State# RealWorld
s1, PromptTag# (Either e a)
tag #) -> case PromptTag# (Either e a)
-> (State# RealWorld -> (# State# RealWorld, Either e a #))
-> State# RealWorld
-> (# State# RealWorld, Either e a #)
forall a.
PromptTag# a
-> (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld
-> (# State# RealWorld, a #)
prompt# PromptTag# (Either e a)
tag
         -- run the `f` inside prompt,
         -- and once we get to the end return `Right` value
         (\State# RealWorld
s2 -> case (# PromptTag# (Either e a), State# RealWorld #)
-> (# State# RealWorld, a #)
forall r.
(# PromptTag# (Either e r), State# RealWorld #)
-> (# State# RealWorld, a #)
f (# PromptTag# (Either e a)
tag, State# RealWorld
s2 #) of (# State# RealWorld
s3, a
a #) -> (# State# RealWorld
s3, a -> Either e a
forall a b. b -> Either a b
Right a
a #)) State# RealWorld
s1 of {
    (# State# RealWorld
_, Either e a
a #) -> Either e a
a }})