--------------------------------------------------------------------------------

-- Copyright © 2010-2012 Bas van Dijk & Roel van Dijk
-- Copyright © 2018 DFINITY Stiftung
--
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--
--     * Redistributions in binary form must reproduce the above
--       copyright notice, this list of conditions and the following
--       disclaimer in the documentation and/or other materials provided
--       with the distribution.
--
--     * The names of Bas van Dijk, Roel van Dijk and the names of
--       contributors may NOT be used to endorse or promote products
--       derived from this software without specific prior written
--       permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-------------------------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE UndecidableInstances #-}

-------------------------------------------------------------------------------

-- |
-- Module     : Control.Concurrent.Classy.RWLock
-- Copyright  : © 2010-2011 Bas van Dijk & Roel van Dijk
--            , © 2018 DFINITY Stiftung
-- Maintainer : DFINITY USA Research <team@dfinity.org>
--
-- Multiple-reader, single-writer locks. Used to protect shared resources which
-- may be concurrently read, but only sequentially written.
--
-- All functions are /exception safe/. Throwing asynchronous exceptions will not
-- compromise the internal state of an 'RWLock'. This means it is perfectly safe
-- to kill a thread that is blocking on, for example, 'acquireRead'.

-------------------------------------------------------------------------------

module Control.Concurrent.Classy.RWLock
  ( -- * @RWLock@
    RWLock

    -- * Creating locks
  , newRWLock
  , newAcquiredRead
  , newAcquiredWrite

    -- * Read access

    -- ** Blocking
  , acquireRead
  , releaseRead
  , withRead
  , waitRead

    -- ** Non-blocking
  , tryAcquireRead
  , tryWithRead

    -- * Write access

    -- ** Blocking
  , acquireWrite
  , releaseWrite
  , withWrite
  , waitWrite

    -- ** Non-blocking
  , tryAcquireWrite
  , tryWithWrite
  ) where

-------------------------------------------------------------------------------

import           Control.Applicative            (pure, (<*>))
import           Control.Monad                  (Monad, (>>))
import           Data.Bool                      (Bool(False, True))
import           Data.Eq                        (Eq, (==))
import           Data.Function                  (on, ($))
import           Data.Functor                   ((<$>))
import           Data.Int                       (Int)
import           Data.List                      ((++))
import           Data.Maybe                     (Maybe(Just, Nothing))
import           Data.Ord                       (Ord)
import           Data.Typeable                  (Typeable)
import           Prelude                        (String, error, pred, succ)
import           Text.Read                      (Read)
import           Text.Show                      (Show)

import qualified Control.Concurrent.Classy.MVar as MVar
import           Control.Monad.Catch            (bracket_, mask, mask_,
                                                 onException)
import           Control.Monad.Conc.Class       (MonadConc(MVar))

import           Control.Concurrent.Classy.Lock (Lock)
import qualified Control.Concurrent.Classy.Lock as Lock

-------------------------------------------------------------------------------

-- |
-- Multiple-reader, single-writer lock. Is in one of three states:
--
-- * \"Free\": Read or write access can be acquired without blocking.
--
-- * \"Read\": One or more threads have acquired read access.
--   Blocks write access.
--
-- * \"Write\": A single thread has acquired write access.
--   Blocks other threads from acquiring both read and write access.
--
-- @since 1.6.2.0
data RWLock m
  = RWLock
    { forall (m :: * -> *). RWLock m -> MVar m State
_state     :: MVar m State
    , forall (m :: * -> *). RWLock m -> Lock m
_readLock  :: Lock m
    , forall (m :: * -> *). RWLock m -> Lock m
_writeLock :: Lock m
    }
  deriving (Typeable)

-- TODO: could the fields of RWLock be strict / unpacked?

instance (Eq (MVar m State)) => Eq (RWLock m) where
  == :: RWLock m -> RWLock m -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (m :: * -> *). RWLock m -> MVar m State
_state

