module MonadVar.Default
  ( defaultLockUnsafeWrite
  , defaultReadWriteSwap
  , defaultLockUnsafeSwap
  , defaultReadWriteMutate_
  , defaultReadWriteMutate
  , defaultReadWriteMutateM_
  , defaultReadWriteMutateM
  , defaultLockUnsafeMutate_
  , defaultLockUnsafeMutate
  , defaultLockUnsafeMutateM_
  , defaultLockUnsafeMutateM
  , defaultLockIOMutateM_
  , defaultLockIOMutateM
  ) where

import           MonadVar.Prelude
import           MonadVar.Classes

-- | Default exception-unsafe 'write' for 'MonadLock' entities.
defaultLockUnsafeWrite
  :: MonadLock m v => v a -> a -> m ()
defaultLockUnsafeWrite :: v a -> a -> m ()
defaultLockUnsafeWrite v a
v a
y = v a -> m (Maybe a)
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> m (Maybe a)
tryHold v a
v m (Maybe a) -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y
{-# INLINE defaultLockUnsafeWrite #-}

-- | Default 'swap' for 'MonadRead' and 'MonadWrite' entities.
defaultReadWriteSwap
  :: (MonadRead m v, MonadWrite m v) => v a -> a -> m a
defaultReadWriteSwap :: v a -> a -> m a
defaultReadWriteSwap v a
v a
y = v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadRead m v => v a -> m a
read v a
v m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadWrite m v =>
v a -> a -> m ()
write v a
v a
y
{-# INLINE defaultReadWriteSwap #-}

-- | Default exception-unsafe 'swap' for 'MonadLock' entities.
defaultLockUnsafeSwap
  :: MonadLock m v => v a -> a -> m a
defaultLockUnsafeSwap :: v a -> a -> m a
defaultLockUnsafeSwap v a
v a
y = v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadLock m v => v a -> m a
hold v a
v m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y
{-# INLINE defaultLockUnsafeSwap #-}

-- | Default 'mutate_' for 'MonadRead' and 'MonadWrite' entities.
defaultReadWriteMutate_
  :: (MonadRead m v, MonadWrite m v) => v a -> (a -> a) -> m ()
defaultReadWriteMutate_ :: v a -> (a -> a) -> m ()
defaultReadWriteMutate_ v a
v a -> a
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadRead m v => v a -> m a
read v a
v
  let !y :: a
y = a -> a
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadWrite m v =>
v a -> a -> m ()
write v a
v a
y
{-# INLINE defaultReadWriteMutate_ #-}

-- | Default 'mutate' for 'MonadRead' and 'MonadWrite' entities.
defaultReadWriteMutate
  :: (MonadRead m v, MonadWrite m v) => v a -> (a -> (a, b)) -> m b
defaultReadWriteMutate :: v a -> (a -> (a, b)) -> m b
defaultReadWriteMutate v a
v a -> (a, b)
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadRead m v => v a -> m a
read v a
v
  let !(!a
y, b
z) = a -> (a, b)
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadWrite m v =>
v a -> a -> m ()
write v a
v a
y
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
z
{-# INLINE defaultReadWriteMutate #-}

-- | Default 'mutateM_' for 'MonadRead' and 'MonadWrite' entities.
defaultReadWriteMutateM_
  :: (MonadRead m v, MonadWrite m v) => v a -> (a -> m a) -> m ()
defaultReadWriteMutateM_ :: v a -> (a -> m a) -> m ()
defaultReadWriteMutateM_ v a
v a -> m a
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadRead m v => v a -> m a
read v a
v
  !a
y <- a -> m a
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadWrite m v =>
v a -> a -> m ()
write v a
v a
y
{-# INLINE defaultReadWriteMutateM_ #-}

-- | Default 'mutateM' for 'MonadRead' and 'MonadWrite' entities.
defaultReadWriteMutateM
  :: (MonadRead m v, MonadWrite m v) => v a -> (a -> m (a, b)) -> m b
defaultReadWriteMutateM :: v a -> (a -> m (a, b)) -> m b
defaultReadWriteMutateM v a
v a -> m (a, b)
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadRead m v => v a -> m a
read v a
v
  !(!a
y, b
z) <- a -> m (a, b)
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadWrite m v =>
v a -> a -> m ()
write v a
v a
y
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
z
{-# INLINE defaultReadWriteMutateM #-}

-- | Default exception-unsafe 'mutate_' for 'MonadLock' entities.
defaultLockUnsafeMutate_
  :: MonadLock m v => v a -> (a -> a) -> m ()
defaultLockUnsafeMutate_ :: v a -> (a -> a) -> m ()
defaultLockUnsafeMutate_ v a
v a -> a
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadLock m v => v a -> m a
hold v a
v
  let !y :: a
y = a -> a
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y
{-# INLINE defaultLockUnsafeMutate_ #-}

-- | Default exception-unsafe 'mutate' for 'MonadLock' entities.
defaultLockUnsafeMutate
  :: MonadLock m v => v a -> (a -> (a, b)) -> m b
defaultLockUnsafeMutate :: v a -> (a -> (a, b)) -> m b
defaultLockUnsafeMutate v a
v a -> (a, b)
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadLock m v => v a -> m a
hold v a
v
  let !(!a
y, b
z) = a -> (a, b)
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
z
{-# INLINE defaultLockUnsafeMutate #-}

-- | Default exception-unsafe 'mutateM_' for 'MonadLock' entities.
defaultLockUnsafeMutateM_
  :: MonadLock m v => v a -> (a -> m a) -> m ()
defaultLockUnsafeMutateM_ :: v a -> (a -> m a) -> m ()
defaultLockUnsafeMutateM_ v a
v a -> m a
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadLock m v => v a -> m a
hold v a
v
  !a
y <- a -> m a
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y
{-# INLINE defaultLockUnsafeMutateM_ #-}

-- | Default exception-unsafe 'mutateM' for 'MonadLock' entities.
defaultLockUnsafeMutateM
  :: MonadLock m v => v a -> (a -> m (a, b)) -> m b
defaultLockUnsafeMutateM :: v a -> (a -> m (a, b)) -> m b
defaultLockUnsafeMutateM v a
v a -> m (a, b)
f = do
  a
x <- v a -> m a
forall (m :: * -> *) (v :: * -> *) a. MonadLock m v => v a -> m a
hold v a
v
  !(!a
y, b
z) <- a -> m (a, b)
f a
x
  v a -> a -> m ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
z
{-# INLINE defaultLockUnsafeMutateM #-}

-- | Default 'mutateM_' for 'MonadLock' 'IO' entities
defaultLockIOMutateM_ :: MonadLock IO v => v a -> (a -> IO a) -> IO ()
defaultLockIOMutateM_ :: v a -> (a -> IO a) -> IO ()
defaultLockIOMutateM_ v a
v a -> IO a
f = ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  a
x <- v a -> IO a
forall (m :: * -> *) (v :: * -> *) a. MonadLock m v => v a -> m a
hold v a
v
  a
y <- IO a -> IO a
forall a. IO a -> IO a
restore (a -> IO a
f a
x) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` v a -> a -> IO ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
x
  v a -> a -> IO ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y
  a -> IO a
forall a. a -> IO a
evaluate a
y
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE defaultLockIOMutateM_ #-}

-- | Default 'mutateM' for 'MonadLock' 'IO' entities.
defaultLockIOMutateM :: MonadLock IO v => v a -> (a -> IO (a, b)) -> IO b
defaultLockIOMutateM :: v a -> (a -> IO (a, b)) -> IO b
defaultLockIOMutateM v a
v a -> IO (a, b)
f = ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  a
x      <- v a -> IO a
forall (m :: * -> *) (v :: * -> *) a. MonadLock m v => v a -> m a
hold v a
v
  (a
y, b
z) <- IO (a, b) -> IO (a, b)
forall a. IO a -> IO a
restore (a -> IO (a, b)
f a
x IO (a, b) -> ((a, b) -> IO (a, b)) -> IO (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a, b) -> IO (a, b)
forall a. a -> IO a
evaluate) IO (a, b) -> IO () -> IO (a, b)
forall a b. IO a -> IO b -> IO a
`onException` v a -> a -> IO ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
x
  v a -> a -> IO ()
forall (m :: * -> *) (v :: * -> *) a.
MonadLock m v =>
v a -> a -> m ()
fill v a
v a
y    -- See "Parallel and Concurrent Programming in Haskell",
  a -> IO a
forall a. a -> IO a
evaluate a
y  -- the "MVar as a Container for Shared State" section.
  b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
z
{-# INLINE defaultLockIOMutateM #-}