{-# LANGUAGE AllowAmbiguousTypes #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{- |
Copyright   :  (c) 2023-2024 Sayo Koyoneda
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
Stability   :  experimental
Portability :  portable
-}
module Control.Effect.Key where

import Control.Applicative (Alternative)
import Control.Effect (SendFOE (sendFOE), SendHOE (sendHOE))
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 (EffectF, EffectH)
import Data.Effect.HFunctor (HFunctor, hfmap)
import Data.Kind (Type)

class SendFOEBy key (ins :: EffectF) f | key f -> ins where
    sendFOEBy :: ins a -> f a

class SendHOEBy key (sig :: EffectH) f | key f -> sig where
    sendHOEBy :: sig f a -> f a

-- | A wrapper data type to represent sending an effect to the carrier @f@ with the specified key.
newtype ByKey key (f :: Type -> Type) a = ByKey {forall {k} (key :: k) (f :: * -> *) a. ByKey key f a -> f a
runByKey :: f a}
    deriving newtype
        ( (forall a b. (a -> b) -> ByKey key f a -> ByKey key f b)
-> (forall a b. a -> ByKey key f b -> ByKey key f a)
-> Functor (ByKey key f)
forall k (key :: k) (f :: * -> *) a b.
Functor f =>
a -> ByKey key f b -> ByKey key f a
forall k (key :: k) (f :: * -> *) a b.
Functor f =>
(a -> b) -> ByKey key f a -> ByKey key f b
forall a b. a -> ByKey key f b -> ByKey key f a
forall a b. (a -> b) -> ByKey key f a -> ByKey key 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 (key :: k) (f :: * -> *) a b.
Functor f =>
(a -> b) -> ByKey key f a -> ByKey key f b
fmap :: forall a b. (a -> b) -> ByKey key f a -> ByKey key f b
$c<$ :: forall k (key :: k) (f :: * -> *) a b.
Functor f =>
a -> ByKey key f b -> ByKey key f a
<$ :: forall a b. a -> ByKey key f b -> ByKey key f a
Functor
        , Functor (ByKey key f)
Functor (ByKey key f) =>
(forall a. a -> ByKey key f a)
-> (forall a b.
    ByKey key f (a -> b) -> ByKey key f a -> ByKey key f b)
-> (forall a b c.
    (a -> b -> c) -> ByKey key f a -> ByKey key f b -> ByKey key f c)
-> (forall a b. ByKey key f a -> ByKey key f b -> ByKey key f b)
-> (forall a b. ByKey key f a -> ByKey key f b -> ByKey key f a)
-> Applicative (ByKey key f)
forall a. a -> ByKey key f a
forall k (key :: k) (f :: * -> *).
Applicative f =>
Functor (ByKey key f)
forall k (key :: k) (f :: * -> *) a.
Applicative f =>
a -> ByKey key f a
forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f a -> ByKey key f b -> ByKey key f a
forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f a -> ByKey key f b -> ByKey key f b
forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f (a -> b) -> ByKey key f a -> ByKey key f b
forall k (key :: k) (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> ByKey key f a -> ByKey key f b -> ByKey key f c
forall a b. ByKey key f a -> ByKey key f b -> ByKey key f a
forall a b. ByKey key f a -> ByKey key f b -> ByKey key f b
forall a b. ByKey key f (a -> b) -> ByKey key f a -> ByKey key f b
forall a b c.
(a -> b -> c) -> ByKey key f a -> ByKey key f b -> ByKey key 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 (key :: k) (f :: * -> *) a.
Applicative f =>
a -> ByKey key f a
pure :: forall a. a -> ByKey key f a
$c<*> :: forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f (a -> b) -> ByKey key f a -> ByKey key f b
<*> :: forall a b. ByKey key f (a -> b) -> ByKey key f a -> ByKey key f b
$cliftA2 :: forall k (key :: k) (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> ByKey key f a -> ByKey key f b -> ByKey key f c
liftA2 :: forall a b c.
(a -> b -> c) -> ByKey key f a -> ByKey key f b -> ByKey key f c
$c*> :: forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f a -> ByKey key f b -> ByKey key f b
*> :: forall a b. ByKey key f a -> ByKey key f b -> ByKey key f b
$c<* :: forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f a -> ByKey key f b -> ByKey key f a
<* :: forall a b. ByKey key f a -> ByKey key f b -> ByKey key f a
Applicative
        , Applicative (ByKey key f)
Applicative (ByKey key f) =>
(forall a. ByKey key f a)
-> (forall a. ByKey key f a -> ByKey key f a -> ByKey key f a)
-> (forall a. ByKey key f a -> ByKey key f [a])
-> (forall a. ByKey key f a -> ByKey key f [a])
-> Alternative (ByKey key f)
forall a. ByKey key f a
forall a. ByKey key f a -> ByKey key f [a]
forall a. ByKey key f a -> ByKey key f a -> ByKey key f a
forall k (key :: k) (f :: * -> *).
Alternative f =>
Applicative (ByKey key f)
forall k (key :: k) (f :: * -> *) a. Alternative f => ByKey key f a
forall k (key :: k) (f :: * -> *) a.
Alternative f =>
ByKey key f a -> ByKey key f [a]
forall k (key :: k) (f :: * -> *) a.
Alternative f =>
ByKey key f a -> ByKey key f a -> ByKey key 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 (key :: k) (f :: * -> *) a. Alternative f => ByKey key f a
empty :: forall a. ByKey key f a
$c<|> :: forall k (key :: k) (f :: * -> *) a.
Alternative f =>
ByKey key f a -> ByKey key f a -> ByKey key f a
<|> :: forall a. ByKey key f a -> ByKey key f a -> ByKey key f a
$csome :: forall k (key :: k) (f :: * -> *) a.
Alternative f =>
ByKey key f a -> ByKey key f [a]
some :: forall a. ByKey key f a -> ByKey key f [a]
$cmany :: forall k (key :: k) (f :: * -> *) a.
Alternative f =>
ByKey key f a -> ByKey key f [a]
many :: forall a. ByKey key f a -> ByKey key f [a]
Alternative
        , Applicative (ByKey key f)
Applicative (ByKey key f) =>
(forall a b.
 ByKey key f a -> (a -> ByKey key f b) -> ByKey key f b)
-> (forall a b. ByKey key f a -> ByKey key f b -> ByKey key f b)
-> (forall a. a -> ByKey key f a)
-> Monad (ByKey key f)
forall a. a -> ByKey key f a
forall k (key :: k) (f :: * -> *).
Monad f =>
Applicative (ByKey key f)
forall k (key :: k) (f :: * -> *) a. Monad f => a -> ByKey key f a
forall k (key :: k) (f :: * -> *) a b.
Monad f =>
ByKey key f a -> ByKey key f b -> ByKey key f b
forall k (key :: k) (f :: * -> *) a b.
Monad f =>
ByKey key f a -> (a -> ByKey key f b) -> ByKey key f b
forall a b. ByKey key f a -> ByKey key f b -> ByKey key f b
forall a b. ByKey key f a -> (a -> ByKey key f b) -> ByKey key 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 (key :: k) (f :: * -> *) a b.
Monad f =>
ByKey key f a -> (a -> ByKey key f b) -> ByKey key f b
>>= :: forall a b. ByKey key f a -> (a -> ByKey key f b) -> ByKey key f b
$c>> :: forall k (key :: k) (f :: * -> *) a b.
Monad f =>
ByKey key f a -> ByKey key f b -> ByKey key f b
>> :: forall a b. ByKey key f a -> ByKey key f b -> ByKey key f b
$creturn :: forall k (key :: k) (f :: * -> *) a. Monad f => a -> ByKey key f a
return :: forall a. a -> ByKey key f a
Monad
        , Monad (ByKey key f)
Alternative (ByKey key f)
(Alternative (ByKey key f), Monad (ByKey key f)) =>
(forall a. ByKey key f a)
-> (forall a. ByKey key f a -> ByKey key f a -> ByKey key f a)
-> MonadPlus (ByKey key f)
forall a. ByKey key f a
forall a. ByKey key f a -> ByKey key f a -> ByKey key f a
forall k (key :: k) (f :: * -> *).
MonadPlus f =>
Monad (ByKey key f)
forall k (key :: k) (f :: * -> *).
MonadPlus f =>
Alternative (ByKey key f)
forall k (key :: k) (f :: * -> *) a. MonadPlus f => ByKey key f a
forall k (key :: k) (f :: * -> *) a.
MonadPlus f =>
ByKey key f a -> ByKey key f a -> ByKey key 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 (key :: k) (f :: * -> *) a. MonadPlus f => ByKey key f a
mzero :: forall a. ByKey key f a
$cmplus :: forall k (key :: k) (f :: * -> *) a.
MonadPlus f =>
ByKey key f a -> ByKey key f a -> ByKey key f a
mplus :: forall a. ByKey key f a -> ByKey key f a -> ByKey key f a
MonadPlus
        , Monad (ByKey key f)
Monad (ByKey key f) =>
(forall a. (a -> ByKey key f a) -> ByKey key f a)
-> MonadFix (ByKey key f)
forall a. (a -> ByKey key f a) -> ByKey key f a
forall k (key :: k) (f :: * -> *).
MonadFix f =>
Monad (ByKey key f)
forall k (key :: k) (f :: * -> *) a.
MonadFix f =>
(a -> ByKey key f a) -> ByKey key f a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall k (key :: k) (f :: * -> *) a.
MonadFix f =>
(a -> ByKey key f a) -> ByKey key f a
mfix :: forall a. (a -> ByKey key f a) -> ByKey key f a
MonadFix
        , Monad (ByKey key f)
Monad (ByKey key f) =>
(forall a. IO a -> ByKey key f a) -> MonadIO (ByKey key f)
forall a. IO a -> ByKey key f a
forall k (key :: k) (f :: * -> *). MonadIO f => Monad (ByKey key f)
forall k (key :: k) (f :: * -> *) a.
MonadIO f =>
IO a -> ByKey key f a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall k (key :: k) (f :: * -> *) a.
MonadIO f =>
IO a -> ByKey key f a
liftIO :: forall a. IO a -> ByKey key f a
MonadIO
        , Monad (ByKey key f)
Monad (ByKey key f) =>
(forall a. String -> ByKey key f a) -> MonadFail (ByKey key f)
forall a. String -> ByKey key f a
forall k (key :: k) (f :: * -> *).
MonadFail f =>
Monad (ByKey key f)
forall k (key :: k) (f :: * -> *) a.
MonadFail f =>
String -> ByKey key f a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall k (key :: k) (f :: * -> *) a.
MonadFail f =>
String -> ByKey key f a
fail :: forall a. String -> ByKey key f a
MonadFail
        , MonadReader r
        , MonadWriter w
        , MonadState s
        , MonadRWS r w s
        , MonadError e
        )

-- | Send all effects within the scope, keyed, to carrier @f@.
key :: forall key f a. ByKey key f a -> f a
key :: forall {k} (key :: k) (f :: * -> *) a. ByKey key f a -> f a
key = ByKey key f a -> f a
forall {k} (key :: k) (f :: * -> *) a. ByKey key f a -> f a
runByKey
{-# INLINE key #-}

instance (SendFOEBy key ins f) => SendFOE ins (ByKey key f) where
    sendFOE :: forall a. ins a -> ByKey key f a
sendFOE = f a -> ByKey key f a
forall {k} (key :: k) (f :: * -> *) a. f a -> ByKey key f a
ByKey (f a -> ByKey key f a) -> (ins a -> f a) -> ins a -> ByKey key 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
    {-# INLINE sendFOE #-}

instance (SendHOEBy key sig f, HFunctor sig) => SendHOE sig (ByKey key f) where
    sendHOE :: forall a. sig (ByKey key f) a -> ByKey key f a
sendHOE = f a -> ByKey key f a
forall {k} (key :: k) (f :: * -> *) a. f a -> ByKey key f a
ByKey (f a -> ByKey key f a)
-> (sig (ByKey key f) a -> f a)
-> sig (ByKey key f) a
-> ByKey key 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 (sig f a -> f a)
-> (sig (ByKey key f) a -> sig f a) -> sig (ByKey key f) a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByKey key f :-> f) -> sig (ByKey key 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 ByKey key f i -> f i
ByKey key f :-> f
forall a b. Coercible a b => a -> b
coerce
    {-# INLINE sendHOE #-}