-------------------------------------------------------------------------------

-- |
-- Internal state of the 'RWLock'.
data State
  = Free
  | Read !Int
  | Write
  deriving (State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Eq State
State -> State -> Bool
State -> State -> Ordering
State -> State -> State
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: State -> State -> State
$cmin :: State -> State -> State
max :: State -> State -> State
$cmax :: State -> State -> State
>= :: State -> State -> Bool
$c>= :: State -> State -> Bool
> :: State -> State -> Bool
$c> :: State -> State -> Bool
<= :: State -> State -> Bool
$c<= :: State -> State -> Bool
< :: State -> State -> Bool
$c< :: State -> State -> Bool
compare :: State -> State -> Ordering
$ccompare :: State -> State -> Ordering
Ord, Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show, ReadPrec [State]
ReadPrec State
Int -> ReadS State
ReadS [State]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [State]
$creadListPrec :: ReadPrec [State]
readPrec :: ReadPrec State
$creadPrec :: ReadPrec State
readList :: ReadS [State]
$creadList :: ReadS [State]
readsPrec :: Int -> ReadS State
$creadsPrec :: Int -> ReadS State
Read)

-------------------------------------------------------------------------------

-- |
-- Create a new 'RWLock' in the \"free\" state; either read or write access
-- can be acquired without blocking.
--
-- @since 1.6.2.0
newRWLock :: (MonadConc m) => m (RWLock m)
newRWLock :: forall (m :: * -> *). MonadConc m => m (RWLock m)
newRWLock = do
  MVar m State
state <- forall (m :: * -> *) a. MonadConc m => a -> m (MVar m a)
MVar.newMVar State
Free
  Lock m
rlock <- forall (m :: * -> *). MonadConc m => m (Lock m)
Lock.newLock
  forall (m :: * -> *). MVar m State -> Lock m -> Lock m -> RWLock m
RWLock MVar m State
state Lock m
rlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadConc m => m (Lock m)
Lock.newLock

-- |
-- Create a new 'RWLock' in the \"read\" state; only read can be acquired
-- without blocking.
--
-- @since 1.6.2.0
newAcquiredRead :: (MonadConc m) => m (RWLock m)
newAcquiredRead :: forall (m :: * -> *). MonadConc m => m (RWLock m)
newAcquiredRead = do
  MVar m State
state <- forall (m :: * -> *) a. MonadConc m => a -> m (MVar m a)
MVar.newMVar (Int -> State
Read Int
1)
  Lock m
rlock <- forall (m :: * -> *). MonadConc m => m (Lock m)
Lock.newAcquired
  forall (m :: * -> *). MVar m State -> Lock m -> Lock m -> RWLock m
RWLock MVar m State
state Lock m
rlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadConc m => m (Lock m)
Lock.newLock

-- |
-- Create a new 'RWLock' in the \"write\" state; either acquiring read or
-- write will block.
--
-- @since 1.6.2.0
newAcquiredWrite :: (MonadConc m) => m (RWLock m)
newAcquiredWrite :: forall (m :: * -> *). MonadConc m => m (RWLock m)
newAcquiredWrite = do
  MVar m State
state <- forall (m :: * -> *) a. MonadConc m => a -> m (MVar m a)
MVar.newMVar State
Write
  Lock m
rlock <- forall (m :: * -> *). MonadConc m => m (Lock m)
Lock.newLock
  forall (m :: * -> *). MVar m State -> Lock m -> Lock m -> RWLock m
RWLock MVar m State
state Lock m
rlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadConc m => m (Lock m)
Lock.newAcquired

-------------------------------------------------------------------------------

