{-# LANGUAGE Trustworthy #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: experimental
-- Portability: non-portable (GHC only)
module Cleff.Fresh
  ( -- * Effect
    Fresh (..)
  , -- * Operations
    fresh
  , -- * Interpretations
    freshIntToState, runFreshUnique
  ) where

import           Cleff
import           Cleff.State
import           Data.Unique (Unique, newUnique)

-- * Effect

-- | An effect capable of generating unique values. This effect can be useful in generating variable indices.
data Fresh u :: Effect where
  Fresh :: Fresh u m u

-- * Operations

makeEffect ''Fresh

-- * Interpretations

-- | Interpret a @'Fresh' 'Int'@ effect in terms of @'State' 'Int'@.
freshIntToState :: Eff (Fresh Int ': es) ~> Eff (State Int ': es)
freshIntToState :: Eff (Fresh Int : es) a -> Eff (State Int : es) a
freshIntToState = Handler (Fresh Int) (State Int : es)
-> Eff (Fresh Int : es) ~> Eff (State Int : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e (e' : es) -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  Fresh Int (Eff esSend) a
Fresh -> (a -> (a, a)) -> Eff (State Int : es) a
forall s (es :: [(Type -> Type) -> Type -> Type]) a.
(State s :> es) =>
(s -> (a, s)) -> Eff es a
state \a
s -> (a
s, a
s a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
{-# INLINE freshIntToState #-}

-- | Interpret a @'Fresh' 'Unique'@ effect in terms of IO actions.
runFreshUnique :: IOE :> es => Eff (Fresh Unique ': es) ~> Eff es
runFreshUnique :: Eff (Fresh Unique : es) ~> Eff es
runFreshUnique = Handler (Fresh Unique) es -> Eff (Fresh Unique : es) ~> Eff es
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e es -> Eff (e : es) ~> Eff es
interpret \case
  Fresh Unique (Eff esSend) a
Fresh -> IO Unique -> Eff es Unique
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO Unique
newUnique
{-# INLINE runFreshUnique #-}