-- |
-- Module:       Control.Monad.Freer.Fresh
-- Description:  Generation of fresh integers as an effect.
-- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
-- License:      BSD3
-- Maintainer:   Alexis King <lexi.lambda@gmail.com>
-- Stability:    experimental
-- Portability:  GHC specific language extensions.
--
-- Composable handler for 'Fresh' effects. This is likely to be of use when
-- implementing De Bruijn naming/scopes.
--
-- Using <http://okmij.org/ftp/Haskell/extensible/Eff1.hs> as a starting point.

module Control.Monad.Freer.Fresh
  ( Fresh(..)
  , fresh
  , runFresh
  , evalFresh
  ) where

import Control.Monad.Freer.Internal (Eff, Member, handleRelayS, send)

-- | Fresh effect model.
data Fresh r where
  Fresh :: Fresh Int

-- | Request a fresh effect.
fresh :: Member Fresh effs => Eff effs Int
fresh :: Eff effs Int
fresh = Fresh Int -> Eff effs Int
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send Fresh Int
Fresh

-- | Handler for 'Fresh' effects, with an 'Int' for a starting value. The
-- return value includes the next fresh value.
runFresh :: Int -> Eff (Fresh ': effs) a -> Eff effs (a, Int)
runFresh :: Int -> Eff (Fresh : effs) a -> Eff effs (a, Int)
runFresh Int
s =
  Int
-> (Int -> a -> Eff effs (a, Int))
-> (forall v.
    Int
    -> Fresh v -> (Int -> Arr effs v (a, Int)) -> Eff effs (a, Int))
-> Eff (Fresh : effs) a
-> Eff effs (a, Int)
forall s a (effs :: [* -> *]) b (eff :: * -> *).
s
-> (s -> a -> Eff effs b)
-> (forall v. s -> eff v -> (s -> Arr effs v b) -> Eff effs b)
-> Eff (eff : effs) a
-> Eff effs b
handleRelayS Int
s (\Int
s' a
a -> (a, Int) -> Eff effs (a, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Int
s')) (\Int
s' Fresh v
Fresh Int -> Arr effs v (a, Int)
k -> (Int -> Arr effs v (a, Int)
k (Int -> Arr effs v (a, Int)) -> Int -> Arr effs v (a, Int)
forall a b. (a -> b) -> a -> b
$! Int
s' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) v
Int
s')

-- | Handler for 'Fresh' effects, with an 'Int' for a starting value. Discards
-- the next fresh value.
evalFresh :: Int -> Eff (Fresh ': effs) a -> Eff effs a
evalFresh :: Int -> Eff (Fresh : effs) a -> Eff effs a
evalFresh Int
s = ((a, Int) -> a) -> Eff effs (a, Int) -> Eff effs a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Int) -> a
forall a b. (a, b) -> a
fst (Eff effs (a, Int) -> Eff effs a)
-> (Eff (Fresh : effs) a -> Eff effs (a, Int))
-> Eff (Fresh : effs) a
-> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Eff (Fresh : effs) a -> Eff effs (a, Int)
forall (effs :: [* -> *]) a.
Int -> Eff (Fresh : effs) a -> Eff effs (a, Int)
runFresh Int
s