{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Labeled effects.
--
-- Any effect can be assigned multiple labels so you have more than one
-- available simultaneously.
--
-- @since 2.3.0.0
module Effectful.Labeled
  ( -- * Effect
    Labeled(..)

    -- ** Handlers
  , runLabeled

    -- ** Operations
  , labeled
  ) where

import Unsafe.Coerce (unsafeCoerce)

import Effectful
import Effectful.Dispatch.Static

-- | Assign a label to an effect.
--
-- The constructor is for sending labeled operations of a dynamically dispatched
-- effect to the handler:
--
-- >>> import Effectful.Dispatch.Dynamic
--
-- >>> :{
--   data X :: Effect where
--     X :: X m Int
--   type instance DispatchOf X = Dynamic
-- :}
--
-- >>> :{
--   runPureEff . runLabeled @"x" (interpret_ $ \X -> pure 333) $ do
--     send $ Labeled @"x" X
-- :}
-- 333
--
newtype Labeled (label :: k) (e :: Effect) :: Effect where
  -- | @since 2.4.0.0
  Labeled :: forall label e m a. e m a -> Labeled label e m a

type instance DispatchOf (Labeled label e) = DispatchOf e

data instance StaticRep (Labeled label e)

-- | Run a 'Labeled' effect with a given effect handler.
runLabeled
  :: forall label e es a b
   . HasCallStack
  => (Eff (e : es) a -> Eff es b)
  -- ^ The effect handler.
  -> Eff (Labeled label e : es) a
  -> Eff es b
runLabeled :: forall {k} (label :: k) (e :: Effect) (es :: [Effect]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled Eff (e : es) a -> Eff es b
runE Eff (Labeled label e : es) a
m = Eff (e : es) a -> Eff es b
runE (Eff (Labeled label e : es) a -> Eff (e : es) a
forall {k} (label :: k) (e :: Effect) (es :: [Effect]) a.
Eff (Labeled label e : es) a -> Eff (e : es) a
fromLabeled Eff (Labeled label e : es) a
m)

-- | Bring an effect into scope without a label.
--
-- Useful for running code written with the non-labeled effect in mind.
labeled
  :: forall label e es a
   . (HasCallStack, Labeled label e :> es)
  => Eff (e : es) a
  -- ^ The action using the effect.
  -> Eff es a
labeled :: forall {k} (label :: k) (e :: Effect) (es :: [Effect]) a.
(HasCallStack, Labeled label e :> es) =>
Eff (e : es) a -> Eff es a
labeled Eff (e : es) a
m = forall (e :: Effect) (es :: [Effect]) a.
(e :> es) =>
Eff (e : es) a -> Eff es a
subsume @(Labeled label e) (Eff (e : es) a -> Eff (Labeled label e : es) a
forall {k} (e :: Effect) (es :: [Effect]) a (label :: k).
Eff (e : es) a -> Eff (Labeled label e : es) a
toLabeled Eff (e : es) a
m)

----------------------------------------
-- Helpers

fromLabeled :: Eff (Labeled label e : es) a -> Eff (e : es) a
fromLabeled :: forall {k} (label :: k) (e :: Effect) (es :: [Effect]) a.
Eff (Labeled label e : es) a -> Eff (e : es) a
fromLabeled = Eff (Labeled label e : es) a -> Eff (e : es) a
forall a b. a -> b
unsafeCoerce

toLabeled :: Eff (e : es) a -> Eff (Labeled label e : es) a
toLabeled :: forall {k} (e :: Effect) (es :: [Effect]) a (label :: k).
Eff (e : es) a -> Eff (Labeled label e : es) a
toLabeled = Eff (e : es) a -> Eff (Labeled label e : es) a
forall a b. a -> b
unsafeCoerce