{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE Safe #-} -- | Create unique Enumerable values. module Control.Eff.Fresh( Fresh (..) , fresh , runFresh' ) where import Control.Eff import Data.OpenUnion -- There are three possible implementations -- The first one uses State Fresh where -- newtype Fresh = Fresh Int -- We get the `private' effect layer (State Fresh) that does not interfere -- with with other layers. -- This is the easiest implementation. -- The second implementation defines a new effect Fresh -- | Create unique Enumerable values. data Fresh v where Fresh :: Fresh Int -- | Produce a value that has not been previously produced. fresh :: Member Fresh r => Eff r Int fresh = send Fresh -- | Run an effect requiring unique values. runFresh' :: Eff (Fresh ': r) w -> Int -> Eff r w runFresh' m s = handle_relay_s s (\_s x -> return x) (\s' Fresh k -> (k $! s' + 1) s') m {- -- Finally, the worst implementation but the one that answers -- reviewer's question: implementing Fresh in terms of State -- but not revealing that fact. runFresh :: Eff (Fresh :> r) w -> Int -> Eff r w runFresh m s = runState m' s >>= return . fst where m' = loop m loop (Val x) = return x loop (E u q) = case decomp u of Right Fresh -> do n <- get put (n+1::Int) k n Left u -> send (\k -> weaken $ fmap k u) >>= loop tfresh = runTrace $ flip runFresh 0 $ do n <- fresh -- (x::Int) <- get trace $ "Fresh " ++ show n n <- fresh trace $ "Fresh " ++ show n {- If we try to meddle with the encapsulated state, by uncommenting the get statement above, we get: No instance for (Member (State Int) Void) arising from a use of `get' -} -} -- Encapsulation of effects -- The example suggested by a reviewer {- The reviewer outlined an MTL implementation below, writing ``This hides the state effect and I can layer another state effect on top without getting into conflict with the class system.'' class Monad m => MonadFresh m where fresh :: m Int newtype FreshT m a = FreshT { unFreshT :: State Int m a } deriving (Functor, Monad, MonadTrans) instance Monad m => MonadFresh (FreshT m) where fresh = FreshT $ do n <- get; put (n+1); return n See EncapsMTL.hs for the complete code. -}