module Control.Effect.Fresh
  ( -- * Effects
    Fresh(..)

    -- * Actions
  , fresh

    -- * Interpretations
  , freshToIO

  , runFreshEnumIO

    -- * Unsafe interpretations
  , runFreshEnum

    -- * Simple variants of interpretations
  , runFreshEnumIOSimple

    -- * Threading constraints
  , StateThreads

    -- * Carriers
  , FreshToIOC
  , FreshEnumC
  ) where

import Data.Unique
import Data.IORef

import Control.Effect
import Control.Effect.State

-- For coercion purposes
import Control.Effect.Internal.Utils
import Control.Effect.Carrier.Internal.Interpret
import Control.Effect.Carrier.Internal.Compose
import Control.Effect.Carrier.Internal.Intro
import Control.Monad.Trans.Identity


-- | An effect for creating unique objects which may be used as references,
-- a la 'Unique'. Polymorphic code making use of 'Fresh' is expected
-- to place constraints upon @uniq@ as necessary.
--
-- Any interpreter for 'Fresh' has the responsibilty of ensuring
-- that any call to 'fresh' produces an object that __never__
-- compares equal to an object produced by a previous call to 'fresh'.
data Fresh uniq :: Effect where
  Fresh :: Fresh uniq m uniq

fresh :: Eff (Fresh uniq) m => m uniq
fresh :: m uniq
fresh = Fresh uniq m uniq -> m uniq
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send Fresh uniq m uniq
forall uniq (m :: * -> *). Fresh uniq m uniq
Fresh
{-# INLINE fresh #-}

data FreshToIOH

instance Eff (Embed IO) m
      => Handler FreshToIOH (Fresh Unique) m where
  effHandler :: Fresh Unique (Effly z) x -> Effly z x
effHandler Fresh Unique (Effly z) x
Fresh = IO Unique -> Effly z Unique
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed IO Unique
newUnique
  {-# INLINEABLE effHandler #-}

type FreshToIOC = InterpretC FreshToIOH (Fresh Unique)

-- | Runs a 'Fresh' effect through generating 'Unique's using 'IO'.
--
-- @'Derivs' ('FreshToIOC' m) = 'Fresh' 'Unique' ': 'Derivs' m@
--
-- @'Control.Effect.Primitive.Prims'  ('FreshToIOC' m) = 'Control.Effect.Primitive.Prims' m@
freshToIO :: Eff (Embed IO) m
          => FreshToIOC m a
          -> m a
freshToIO :: FreshToIOC m a -> m a
freshToIO = FreshToIOC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
{-# INLINE freshToIO #-}

-- | Run a 'Fresh' effect through atomic operations in 'IO'
-- by specifying an 'Enum' to be used as the type of unique objects.
--
-- This is a safe variant of 'runFreshEnum'.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'runFreshEnumIO' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower
-- 'runFreshEnumIOSimple', which doesn't have a higher-rank type.
runFreshEnumIO :: forall uniq m a
                . ( Enum uniq
                  , Eff (Embed IO) m
                  )
               => InterpretReifiedC (Fresh uniq) m a
               -> m a
runFreshEnumIO :: InterpretReifiedC (Fresh uniq) m a -> m a
runFreshEnumIO InterpretReifiedC (Fresh uniq) m a
m = do
  IORef uniq
ref <- IO (IORef uniq) -> m (IORef uniq)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (IORef uniq) -> m (IORef uniq))
-> IO (IORef uniq) -> m (IORef uniq)
forall a b. (a -> b) -> a -> b
$ uniq -> IO (IORef uniq)
forall a. a -> IO (IORef a)
newIORef (Int -> uniq
forall a. Enum a => Int -> a
toEnum @uniq Int
0)
  (EffHandler (Fresh uniq) m
-> InterpretReifiedC (Fresh uniq) m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
`interpret` InterpretReifiedC (Fresh uniq) m a
m) (EffHandler (Fresh uniq) m -> m a)
-> EffHandler (Fresh uniq) m -> m a
forall a b. (a -> b) -> a -> b
$ \case
    Fresh uniq (Effly z) x
Fresh -> IO uniq -> Effly z uniq
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO uniq -> Effly z uniq) -> IO uniq -> Effly z uniq
forall a b. (a -> b) -> a -> b
$ IORef uniq -> (uniq -> (uniq, uniq)) -> IO uniq
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef uniq
ref (\uniq
s -> (uniq -> uniq
forall a. Enum a => a -> a
succ uniq
s, uniq
s))
{-# INLINE runFreshEnumIO #-}

-- | Run a 'Fresh' effect though atomic operations in 'IO'
-- by specifying an 'Enum' to be used as the type of unique objects.
--
-- This is a less performant version of 'runFreshEnumIO' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
runFreshEnumIOSimple :: forall uniq m a p
                      . ( Enum uniq
                        , Eff (Embed IO) m
                        , Threaders '[ReaderThreads] m p
                        )
                     => InterpretSimpleC (Fresh uniq) m a
                     -> m a
runFreshEnumIOSimple :: InterpretSimpleC (Fresh uniq) m a -> m a
runFreshEnumIOSimple InterpretSimpleC (Fresh uniq) m a
m = do
  IORef uniq
ref <- IO (IORef uniq) -> m (IORef uniq)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (IORef uniq) -> m (IORef uniq))
-> IO (IORef uniq) -> m (IORef uniq)
forall a b. (a -> b) -> a -> b
$ uniq -> IO (IORef uniq)
forall a. a -> IO (IORef a)
newIORef (Int -> uniq
forall a. Enum a => Int -> a
toEnum @uniq Int
0)
  (EffHandler (Fresh uniq) m
-> InterpretSimpleC (Fresh uniq) m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
 Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
`interpretSimple` InterpretSimpleC (Fresh uniq) m a
m) (EffHandler (Fresh uniq) m -> m a)
-> EffHandler (Fresh uniq) m -> m a
forall a b. (a -> b) -> a -> b
$ \case
    Fresh uniq (Effly z) x
Fresh -> IO uniq -> Effly z uniq
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO uniq -> Effly z uniq) -> IO uniq -> Effly z uniq
forall a b. (a -> b) -> a -> b
$ IORef uniq -> (uniq -> (uniq, uniq)) -> IO uniq
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef uniq
ref (\uniq
s -> (uniq -> uniq
forall a. Enum a => a -> a
succ uniq
s, uniq
s))
{-# INLINE runFreshEnumIOSimple #-}

data FreshEnumH

instance (Enum uniq, Eff (State uniq) m)
      => Handler FreshEnumH (Fresh uniq) m where
  effHandler :: Fresh uniq (Effly z) x -> Effly z x
effHandler Fresh uniq (Effly z) x
Fresh = (x -> (x, x)) -> Effly z x
forall s (m :: * -> *) a. Eff (State s) m => (s -> (s, a)) -> m a
state' (\x
s -> (x -> x
forall a. Enum a => a -> a
succ x
s, x
s))
  {-# INLINEABLE effHandler #-}

type FreshEnumC uniq = CompositionC
 '[ ReinterpretC FreshEnumH (Fresh uniq) '[State uniq]
  , StateC uniq
  ]
