{-# 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 , freshEnumToState , runFreshAtomicCounter , runFreshUnique ) where import Cleff import Cleff.Internal.Base (thisIsPureTrustMe) import Cleff.State import Data.Atomics.Counter (incrCounter, newCounter) 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 -- | Obtain a fresh unique value. fresh :: Fresh u :> es => Eff es u -- * Interpretations -- | Interpret a @'Fresh' a@ in terms of @'State' a@ for any 'Enum'. Every time 'succ' is called to generate the next -- value. -- -- @since 0.2.1.0 freshEnumToState :: Enum a => Eff (Fresh a : es) ~> Eff (State a : es) freshEnumToState = reinterpret \case Fresh -> state \s -> (s, succ s) {-# INLINE freshEnumToState #-} -- | Interpret a @'Fresh' 'Int'@ effect in terms of @'State' 'Int'@. This is a specialized version of -- 'freshEnumToState'. freshIntToState :: Eff (Fresh Int : es) ~> Eff (State Int : es) freshIntToState = freshEnumToState {-# INLINE freshIntToState #-} -- | Interpret a @'Fresh' 'Int'@ effect in terms of a 'Data.Atomics.Counter.AtomicCounter'. This is usually faster -- than 'runFreshUnique'. -- -- @since 0.2.1.0 runFreshAtomicCounter :: Eff (Fresh Int : es) ~> Eff es runFreshAtomicCounter m = thisIsPureTrustMe do counter <- liftIO $ newCounter minBound reinterpret (\case Fresh -> liftIO $ incrCounter 1 counter) m {-# INLINE runFreshAtomicCounter #-} -- | Interpret a @'Fresh' 'Unique'@ effect in terms of IO actions. This is slower than 'runFreshAtomicCounter', but it -- won't overflow on @'maxBound' :: 'Int'@. runFreshUnique :: IOE :> es => Eff (Fresh Unique : es) ~> Eff es runFreshUnique = interpret \case Fresh -> liftIO newUnique {-# INLINE runFreshUnique #-}