-- |
-- Acquire the read lock.
--
-- Blocks if another thread has acquired write access.
-- If @acquireRead@ terminates without throwing an exception the state of
-- the 'RWLock' will be \"read\".
--
-- Implementation note: throws an exception when more than @'maxBound' :: 'Int'@
-- simultaneous threads acquire the read lock. But that is unlikely.
--
-- @since 1.6.2.0
acquireRead :: (MonadConc m) => RWLock m -> m ()
acquireRead :: forall (m :: * -> *). MonadConc m => RWLock m -> m ()
acquireRead RWLock { MVar m State
_state :: MVar m State
_state :: forall (m :: * -> *). RWLock m -> MVar m State
_state, Lock m
_readLock :: Lock m
_readLock :: forall (m :: * -> *). RWLock m -> Lock m
_readLock, Lock m
_writeLock :: Lock m
_writeLock :: forall (m :: * -> *). RWLock m -> Lock m
_writeLock } = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ m ()
go
  where
    go :: m ()
go = do
      State
st <- forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
MVar.takeMVar MVar m State
_state
      case State
st of
        State
Free     -> do forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.acquire Lock m
_readLock
                       forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state forall a b. (a -> b) -> a -> b
$ Int -> State
Read Int
1
        (Read Int
n) ->    forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state forall a b. (a -> b) -> a -> b
$ Int -> State
Read (forall a. Enum a => a -> a
succ Int
n)
        State
Write    -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
st
                       forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.wait Lock m
_writeLock
                       m ()
go

-- |
-- Try to acquire the read lock; non blocking.
--
-- Like 'acquireRead', but doesn't block. Returns 'True' if the resulting
-- state is \"read\", 'False' otherwise.
--
-- @since 1.6.2.0
tryAcquireRead :: (MonadConc m) => RWLock m -> m Bool
tryAcquireRead :: forall (m :: * -> *). MonadConc m => RWLock m -> m Bool
tryAcquireRead RWLock { MVar m State
_state :: MVar m State
_state :: forall (m :: * -> *). RWLock m -> MVar m State
_state, Lock m
_readLock :: Lock m
_readLock :: forall (m :: * -> *). RWLock m -> Lock m
_readLock } = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ forall a b. (a -> b) -> a -> b
$ do
  State
st <- forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
MVar.takeMVar MVar m State
_state
  case State
st of
    State
Free   -> do forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.acquire Lock m
_readLock
                 forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state forall a b. (a -> b) -> a -> b
$ Int -> State
Read Int
1
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    Read Int
n -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state forall a b. (a -> b) -> a -> b
$ Int -> State
Read (forall a. Enum a => a -> a
succ Int
n)
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    State
Write  -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
st
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- |
-- Release the read lock.
--
-- If the calling thread was the last one to relinquish read access the state
-- will revert to \"free\".
--
-- It is an error to release read access to an 'RWLock' which is not in
-- the \"read\" state.
--
-- @since 1.6.2.0
releaseRead :: (MonadConc m) => RWLock m -> m ()
releaseRead :: forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseRead RWLock { MVar m State
_state :: MVar m State
_state :: forall (m :: * -> *). RWLock m -> MVar m State
_state, Lock m
_readLock :: Lock m
_readLock :: forall (m :: * -> *). RWLock m -> Lock m
_readLock } = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ forall a b. (a -> b) -> a -> b
$ do
  State
st <- forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
MVar.takeMVar MVar m State
_state
  case State
st of
    Read Int
1 -> do forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.release Lock m
_readLock
                 forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
Free
    Read Int
n ->    forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state forall a b. (a -> b) -> a -> b
$ Int -> State
Read (forall a. Enum a => a -> a
pred Int
n)
    State
_      -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
st
                 forall (m :: * -> *) a. Monad m => String -> String -> m a
throw String
"releaseRead" String
"already released"

-- |
-- A convenience function wich first acquires read access and then performs the
-- computation. When the computation terminates, whether normally or by raising
-- an exception, the read lock is released.
--
-- @since 1.6.2.0
withRead :: (MonadConc m) => RWLock m -> m a -> m a
withRead :: forall (m :: * -> *) a. MonadConc m => RWLock m -> m a -> m a
withRead = forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadConc m => RWLock m -> m ()
acquireRead forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseRead

