module Polysemy.Internal.Union.Inject
  ( inject
  , Inject
  ) where

import Polysemy.Internal
import Polysemy.Internal.Union


------------------------------------------------------------------------------
-- | Morally:
--
-- @
-- 'inject' :: 'Members' effs r => 'Sem' effs a -> 'Sem' r a
-- @
inject :: Inject effs r => Sem effs a -> Sem r a
inject :: Sem effs a -> Sem r a
inject (Sem a :: forall (m :: * -> *).
Monad m =>
(forall x. Union effs (Sem effs) x -> m x) -> m a
a) = (forall x. Union effs (Sem effs) x -> Sem r x) -> Sem r a
forall (m :: * -> *).
Monad m =>
(forall x. Union effs (Sem effs) x -> m x) -> m a
a ((forall x. Union effs (Sem effs) x -> Sem r x) -> Sem r a)
-> (forall x. Union effs (Sem effs) x -> Sem r x) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Union r (Sem r) x -> Sem r x
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union r (Sem r) x -> Sem r x)
-> (Union effs (Sem effs) x -> Union r (Sem r) x)
-> Union effs (Sem effs) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union effs (Sem r) x -> Union r (Sem r) x
forall (effs :: EffectRow) (r :: EffectRow) a.
Inject effs r =>
Union effs (Sem r) a -> Union r (Sem r) a
deject (Union effs (Sem r) x -> Union r (Sem r) x)
-> (Union effs (Sem effs) x -> Union effs (Sem r) x)
-> Union effs (Sem effs) x
-> Union r (Sem r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Sem effs x -> Sem r x)
-> Union effs (Sem effs) x -> Union effs (Sem r) x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall (effs :: EffectRow) (r :: EffectRow) a.
Inject effs r =>
Sem effs a -> Sem r a
forall x. Sem effs x -> Sem r x
inject


------------------------------------------------------------------------------
-- | Helper class for munging the 'Union' so that we can implement 'inject'.
class Inject effs r where
  deject :: Union effs (Sem r) a -> Union r (Sem r) a

instance Inject '[] r where
  deject :: Union '[] (Sem r) a -> Union r (Sem r) a
deject = Union '[] (Sem r) a -> Union r (Sem r) a
forall (m :: * -> *) a b. Union '[] m a -> b
absurdU

instance {-# INCOHERENT #-} Inject r r where
  deject :: Union r (Sem r) a -> Union r (Sem r) a
deject = Union r (Sem r) a -> Union r (Sem r) a
forall a. a -> a
id

instance (Member eff r, Inject effs r) => Inject (eff ': effs) r where
  deject :: Union (eff : effs) (Sem r) a -> Union r (Sem r) a
deject u :: Union (eff : effs) (Sem r) a
u =
    case Union (eff : effs) (Sem r) a
-> Either (Union effs (Sem r) a) (Weaving eff (Sem r) a)
forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (eff : effs) (Sem r) a
u of
      Left  u' :: Union effs (Sem r) a
u' -> Union effs (Sem r) a -> Union r (Sem r) a
forall (effs :: EffectRow) (r :: EffectRow) a.
Inject effs r =>
Union effs (Sem r) a -> Union r (Sem r) a
deject Union effs (Sem r) a
u'
      Right w :: Weaving eff (Sem r) a
w  -> ElemOf eff r -> Weaving eff (Sem r) a -> Union r (Sem r) a
forall (e :: Effect) (r :: EffectRow) (mWoven :: * -> *) a.
ElemOf e r -> Weaving e mWoven a -> Union r mWoven a
Union ElemOf eff r
forall a (e :: a) (r :: [a]). Member e r => ElemOf e r
membership Weaving eff (Sem r) a
w