{-# 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 :: Eff (Fresh a : es) ~> Eff (State a : es)
freshEnumToState = Handler (Fresh a) (State a : es)
-> Eff (Fresh a : es) ~> Eff (State a : 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 a (Eff esSend) a
Fresh -> (a -> (a, a)) -> Eff (State a : 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 -> a
forall a. Enum a => a -> a
succ a
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 :: Eff (Fresh Int : es) a -> Eff (State Int : es) a
freshIntToState = Eff (Fresh Int : es) a -> Eff (State Int : es) a
forall a (es :: [(Type -> Type) -> Type -> Type]).
Enum a =>
Eff (Fresh a : es) ~> Eff (State a : es)
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 :: Eff (Fresh Int : es) a -> Eff es a
runFreshAtomicCounter Eff (Fresh Int : es) a
m = Eff (IOE : es) a -> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type]).
Eff (IOE : es) ~> Eff es
thisIsPureTrustMe do
  AtomicCounter
counter <- IO AtomicCounter -> Eff (IOE : es) AtomicCounter
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO AtomicCounter -> Eff (IOE : es) AtomicCounter)
-> IO AtomicCounter -> Eff (IOE : es) AtomicCounter
forall a b. (a -> b) -> a -> b
$ Int -> IO AtomicCounter
newCounter Int
forall a. Bounded a => a
minBound
  Handler (Fresh Int) (IOE : es)
-> Eff (Fresh Int : es) a -> Eff (IOE : es) a
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 -> IO Int -> Eff (IOE : es) Int
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Eff (IOE : es) Int) -> IO Int -> Eff (IOE : es) Int
forall a b. (a -> b) -> a -> b
$ Int -> AtomicCounter -> IO Int
incrCounter Int
1 AtomicCounter
counter) Eff (Fresh Int : es) a
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 :: 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 #-}