{-# 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 Yamada Ryo
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 (SendIns (sendIns), SendSig (sendSig))
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 (InsClass, SigClass)
import Data.Effect.HFunctor (HFunctor, hfmap)
import Data.Kind (Type)

class SendInsBy key (ins :: InsClass) f | key f -> ins where
    sendInsBy :: ins a -> f a

class SendSigBy key (sig :: SigClass) f | key f -> sig where
    sendSigBy :: 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 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
<$ :: forall a b. a -> ByKey key f b -> ByKey key f a
$c<$ :: forall k (key :: k) (f :: * -> *) a b.
Functor f =>
a -> ByKey key f b -> ByKey key f a
fmap :: forall a b. (a -> b) -> ByKey key f a -> ByKey key f b
$cfmap :: forall k (key :: k) (f :: * -> *) a b.
Functor f =>
(a -> b) -> ByKey key f a -> ByKey key f b
Functor
        , 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
<* :: forall a b. ByKey key f a -> ByKey key f b -> ByKey key f a
$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 b
$c*> :: forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f a -> ByKey key f b -> ByKey key f b
liftA2 :: forall a b c.
(a -> b -> c) -> ByKey key f a -> ByKey key f b -> ByKey key f c
$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
<*> :: forall a b. ByKey key f (a -> b) -> ByKey key f a -> ByKey key f b
$c<*> :: forall k (key :: k) (f :: * -> *) a b.
Applicative f =>
ByKey key f (a -> b) -> ByKey key f a -> ByKey key f b
pure :: forall a. a -> ByKey key f a
$cpure :: forall k (key :: k) (f :: * -> *) a.
Applicative f =>
a -> ByKey key f a
Applicative
        , 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
many :: 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]
some :: forall 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]
<|> :: forall a. ByKey key f a -> ByKey key f 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
empty :: forall a. ByKey key f a
$cempty :: forall k (key :: k) (f :: * -> *) a. Alternative f => ByKey key f a
Alternative
        , 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
return :: forall a. a -> ByKey key f a
$creturn :: forall k (key :: k) (f :: * -> *) a. Monad f => a -> ByKey key f a
>> :: forall a b. ByKey key f 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 -> (a -> ByKey key f b) -> ByKey key f b
$c>>= :: forall k (key :: k) (f :: * -> *) a b.
Monad f =>
ByKey key f a -> (a -> ByKey key f b) -> ByKey key f b
Monad
        , 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
mplus :: forall a. ByKey key f a -> ByKey key f 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
mzero :: forall a. ByKey key f a
$cmzero :: forall k (key :: k) (f :: * -> *) a. MonadPlus f => ByKey key f a
MonadPlus
        , 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
mfix :: forall a. (a -> ByKey key f a) -> ByKey key f a
$cmfix :: forall k (key :: k) (f :: * -> *) a.
MonadFix f =>
(a -> ByKey key f a) -> ByKey key f a
MonadFix
        , 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
liftIO :: forall a. IO a -> ByKey key f a
$cliftIO :: forall k (key :: k) (f :: * -> *) a.
MonadIO f =>
IO a -> ByKey key f a
MonadIO
        , 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
fail :: forall a. String -> ByKey key f a
$cfail :: forall k (key :: k) (f :: * -> *) a.
MonadFail f =>
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 = forall {k} (key :: k) (f :: * -> *) a. ByKey key f a -> f a
runByKey
{-# INLINE key #-}

instance SendInsBy key ins f => SendIns ins (ByKey key f) where
    sendIns :: forall a. ins a -> ByKey key f a
sendIns = forall {k} (key :: k) (f :: * -> *) a. f a -> ByKey key f a
ByKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (key :: k) (ins :: * -> *) (f :: * -> *) a.
SendInsBy key ins f =>
ins a -> f a
sendInsBy @key
    {-# INLINE sendIns #-}

instance (SendSigBy key sig f, HFunctor sig) => SendSig sig (ByKey key f) where
    sendSig :: forall a. sig (ByKey key f) a -> ByKey key f a
sendSig = forall {k} (key :: k) (f :: * -> *) a. f a -> ByKey key f a
ByKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (key :: k) (sig :: SigClass) (f :: * -> *) a.
SendSigBy key sig f =>
sig f a -> f a
sendSigBy @key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: SigClass) (f :: * -> *) (g :: * -> *).
HFunctor h =>
(f :-> g) -> h f :-> h g
hfmap coerce :: forall a b. Coercible a b => a -> b
coerce
    {-# INLINE sendSig #-}