46 lines
1.7 KiB
Plaintext
46 lines
1.7 KiB
Plaintext
module Data.Async.Mutex (Mutex, MutexGuard) where
|
|
|
|
import Prelude
|
|
|
|
import Control.Monad.Error.Class (liftMaybe, throwError)
|
|
import Data.Async.Class (class AsyncState, class AsyncStateLock, class AsyncStateReadable, class AsyncStateWritable)
|
|
import Data.Maybe (isNothing)
|
|
import Data.Traversable (for, for_)
|
|
import Effect.Aff.AVar (AVar)
|
|
import Effect.Aff.AVar as AVar
|
|
import Effect.Aff.Class (liftAff)
|
|
import Effect.Exception (error)
|
|
|
|
-- | A lock guaranteeing exclusive access to
|
|
-- | the data contained within a `Mutex`
|
|
data MutexGuard a = MutexGuard (AVar a)
|
|
|
|
-- | Mutable state guaranteeing mutually exclusive
|
|
-- | access to the data of type `a`.
|
|
-- |
|
|
-- | There will be at most 1 thread with access to
|
|
-- | the data contained in the mutex at a time.
|
|
data Mutex a = Mutex (AVar a)
|
|
|
|
instance AsyncState Mutex MutexGuard MutexGuard where
|
|
boxed = liftAff <<< map Mutex <<< AVar.new
|
|
|
|
instance AsyncStateReadable Mutex MutexGuard where
|
|
read _ (MutexGuard cell) = liftAff $ liftMaybe (error "MutexGuard used after `unlock`!") =<< AVar.tryRead cell
|
|
|
|
instance AsyncStateWritable Mutex MutexGuard where
|
|
write _ (MutexGuard cell) s = liftAff $ (const $ AVar.put s cell) =<< liftMaybe (error "MutexGuard used after `unlock`!") =<< AVar.tryTake cell
|
|
|
|
instance AsyncStateLock Mutex MutexGuard where
|
|
unlock (Mutex stateCell) (MutexGuard localStateCell) = liftAff do
|
|
state <- AVar.tryTake localStateCell
|
|
void $ AVar.tryTake localStateCell
|
|
when (isNothing state) $ throwError $ error "MutexGuard unlocked already!"
|
|
for_ state (flip AVar.put stateCell)
|
|
lock (Mutex stateCell) = liftAff do
|
|
state <- AVar.take stateCell
|
|
MutexGuard <$> AVar.new state
|
|
tryLock (Mutex stateCell) = liftAff do
|
|
state <- AVar.tryTake stateCell
|
|
for state (map MutexGuard <<< AVar.new)
|