{-# LANGUAGE CPP
           , DeriveDataTypeable
           , NoImplicitPrelude
           , TupleSections
  #-}

#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#endif

-------------------------------------------------------------------------------
-- |
-- Module     : Control.Concurrent.ReadWriteVar
-- Copyright  : 2010—2011 Bas van Dijk & Roel van Dijk
-- License    : BSD3 (see the file LICENSE)
-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>
--            , Roel van Dijk <vandijk.roel@gmail.com>
--
-- Concurrent read, sequential write variables. Comparable to an 'IORef' with
-- more advanced synchronization mechanisms. The value stored inside the 'RWVar'
-- can be read and used by multiple threads at the same time. Concurrent
-- computations inside a 'with' \"block\" observe the same value.
--
-- Observing and changing the contents of an 'RWVar' are mutually
-- exclusive. The 'with' function will block if 'modify' is active and
-- vice-versa. Furthermore 'with' is fully sequential and will also
-- block on concurrent calls of 'modify'.
--
-- The following are guaranteed deadlocks:
--
-- * @'modify_' v '$' 'const' '$' 'with' v '$' 'const' 'undefined'@
--
-- * @'with' v '$' 'const' '$' 'modify_' v '$' 'const' 'undefined'@
--
-- * @'modify_' v '$' 'const' '$' 'modify_' v '$' 'const' 'undefined'@
--
-- All functions are /exception safe/. Throwing asynchronous exceptions will not
-- compromise the internal state of an 'RWVar'. This also means that threads
-- blocking on 'with' or 'modify' and friends can still be unblocked by throwing
-- an asynchronous exception.
--
-- This module is designed to be imported qualified. We suggest importing it
-- like:
--
-- @
-- import           Control.Concurrent.ReadWriteVar        ( RWVar )
-- import qualified Control.Concurrent.ReadWriteVar as RWV ( ... )
-- @
--
-------------------------------------------------------------------------------

module Control.Concurrent.ReadWriteVar
  ( RWVar
  , new
  , with
  , tryWith
  , modify_
  , modify
  , tryModify_
  , tryModify
  ) where


-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

-- from base:
import Control.Applicative ( liftA2 )
import Control.Monad       ( (>>=) )
import Data.Bool           ( Bool(..) )
import Data.Eq             ( Eq, (==) )
import Data.Function       ( ($), (.), on )
import Data.Functor        ( fmap  )
import Data.Maybe          ( Maybe(..), isJust )
import Data.IORef          ( IORef, newIORef, readIORef )
import Data.Typeable       ( Typeable )
import System.IO           ( IO )
#ifdef __HADDOCK_VERSION__
import Data.Function       ( const )
import Prelude             ( undefined )
#endif

-- from concurrent-extra (this package):
import           Control.Concurrent.ReadWriteLock ( RWLock )
import qualified Control.Concurrent.ReadWriteLock as RWLock

import Utils ( modifyIORefM, modifyIORefM_ )


-------------------------------------------------------------------------------
-- Read-Write Variables: concurrent read, sequential write
-------------------------------------------------------------------------------

-- | Concurrently readable and sequentially writable variable.
data RWVar a = RWVar RWLock (IORef a) deriving Typeable

instance Eq (RWVar a) where
    == :: RWVar a -> RWVar a -> Bool
(==) = RWLock -> RWLock -> Bool
forall a. Eq a => a -> a -> Bool
(==) (RWLock -> RWLock -> Bool)
-> (RWVar a -> RWLock) -> RWVar a -> RWVar a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RWVar a -> RWLock
forall {a}. RWVar a -> RWLock
rwlock
        where
          rwlock :: RWVar a -> RWLock
rwlock (RWVar RWLock
rwl IORef a
_) = RWLock
rwl

-- | Create a new 'RWVar'.
new :: a -> IO (RWVar a)
new :: forall a. a -> IO (RWVar a)
new = (RWLock -> IORef a -> RWVar a)
-> IO RWLock -> IO (IORef a) -> IO (RWVar a)
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 RWLock -> IORef a -> RWVar a
forall a. RWLock -> IORef a -> RWVar a
RWVar IO RWLock
RWLock.new (IO (IORef a) -> IO (RWVar a))
-> (a -> IO (IORef a)) -> a -> IO (RWVar a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef

{-| Execute an action that operates on the contents of the 'RWVar'.

The action is guaranteed to have a consistent view of the stored value. Any
function that attempts to 'modify' the contents will block until the action is
completed.

If another thread is modifying the contents of the 'RWVar' this function will
block until the other thread finishes its action.
-}
with :: RWVar a -> (a -> IO b) -> IO b
with :: forall a b. RWVar a -> (a -> IO b) -> IO b
with (RWVar RWLock
l IORef a
r) a -> IO b
f = RWLock -> IO b -> IO b
forall a. RWLock -> IO a -> IO a
RWLock.withRead RWLock
l (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
r IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO b
f

{-| Like 'with' but doesn't block. Returns 'Just' the result if read access
could be acquired without blocking, 'Nothing' otherwise.
-}
tryWith :: RWVar a -> (a -> IO b) -> IO (Maybe b)
tryWith :: forall a b. RWVar a -> (a -> IO b) -> IO (Maybe b)
tryWith (RWVar RWLock
l IORef a
r) a -> IO b
f = RWLock -> IO b -> IO (Maybe b)
forall a. RWLock -> IO a -> IO (Maybe a)
RWLock.tryWithRead RWLock
l (IO b -> IO (Maybe b)) -> IO b -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
r IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO b
f

{-| Modify the contents of an 'RWVar'.

This function needs exclusive write access to the 'RWVar'. Only one thread can
modify an 'RWVar' at the same time. All others will block.
-}
modify_ :: RWVar a -> (a -> IO a) -> IO ()
modify_ :: forall a. RWVar a -> (a -> IO a) -> IO ()
modify_ (RWVar RWLock
l IORef a
r) = RWLock -> IO () -> IO ()
forall a. RWLock -> IO a -> IO a
RWLock.withWrite RWLock
l (IO () -> IO ()) -> ((a -> IO a) -> IO ()) -> (a -> IO a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> (a -> IO a) -> IO ()
forall a. IORef a -> (a -> IO a) -> IO ()
modifyIORefM_ IORef a
r

{-| Modify the contents of an 'RWVar' and return an additional value.

Like 'modify_', but allows a value to be returned (&#x3b2;) in addition to the
modified value of the 'RWVar'.
-}
modify :: RWVar a -> (a -> IO (a, b)) -> IO b
modify :: forall a b. RWVar a -> (a -> IO (a, b)) -> IO b
modify (RWVar RWLock
l IORef a
r) = RWLock -> IO b -> IO b
forall a. RWLock -> IO a -> IO a
RWLock.withWrite RWLock
l (IO b -> IO b)
-> ((a -> IO (a, b)) -> IO b) -> (a -> IO (a, b)) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> (a -> IO (a, b)) -> IO b
forall a b. IORef a -> (a -> IO (a, b)) -> IO b
modifyIORefM IORef a
r

{-| Attempt to modify the contents of an 'RWVar'.

Like 'modify_', but doesn't block. Returns 'True' if the contents could be
replaced, 'False' otherwise.
-}
tryModify_ :: RWVar a -> (a -> IO a) -> IO Bool
tryModify_ :: forall a. RWVar a -> (a -> IO a) -> IO Bool
tryModify_ (RWVar RWLock
l IORef a
r) = (Maybe () -> Bool) -> IO (Maybe ()) -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe ()) -> IO Bool)
-> ((a -> IO a) -> IO (Maybe ())) -> (a -> IO a) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWLock -> IO () -> IO (Maybe ())
forall a. RWLock -> IO a -> IO (Maybe a)
RWLock.tryWithWrite RWLock
l (IO () -> IO (Maybe ()))
-> ((a -> IO a) -> IO ()) -> (a -> IO a) -> IO (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> (a -> IO a) -> IO ()
forall a. IORef a -> (a -> IO a) -> IO ()
modifyIORefM_ IORef a
r

{-| Attempt to modify the contents of an 'RWVar' and return an additional value.

Like 'modify', but doesn't block. Returns 'Just' the additional value if the
contents could be replaced, 'Nothing' otherwise.
-}
tryModify :: RWVar a -> (a -> IO (a, b)) -> IO (Maybe b)
tryModify :: forall a b. RWVar a -> (a -> IO (a, b)) -> IO (Maybe b)
tryModify (RWVar RWLock
l IORef a
r) = RWLock -> IO b -> IO (Maybe b)
forall a. RWLock -> IO a -> IO (Maybe a)
RWLock.tryWithWrite RWLock
l (IO b -> IO (Maybe b))
-> ((a -> IO (a, b)) -> IO b) -> (a -> IO (a, b)) -> IO (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> (a -> IO (a, b)) -> IO b
forall a b. IORef a -> (a -> IO (a, b)) -> IO b
modifyIORefM IORef a
r