-- | Run a 'Fresh' effect purely by specifying an 'Enum' to be used as the
-- type of unique objects.
--
-- __Beware:__ This is safe only if:
--
--   1. This is run after all interpreters which may revert local state
--      or produce multiple, inconsistent instances of local state.
--      This includes interpreters that may backtrack or produce multiple results
--      (such as 'Control.Error.Error.runError' or 'Control.Effect.NonDet.runNonDet').
--
--   2. You don't use any interpreter which may cause the final monad
--      to revert local state or produce multiple, inconsistent instances
--      of local state. This includes 'Control.Effect.Error.errorToIO' and
--      'Control.Effect.Conc.asyncToIO'.
--
-- Prefer 'freshToIO' or 'runFreshEnumIO' whenever possible.
--
-- @'Derivs' ('FreshEnumC' uniq m) = 'Fresh' uniq ': 'Derivs' m@
--
-- @'Control.Effect.Primitive.Prims'  ('FreshEnumC' uniq m) = 'Control.Effect.Primitive.Prims' m@
runFreshEnum :: forall uniq m a p
              . ( Enum uniq
                , Threaders '[StateThreads] m p
                , Carrier m
                )
             => FreshEnumC uniq m a
             -> m a
runFreshEnum :: FreshEnumC uniq m a -> m a
runFreshEnum =
     uniq -> StateC uniq m a -> m a
forall s (m :: * -> *) a (p :: [Effect]).
(Carrier m, Threaders '[StateThreads] m p) =>
s -> StateC s m a -> m a
evalState (Int -> uniq
forall a. Enum a => Int -> a
toEnum Int
0)
  (StateC uniq m a -> m a)
-> (ReinterpretC
      FreshEnumH (Fresh uniq) '[State uniq] (StateC uniq m) a
    -> StateC uniq m a)
-> ReinterpretC
     FreshEnumH (Fresh uniq) '[State uniq] (StateC uniq m) a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ReinterpretC
  FreshEnumH (Fresh uniq) '[State uniq] (StateC uniq m) a
-> StateC uniq m a
forall h (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(Handler h e m, KnownList new, HeadEffs new m) =>
ReinterpretC h e new m a -> m a
reinterpretViaHandler
  (ReinterpretC
   FreshEnumH (Fresh uniq) '[State uniq] (StateC uniq m) a
 -> m a)
-> (FreshEnumC uniq m a
    -> ReinterpretC
         FreshEnumH (Fresh uniq) '[State uniq] (StateC uniq m) a)
-> FreshEnumC uniq m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# FreshEnumC uniq m a
-> ReinterpretC
     FreshEnumH (Fresh uniq) '[State uniq] (StateC uniq m) a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE runFreshEnum #-}