{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE PolyKinds #-}
-- | Labeled effects.
module Effectful.Labeled
  ( -- * Example
    -- $example

    -- * Effect
    Labeled

    -- ** Handlers
  , runLabeled

    -- ** Operations
  , labeled
  ) where

import Unsafe.Coerce (unsafeCoerce)

import Effectful
import Effectful.Dispatch.Static

-- $example
--
-- An effect can be assigned multiple labels and you can have all of them
-- available at the same time.
--
-- >>> import Effectful.Reader.Static
--
-- >>> :{
--  action
--    :: ( Labeled "a" (Reader String) :> es
--       , Labeled "b" (Reader String) :> es
--       , Reader String :> es
--       )
--    => Eff es String
--  action = do
--    a <- labeled @"b" @(Reader String) $ do
--      labeled @"a" @(Reader String) $ do
--        ask
--    b <- labeled @"b" @(Reader String) $ do
--      ask
--    pure $ a ++ b
-- :}
--
-- >>> :{
--  runPureEff @String
--    . runLabeled @"a" (runReader "a")
--    . runLabeled @"b" (runReader "b")
--    . runReader "c"
--    $ action
-- :}
-- "ab"

-- | Assign a label to an effect.
data Labeled (label :: k) (e :: Effect) :: Effect

type instance DispatchOf (Labeled label e) = Static NoSideEffects

data instance StaticRep (Labeled label e)

-- | Run a 'Labeled' effect with a given effect handler.
runLabeled
  :: forall label e es a b
   . (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.
(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 (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 to be able to run its operations.
labeled
  :: forall label e es a
   . 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.
(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) (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 = 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 = forall a b. a -> b
unsafeCoerce