{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_HADDOCK hide #-}

module Capability.Sink.Internal.Class where

import Capability.Reflection
import Data.Coerce (coerce)
import Data.Kind (Type)
import GHC.Exts (Proxy#, proxy#)

-- | Sinking capability.
--
-- An instance does not need to fulfill any additional laws
-- besides the monad laws.
class Monad m
  => HasSink (tag :: k) (a :: Type) (m :: Type -> Type) | tag m -> a
  where
    -- | For technical reasons, this method needs an extra proxy argument.
    -- You only need it if you are defining new instances of 'HasSink'.
    -- Otherwise, you will want to use 'yield'.
    -- See 'yield' for more documentation.
    yield_ :: Proxy# tag -> a -> m ()

-- | @yield \@tag a@
-- emits @a@ in the sink capability @tag@.
yield :: forall tag a m. HasSink tag a m => a -> m ()
yield :: a -> m ()
yield = Proxy# tag -> a -> m ()
forall k (tag :: k) a (m :: * -> *).
HasSink tag a m =>
Proxy# tag -> a -> m ()
yield_ (Proxy# tag
forall k (a :: k). Proxy# a
proxy# @tag)
{-# INLINE yield #-}

--------------------------------------------------------------------------------

data instance Reified tag (HasSink tag a) m = ReifiedSink {Reified tag (HasSink tag a) m -> a -> m ()
_yield :: a -> m ()}

instance
  ( Monad m,
    Reifies s (Reified tag (HasSink tag a) m)
  ) =>
  HasSink tag a (Reflected s (HasSink tag a) m)
  where
  yield_ :: Proxy# tag -> a -> Reflected s (HasSink tag a) m ()
yield_ Proxy# tag
_ = (a -> m ()) -> a -> Reflected s (HasSink tag a) m ()
coerce ((a -> m ()) -> a -> Reflected s (HasSink tag a) m ())
-> (a -> m ()) -> a -> Reflected s (HasSink tag a) m ()
forall a b. (a -> b) -> a -> b
$ Reified tag (HasSink tag a) m -> a -> m ()
forall k (tag :: k) a (m :: * -> *).
Reified tag (HasSink tag a) m -> a -> m ()
_yield (forall (tag :: k) (c :: Capability) (m :: * -> *).
Reifies s (Reified tag c m) =>
Reified tag c m
forall k1 k2 (s :: k1) (tag :: k2) (c :: Capability) (m :: * -> *).
Reifies s (Reified tag c m) =>
Reified tag c m
reified @s)
  {-# INLINE yield_ #-}