{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Effect.Tag where
import Control.Applicative (Alternative)
import Control.Effect (SendFOE (sendFOE), SendHOE (sendHOE))
import Control.Effect.Key (SendFOEBy, SendHOEBy, sendFOEBy, sendHOEBy)
import Control.Monad (MonadPlus)
import Control.Monad.Except (MonadError)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.RWS (MonadRWS)
import Control.Monad.Reader (MonadReader)
import Control.Monad.State (MonadState)
import Control.Monad.Writer (MonadWriter)
import Data.Coerce (coerce)
import Data.Effect.HFunctor (HFunctor, hfmap)
import Data.Effect.Tag (pattern T, pattern TH, type (#), type (##))
import Data.Kind (Type)
newtype ViaTag tag (f :: Type -> Type) a = ViaTag {forall {k} (tag :: k) (f :: * -> *) a. ViaTag tag f a -> f a
runViaTag :: f a}
deriving newtype
( (forall a b. (a -> b) -> ViaTag tag f a -> ViaTag tag f b)
-> (forall a b. a -> ViaTag tag f b -> ViaTag tag f a)
-> Functor (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a b.
Functor f =>
a -> ViaTag tag f b -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *) a b.
Functor f =>
(a -> b) -> ViaTag tag f a -> ViaTag tag f b
forall a b. a -> ViaTag tag f b -> ViaTag tag f a
forall a b. (a -> b) -> ViaTag tag f a -> ViaTag tag f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k (tag :: k) (f :: * -> *) a b.
Functor f =>
(a -> b) -> ViaTag tag f a -> ViaTag tag f b
fmap :: forall a b. (a -> b) -> ViaTag tag f a -> ViaTag tag f b
$c<$ :: forall k (tag :: k) (f :: * -> *) a b.
Functor f =>
a -> ViaTag tag f b -> ViaTag tag f a
<$ :: forall a b. a -> ViaTag tag f b -> ViaTag tag f a
Functor
, Functor (ViaTag tag f)
Functor (ViaTag tag f) =>
(forall a. a -> ViaTag tag f a)
-> (forall a b.
ViaTag tag f (a -> b) -> ViaTag tag f a -> ViaTag tag f b)
-> (forall a b c.
(a -> b -> c)
-> ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f c)
-> (forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b)
-> (forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f a)
-> Applicative (ViaTag tag f)
forall a. a -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *).
Applicative f =>
Functor (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a.
Applicative f =>
a -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *) a b.
Applicative f =>
ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *) a b.
Applicative f =>
ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
forall k (tag :: k) (f :: * -> *) a b.
Applicative f =>
ViaTag tag f (a -> b) -> ViaTag tag f a -> ViaTag tag f b
forall k (tag :: k) (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f c
forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f a
forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
forall a b.
ViaTag tag f (a -> b) -> ViaTag tag f a -> ViaTag tag f b
forall a b c.
(a -> b -> c) -> ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f 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
$cpure :: forall k (tag :: k) (f :: * -> *) a.
Applicative f =>
a -> ViaTag tag f a
pure :: forall a. a -> ViaTag tag f a
$c<*> :: forall k (tag :: k) (f :: * -> *) a b.
Applicative f =>
ViaTag tag f (a -> b) -> ViaTag tag f a -> ViaTag tag f b
<*> :: forall a b.
ViaTag tag f (a -> b) -> ViaTag tag f a -> ViaTag tag f b
$cliftA2 :: forall k (tag :: k) (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f c
liftA2 :: forall a b c.
(a -> b -> c) -> ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f c
$c*> :: forall k (tag :: k) (f :: * -> *) a b.
Applicative f =>
ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
*> :: forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
$c<* :: forall k (tag :: k) (f :: * -> *) a b.
Applicative f =>
ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f a
<* :: forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f a
Applicative
, Applicative (ViaTag tag f)
Applicative (ViaTag tag f) =>
(forall a. ViaTag tag f a)
-> (forall a. ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a)
-> (forall a. ViaTag tag f a -> ViaTag tag f [a])
-> (forall a. ViaTag tag f a -> ViaTag tag f [a])
-> Alternative (ViaTag tag f)
forall a. ViaTag tag f a
forall a. ViaTag tag f a -> ViaTag tag f [a]
forall a. ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *).
Alternative f =>
Applicative (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a.
Alternative f =>
ViaTag tag f a
forall k (tag :: k) (f :: * -> *) a.
Alternative f =>
ViaTag tag f a -> ViaTag tag f [a]
forall k (tag :: k) (f :: * -> *) a.
Alternative f =>
ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f 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
$cempty :: forall k (tag :: k) (f :: * -> *) a.
Alternative f =>
ViaTag tag f a
empty :: forall a. ViaTag tag f a
$c<|> :: forall k (tag :: k) (f :: * -> *) a.
Alternative f =>
ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a
<|> :: forall a. ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a
$csome :: forall k (tag :: k) (f :: * -> *) a.
Alternative f =>
ViaTag tag f a -> ViaTag tag f [a]
some :: forall a. ViaTag tag f a -> ViaTag tag f [a]
$cmany :: forall k (tag :: k) (f :: * -> *) a.
Alternative f =>
ViaTag tag f a -> ViaTag tag f [a]
many :: forall a. ViaTag tag f a -> ViaTag tag f [a]
Alternative
, Applicative (ViaTag tag f)
Applicative (ViaTag tag f) =>
(forall a b.
ViaTag tag f a -> (a -> ViaTag tag f b) -> ViaTag tag f b)
-> (forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b)
-> (forall a. a -> ViaTag tag f a)
-> Monad (ViaTag tag f)
forall a. a -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *).
Monad f =>
Applicative (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a. Monad f => a -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *) a b.
Monad f =>
ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
forall k (tag :: k) (f :: * -> *) a b.
Monad f =>
ViaTag tag f a -> (a -> ViaTag tag f b) -> ViaTag tag f b
forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
forall a b.
ViaTag tag f a -> (a -> ViaTag tag f b) -> ViaTag tag f 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
$c>>= :: forall k (tag :: k) (f :: * -> *) a b.
Monad f =>
ViaTag tag f a -> (a -> ViaTag tag f b) -> ViaTag tag f b
>>= :: forall a b.
ViaTag tag f a -> (a -> ViaTag tag f b) -> ViaTag tag f b
$c>> :: forall k (tag :: k) (f :: * -> *) a b.
Monad f =>
ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
>> :: forall a b. ViaTag tag f a -> ViaTag tag f b -> ViaTag tag f b
$creturn :: forall k (tag :: k) (f :: * -> *) a. Monad f => a -> ViaTag tag f a
return :: forall a. a -> ViaTag tag f a
Monad
, Monad (ViaTag tag f)
Alternative (ViaTag tag f)
(Alternative (ViaTag tag f), Monad (ViaTag tag f)) =>
(forall a. ViaTag tag f a)
-> (forall a. ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a)
-> MonadPlus (ViaTag tag f)
forall a. ViaTag tag f a
forall a. ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *).
MonadPlus f =>
Monad (ViaTag tag f)
forall k (tag :: k) (f :: * -> *).
MonadPlus f =>
Alternative (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a. MonadPlus f => ViaTag tag f a
forall k (tag :: k) (f :: * -> *) a.
MonadPlus f =>
ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall k (tag :: k) (f :: * -> *) a. MonadPlus f => ViaTag tag f a
mzero :: forall a. ViaTag tag f a
$cmplus :: forall k (tag :: k) (f :: * -> *) a.
MonadPlus f =>
ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a
mplus :: forall a. ViaTag tag f a -> ViaTag tag f a -> ViaTag tag f a
MonadPlus
, Monad (ViaTag tag f)
Monad (ViaTag tag f) =>
(forall a. (a -> ViaTag tag f a) -> ViaTag tag f a)
-> MonadFix (ViaTag tag f)
forall a. (a -> ViaTag tag f a) -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *).
MonadFix f =>
Monad (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a.
MonadFix f =>
(a -> ViaTag tag f a) -> ViaTag tag f a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall k (tag :: k) (f :: * -> *) a.
MonadFix f =>
(a -> ViaTag tag f a) -> ViaTag tag f a
mfix :: forall a. (a -> ViaTag tag f a) -> ViaTag tag f a
MonadFix
, Monad (ViaTag tag f)
Monad (ViaTag tag f) =>
(forall a. IO a -> ViaTag tag f a) -> MonadIO (ViaTag tag f)
forall a. IO a -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *).
MonadIO f =>
Monad (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a.
MonadIO f =>
IO a -> ViaTag tag f a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall k (tag :: k) (f :: * -> *) a.
MonadIO f =>
IO a -> ViaTag tag f a
liftIO :: forall a. IO a -> ViaTag tag f a
MonadIO
, Monad (ViaTag tag f)
Monad (ViaTag tag f) =>
(forall a. String -> ViaTag tag f a) -> MonadFail (ViaTag tag f)
forall a. String -> ViaTag tag f a
forall k (tag :: k) (f :: * -> *).
MonadFail f =>
Monad (ViaTag tag f)
forall k (tag :: k) (f :: * -> *) a.
MonadFail f =>
String -> ViaTag tag f a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall k (tag :: k) (f :: * -> *) a.
MonadFail f =>
String -> ViaTag tag f a
fail :: forall a. String -> ViaTag tag f a
MonadFail
, MonadReader r
, MonadWriter w
, MonadState s
, MonadRWS r w s
, MonadError e
)
tag :: forall tag f a. ViaTag tag f a -> f a
tag :: forall {k} (tag :: k) (f :: * -> *) a. ViaTag tag f a -> f a
tag = ViaTag tag f a -> f a
forall {k} (tag :: k) (f :: * -> *) a. ViaTag tag f a -> f a
runViaTag
{-# INLINE tag #-}
instance (SendFOE (ins # tag) f) => SendFOE ins (ViaTag tag f) where
sendFOE :: forall a. ins a -> ViaTag tag f a
sendFOE = f a -> ViaTag tag f a
forall {k} (tag :: k) (f :: * -> *) a. f a -> ViaTag tag f a
ViaTag (f a -> ViaTag tag f a)
-> (ins a -> f a) -> ins a -> ViaTag tag f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag ins tag a -> f a
forall a. Tag ins tag a -> f a
forall (ins :: * -> *) (f :: * -> *) a.
SendFOE ins f =>
ins a -> f a
sendFOE (Tag ins tag a -> f a) -> (ins a -> Tag ins tag a) -> ins a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: k) (ins :: * -> *) a. ins a -> Tag ins tag a
forall {k} (tag :: k) (ins :: * -> *) a. ins a -> Tag ins tag a
T @tag
{-# INLINE sendFOE #-}
instance (SendHOE (sig ## tag) f, HFunctor sig) => SendHOE sig (ViaTag tag f) where
sendHOE :: forall a. sig (ViaTag tag f) a -> ViaTag tag f a
sendHOE = f a -> ViaTag tag f a
forall {k} (tag :: k) (f :: * -> *) a. f a -> ViaTag tag f a
ViaTag (f a -> ViaTag tag f a)
-> (sig (ViaTag tag f) a -> f a)
-> sig (ViaTag tag f) a
-> ViaTag tag f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagH sig tag f a -> f a
forall a. TagH sig tag f a -> f a
forall (sig :: EffectH) (f :: * -> *) a.
SendHOE sig f =>
sig f a -> f a
sendHOE (TagH sig tag f a -> f a)
-> (sig (ViaTag tag f) a -> TagH sig tag f a)
-> sig (ViaTag tag f) a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: k) (sig :: EffectH) (f :: * -> *) a.
sig f a -> TagH sig tag f a
forall {k} (tag :: k) (sig :: EffectH) (f :: * -> *) a.
sig f a -> TagH sig tag f a
TH @tag (sig f a -> TagH sig tag f a)
-> (sig (ViaTag tag f) a -> sig f a)
-> sig (ViaTag tag f) a
-> TagH sig tag f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViaTag tag f :-> f) -> sig (ViaTag tag f) :-> sig f
forall (f :: * -> *) (g :: * -> *). (f :-> g) -> sig f :-> sig g
forall (h :: EffectH) (f :: * -> *) (g :: * -> *).
HFunctor h =>
(f :-> g) -> h f :-> h g
hfmap ViaTag tag f i -> f i
ViaTag tag f :-> f
forall a b. Coercible a b => a -> b
coerce
{-# INLINE sendHOE #-}
instance (SendFOEBy key (ins # tag) f) => SendFOEBy key ins (ViaTag tag f) where
sendFOEBy :: forall a. ins a -> ViaTag tag f a
sendFOEBy = f a -> ViaTag tag f a
forall {k} (tag :: k) (f :: * -> *) a. f a -> ViaTag tag f a
ViaTag (f a -> ViaTag tag f a)
-> (ins a -> f a) -> ins a -> ViaTag tag f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (key :: k) (ins :: * -> *) (f :: * -> *) a.
SendFOEBy key ins f =>
ins a -> f a
forall {k} (key :: k) (ins :: * -> *) (f :: * -> *) a.
SendFOEBy key ins f =>
ins a -> f a
sendFOEBy @key (Tag ins tag a -> f a) -> (ins a -> Tag ins tag a) -> ins a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: k) (ins :: * -> *) a. ins a -> Tag ins tag a
forall {k} (tag :: k) (ins :: * -> *) a. ins a -> Tag ins tag a
T @tag
{-# INLINE sendFOEBy #-}
instance (SendHOEBy key (sig ## tag) f, HFunctor sig) => SendHOEBy key sig (ViaTag tag f) where
sendHOEBy :: forall a. sig (ViaTag tag f) a -> ViaTag tag f a
sendHOEBy = f a -> ViaTag tag f a
forall {k} (tag :: k) (f :: * -> *) a. f a -> ViaTag tag f a
ViaTag (f a -> ViaTag tag f a)
-> (sig (ViaTag tag f) a -> f a)
-> sig (ViaTag tag f) a
-> ViaTag tag f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (key :: k) (sig :: EffectH) (f :: * -> *) a.
SendHOEBy key sig f =>
sig f a -> f a
forall {k} (key :: k) (sig :: EffectH) (f :: * -> *) a.
SendHOEBy key sig f =>
sig f a -> f a
sendHOEBy @key (TagH sig tag f a -> f a)
-> (sig (ViaTag tag f) a -> TagH sig tag f a)
-> sig (ViaTag tag f) a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: k) (sig :: EffectH) (f :: * -> *) a.
sig f a -> TagH sig tag f a
forall {k} (tag :: k) (sig :: EffectH) (f :: * -> *) a.
sig f a -> TagH sig tag f a
TH @tag (sig f a -> TagH sig tag f a)
-> (sig (ViaTag tag f) a -> sig f a)
-> sig (ViaTag tag f) a
-> TagH sig tag f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViaTag tag f :-> f) -> sig (ViaTag tag f) :-> sig f
forall (f :: * -> *) (g :: * -> *). (f :-> g) -> sig f :-> sig g
forall (h :: EffectH) (f :: * -> *) (g :: * -> *).
HFunctor h =>
(f :-> g) -> h f :-> h g
hfmap ViaTag tag f i -> f i
ViaTag tag f :-> f
forall a b. Coercible a b => a -> b
coerce
{-# INLINE sendHOEBy #-}