Check.hs

module RefExtras.Check
  ( CheckEffect (..)
  , checkEffectRef
  , checkEffectXVar
  , runCheckEffectRef
  , runCheckEffectXVar
  ) where

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import RefExtras.Classes (AtomicRef, atomicModifyRef, readRef)
import RefExtras.XVar (XVar, atomicModifyXVarM)

-- | Conditionally updates an AtomicRef. First reads the value with the prepare function, which
-- chooses to write with the commit function or chooses to return. This function allows you to
-- sequence a read, some effectful operation, and an optional write, all with the caveat that
-- the ref may have changed between the read and the write.
checkEffectRef :: (MonadIO m, AtomicRef r m) => r a -> (a -> m (Either x b)) -> (x -> a -> (a, b)) -> m b
checkEffectRef ref prepare commit = do
  a <- readRef ref
  e <- prepare a
  case e of
    Left b -> atomicModifyRef ref (commit b)
    Right c -> pure c

-- | checkEffectRef but locking around the effectful prepare function. You will block for the duration
-- of the prepare and commit functions but are guaranteed that the var does not change in the
-- meantime.
checkEffectXVar :: MonadUnliftIO m => XVar a -> (a -> m (Either x b)) -> (x -> a -> (a, b)) -> m b
checkEffectXVar ref prepare commit = atomicModifyXVarM ref $ \a -> do
  e <- prepare a
  case e of
    Left b -> pure (commit b a)
    Right c -> pure (a, c)

-- | The two prepare and commit functions packaged up.
data CheckEffect m a b where
  CheckEffect :: !(a -> m (Either x b)) -> !(x -> a -> (a, b)) -> CheckEffect m a b

runCheckEffectRef :: (MonadIO m, AtomicRef r m) => r a -> CheckEffect m a b -> m b
runCheckEffectRef ref (CheckEffect prepare commit) = checkEffectRef ref prepare commit

runCheckEffectXVar :: MonadUnliftIO m => XVar a -> CheckEffect m a b -> m b
runCheckEffectXVar ref (CheckEffect prepare commit) = checkEffectXVar ref prepare commit