{-# LANGUAGE AllowAmbiguousTypes #-}
module Polysemy.Final.NonDet
(
module Polysemy.NonDet
, nonDetToFinal
) where
import Control.Applicative
import Polysemy
import Polysemy.NonDet
import Polysemy.Final
nonDetToFinal :: forall m r a
. (Member (Final m) r, Alternative m)
=> Sem (NonDet ': r) a
-> Sem r a
nonDetToFinal :: Sem (NonDet : r) a -> Sem r a
nonDetToFinal = forall (m :: * -> *) (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal @m ((forall x (rInitial :: EffectRow).
NonDet (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (NonDet : r) a -> Sem r a)
-> (forall x (rInitial :: EffectRow).
NonDet (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (NonDet : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
NonDet (Sem rInitial) x
Empty -> m (f x) -> Sem (WithStrategy m f (Sem rInitial)) (m (f x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure m (f x)
forall (f :: * -> *) a. Alternative f => f a
empty
Choose left right -> do
m (f x)
left' <- Sem rInitial x -> Sem (WithStrategy m f (Sem rInitial)) (m (f x))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial x
left
m (f x)
right' <- Sem rInitial x -> Sem (WithStrategy m f (Sem rInitial)) (m (f x))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial x
right
m (f x) -> Sem (WithStrategy m f (Sem rInitial)) (m (f x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (f x) -> Sem (WithStrategy m f (Sem rInitial)) (m (f x)))
-> m (f x) -> Sem (WithStrategy m f (Sem rInitial)) (m (f x))
forall a b. (a -> b) -> a -> b
$ m (f x)
left' m (f x) -> m (f x) -> m (f x)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (f x)
right'
{-# INLINE nonDetToFinal #-}