{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Effect.Labelled
( runLabelled
, Labelled(Labelled)
, LabelledMember(..)
, HasLabelled
, sendLabelled
, runUnderLabel
, UnderLabel(UnderLabel)
, module Control.Algebra
) where
import Control.Algebra
import Control.Applicative (Alternative)
import Control.Effect.Sum (reassociateSumL)
import Control.Monad (MonadPlus)
import Control.Monad.Fail as Fail
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.Kind (Type)
newtype Labelled (label :: k) (sub :: (Type -> Type) -> (Type -> Type)) m a = Labelled (sub m a)
deriving (Applicative (Labelled label sub m)
Labelled label sub m a
Applicative (Labelled label sub m) =>
(forall a. Labelled label sub m a)
-> (forall a.
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a)
-> (forall a. Labelled label sub m a -> Labelled label sub m [a])
-> (forall a. Labelled label sub m a -> Labelled label sub m [a])
-> Alternative (Labelled label sub m)
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
Labelled label sub m a -> Labelled label sub m [a]
Labelled label sub m a -> Labelled label sub m [a]
forall a. Labelled label sub m a
forall a. Labelled label sub m a -> Labelled label sub m [a]
forall a.
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Alternative (sub m) =>
Applicative (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a -> Labelled label sub m [a]
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Labelled label sub m a -> Labelled label sub m [a]
$cmany :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a -> Labelled label sub m [a]
some :: Labelled label sub m a -> Labelled label sub m [a]
$csome :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a -> Labelled label sub m [a]
<|> :: Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
$c<|> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
empty :: Labelled label sub m a
$cempty :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a
$cp1Alternative :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Alternative (sub m) =>
Applicative (Labelled label sub m)
Alternative, Functor (Labelled label sub m)
a -> Labelled label sub m a
Functor (Labelled label sub m) =>
(forall a. a -> Labelled label sub m a)
-> (forall a b.
Labelled label sub m (a -> b)
-> Labelled label sub m a -> Labelled label sub m b)
-> (forall a b c.
(a -> b -> c)
-> Labelled label sub m a
-> Labelled label sub m b
-> Labelled label sub m c)
-> (forall a b.
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b)
-> (forall a b.
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m a)
-> Applicative (Labelled label sub m)
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m a
Labelled label sub m (a -> b)
-> Labelled label sub m a -> Labelled label sub m b
(a -> b -> c)
-> Labelled label sub m a
-> Labelled label sub m b
-> Labelled label sub m c
forall a. a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Applicative (sub m) =>
Functor (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (sub m) =>
a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative (sub m) =>
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative (sub m) =>
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative (sub m) =>
Labelled label sub m (a -> b)
-> Labelled label sub m a -> Labelled label sub m b
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a b
c.
Applicative (sub m) =>
(a -> b -> c)
-> Labelled label sub m a
-> Labelled label sub m b
-> Labelled label sub m c
forall a b.
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m a
forall a b.
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
forall a b.
Labelled label sub m (a -> b)
-> Labelled label sub m a -> Labelled label sub m b
forall a b c.
(a -> b -> c)
-> Labelled label sub m a
-> Labelled label sub m b
-> Labelled label sub m 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
<* :: Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m a
$c<* :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative (sub m) =>
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m a
*> :: Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
$c*> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative (sub m) =>
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
liftA2 :: (a -> b -> c)
-> Labelled label sub m a
-> Labelled label sub m b
-> Labelled label sub m c
$cliftA2 :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a b
c.
Applicative (sub m) =>
(a -> b -> c)
-> Labelled label sub m a
-> Labelled label sub m b
-> Labelled label sub m c
<*> :: Labelled label sub m (a -> b)
-> Labelled label sub m a -> Labelled label sub m b
$c<*> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative (sub m) =>
Labelled label sub m (a -> b)
-> Labelled label sub m a -> Labelled label sub m b
pure :: a -> Labelled label sub m a
$cpure :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (sub m) =>
a -> Labelled label sub m a
$cp1Applicative :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Applicative (sub m) =>
Functor (Labelled label sub m)
Applicative, HFunctor (Labelled label sub)
ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Labelled label sub m a
-> Labelled label sub n (ctx a)
HFunctor (Labelled label sub) =>
(forall (ctx :: * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx, Monad m) =>
ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Labelled label sub m a
-> Labelled label sub n (ctx a))
-> Effect (Labelled label sub)
forall k (label :: k) (sub :: (* -> *) -> * -> *).
Effect sub =>
HFunctor (Labelled label sub)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (ctx :: * -> *)
(m :: * -> *) (n :: * -> *) a.
(Effect sub, Functor ctx, Monad m) =>
ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Labelled label sub m a
-> Labelled label sub n (ctx a)
forall (ctx :: * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx, Monad m) =>
ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Labelled label sub m a
-> Labelled label sub n (ctx a)
forall (sig :: (* -> *) -> * -> *).
HFunctor sig =>
(forall (ctx :: * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx, Monad m) =>
ctx ()
-> (forall x. ctx (m x) -> n (ctx x)) -> sig m a -> sig n (ctx a))
-> Effect sig
thread :: ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Labelled label sub m a
-> Labelled label sub n (ctx a)
$cthread :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (ctx :: * -> *)
(m :: * -> *) (n :: * -> *) a.
(Effect sub, Functor ctx, Monad m) =>
ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Labelled label sub m a
-> Labelled label sub n (ctx a)
$cp1Effect :: forall k (label :: k) (sub :: (* -> *) -> * -> *).
Effect sub =>
HFunctor (Labelled label sub)
Effect, a -> Labelled label sub m b -> Labelled label sub m a
(a -> b) -> Labelled label sub m a -> Labelled label sub m b
(forall a b.
(a -> b) -> Labelled label sub m a -> Labelled label sub m b)
-> (forall a b.
a -> Labelled label sub m b -> Labelled label sub m a)
-> Functor (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor (sub m) =>
a -> Labelled label sub m b -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor (sub m) =>
(a -> b) -> Labelled label sub m a -> Labelled label sub m b
forall a b. a -> Labelled label sub m b -> Labelled label sub m a
forall a b.
(a -> b) -> Labelled label sub m a -> Labelled label sub m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Labelled label sub m b -> Labelled label sub m a
$c<$ :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor (sub m) =>
a -> Labelled label sub m b -> Labelled label sub m a
fmap :: (a -> b) -> Labelled label sub m a -> Labelled label sub m b
$cfmap :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor (sub m) =>
(a -> b) -> Labelled label sub m a -> Labelled label sub m b
Functor, (forall x. m x -> n x)
-> Labelled label sub m a -> Labelled label sub n a
(forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall x. m x -> n x)
-> Labelled label sub m a -> Labelled label sub n a)
-> HFunctor (Labelled label sub)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
(n :: * -> *) a.
(HFunctor sub, Functor m) =>
(forall x. m x -> n x)
-> Labelled label sub m a -> Labelled label sub n a
forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall x. m x -> n x)
-> Labelled label sub m a -> Labelled label sub n a
forall (h :: (* -> *) -> * -> *).
(forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall x. m x -> n x) -> h m a -> h n a)
-> HFunctor h
hmap :: (forall x. m x -> n x)
-> Labelled label sub m a -> Labelled label sub n a
$chmap :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
(n :: * -> *) a.
(HFunctor sub, Functor m) =>
(forall x. m x -> n x)
-> Labelled label sub m a -> Labelled label sub n a
HFunctor, Applicative (Labelled label sub m)
a -> Labelled label sub m a
Applicative (Labelled label sub m) =>
(forall a b.
Labelled label sub m a
-> (a -> Labelled label sub m b) -> Labelled label sub m b)
-> (forall a b.
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b)
-> (forall a. a -> Labelled label sub m a)
-> Monad (Labelled label sub m)
Labelled label sub m a
-> (a -> Labelled label sub m b) -> Labelled label sub m b
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
forall a. a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Monad (sub m) =>
Applicative (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (sub m) =>
a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad (sub m) =>
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad (sub m) =>
Labelled label sub m a
-> (a -> Labelled label sub m b) -> Labelled label sub m b
forall a b.
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
forall a b.
Labelled label sub m a
-> (a -> Labelled label sub m b) -> Labelled label sub m 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
return :: a -> Labelled label sub m a
$creturn :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (sub m) =>
a -> Labelled label sub m a
>> :: Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
$c>> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad (sub m) =>
Labelled label sub m a
-> Labelled label sub m b -> Labelled label sub m b
>>= :: Labelled label sub m a
-> (a -> Labelled label sub m b) -> Labelled label sub m b
$c>>= :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad (sub m) =>
Labelled label sub m a
-> (a -> Labelled label sub m b) -> Labelled label sub m b
$cp1Monad :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Monad (sub m) =>
Applicative (Labelled label sub m)
Monad, Monad (Labelled label sub m)
Monad (Labelled label sub m) =>
(forall a. String -> Labelled label sub m a)
-> MonadFail (Labelled label sub m)
String -> Labelled label sub m a
forall a. String -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadFail (sub m) =>
Monad (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail (sub m) =>
String -> Labelled label sub m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> Labelled label sub m a
$cfail :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail (sub m) =>
String -> Labelled label sub m a
$cp1MonadFail :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadFail (sub m) =>
Monad (Labelled label sub m)
Fail.MonadFail, Monad (Labelled label sub m)
Monad (Labelled label sub m) =>
(forall a. IO a -> Labelled label sub m a)
-> MonadIO (Labelled label sub m)
IO a -> Labelled label sub m a
forall a. IO a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadIO (sub m) =>
Monad (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIO (sub m) =>
IO a -> Labelled label sub m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Labelled label sub m a
$cliftIO :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIO (sub m) =>
IO a -> Labelled label sub m a
$cp1MonadIO :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadIO (sub m) =>
Monad (Labelled label sub m)
MonadIO, Monad (Labelled label sub m)
Alternative (Labelled label sub m)
Labelled label sub m a
(Alternative (Labelled label sub m),
Monad (Labelled label sub m)) =>
(forall a. Labelled label sub m a)
-> (forall a.
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a)
-> MonadPlus (Labelled label sub m)
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
forall a. Labelled label sub m a
forall a.
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus (sub m) =>
Monad (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus (sub m) =>
Alternative (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus (sub m) =>
Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus (sub m) =>
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
mplus :: Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
$cmplus :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus (sub m) =>
Labelled label sub m a
-> Labelled label sub m a -> Labelled label sub m a
mzero :: Labelled label sub m a
$cmzero :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus (sub m) =>
Labelled label sub m a
$cp2MonadPlus :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus (sub m) =>
Monad (Labelled label sub m)
$cp1MonadPlus :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus (sub m) =>
Alternative (Labelled label sub m)
MonadPlus, m a -> Labelled label sub m a
(forall (m :: * -> *) a. Monad m => m a -> Labelled label sub m a)
-> MonadTrans (Labelled label sub)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans sub, Monad m) =>
m a -> Labelled label sub m a
forall (m :: * -> *) a. Monad m => m a -> Labelled label sub m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Labelled label sub m a
$clift :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans sub, Monad m) =>
m a -> Labelled label sub m a
MonadTrans)
runLabelled :: forall label sub m a . Labelled label sub m a -> sub m a
runLabelled :: Labelled label sub m a -> sub m a
runLabelled (Labelled l :: sub m a
l) = sub m a
l
instance (Algebra (eff :+: sig) (sub m), HFunctor eff, HFunctor sig) => Algebra (Labelled label eff :+: sig) (Labelled label sub m) where
alg :: (:+:) (Labelled label eff) sig (Labelled label sub m) a
-> Labelled label sub m a
alg = \case
L eff :: Labelled label eff (Labelled label sub m) a
eff -> sub m a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
sub m a -> Labelled label sub m a
Labelled (eff (sub m) a -> sub m a
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
(m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (eff (Labelled label sub m) a -> eff (sub m) a
forall (sig :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *) a.
(HFunctor sig, Functor f, Coercible f g) =>
sig f a -> sig g a
handleCoercible (Labelled label eff (Labelled label sub m) a
-> eff (Labelled label sub m) a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Labelled label sub m a -> sub m a
runLabelled Labelled label eff (Labelled label sub m) a
eff)))
R sig :: sig (Labelled label sub m) a
sig -> sub m a -> Labelled label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
sub m a -> Labelled label sub m a
Labelled (sig (sub m) a -> sub m a
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
(m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (sig (Labelled label sub m) a -> sig (sub m) a
forall (sig :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *) a.
(HFunctor sig, Functor f, Coercible f g) =>
sig f a -> sig g a
handleCoercible sig (Labelled label sub m) a
sig))
{-# INLINE alg #-}
class LabelledMember label (sub :: (Type -> Type) -> (Type -> Type)) sup | label sup -> sub where
injLabelled :: Labelled label sub m a -> sup m a
instance LabelledMember label t (Labelled label t) where
injLabelled :: Labelled label t m a -> Labelled label t m a
injLabelled = Labelled label t m a -> Labelled label t m a
forall a. a -> a
id
{-# INLINE injLabelled #-}
instance {-# OVERLAPPABLE #-}
LabelledMember label t (l1 :+: l2 :+: r)
=> LabelledMember label t ((l1 :+: l2) :+: r) where
injLabelled :: Labelled label t m a -> (:+:) (l1 :+: l2) r m a
injLabelled = (:+:) l1 (l2 :+: r) m a -> (:+:) (l1 :+: l2) r m a
forall (l1 :: (* -> *) -> * -> *) (l2 :: (* -> *) -> * -> *)
(r :: (* -> *) -> * -> *) (m :: * -> *) a.
(:+:) l1 (l2 :+: r) m a -> (:+:) (l1 :+: l2) r m a
reassociateSumL ((:+:) l1 (l2 :+: r) m a -> (:+:) (l1 :+: l2) r m a)
-> (Labelled label t m a -> (:+:) l1 (l2 :+: r) m a)
-> Labelled label t m a
-> (:+:) (l1 :+: l2) r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Labelled label t m a -> (:+:) l1 (l2 :+: r) m a
forall k (label :: k) (sub :: (* -> *) -> * -> *)
(sup :: (* -> *) -> * -> *) (m :: * -> *) a.
LabelledMember label sub sup =>
Labelled label sub m a -> sup m a
injLabelled
{-# INLINE injLabelled #-}
instance {-# OVERLAPPABLE #-}
LabelledMember label l (Labelled label l :+: r) where
injLabelled :: Labelled label l m a -> (:+:) (Labelled label l) r m a
injLabelled = Labelled label l m a -> (:+:) (Labelled label l) r m a
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
(m :: * -> *) k.
f m k -> (:+:) f g m k
L
{-# INLINE injLabelled #-}
instance {-# OVERLAPPABLE #-}
LabelledMember label l r
=> LabelledMember label l (l' :+: r) where
injLabelled :: Labelled label l m a -> (:+:) l' r m a
injLabelled = r m a -> (:+:) l' r m a
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
(m :: * -> *) k.
g m k -> (:+:) f g m k
R (r m a -> (:+:) l' r m a)
-> (Labelled label l m a -> r m a)
-> Labelled label l m a
-> (:+:) l' r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Labelled label l m a -> r m a
forall k (label :: k) (sub :: (* -> *) -> * -> *)
(sup :: (* -> *) -> * -> *) (m :: * -> *) a.
LabelledMember label sub sup =>
Labelled label sub m a -> sup m a
injLabelled
{-# INLINE injLabelled #-}
type HasLabelled label eff sig m = (LabelledMember label eff sig, Algebra sig m)
sendLabelled :: forall label eff sig m a . HasLabelled label eff sig m => eff m a -> m a
sendLabelled :: eff m a -> m a
sendLabelled = sig m a -> m a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Algebra sig m =>
sig m a -> m a
alg (sig m a -> m a) -> (eff m a -> sig m a) -> eff m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (label :: k) (sub :: (* -> *) -> * -> *)
(sup :: (* -> *) -> * -> *) (m :: * -> *) a.
LabelledMember label sub sup =>
Labelled label sub m a -> sup m a
forall (sub :: (* -> *) -> * -> *) (sup :: (* -> *) -> * -> *)
(m :: * -> *) a.
LabelledMember label sub sup =>
Labelled label sub m a -> sup m a
injLabelled @label (Labelled label eff m a -> sig m a)
-> (eff m a -> Labelled label eff m a) -> eff m a -> sig m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. eff m a -> Labelled label eff m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
sub m a -> Labelled label sub m a
Labelled
{-# INLINABLE sendLabelled #-}
newtype UnderLabel (label :: k) (sub :: (Type -> Type) -> (Type -> Type)) (m :: Type -> Type) a = UnderLabel (m a)
deriving (Applicative (UnderLabel label sub m)
UnderLabel label sub m a
Applicative (UnderLabel label sub m) =>
(forall a. UnderLabel label sub m a)
-> (forall a.
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a)
-> (forall a.
UnderLabel label sub m a -> UnderLabel label sub m [a])
-> (forall a.
UnderLabel label sub m a -> UnderLabel label sub m [a])
-> Alternative (UnderLabel label sub m)
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
UnderLabel label sub m a -> UnderLabel label sub m [a]
UnderLabel label sub m a -> UnderLabel label sub m [a]
forall a. UnderLabel label sub m a
forall a. UnderLabel label sub m a -> UnderLabel label sub m [a]
forall a.
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Alternative m =>
Applicative (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a -> UnderLabel label sub m [a]
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: UnderLabel label sub m a -> UnderLabel label sub m [a]
$cmany :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a -> UnderLabel label sub m [a]
some :: UnderLabel label sub m a -> UnderLabel label sub m [a]
$csome :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a -> UnderLabel label sub m [a]
<|> :: UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
$c<|> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
empty :: UnderLabel label sub m a
$cempty :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a
$cp1Alternative :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Alternative m =>
Applicative (UnderLabel label sub m)
Alternative, Functor (UnderLabel label sub m)
a -> UnderLabel label sub m a
Functor (UnderLabel label sub m) =>
(forall a. a -> UnderLabel label sub m a)
-> (forall a b.
UnderLabel label sub m (a -> b)
-> UnderLabel label sub m a -> UnderLabel label sub m b)
-> (forall a b c.
(a -> b -> c)
-> UnderLabel label sub m a
-> UnderLabel label sub m b
-> UnderLabel label sub m c)
-> (forall a b.
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b)
-> (forall a b.
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m a)
-> Applicative (UnderLabel label sub m)
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m a
UnderLabel label sub m (a -> b)
-> UnderLabel label sub m a -> UnderLabel label sub m b
(a -> b -> c)
-> UnderLabel label sub m a
-> UnderLabel label sub m b
-> UnderLabel label sub m c
forall a. a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Applicative m =>
Functor (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative m =>
a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative m =>
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative m =>
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative m =>
UnderLabel label sub m (a -> b)
-> UnderLabel label sub m a -> UnderLabel label sub m b
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a b
c.
Applicative m =>
(a -> b -> c)
-> UnderLabel label sub m a
-> UnderLabel label sub m b
-> UnderLabel label sub m c
forall a b.
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m a
forall a b.
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
forall a b.
UnderLabel label sub m (a -> b)
-> UnderLabel label sub m a -> UnderLabel label sub m b
forall a b c.
(a -> b -> c)
-> UnderLabel label sub m a
-> UnderLabel label sub m b
-> UnderLabel label sub m 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
<* :: UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m a
$c<* :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative m =>
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m a
*> :: UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
$c*> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative m =>
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
liftA2 :: (a -> b -> c)
-> UnderLabel label sub m a
-> UnderLabel label sub m b
-> UnderLabel label sub m c
$cliftA2 :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a b
c.
Applicative m =>
(a -> b -> c)
-> UnderLabel label sub m a
-> UnderLabel label sub m b
-> UnderLabel label sub m c
<*> :: UnderLabel label sub m (a -> b)
-> UnderLabel label sub m a -> UnderLabel label sub m b
$c<*> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Applicative m =>
UnderLabel label sub m (a -> b)
-> UnderLabel label sub m a -> UnderLabel label sub m b
pure :: a -> UnderLabel label sub m a
$cpure :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative m =>
a -> UnderLabel label sub m a
$cp1Applicative :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Applicative m =>
Functor (UnderLabel label sub m)
Applicative, a -> UnderLabel label sub m b -> UnderLabel label sub m a
(a -> b) -> UnderLabel label sub m a -> UnderLabel label sub m b
(forall a b.
(a -> b) -> UnderLabel label sub m a -> UnderLabel label sub m b)
-> (forall a b.
a -> UnderLabel label sub m b -> UnderLabel label sub m a)
-> Functor (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor m =>
a -> UnderLabel label sub m b -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor m =>
(a -> b) -> UnderLabel label sub m a -> UnderLabel label sub m b
forall a b.
a -> UnderLabel label sub m b -> UnderLabel label sub m a
forall a b.
(a -> b) -> UnderLabel label sub m a -> UnderLabel label sub m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> UnderLabel label sub m b -> UnderLabel label sub m a
$c<$ :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor m =>
a -> UnderLabel label sub m b -> UnderLabel label sub m a
fmap :: (a -> b) -> UnderLabel label sub m a -> UnderLabel label sub m b
$cfmap :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Functor m =>
(a -> b) -> UnderLabel label sub m a -> UnderLabel label sub m b
Functor, Applicative (UnderLabel label sub m)
a -> UnderLabel label sub m a
Applicative (UnderLabel label sub m) =>
(forall a b.
UnderLabel label sub m a
-> (a -> UnderLabel label sub m b) -> UnderLabel label sub m b)
-> (forall a b.
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b)
-> (forall a. a -> UnderLabel label sub m a)
-> Monad (UnderLabel label sub m)
UnderLabel label sub m a
-> (a -> UnderLabel label sub m b) -> UnderLabel label sub m b
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
forall a. a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Monad m =>
Applicative (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad m =>
a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad m =>
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad m =>
UnderLabel label sub m a
-> (a -> UnderLabel label sub m b) -> UnderLabel label sub m b
forall a b.
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
forall a b.
UnderLabel label sub m a
-> (a -> UnderLabel label sub m b) -> UnderLabel label sub m 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
return :: a -> UnderLabel label sub m a
$creturn :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad m =>
a -> UnderLabel label sub m a
>> :: UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
$c>> :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad m =>
UnderLabel label sub m a
-> UnderLabel label sub m b -> UnderLabel label sub m b
>>= :: UnderLabel label sub m a
-> (a -> UnderLabel label sub m b) -> UnderLabel label sub m b
$c>>= :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a
b.
Monad m =>
UnderLabel label sub m a
-> (a -> UnderLabel label sub m b) -> UnderLabel label sub m b
$cp1Monad :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
Monad m =>
Applicative (UnderLabel label sub m)
Monad, Monad (UnderLabel label sub m)
Monad (UnderLabel label sub m) =>
(forall a. String -> UnderLabel label sub m a)
-> MonadFail (UnderLabel label sub m)
String -> UnderLabel label sub m a
forall a. String -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadFail m =>
Monad (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail m =>
String -> UnderLabel label sub m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> UnderLabel label sub m a
$cfail :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail m =>
String -> UnderLabel label sub m a
$cp1MonadFail :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadFail m =>
Monad (UnderLabel label sub m)
Fail.MonadFail, Monad (UnderLabel label sub m)
Monad (UnderLabel label sub m) =>
(forall a. IO a -> UnderLabel label sub m a)
-> MonadIO (UnderLabel label sub m)
IO a -> UnderLabel label sub m a
forall a. IO a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadIO m =>
Monad (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> UnderLabel label sub m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> UnderLabel label sub m a
$cliftIO :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> UnderLabel label sub m a
$cp1MonadIO :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadIO m =>
Monad (UnderLabel label sub m)
MonadIO, Monad (UnderLabel label sub m)
Alternative (UnderLabel label sub m)
UnderLabel label sub m a
(Alternative (UnderLabel label sub m),
Monad (UnderLabel label sub m)) =>
(forall a. UnderLabel label sub m a)
-> (forall a.
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a)
-> MonadPlus (UnderLabel label sub m)
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
forall a. UnderLabel label sub m a
forall a.
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus m =>
Monad (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus m =>
Alternative (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
mplus :: UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
$cmplus :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
UnderLabel label sub m a
-> UnderLabel label sub m a -> UnderLabel label sub m a
mzero :: UnderLabel label sub m a
$cmzero :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
UnderLabel label sub m a
$cp2MonadPlus :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus m =>
Monad (UnderLabel label sub m)
$cp1MonadPlus :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus m =>
Alternative (UnderLabel label sub m)
MonadPlus)
runUnderLabel :: forall label sub m a . UnderLabel label sub m a -> m a
runUnderLabel :: UnderLabel label sub m a -> m a
runUnderLabel (UnderLabel l :: m a
l) = m a
l
instance MonadTrans (UnderLabel sub label) where
lift :: m a -> UnderLabel sub label m a
lift = m a -> UnderLabel sub label m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> UnderLabel label sub m a
UnderLabel
{-# INLINE lift #-}
instance (LabelledMember label sub sig, HFunctor sub, Algebra sig m) => Algebra (sub :+: sig) (UnderLabel label sub m) where
alg :: (:+:) sub sig (UnderLabel label sub m) a
-> UnderLabel label sub m a
alg = \case
L sub :: sub (UnderLabel label sub m) a
sub -> m a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> UnderLabel label sub m a
UnderLabel (sub m a -> m a
forall k (label :: k) (eff :: (* -> *) -> * -> *)
(sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasLabelled label eff sig m =>
eff m a -> m a
sendLabelled @label (sub (UnderLabel label sub m) a -> sub m a
forall (sig :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *) a.
(HFunctor sig, Functor f, Coercible f g) =>
sig f a -> sig g a
handleCoercible sub (UnderLabel label sub m) a
sub))
R sig :: sig (UnderLabel label sub m) a
sig -> m a -> UnderLabel label sub m a
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> UnderLabel label sub m a
UnderLabel (sig m a -> m a
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
(m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (sig (UnderLabel label sub m) a -> sig m a
forall (sig :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *) a.
(HFunctor sig, Functor f, Coercible f g) =>
sig f a -> sig g a
handleCoercible sig (UnderLabel label sub m) a
sig))
{-# INLINE alg #-}