-- |
-- A non-blocking 'withRead'. First tries to acquire the lock. If that fails,
-- 'Nothing' is returned. If it succeeds, the computation is performed.
-- When the computation terminates, whether normally or by raising an exception,
-- the lock is released and 'Just' the result of the computation is returned.
--
-- @since 1.6.2.0
tryWithRead :: (MonadConc m) => RWLock m -> m a -> m (Maybe a)
tryWithRead :: forall (m :: * -> *) a.
MonadConc m =>
RWLock m -> m a -> m (Maybe a)
tryWithRead RWLock m
l m a
a = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
  Bool
acquired <- forall (m :: * -> *). MonadConc m => RWLock m -> m Bool
tryAcquireRead RWLock m
l
  if Bool
acquired
    then do a
r <- forall a. m a -> m a
restore m a
a forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseRead RWLock m
l
            forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseRead RWLock m
l
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
r
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- |
-- * When the state is \"write\", @waitRead@ /blocks/ until a call to
--   'releaseWrite' in another thread changes the state to \"free\".
--
-- * When the state is \"free\" or \"read\" @waitRead@ returns immediately.
--
-- @waitRead@ does not alter the state of the lock.
--
-- Note that @waitRead@ is just a convenience function defined as:
--
-- @waitRead l = 'mask_' '$' 'acquireRead' l '>>' 'releaseRead' l@
--
-- @since 1.6.2.0
waitRead :: (MonadConc m) => RWLock m -> m ()
waitRead :: forall (m :: * -> *). MonadConc m => RWLock m -> m ()
waitRead RWLock m
l = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (forall (m :: * -> *). MonadConc m => RWLock m -> m ()
acquireRead RWLock m
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseRead RWLock m
l)

-------------------------------------------------------------------------------

-- |
-- Acquire the write lock.
--
-- Blocks if another thread has acquired either read or write access.
-- If @acquireWrite@ terminates without throwing an exception the state of
-- the 'RWLock' will be \"write\".
--
-- @since 1.6.2.0
acquireWrite :: (MonadConc m) => RWLock m -> m ()
acquireWrite :: forall (m :: * -> *). MonadConc m => RWLock m -> m ()
acquireWrite RWLock { MVar m State
_state :: MVar m State
_state :: forall (m :: * -> *). RWLock m -> MVar m State
_state, Lock m
_readLock :: Lock m
_readLock :: forall (m :: * -> *). RWLock m -> Lock m
_readLock, Lock m
_writeLock :: Lock m
_writeLock :: forall (m :: * -> *). RWLock m -> Lock m
_writeLock } = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ m ()
go'
  where
    go' :: m ()
go' = do
      State
st <- forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
MVar.takeMVar MVar m State
_state
      case State
st of
        State
Free   -> do forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.acquire Lock m
_writeLock
                     forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
Write
        Read Int
_ -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
st
                     forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.wait Lock m
_readLock
                     m ()
go'
        State
Write  -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
st
                     forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.wait Lock m
_writeLock
                     m ()
go'

-- |
-- Try to acquire the write lock; non blocking.
--
-- Like 'acquireWrite', but doesn't block.
-- Returns 'True' if the resulting state is \"write\", 'False' otherwise.
--
-- @since 1.6.2.0
tryAcquireWrite :: (MonadConc m) => RWLock m -> m Bool
tryAcquireWrite :: forall (m :: * -> *). MonadConc m => RWLock m -> m Bool
tryAcquireWrite RWLock { MVar m State
_state :: MVar m State
_state :: forall (m :: * -> *). RWLock m -> MVar m State
_state, Lock m
_writeLock :: Lock m
_writeLock :: forall (m :: * -> *). RWLock m -> Lock m
_writeLock } = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ forall a b. (a -> b) -> a -> b
$ do
  State
st <- forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
MVar.takeMVar MVar m State
_state
  case State
st of
    State
