{-# LANGUAGE TemplateHaskell, Unsafe #-}
module Polysemy.Cont.Internal where
import Data.Functor.Contravariant
import Polysemy
import Polysemy.Internal
import Polysemy.Internal.Union
import Polysemy.Fresh
import Polysemy.Error
import Control.Monad
import Control.Monad.Trans.Cont hiding (Cont)
import Unsafe.Coerce
import GHC.Exts (Any)
data Cont ref m a where
Jump :: ref a -> a -> Cont ref m b
Subst :: (ref a -> m b) -> (a -> m b) -> Cont ref m b
makeSem_ ''Cont
jump :: forall ref a b r.
Member (Cont ref) r
=> ref a
-> a
-> Sem r b
subst :: forall ref a b r
. Member (Cont ref) r
=> (ref a -> Sem r b)
-> (a -> Sem r b)
-> Sem r b
runContWithCUnsafe :: (a -> Sem r s) -> Sem (Cont (Ref (Sem r) s) ': r) a -> Sem r s
runContWithCUnsafe :: (a -> Sem r s) -> Sem (Cont (Ref (Sem r) s) : r) a -> Sem r s
runContWithCUnsafe a -> Sem r s
c (Sem forall (m :: * -> *).
Monad m =>
(forall x.
Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
-> m x)
-> m a
m) = (ContT s (Sem r) a -> (a -> Sem r s) -> Sem r s
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
`runContT` a -> Sem r s
c) (ContT s (Sem r) a -> Sem r s) -> ContT s (Sem r) a -> Sem r s
forall a b. (a -> b) -> a -> b
$ (forall x.
Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
-> ContT s (Sem r) x)
-> ContT s (Sem r) a
forall (m :: * -> *).
Monad m =>
(forall x.
Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
-> m x)
-> m a
m ((forall x.
Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
-> ContT s (Sem r) x)
-> ContT s (Sem r) a)
-> (forall x.
Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
-> ContT s (Sem r) x)
-> ContT s (Sem r) a
forall a b. (a -> b) -> a -> b
$ \Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
u -> case Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
-> Either
(Union r (Sem (Cont (Ref (Sem r) s) : r)) x)
(Weaving (Cont (Ref (Sem r) s)) (Sem (Cont (Ref (Sem r) s) : r)) x)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Cont (Ref (Sem r) s) : r) (Sem (Cont (Ref (Sem r) s) : r)) x
u of
Right Weaving (Cont (Ref (Sem r) s)) (Sem (Cont (Ref (Sem r) s) : r)) x
weaving -> (forall x.
(x -> Sem r s) -> Sem (Cont (Ref (Sem r) s) : r) x -> Sem r s)
-> Weaving
(Cont (Ref (Sem r) s)) (Sem (Cont (Ref (Sem r) s) : r)) x
-> ContT s (Sem r) x
forall (m :: * -> *) s (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. (x -> m s) -> Sem r x -> m s)
-> Weaving (Cont (Ref m s)) (Sem r) a -> ContT s m a
runContWeaving forall x.
(x -> Sem r s) -> Sem (Cont (Ref (Sem r) s) : r) x -> Sem r s
forall a (r :: [(* -> *) -> * -> *]) s.
(a -> Sem r s) -> Sem (Cont (Ref (Sem r) s) : r) a -> Sem r s
runContWithCUnsafe Weaving (Cont (Ref (Sem r) s)) (Sem (Cont (Ref (Sem r) s) : r)) x
weaving
Left Union r (Sem (Cont (Ref (Sem r) s) : r)) x
g -> ((x -> Sem r s) -> Sem r s) -> ContT s (Sem r) x
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((x -> Sem r s) -> Sem r s) -> ContT s (Sem r) x)
-> ((x -> Sem r s) -> Sem r s) -> ContT s (Sem r) x
forall a b. (a -> b) -> a -> b
$ \x -> Sem r s
c' -> Union r (Sem (Cont (Ref (Sem r) s) : r)) x
-> Sem r (Sem (Cont (Ref (Sem r) s) : r) x)
forall (r :: [(* -> *) -> * -> *]) (r' :: [(* -> *) -> * -> *]) a.
Union r (Sem r') a -> Sem r (Sem r' a)
embedSem Union r (Sem (Cont (Ref (Sem r) s) : r)) x
g Sem r (Sem (Cont (Ref (Sem r) s) : r) x)
-> (Sem (Cont (Ref (Sem r) s) : r) x -> Sem r s) -> Sem r s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (x -> Sem r s) -> Sem (Cont (Ref (Sem r) s) : r) x -> Sem r s
forall a (r :: [(* -> *) -> * -> *]) s.
(a -> Sem r s) -> Sem (Cont (Ref (Sem r) s) : r) a -> Sem r s
runContWithCUnsafe x -> Sem r s
c'
{-# INLINE runContWithCUnsafe #-}
runContWeaving :: Monad m
=> (forall x. (x -> m s) -> Sem r x -> m s)
-> Weaving (Cont (Ref m s)) (Sem r) a
-> ContT s m a
runContWeaving :: (forall x. (x -> m s) -> Sem r x -> m s)
-> Weaving (Cont (Ref m s)) (Sem r) a -> ContT s m a
runContWeaving forall x. (x -> m s) -> Sem r x -> m s
runW (Weaving Cont (Ref m s) (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
wv f a -> a
ex forall x. f x -> Maybe x
_) =
((a -> m s) -> m s) -> ContT s m a
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((a -> m s) -> m s) -> ContT s m a)
-> ((a -> m s) -> m s) -> ContT s m a
forall a b. (a -> b) -> a -> b
$ \a -> m s
c ->
case Cont (Ref m s) (Sem rInitial) a
e of
Jump Ref m s a
ref a
a -> Ref m s a -> a -> m s
forall k (m :: k -> *) (s :: k) a. Ref m s a -> a -> m s
runRef Ref m s a
ref a
a
Subst Ref m s a -> Sem rInitial a
main a -> Sem rInitial a
cb ->
let
callback :: a -> m s
callback a
a = (f a -> m s) -> Sem r (f a) -> m s
forall x. (x -> m s) -> Sem r x -> m s
runW (a -> m s
c (a -> m s) -> (f a -> a) -> f a -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
ex) (f (Sem rInitial a) -> Sem r (f a)
forall x. f (Sem rInitial x) -> Sem r (f x)
wv (a -> Sem rInitial a
cb a
a Sem rInitial a -> f () -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s))
in
(f a -> m s) -> Sem r (f a) -> m s
forall x. (x -> m s) -> Sem r x -> m s
runW (a -> m s
c (a -> m s) -> (f a -> a) -> f a -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
ex) (f (Sem rInitial a) -> Sem r (f a)
forall x. f (Sem rInitial x) -> Sem r (f x)
wv (Ref m s a -> Sem rInitial a
main ((a -> m s) -> Ref m s a
forall k (m :: k -> *) (s :: k) a. (a -> m s) -> Ref m s a
Ref a -> m s
callback) Sem rInitial a -> f () -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s))
{-# INLINE runContWeaving #-}
inspectSem :: Sem r a -> Maybe a
inspectSem :: Sem r a -> Maybe a
inspectSem (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m) = (forall x. Union r (Sem r) x -> Maybe x) -> Maybe a
forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m (\Union r (Sem r) x
_ -> Maybe x
forall a. Maybe a
Nothing)
{-# INLINE inspectSem #-}
embedSem :: Union r (Sem r') a -> Sem r (Sem r' a)
embedSem :: Union r (Sem r') a -> Sem r (Sem r' a)
embedSem = Union r (Sem r) (Sem r' a) -> Sem r (Sem r' a)
forall (r :: [(* -> *) -> * -> *]) a. Union r (Sem r) a -> Sem r a
liftSem (Union r (Sem r) (Sem r' a) -> Sem r (Sem r' a))
-> (Union r (Sem r') a -> Union r (Sem r) (Sem r' a))
-> Union r (Sem r') a
-> Sem r (Sem r' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r' ()
-> (forall x. Sem r' (Sem r' x) -> Sem r (Sem r' x))
-> (forall x. Sem r' x -> Maybe x)
-> Union r (Sem r') a
-> Union r (Sem r) (Sem r' a)
forall (s :: * -> *) (n :: * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]) a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave (() -> Sem r' ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Sem r' x -> Sem r (Sem r' x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sem r' x -> Sem r (Sem r' x))
-> (Sem r' (Sem r' x) -> Sem r' x)
-> Sem r' (Sem r' x)
-> Sem r (Sem r' x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r' (Sem r' x) -> Sem r' x
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join) forall (r :: [(* -> *) -> * -> *]) a. Sem r a -> Maybe a
forall x. Sem r' x -> Maybe x
inspectSem
{-# INLINE embedSem #-}
newtype Ref m s a = Ref { Ref m s a -> a -> m s
runRef :: a -> m s }
instance Contravariant (Ref m s) where
contramap :: (a -> b) -> Ref m s b -> Ref m s a
contramap a -> b
f Ref m s b
ref = (a -> m s) -> Ref m s a
forall k (m :: k -> *) (s :: k) a. (a -> m s) -> Ref m s a
Ref (Ref m s b -> b -> m s
forall k (m :: k -> *) (s :: k) a. Ref m s a -> a -> m s
runRef Ref m s b
ref (b -> m s) -> (a -> b) -> a -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
newtype ExitRef m a = ExitRef { ExitRef m a -> forall (b :: k). a -> m b
enterExit :: forall b. a -> m b }
instance Contravariant (ExitRef m) where
contramap :: (a -> b) -> ExitRef m b -> ExitRef m a
contramap a -> b
f ExitRef m b
ref = (forall (b :: k). a -> m b) -> ExitRef m a
forall k (m :: k -> *) a.
(forall (b :: k). a -> m b) -> ExitRef m a
ExitRef ((forall (b :: k). a -> m b) -> ExitRef m a)
-> (forall (b :: k). a -> m b) -> ExitRef m a
forall a b. (a -> b) -> a -> b
$ \a
a -> ExitRef m b -> b -> m b
forall k (m :: k -> *) a. ExitRef m a -> forall (b :: k). a -> m b
enterExit ExitRef m b
ref (a -> b
f a
a)
data ViaFreshRef uniq a = ViaFreshRef { ViaFreshRef uniq a -> a -> (uniq, Any)
getBacktrackException :: a -> (uniq, Any) }
instance Contravariant (ViaFreshRef uniq) where
contramap :: (a -> b) -> ViaFreshRef uniq b -> ViaFreshRef uniq a
contramap a -> b
f ViaFreshRef uniq b
ref = (a -> (uniq, Any)) -> ViaFreshRef uniq a
forall uniq a. (a -> (uniq, Any)) -> ViaFreshRef uniq a
ViaFreshRef ((a -> (uniq, Any)) -> ViaFreshRef uniq a)
-> (a -> (uniq, Any)) -> ViaFreshRef uniq a
forall a b. (a -> b) -> a -> b
$ \a
a -> ViaFreshRef uniq b -> b -> (uniq, Any)
forall uniq a. ViaFreshRef uniq a -> a -> (uniq, Any)
getBacktrackException ViaFreshRef uniq b
ref (a -> b
f a
a)
runContViaFreshInC :: forall uniq s r a
. (Member (Fresh uniq) r, Eq uniq)
=> Sem (Cont (ViaFreshRef uniq) ': r) a
-> ContT s (Sem (Error (uniq, Any) ': r)) a
runContViaFreshInC :: Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a
runContViaFreshInC = (forall x.
Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> ContT s (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem ((forall x.
Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> ContT s (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a)
-> (forall x.
Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> ContT s (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a
forall a b. (a -> b) -> a -> b
$ \Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
u -> ((x -> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) s)
-> ContT s (Sem (Error (uniq, Any) : r)) x
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((x -> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) s)
-> ContT s (Sem (Error (uniq, Any) : r)) x)
-> ((x -> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) s)
-> ContT s (Sem (Error (uniq, Any) : r)) x
forall a b. (a -> b) -> a -> b
$ \x -> Sem (Error (uniq, Any) : r) s
c ->
case Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> Either
(Union r (Sem (Cont (ViaFreshRef uniq) : r)) x)
(Weaving
(Cont (ViaFreshRef uniq)) (Sem (Cont (ViaFreshRef uniq) : r)) x)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
u of
Right (Weaving Cont (ViaFreshRef uniq) (Sem rInitial) a
e f ()
s forall x.
f (Sem rInitial x) -> Sem (Cont (ViaFreshRef uniq) : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
_) ->
case Cont (ViaFreshRef uniq) (Sem rInitial) a
e of
Subst main cn -> do
uniq
ref <- Sem (Error (uniq, Any) : r) uniq
forall uniq (r :: [(* -> *) -> * -> *]).
Member (Fresh uniq) r =>
Sem r uniq
fresh
let
main' :: ViaFreshRef uniq a -> ContT s (Sem (Error (uniq, Any) : r)) (f a)
main' = Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT s (Sem (Error (uniq, Any) : r)) (f a)
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a
runContViaFreshInC (Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT s (Sem (Error (uniq, Any) : r)) (f a))
-> (ViaFreshRef uniq a -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> ViaFreshRef uniq a
-> ContT s (Sem (Error (uniq, Any) : r)) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall x.
f (Sem rInitial x) -> Sem (Cont (ViaFreshRef uniq) : r) (f x)
wv (f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> (ViaFreshRef uniq a -> f (Sem rInitial a))
-> ViaFreshRef uniq a
-> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViaFreshRef uniq a -> Sem rInitial a)
-> f (ViaFreshRef uniq a) -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ViaFreshRef uniq a -> Sem rInitial a
main (f (ViaFreshRef uniq a) -> f (Sem rInitial a))
-> (ViaFreshRef uniq a -> f (ViaFreshRef uniq a))
-> ViaFreshRef uniq a
-> f (Sem rInitial a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViaFreshRef uniq a -> f () -> f (ViaFreshRef uniq a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)
cn' :: a -> ContT s (Sem (Error (uniq, Any) : r)) (f a)
cn' = Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT s (Sem (Error (uniq, Any) : r)) (f a)
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a
runContViaFreshInC (Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT s (Sem (Error (uniq, Any) : r)) (f a))
-> (a -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> a
-> ContT s (Sem (Error (uniq, Any) : r)) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall x.
f (Sem rInitial x) -> Sem (Cont (ViaFreshRef uniq) : r) (f x)
wv (f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> (a -> f (Sem rInitial a))
-> a
-> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Sem rInitial a) -> f a -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Sem rInitial a
cn (f a -> f (Sem rInitial a))
-> (a -> f a) -> a -> f (Sem rInitial a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f () -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)
loop :: ContT s (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) s
loop ContT s (Sem (Error (uniq, Any) : r)) (f a)
act =
ContT s (Sem (Error (uniq, Any) : r)) x
-> (x -> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) s
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT (f a -> x
ex (f a -> x)
-> ContT s (Sem (Error (uniq, Any) : r)) (f a)
-> ContT s (Sem (Error (uniq, Any) : r)) x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContT s (Sem (Error (uniq, Any) : r)) (f a)
act) x -> Sem (Error (uniq, Any) : r) s
c Sem (Error (uniq, Any) : r) s
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) s
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
`catch` \ x :: (uniq, Any)
x@(uniq
ref', Any
a') -> do
if uniq
ref uniq -> uniq -> Bool
forall a. Eq a => a -> a -> Bool
== uniq
ref' then
ContT s (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) s
loop (a -> ContT s (Sem (Error (uniq, Any) : r)) (f a)
cn' (a -> ContT s (Sem (Error (uniq, Any) : r)) (f a))
-> a -> ContT s (Sem (Error (uniq, Any) : r)) (f a)
forall a b. (a -> b) -> a -> b
$ Any -> a
forall a b. a -> b
unsafeCoerce Any
a')
else
(uniq, Any) -> Sem (Error (uniq, Any) : r) s
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw @(uniq, Any) (uniq, Any)
x
ContT s (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) s
loop (ContT s (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) s)
-> ContT s (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) s
forall a b. (a -> b) -> a -> b
$ ViaFreshRef uniq a -> ContT s (Sem (Error (uniq, Any) : r)) (f a)
main' (ViaFreshRef uniq a -> ContT s (Sem (Error (uniq, Any) : r)) (f a))
-> ViaFreshRef uniq a
-> ContT s (Sem (Error (uniq, Any) : r)) (f a)
forall a b. (a -> b) -> a -> b
$ (a -> (uniq, Any)) -> ViaFreshRef uniq a
forall uniq a. (a -> (uniq, Any)) -> ViaFreshRef uniq a
ViaFreshRef (\a
a -> (uniq
ref, a -> Any
forall a b. a -> b
unsafeCoerce a
a))
Jump ref a -> (uniq, Any) -> Sem (Error (uniq, Any) : r) s
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw (ViaFreshRef uniq a -> a -> (uniq, Any)
forall uniq a. ViaFreshRef uniq a -> a -> (uniq, Any)
getBacktrackException ViaFreshRef uniq a
ref a
a)
Left Union r (Sem (Cont (ViaFreshRef uniq) : r)) x
g -> do
ResAndHandler x
a (uniq, Any) -> Sem (Error (uniq, Any) : r) x
rc <- Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall (r :: [(* -> *) -> * -> *]) a. Union r (Sem r) a -> Sem r a
liftSem (Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall a b. (a -> b) -> a -> b
$
ContFreshState uniq r ()
-> (forall x.
ContFreshState uniq r (Sem (Cont (ViaFreshRef uniq) : r) x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> (forall x. ContFreshState uniq r x -> Maybe x)
-> Union
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
forall (s :: * -> *) (n :: * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]) a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave
(()
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) ())
-> ContFreshState uniq r ()
forall uniq (r :: [(* -> *) -> * -> *]) a.
a
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) a)
-> ContFreshState uniq r a
ResAndHandler @uniq @r () (uniq, Any) -> Sem (Error (uniq, Any) : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw)
(\(ResAndHandler Sem (Cont (ViaFreshRef uniq) : r) x
a (uniq, Any)
-> Sem
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r) x)
rc) ->
ContT (ContFreshState uniq r x) (Sem (Error (uniq, Any) : r)) x
-> (x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT
(Sem (Cont (ViaFreshRef uniq) : r) x
-> ContT (ContFreshState uniq r x) (Sem (Error (uniq, Any) : r)) x
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a
runContViaFreshInCWeave Sem (Cont (ViaFreshRef uniq) : r) x
a)
(\x
x -> ContFreshState uniq r x
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContFreshState uniq r x
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> ContFreshState uniq r x
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall a b. (a -> b) -> a -> b
$
x
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) x)
-> ContFreshState uniq r x
forall uniq (r :: [(* -> *) -> * -> *]) a.
a
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) a)
-> ContFreshState uniq r a
ResAndHandler
x
x
((uniq, Any)
-> Sem
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r) x)
rc ((uniq, Any)
-> Sem
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r) x))
-> (Sem (Cont (ViaFreshRef uniq) : r) x
-> Sem (Error (uniq, Any) : r) x)
-> (uniq, Any)
-> Sem (Error (uniq, Any) : r) x
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ContT x (Sem (Error (uniq, Any) : r)) x
-> (x -> Sem (Error (uniq, Any) : r) x)
-> Sem (Error (uniq, Any) : r) x
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
`runContT` x -> Sem (Error (uniq, Any) : r) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ContT x (Sem (Error (uniq, Any) : r)) x
-> Sem (Error (uniq, Any) : r) x)
-> (Sem (Cont (ViaFreshRef uniq) : r) x
-> ContT x (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) x
-> Sem (Error (uniq, Any) : r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Cont (ViaFreshRef uniq) : r) x
-> ContT x (Sem (Error (uniq, Any) : r)) x
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a
runContViaFreshInC)
)
)
(x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x)
-> (ContFreshState uniq r x -> x)
-> ContFreshState uniq r x
-> Maybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContFreshState uniq r x -> x
forall uniq (r :: [(* -> *) -> * -> *]) a.
ContFreshState uniq r a -> a
getResult)
(Union r (Sem (Cont (ViaFreshRef uniq) : r)) x
-> Union
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
Union r m a -> Union (e : r) m a
weaken Union r (Sem (Cont (ViaFreshRef uniq) : r)) x
g)
let loop :: x -> Sem (Error (uniq, Any) : r) s
loop x
x = x -> Sem (Error (uniq, Any) : r) s
c x
x Sem (Error (uniq, Any) : r) s
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) s
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
`catch` ((uniq, Any) -> Sem (Error (uniq, Any) : r) x
rc ((uniq, Any) -> Sem (Error (uniq, Any) : r) x)
-> (x -> Sem (Error (uniq, Any) : r) s)
-> (uniq, Any)
-> Sem (Error (uniq, Any) : r) s
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> x -> Sem (Error (uniq, Any) : r) s
loop)
x -> Sem (Error (uniq, Any) : r) s
loop x
a
runContViaFreshInCWeave :: forall uniq s r a
. (Member (Fresh uniq) r, Eq uniq)
=> Sem (Cont (ViaFreshRef uniq) ': r) a
-> ContT (ContFreshState uniq r s)
(Sem (Error (uniq, Any) ': r))
a
runContViaFreshInCWeave :: Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a
runContViaFreshInCWeave = (forall x.
Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem ((forall x.
Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a)
-> (forall x.
Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a
forall a b. (a -> b) -> a -> b
$ \Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
u -> ((x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x)
-> ((x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x
forall a b. (a -> b) -> a -> b
$ \x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
c ->
case Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> Either
(Union r (Sem (Cont (ViaFreshRef uniq) : r)) x)
(Weaving
(Cont (ViaFreshRef uniq)) (Sem (Cont (ViaFreshRef uniq) : r)) x)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union
(Cont (ViaFreshRef uniq) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
u of
Right (Weaving Cont (ViaFreshRef uniq) (Sem rInitial) a
e f ()
s forall x.
f (Sem rInitial x) -> Sem (Cont (ViaFreshRef uniq) : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
_) ->
case Cont (ViaFreshRef uniq) (Sem rInitial) a
e of
Subst main cn -> do
uniq
ref <- Sem (Error (uniq, Any) : r) uniq
forall uniq (r :: [(* -> *) -> * -> *]).
Member (Fresh uniq) r =>
Sem r uniq
fresh
let
main' :: ViaFreshRef uniq a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
main' = Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a
runContViaFreshInCWeave (Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a))
-> (ViaFreshRef uniq a -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> ViaFreshRef uniq a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall x.
f (Sem rInitial x) -> Sem (Cont (ViaFreshRef uniq) : r) (f x)
wv (f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> (ViaFreshRef uniq a -> f (Sem rInitial a))
-> ViaFreshRef uniq a
-> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViaFreshRef uniq a -> Sem rInitial a)
-> f (ViaFreshRef uniq a) -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ViaFreshRef uniq a -> Sem rInitial a
main (f (ViaFreshRef uniq a) -> f (Sem rInitial a))
-> (ViaFreshRef uniq a -> f (ViaFreshRef uniq a))
-> ViaFreshRef uniq a
-> f (Sem rInitial a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViaFreshRef uniq a -> f () -> f (ViaFreshRef uniq a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)
cn' :: a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
cn' = Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a
runContViaFreshInCWeave (Sem (Cont (ViaFreshRef uniq) : r) (f a)
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a))
-> (a -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall x.
f (Sem rInitial x) -> Sem (Cont (ViaFreshRef uniq) : r) (f x)
wv (f (Sem rInitial a) -> Sem (Cont (ViaFreshRef uniq) : r) (f a))
-> (a -> f (Sem rInitial a))
-> a
-> Sem (Cont (ViaFreshRef uniq) : r) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Sem rInitial a) -> f a -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Sem rInitial a
cn (f a -> f (Sem rInitial a))
-> (a -> f a) -> a -> f (Sem rInitial a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f () -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)
loop :: ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
act =
ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x
-> (x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT (f a -> x
ex (f a -> x)
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
act) x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
c Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
-> ((uniq, Any)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
`catch` \ x :: (uniq, Any)
x@(uniq
ref', Any
a') -> do
if uniq
ref uniq -> uniq -> Bool
forall a. Eq a => a -> a -> Bool
== uniq
ref' then
ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop (a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
cn' (a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a))
-> a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall a b. (a -> b) -> a -> b
$ Any -> a
forall a b. a -> b
unsafeCoerce Any
a')
else
(uniq, Any)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw @(uniq, Any) (uniq, Any)
x
ResAndHandler s
res (uniq, Any) -> Sem (Error (uniq, Any) : r) s
h <-
ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop (ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall a b. (a -> b) -> a -> b
$ ViaFreshRef uniq a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
main' (ViaFreshRef uniq a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a))
-> ViaFreshRef uniq a
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall a b. (a -> b) -> a -> b
$ (a -> (uniq, Any)) -> ViaFreshRef uniq a
forall uniq a. (a -> (uniq, Any)) -> ViaFreshRef uniq a
ViaFreshRef (\a
a -> (uniq
ref, a -> Any
forall a b. a -> b
unsafeCoerce a
a))
ContFreshState uniq r s
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall (m :: * -> *) a. Monad m => a -> m a
return (ContFreshState uniq r s
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContFreshState uniq r s
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall a b. (a -> b) -> a -> b
$ s
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> ContFreshState uniq r s
forall uniq (r :: [(* -> *) -> * -> *]) a.
a
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) a)
-> ContFreshState uniq r a
ResAndHandler s
res
(((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> ContFreshState uniq r s)
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> ContFreshState uniq r s
forall a b. (a -> b) -> a -> b
$ \(uniq, Any)
x -> (ContFreshState uniq r s -> s)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
-> Sem (Error (uniq, Any) : r) s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ContFreshState uniq r s -> s
forall uniq (r :: [(* -> *) -> * -> *]) a.
ContFreshState uniq r a -> a
getResult (Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
-> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
-> Sem (Error (uniq, Any) : r) s
forall a b. (a -> b) -> a -> b
$ ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop (ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall a b. (a -> b) -> a -> b
$ ((f a -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((f a -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a))
-> ((f a -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> ContT
(ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) (f a)
forall a b. (a -> b) -> a -> b
$ \f a -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
_ -> (s -> ContFreshState uniq r s)
-> Sem (Error (uniq, Any) : r) s
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> ContFreshState uniq r s
forall uniq (r :: [(* -> *) -> * -> *]) a.
a
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) a)
-> ContFreshState uniq r a
`ResAndHandler` (uniq, Any) -> Sem (Error (uniq, Any) : r) s
h) ((uniq, Any) -> Sem (Error (uniq, Any) : r) s
h (uniq, Any)
x)
Jump ref a -> (uniq, Any)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw (ViaFreshRef uniq a -> a -> (uniq, Any)
forall uniq a. ViaFreshRef uniq a -> a -> (uniq, Any)
getBacktrackException ViaFreshRef uniq a
ref a
a)
Left Union r (Sem (Cont (ViaFreshRef uniq) : r)) x
g -> do
ResAndHandler x
a (uniq, Any) -> Sem (Error (uniq, Any) : r) x
h <- Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall (r :: [(* -> *) -> * -> *]) a. Union r (Sem r) a -> Sem r a
liftSem (Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall a b. (a -> b) -> a -> b
$
ContFreshState uniq r ()
-> (forall x.
ContFreshState uniq r (Sem (Cont (ViaFreshRef uniq) : r) x)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> (forall x. ContFreshState uniq r x -> Maybe x)
-> Union
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
-> Union
(Error (uniq, Any) : r)
(Sem (Error (uniq, Any) : r))
(ContFreshState uniq r x)
forall (s :: * -> *) (n :: * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]) a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave
(()
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) ())
-> ContFreshState uniq r ()
forall uniq (r :: [(* -> *) -> * -> *]) a.
a
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) a)
-> ContFreshState uniq r a
ResAndHandler @uniq @r () (uniq, Any) -> Sem (Error (uniq, Any) : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw)
(\(ResAndHandler Sem (Cont (ViaFreshRef uniq) : r) x
a (uniq, Any)
-> Sem
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r) x)
rc) ->
ContT (ContFreshState uniq r x) (Sem (Error (uniq, Any) : r)) x
-> (x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT
(Sem (Cont (ViaFreshRef uniq) : r) x
-> ContT (ContFreshState uniq r x) (Sem (Error (uniq, Any) : r)) x
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT (ContFreshState uniq r s) (Sem (Error (uniq, Any) : r)) a
runContViaFreshInCWeave Sem (Cont (ViaFreshRef uniq) : r) x
a)
(\x
x -> ContFreshState uniq r x
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContFreshState uniq r x
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x))
-> ContFreshState uniq r x
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r x)
forall a b. (a -> b) -> a -> b
$
x
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) x)
-> ContFreshState uniq r x
forall uniq (r :: [(* -> *) -> * -> *]) a.
a
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) a)
-> ContFreshState uniq r a
ResAndHandler
x
x
((uniq, Any)
-> Sem
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r) x)
rc ((uniq, Any)
-> Sem
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r) x))
-> (Sem (Cont (ViaFreshRef uniq) : r) x
-> Sem (Error (uniq, Any) : r) x)
-> (uniq, Any)
-> Sem (Error (uniq, Any) : r) x
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ContT x (Sem (Error (uniq, Any) : r)) x
-> (x -> Sem (Error (uniq, Any) : r) x)
-> Sem (Error (uniq, Any) : r) x
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
`runContT` x -> Sem (Error (uniq, Any) : r) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ContT x (Sem (Error (uniq, Any) : r)) x
-> Sem (Error (uniq, Any) : r) x)
-> (Sem (Cont (ViaFreshRef uniq) : r) x
-> ContT x (Sem (Error (uniq, Any) : r)) x)
-> Sem (Cont (ViaFreshRef uniq) : r) x
-> Sem (Error (uniq, Any) : r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Cont (ViaFreshRef uniq) : r) x
-> ContT x (Sem (Error (uniq, Any) : r)) x
forall uniq s (r :: [(* -> *) -> * -> *]) a.
(Member (Fresh uniq) r, Eq uniq) =>
Sem (Cont (ViaFreshRef uniq) : r) a
-> ContT s (Sem (Error (uniq, Any) : r)) a
runContViaFreshInC)
)
)
(x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x)
-> (ContFreshState uniq r x -> x)
-> ContFreshState uniq r x
-> Maybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContFreshState uniq r x -> x
forall uniq (r :: [(* -> *) -> * -> *]) a.
ContFreshState uniq r a -> a
getResult)
(Union r (Sem (Cont (ViaFreshRef uniq) : r)) x
-> Union
(Error (uniq, Any) : r) (Sem (Cont (ViaFreshRef uniq) : r)) x
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
Union r m a -> Union (e : r) m a
weaken Union r (Sem (Cont (ViaFreshRef uniq) : r)) x
g)
let loop :: x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop x
x = x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
c x
x Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
-> ((uniq, Any)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
`catch` ((uniq, Any) -> Sem (Error (uniq, Any) : r) x
h ((uniq, Any) -> Sem (Error (uniq, Any) : r) x)
-> (x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> (uniq, Any)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop)
ResAndHandler s
res (uniq, Any) -> Sem (Error (uniq, Any) : r) s
h' <- x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop x
a
ContFreshState uniq r s
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> ContFreshState uniq r s
forall uniq (r :: [(* -> *) -> * -> *]) a.
a
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) a)
-> ContFreshState uniq r a
ResAndHandler s
res (((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> ContFreshState uniq r s)
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> ContFreshState uniq r s
forall a b. (a -> b) -> a -> b
$ \(uniq, Any)
x -> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s
h' (uniq, Any)
x Sem (Error (uniq, Any) : r) s
-> ((uniq, Any) -> Sem (Error (uniq, Any) : r) s)
-> Sem (Error (uniq, Any) : r) s
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
`catch` ((uniq, Any) -> Sem (Error (uniq, Any) : r) x
h ((uniq, Any) -> Sem (Error (uniq, Any) : r) x)
-> (x -> Sem (Error (uniq, Any) : r) s)
-> (uniq, Any)
-> Sem (Error (uniq, Any) : r) s
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ContFreshState uniq r s -> s)
-> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
-> Sem (Error (uniq, Any) : r) s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ContFreshState uniq r s -> s
forall uniq (r :: [(* -> *) -> * -> *]) a.
ContFreshState uniq r a -> a
getResult (Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
-> Sem (Error (uniq, Any) : r) s)
-> (x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s))
-> x
-> Sem (Error (uniq, Any) : r) s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Sem (Error (uniq, Any) : r) (ContFreshState uniq r s)
loop)))
data ContFreshState uniq r a = ResAndHandler {
ContFreshState uniq r a -> a
getResult :: a
, ContFreshState uniq r a
-> (uniq, Any) -> Sem (Error (uniq, Any) : r) a
getHandler :: (uniq, Any) -> Sem (Error (uniq, Any) ': r) a
}
deriving a -> ContFreshState uniq r b -> ContFreshState uniq r a
(a -> b) -> ContFreshState uniq r a -> ContFreshState uniq r b
(forall a b.
(a -> b) -> ContFreshState uniq r a -> ContFreshState uniq r b)
-> (forall a b.
a -> ContFreshState uniq r b -> ContFreshState uniq r a)
-> Functor (ContFreshState uniq r)
forall uniq (r :: [(* -> *) -> * -> *]) a b.
a -> ContFreshState uniq r b -> ContFreshState uniq r a
forall uniq (r :: [(* -> *) -> * -> *]) a b.
(a -> b) -> ContFreshState uniq r a -> ContFreshState uniq r b
forall a b. a -> ContFreshState uniq r b -> ContFreshState uniq r a
forall a b.
(a -> b) -> ContFreshState uniq r a -> ContFreshState uniq r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ContFreshState uniq r b -> ContFreshState uniq r a
$c<$ :: forall uniq (r :: [(* -> *) -> * -> *]) a b.
a -> ContFreshState uniq r b -> ContFreshState uniq r a
fmap :: (a -> b) -> ContFreshState uniq r a -> ContFreshState uniq r b
$cfmap :: forall uniq (r :: [(* -> *) -> * -> *]) a b.
(a -> b) -> ContFreshState uniq r a -> ContFreshState uniq r b
Functor