{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Labelled effects, allowing flexible disambiguation and dependency of parametric effects.
--
-- Among other things, this can be used to:
--
-- * Improve inference by relating parametric effect types to some arbitrary label. This can be used to lift existing effect operations, or to define new ones; cf "Control.Effect.Reader.Labelled", "Control.Effect.State.Labelled" for examples of lifting effect operations into labelled effect operations.
--
-- * Express stronger relationships between an effect and the context it’s run in, e.g. to give an effect shadowing semantics, allowing only one instance of it to be active at a time in a given context.
--
-- * Resolve ambiguous types by relating parameters to a concrete label type.
--
-- @since 1.0.2.0
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.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Kind (Type)

-- | An effect transformer turning effects into labelled effects, and a carrier transformer turning carriers into labelled carriers for the same (labelled) effects.
--
-- @since 1.0.2.0
newtype Labelled (label :: k) (sub :: (Type -> Type) -> (Type -> Type)) m a = Labelled (sub m a)
  deriving
    ( 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 :: forall a. 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 :: forall a. 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]
<|> :: forall 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 :: forall a. Labelled label sub m a
$cempty :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative (sub m) =>
Labelled label sub m a
Alternative
    , 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
<* :: forall a b.
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
*> :: forall a b.
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 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> Labelled label sub m a
$cpure :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (sub m) =>
a -> Labelled label sub m a
Applicative
    , 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
<$ :: forall a b. 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 :: forall a b.
(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 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 :: forall a. a -> Labelled label sub m a
$creturn :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (sub m) =>
a -> Labelled label sub m a
>> :: forall a b.
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
>>= :: forall a 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
Monad
    , 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 :: forall a. String -> Labelled label sub m a
$cfail :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail (sub m) =>
String -> Labelled label sub m a
Fail.MonadFail
    , forall a. (a -> Labelled label sub m a) -> Labelled label sub m a
forall {k} {label :: k} {sub :: (* -> *) -> * -> *} {m :: * -> *}.
MonadFix (sub m) =>
Monad (Labelled label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFix (sub m) =>
(a -> Labelled label sub m a) -> Labelled label sub m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> Labelled label sub m a) -> Labelled label sub m a
$cmfix :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFix (sub m) =>
(a -> Labelled label sub m a) -> Labelled label sub m a
MonadFix -- ^ @since 1.1.1
    , 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 :: forall a. 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
MonadIO
    , 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 :: forall a.
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 :: forall a. Labelled label sub m a
$cmzero :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus (sub m) =>
Labelled label sub m a
MonadPlus
    , 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 :: forall (m :: * -> *) a. Monad m => 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
    )

-- | @since 1.0.2.0
runLabelled :: forall label sub m a . Labelled label sub m a -> sub m a
runLabelled :: forall {k} (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
       a.
Labelled label sub m a -> sub m a
runLabelled (Labelled sub m a
l) = sub m a
l
{-# INLINE runLabelled #-}

instance Algebra (eff :+: sig) (sub m) => Algebra (Labelled label eff :+: sig) (Labelled label sub m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (Labelled label sub m)
-> (:+:) (Labelled label eff) sig n a
-> ctx ()
-> Labelled label sub m (ctx a)
alg Handler ctx n (Labelled label sub m)
hdl = \case
    L Labelled label eff n a
eff -> forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
sub m a -> Labelled label sub m a
Labelled forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (forall {k} (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
       a.
Labelled label sub m a -> sub m a
runLabelled forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler ctx n (Labelled label sub m)
hdl) (forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
f m k -> (:+:) f g m k
L (forall {k} (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
       a.
Labelled label sub m a -> sub m a
runLabelled Labelled label eff n a
eff))
    R sig n a
sig -> forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
sub m a -> Labelled label sub m a
Labelled forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (forall {k} (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
       a.
Labelled label sub m a -> sub m a
runLabelled forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler ctx n (Labelled label sub m)
hdl) (forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
g m k -> (:+:) f g m k
R sig n a
sig)
  {-# INLINE alg #-}


-- | The class of labelled types present in a signature.
--
-- @since 1.0.2.0
class LabelledMember label (sub :: (Type -> Type) -> (Type -> Type)) sup | label sup -> sub where
  -- | Inject a member of a signature into the signature.
  --
  -- @since 1.0.2.0
  injLabelled :: Labelled label sub m a -> sup m a

-- | Reflexivity: @t@ is a member of itself.
instance LabelledMember label t (Labelled label t) where
  injLabelled :: forall (m :: * -> *) a.
Labelled label t m a -> Labelled label t m a
injLabelled = forall a. a -> a
id
  {-# INLINE injLabelled #-}

-- | Left-recursion: if @t@ is a member of @l1 ':+:' l2 ':+:' r@, then we can inject it into @(l1 ':+:' l2) ':+:' r@ by injection into a right-recursive signature, followed by left-association.
instance {-# OVERLAPPABLE #-}
         LabelledMember label t (l1 :+: l2 :+: r)
      => LabelledMember label t ((l1 :+: l2) :+: r) where
  injLabelled :: forall (m :: * -> *) a.
Labelled label t m a -> (:+:) (l1 :+: l2) r m a
injLabelled = forall (l1 :: (* -> *) -> * -> *) (l2 :: (* -> *) -> * -> *)
       (r :: (* -> *) -> * -> *) (m :: * -> *) a.
(:+:) l1 (l2 :+: r) m a -> (:+:) (l1 :+: l2) r m a
reassociateSumL 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
injLabelled
  {-# INLINE injLabelled #-}

-- | Left-occurrence: if @t@ is at the head of a signature, we can inject it in O(1).
instance {-# OVERLAPPABLE #-}
         LabelledMember label l (Labelled label l :+: r) where
  injLabelled :: forall (m :: * -> *) a.
Labelled label l m a -> (:+:) (Labelled label l) r m a
injLabelled = forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
f m k -> (:+:) f g m k
L
  {-# INLINE injLabelled #-}

-- | Right-recursion: if @t@ is a member of @r@, we can inject it into @r@ in O(n), followed by lifting that into @l ':+:' r@ in O(1).
instance {-# OVERLAPPABLE #-}
         LabelledMember label l r
      => LabelledMember label l (l' :+: r) where
  injLabelled :: forall (m :: * -> *) a. Labelled label l m a -> (:+:) l' r m a
injLabelled = forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
g m k -> (:+:) f g m k
R 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
injLabelled
  {-# INLINE injLabelled #-}


-- | @m@ is a carrier for @sig@ containing @eff@ associated with @label@.
--
-- Note that if @eff@ is a sum, it will /not/ be decomposed into multiple 'LabelledMember' constraints. While this technically is possible, it results in unsolvable constraints, as the functional dependencies in 'Labelled' prevent assocating the same label with multiple distinct effects within a signature.
--
-- @since 1.0.2.0
type HasLabelled label eff sig m = (LabelledMember label eff sig, Algebra sig m)

-- | Construct a request for a labelled effect to be interpreted by some handler later on.
--
-- @since 1.0.2.0
sendLabelled :: forall label eff sig m a . HasLabelled label eff sig m => eff m a -> m a
sendLabelled :: forall {k} (label :: k) (eff :: (* -> *) -> * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasLabelled label eff sig m =>
eff m a -> m a
sendLabelled eff m a
op = forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity) (forall {k} (label :: k) (sub :: (* -> *) -> * -> *)
       (sup :: (* -> *) -> * -> *) (m :: * -> *) a.
LabelledMember label sub sup =>
Labelled label sub m a -> sup m a
injLabelled @label (forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
sub m a -> Labelled label sub m a
Labelled eff m a
op)) (forall a. a -> Identity a
Identity ())
{-# INLINABLE sendLabelled #-}


-- | A transformer to lift effectful actions to labelled effectful actions.
--
-- @since 1.0.2.0
newtype UnderLabel (label :: k) (sub :: (Type -> Type) -> (Type -> Type)) (m :: Type -> Type) a = UnderLabel (m a)
  deriving
    ( 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 :: forall a. 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 :: forall a. 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]
<|> :: forall 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 :: forall a. UnderLabel label sub m a
$cempty :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
UnderLabel label sub m a
Alternative
    , 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
<* :: forall a b.
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
*> :: forall a b.
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 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> UnderLabel label sub m a
$cpure :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative m =>
a -> UnderLabel label sub m a
Applicative
    , 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
<$ :: forall a b.
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 :: forall a b.
(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
    , 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 :: forall a. a -> UnderLabel label sub m a
$creturn :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad m =>
a -> UnderLabel label sub m a
>> :: forall a b.
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
>>= :: forall a 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
Monad
    , 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 :: forall a. String -> UnderLabel label sub m a
$cfail :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail m =>
String -> UnderLabel label sub m a
Fail.MonadFail
    , forall a.
(a -> UnderLabel label sub m a) -> UnderLabel label sub m a
forall {k} {label :: k} {sub :: (* -> *) -> * -> *} {m :: * -> *}.
MonadFix m =>
Monad (UnderLabel label sub m)
forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> UnderLabel label sub m a) -> UnderLabel label sub m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a.
(a -> UnderLabel label sub m a) -> UnderLabel label sub m a
$cmfix :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> UnderLabel label sub m a) -> UnderLabel label sub m a
MonadFix -- ^ @since 1.1.1
    , 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 :: forall a. IO a -> UnderLabel label sub m a
$cliftIO :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> UnderLabel label sub m a
MonadIO
    , 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 :: forall a.
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 :: forall a. UnderLabel label sub m a
$cmzero :: forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
UnderLabel label sub m a
MonadPlus
    )

-- | @since 1.0.2.0
runUnderLabel :: forall label sub m a . UnderLabel label sub m a -> m a
runUnderLabel :: forall {k} (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
       a.
UnderLabel label sub m a -> m a
runUnderLabel (UnderLabel m a
l) = m a
l
{-# INLINE runUnderLabel #-}

instance MonadTrans (UnderLabel sub label) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> UnderLabel sub label m a
lift = forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> UnderLabel label sub m a
UnderLabel
  {-# INLINE lift #-}

instance (LabelledMember label sub sig, Algebra sig m) => Algebra (sub :+: sig) (UnderLabel label sub m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (UnderLabel label sub m)
-> (:+:) sub sig n a -> ctx () -> UnderLabel label sub m (ctx a)
alg Handler ctx n (UnderLabel label sub m)
hdl = \case
    L sub n a
sub -> forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> UnderLabel label sub m a
UnderLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (forall {k} (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
       a.
UnderLabel label sub m a -> m a
runUnderLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler ctx n (UnderLabel label sub m)
hdl) (forall {k} (label :: k) (sub :: (* -> *) -> * -> *)
       (sup :: (* -> *) -> * -> *) (m :: * -> *) a.
LabelledMember label sub sup =>
Labelled label sub m a -> sup m a
injLabelled @label (forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
sub m a -> Labelled label sub m a
Labelled sub n a
sub))
    R sig n a
sig -> forall k (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> UnderLabel label sub m a
UnderLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (forall {k} (label :: k) (sub :: (* -> *) -> * -> *) (m :: * -> *)
       a.
UnderLabel label sub m a -> m a
runUnderLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler ctx n (UnderLabel label sub m)
hdl) sig n a
sig
  {-# INLINE alg #-}