Free -> do forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.acquire Lock m
_writeLock
               forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
Write
               forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    State
_    -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
st
               forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- |
-- Release the write lock.
--
-- If @releaseWrite@ terminates without throwing an exception the state
-- will be \"free\".
--
-- It is an error to release write access to an 'RWLock' which is not
-- in the \"write\" state.
--
-- @since 1.6.2.0
releaseWrite :: (MonadConc m) => RWLock m -> m ()
releaseWrite :: forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseWrite RWLock { MVar m State
_state :: MVar m State
_state :: forall (m :: * -> *). RWLock m -> MVar m State
_state, Lock m
_writeLock :: Lock m
_writeLock :: forall (m :: * -> *). RWLock m -> Lock m
_writeLock } = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ forall a b. (a -> b) -> a -> b
$ do
  State
st <- forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
MVar.takeMVar MVar m State
_state
  case State
st of
    State
Write -> do forall (m :: * -> *). MonadConc m => Lock m -> m ()
Lock.release Lock m
_writeLock
                forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
Free
    State
_     -> do forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
MVar.putMVar MVar m State
_state State
st
                forall (m :: * -> *) a. Monad m => String -> String -> m a
throw String
"releaseWrite" String
"already released"

-- |
-- A convenience function wich first acquires write access and then performs
-- the computation. When the computation terminates, whether normally or by
-- raising an exception, the write lock is released.
--
-- @since 1.6.2.0
withWrite :: (MonadConc m) => RWLock m -> m a -> m a
withWrite :: forall (m :: * -> *) a. MonadConc m => RWLock m -> m a -> m a
withWrite = forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadConc m => RWLock m -> m ()
acquireWrite forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseWrite

-- |
-- A non-blocking 'withWrite'. First tries to acquire the lock. If that fails,
-- 'Nothing' is returned. If it succeeds, the computation is performed.
-- When the computation terminates, whether normally or by raising an exception,
-- the lock is released and 'Just' the result of the computation is returned.
--
-- @since 1.6.2.0
tryWithWrite :: (MonadConc m) => RWLock m -> m a -> m (Maybe a)
tryWithWrite :: forall (m :: * -> *) a.
MonadConc m =>
RWLock m -> m a -> m (Maybe a)
tryWithWrite RWLock m
l m a
a = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
  Bool
acquired <- forall (m :: * -> *). MonadConc m => RWLock m -> m Bool
tryAcquireWrite RWLock m
l
  if Bool
acquired
    then do a
r <- forall a. m a -> m a
restore m a
a forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseWrite RWLock m
l
            forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseWrite RWLock m
l
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
r
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- |
-- * When the state is \"write\" or \"read\" @waitWrite@ /blocks/ until a call
--   to 'releaseWrite' or 'releaseRead' in another thread changes the state
--   to \"free\".
--
-- * When the state is \"free\" @waitWrite@ returns immediately.
--
-- @waitWrite@ does not alter the state of the lock.
--
-- Note that @waitWrite@ is just a convenience function defined as:
--
-- @waitWrite l = 'mask_' '$' 'acquireWrite' l '>>' 'releaseWrite' l@
--
-- @since 1.6.2.0
waitWrite :: (MonadConc m) => RWLock m -> m ()
waitWrite :: forall (m :: * -> *). MonadConc m => RWLock m -> m ()
waitWrite RWLock m
l = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (forall (m :: * -> *). MonadConc m => RWLock m -> m ()
acquireWrite RWLock m
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). MonadConc m => RWLock m -> m ()
releaseWrite RWLock m
l)

--------------------------------------------------------------------------------

throw :: (Monad m) => String -> String -> m a
throw :: forall (m :: * -> *) a. Monad m => String -> String -> m a
throw String
func String
msg
  = forall a. HasCallStack => String -> a
error (String
"Control.Concurrent.Classy.RWLock." forall a. [a] -> [a] -> [a]
++ String
func forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg)

--------------------------------------------------------------------------------