diff --git a/src/Data.Async.RwLock.purs b/src/Data.Async.RwLock.purs index 2c738c5..149462e 100644 --- a/src/Data.Async.RwLock.purs +++ b/src/Data.Async.RwLock.purs @@ -50,8 +50,8 @@ data RwLock a = RwLock makeReadGuard :: forall a. AVar ReaderId -> AVar (Set ReaderId) -> AVar a -> a -> Aff (ReadGuard a) makeReadGuard nextReaderIdCell readersCell stateCell state = do nextReaderId <- AVar.take nextReaderIdCell - ids <- AVar.take readersCell AVar.put (nextReaderId + ReaderId 1) nextReaderIdCell + ids <- AVar.take readersCell AVar.put (Set.insert nextReaderId ids) readersCell AVar.put state stateCell pure $ ReadGuard nextReaderId state @@ -59,8 +59,8 @@ makeReadGuard nextReaderIdCell readersCell stateCell state = do mayWrite :: AVar (Array (Effect Unit)) -> Aff Unit mayWrite writerQCell = do writerQueue <- AVar.take writerQCell - liftEffect $ for_ (Array.head writerQueue) identity AVar.put (fromMaybe [] $ Array.tail writerQueue) writerQCell + liftEffect $ fromMaybe (pure unit) $ Array.head writerQueue instance AsyncState RwLock WriteGuard ReadGuard where boxed a = liftAff do @@ -74,13 +74,14 @@ instance AsyncStateWritable RwLock WriteGuard where write _ (WriteGuard stateCell) s = do void $ liftAff $ liftMaybe (error "WriteGuard used after `unlock` invoked!") =<< AVar.tryTake stateCell liftAff $ void $ whileJust $ void <$> AVar.tryTake stateCell - liftAff $ AVar.put s stateCell + wasPut <- liftAff $ AVar.tryPut s stateCell + if not wasPut then + liftAff $ throwError $ error "WriteGuard has multiple pending writes - why?" + else + pure unit instance AsyncStateReadable RwLock WriteGuard where - read _ (WriteGuard stateCell) = - liftAff - $ liftMaybe (error "WriteGuard used after `unlock` invoked!") - =<< AVar.tryRead stateCell + read _ (WriteGuard stateCell) = liftAff $ liftMaybe (error "WriteGuard used after `unlock` invoked!") =<< AVar.tryRead stateCell instance AsyncStateReadable RwLock ReadGuard where read (RwLock { readers: readersCell }) (ReadGuard id a) = liftAff do @@ -103,6 +104,7 @@ instance AsyncStateLock RwLock ReadGuard where instance AsyncStateLock RwLock WriteGuard where unlock (RwLock { writerQueue: writerQCell, state: rwLockStateCell }) (WriteGuard localStateCell) = liftAff do state <- AVar.take localStateCell + void $ AVar.tryTake rwLockStateCell AVar.put state rwLockStateCell mayWrite writerQCell tryLock (RwLock { readers: readersCell, state: stateCell }) = liftAff do @@ -133,4 +135,4 @@ instance AsyncStateLock RwLock WriteGuard where else do AVar.put readers readersCell blockOnWritable - lock rw + onWritable