{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Safe #-}
module Control.Eff.Operational ( Program (..)
, withOperational, Intrprtr (..)
, singleton
, runProgram
) where
import Control.Eff
import Control.Eff.Extend
data Program instr v where
Singleton :: instr a -> Program instr a
newtype Intrprtr f r = Intrprtr { runIntrprtr :: forall x. f x -> Eff r x }
withOperational :: a -> Intrprtr f r -> Eff r a
withOperational x _ = return x
instance Handle (Program f) (Intrprtr f r -> Eff r a) where
handle k (Singleton instr) i = (runIntrprtr i) instr >>= (flip k i)
singleton :: (Member (Program instr) r) => instr a -> Eff r a
singleton = send . Singleton
runProgram :: forall f r a. (forall x. f x -> Eff r x) -> Eff (Program f ': r) a -> Eff r a
runProgram advent m = handle_relay withOperational m (Intrprtr advent)