diff --git a/src/Control.Monad.State.Async.purs b/src/Control.Monad.State.Async.purs index e11de4f..3094c92 100644 --- a/src/Control.Monad.State.Async.purs +++ b/src/Control.Monad.State.Async.purs @@ -25,61 +25,42 @@ import Effect.Aff.Unlift (class MonadUnliftAff) import Effect.Class (class MonadEffect) import Effect.Unlift (class MonadUnliftEffect) --- | Computations with a mutable value of type `s` that may be evaluated in parallel --- | --- | A `MonadStateAsync` will have access to a single state value of type `s`, --- | and many computations may be executed concurrently accessing the same state. --- | --- | When a computation wishes to **read** the state, it will block until --- | it's safe to read (when "it's safe to read" depends on the cell type; `Mutex` or `RwLock`) --- | then it will have access to the state for a brief time. --- | --- | When a computation wishes to **write** a new value to the state, it will block --- | until **exclusive** writable access is guaranteed; when a computation has this type --- | of access no other computations will be able to read from or write to the state. --- | --- | Errors yielded by `MonadThrow` will be re-thrown after releasing any locks --- | still held when the error was thrown. --- | --- | ### Safe vs unsafe state types --- | Care should be taken when state types are used that are not structurally immutable, --- | e.g. `Foreign.Object.Object` or similar mutable raw JS types. --- | --- | Since "reading" an object reference is no different from obtaining writable access to that --- | object, it is possible to leak a mutable reference to the data contained in the cell from a read lock. --- | --- | To avoid this, ensure that state updates via `asyncPut`, `asyncModify`, and `asyncWrite` --- | perform complete replacements with deep cloned state values and do not evaluate mutable --- | effects against the state contained in the cell. --- | --- | ### Types --- | - `w :: Type -> Type` e.g. `RwLock` --- | - a concurrency-safe mutable wrapper (`AsyncState`) --- | - `wl :: Type -> Type` e.g. `WriteGuard` --- | - lock structure for writable access to the data in `w` --- | - `rl :: Type -> Type` e.g. `ReadGuard` --- | - lock structure for readable access to the data in `w` --- | - `s :: Type` --- | - type of state contained in `w` --- | - `m :: Type -> Type` e.g. `Aff` --- | - any `MonadAff` --- | - `t` e.g. `AsyncStateT` --- | - The monad transformer that implements this typeclass --- | --- | ### Operations --- | _**Note**: all asyncX functions will block if necessary until their lock is obtained. Non-blocking versions are available as `asyncTryX`._ --- | - `asyncRead` - Reads the state value. Note that for `Mutex` concurrent `asyncRead`s will be executed serially, for `RwLock` concurrent `asyncRead`s will be executed in parallel --- | - `asyncWrite` - Compute a new state & an arbitrary value based on the current state, commit the new state, and return the value --- | - `asyncModify` - Compute a new state based on the current state & commit the new state --- | - `asyncPut` - Discard the current state & replace with a new state value --- | - `ask` (from `MonadReader`) - Get direct access to the raw Mutex / RwLock / etc. -class MonadAsyncState :: (Type -> Type) -> (Type -> Type) -> (Type -> Type) -> Type -> (Type -> Type) -> ((Type -> Type) -> Type -> Type) -> Constraint -class (MonadTrans t, MonadAff (t m), MonadAff m, AsyncState w wwl wrl, MonadAsk (w s) (t m)) <= MonadAsyncState w wwl wrl s m t | w -> wwl, w -> wrl, m -> w, m -> s, t -> m +-- | Concurrency-safe monads with shared mutable state of type `s` +class MonadAsyncState :: (Type -> Type) -> Type -> (Type -> Type) -> ((Type -> Type) -> Type -> Type) -> Constraint +class (Monad m, MonadTrans t, MonadAsk (w s) (t m)) <= MonadAsyncState w s m t | m -> w, m -> s, t -> m --- | Block until exclusive write access may be obtained, --- | execute a computation that returns the new state (and an arbitrary value of any type), --- | then write the new state and release the lock. -asyncWrite :: forall w wl rl s m t a e. MonadError e (t m) => MonadAsyncState w wl rl s m t => (s -> m (a /\ s)) -> t m a +-- | Write a new state +-- | +-- | Blocks until write lock is acquired, +-- | then commits the provided state value (discarding the previous state). +asyncPut :: forall w wl rl s m t e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => s -> t m Unit +asyncPut = asyncWrite <<< const <<< pure <<< (unit /\ _) + +-- | Write a new state +-- | +-- | If write lock may be immediately acquired, +-- | commits the provided state value (discarding the previous state) and returns `Just`. +-- | +-- | Otherwise, returns `Nothing`. +asyncTryPut :: forall w wl rl s m t e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => s -> t m (Maybe Unit) +asyncTryPut = asyncTryWrite <<< const <<< pure <<< (unit /\ _) + +-- | Write a new state +-- | +-- | Blocks until exclusive write access may be obtained, then invokes the provided +-- | state update function with the current state value. +-- | +-- | If the state update function succeeds, the new state value will be committed and the extra +-- | tuple value `a` will be returned. +-- | +-- | If the state update function throws, the error will be rethrown after releasing the write lock. +-- | +-- | ### Returning state values +-- | Note that if you return the state value from the state update function, it is +-- | strongly recommended that you ensure all state updates perform structurally immutable +-- | updates rather than in-place mutation so that the object reference is not affected by +-- | valid state updates performed by other concurrent computations. +asyncWrite :: forall w wl rl s m t a e. MonadAff (t m) => AsyncState w wl rl => MonadError e (t m) => MonadAsyncState w s m t => (s -> m (a /\ s)) -> t m a asyncWrite f = do state <- ask lock :: wl s <- State.lock state @@ -89,11 +70,13 @@ asyncWrite f = do State.unlock state lock fst <$> liftEither e --- | Non-blocking version of `asyncWrite` +-- | Write a new state -- | --- | If obtaining write access would block, instead --- | returns `Nothing` and does not evaluate the closure. -asyncTryWrite :: forall w wl rl s m t a e. MonadError e (t m) => MonadAsyncState w wl rl s m t => (s -> m (a /\ s)) -> t m (Maybe a) +-- | Immediately acquires a write lock if possible, then behaves like `asyncWrite` +-- | and returns `Just`. +-- | +-- | If a lock was not available immediately, does not block and returns `Nothing` +asyncTryWrite :: forall w wl rl s m t a e. MonadError e (t m) => MonadAff (t m) => AsyncState w wl rl => MonadAsyncState w s m t => (s -> m (a /\ s)) -> t m (Maybe a) asyncTryWrite f = do state <- ask lockM :: Maybe (wl s) <- State.tryLock state @@ -104,22 +87,61 @@ asyncTryWrite f = do State.unlock state lock fst <$> liftEither e --- | Obtain exclusive access to writing the state, execute a computation that returns the new state, --- | then write the new state and release the lock. -asyncModify :: forall w wl rl s m t e. MonadError e (t m) => MonadAsyncState w wl rl s m t => (s -> m s) -> t m Unit +-- | Write a new state +-- | +-- | Blocks until exclusive write access may be obtained, then invokes the provided +-- | state update function with the current state value. +-- | +-- | If the state update function succeeds, the new state value will be committed. +-- | +-- | If the state update function throws, the error will be rethrown after releasing the write lock. +asyncModify :: forall w wl rl s m t e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => (s -> m s) -> t m Unit asyncModify f = asyncWrite (map (unit /\ _) <<< f) --- | Non-blocking version of `asyncModify` +-- | Write a new state -- | --- | If obtaining write access would block, instead --- | returns `Nothing` and does not evaluate the closure. -asyncTryModify :: forall w wl rl s m t e. MonadError e (t m) => MonadAsyncState w wl rl s m t => (s -> m s) -> t m (Maybe Unit) +-- | Immediately acquires a write lock if possible, then behaves like `asyncModify` +-- | and returns `Just`. +-- | +-- | If a lock was not available immediately, does not block and returns `Nothing` +asyncTryModify :: forall w wl rl s m t e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => (s -> m s) -> t m (Maybe Unit) asyncTryModify f = asyncTryWrite (map (unit /\ _) <<< f) --- | Obtains a read lock (for `Mutex` this is exclusive; for `RwLock` many reads may be executed in parallel) --- | and execute a computation that has read lock access to the state value. After the computation finishes, --- | the read lock will be released. -asyncRead :: forall w wl rl s m t a e. MonadError e (t m) => MonadAsyncState w wl rl s m t => (s -> m a) -> t m a +-- | Get the current state +-- | +-- | Blocks until a read lock may be acquired, then returns the current state. +-- | +-- | ### Returning state values +-- | Note that if you return the state value from the state update function, it is +-- | strongly recommended that you ensure all state updates perform structurally immutable +-- | updates rather than in-place mutation so that the object reference is not affected by +-- | valid state updates performed by other concurrent computations. +asyncGet :: forall w wl rl s m t e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => t m s +asyncGet = asyncRead pure + +-- | If a read lock may be acquired immediately, acquires it and returns the current +-- | state in `Just`. +-- | +-- | Otherwise returns `Nothing`. +-- | +-- | ### Returning state values +-- | Note that if you return the state value from the state update function, it is +-- | strongly recommended that you ensure all state updates perform structurally immutable +-- | updates rather than in-place mutation so that the object reference is not affected by +-- | valid state updates performed by other concurrent computations. +asyncTryGet :: forall w wl rl s m t e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => t m (Maybe s) +asyncTryGet = asyncTryRead pure + +-- | Get the current state +-- | +-- | Blocks until a read lock may be acquired, then applies a mapping function to the current state. +-- | +-- | ### Returning state values +-- | Note that if you return the state value from the state update function, it is +-- | strongly recommended that you ensure all state updates perform structurally immutable +-- | updates rather than in-place mutation so that the object reference is not affected by +-- | valid state updates performed by other concurrent computations. +asyncRead :: forall w wl rl s m t a e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => (s -> m a) -> t m a asyncRead f = do state <- ask lock :: rl s <- State.lock state @@ -128,11 +150,19 @@ asyncRead f = do State.unlock state lock liftEither e --- | Non-blocking version of `asyncRead` +-- | Get the current state -- | --- | If obtaining read access would block, instead --- | returns `Nothing` and does not evaluate the closure. -asyncTryRead :: forall w wl rl s m t a e. MonadError e (t m) => MonadAsyncState w wl rl s m t => (s -> m a) -> t m (Maybe a) +-- | If a read lock may be immediately acquired, acquires the lock then applies +-- | a mapping function to the current state, returning `Just`. +-- | +-- | Otherwise returns `Nothing`. +-- | +-- | ### Returning state values +-- | Note that if you return the state value from the state update function, it is +-- | strongly recommended that you ensure all state updates perform structurally immutable +-- | updates rather than in-place mutation so that the object reference is not affected by +-- | valid state updates performed by other concurrent computations. +asyncTryRead :: forall w wl rl s m t a e. AsyncState w wl rl => MonadAff (t m) => MonadError e (t m) => MonadAsyncState w s m t => (s -> m a) -> t m (Maybe a) asyncTryRead f = do state <- ask lockM :: Maybe (rl s) <- State.tryLock state @@ -142,18 +172,6 @@ asyncTryRead f = do State.unlock state lock liftEither e --- | Discard the existing state and replace it with a new value. --- | --- | Blocks if necessary until write access is obtained. -asyncPut :: forall w wl rl s m t e. MonadError e (t m) => MonadAsyncState w wl rl s m t => s -> t m Unit -asyncPut = asyncWrite <<< const <<< pure <<< (unit /\ _) - --- | Non-blocking version of `asyncPut`, returning `Just unit` if --- | write access can be obtained without blocking. --- | Otherwise, returns `Nothing`. -asyncTryPut :: forall w wl rl s m t e. MonadError e (t m) => MonadAsyncState w wl rl s m t => s -> t m (Maybe Unit) -asyncTryPut = asyncTryWrite <<< const <<< pure <<< (unit /\ _) - -- | Implementation of `MonadAsyncState` newtype AsyncStateT :: (Type -> Type) -> Type -> (Type -> Type) -> Type -> Type newtype AsyncStateT w s m ma = AsyncStateT (ReaderT (w s) m ma) @@ -189,7 +207,7 @@ instance (MonadBracket e f m) => MonadBracket e f (AsyncStateT w s m) where uninterruptible a = wrap $ uninterruptible $ unwrap a never = wrap never -instance (AsyncState w wl rl, MonadAff m) => MonadAsyncState w wl rl s m (AsyncStateT w s) +instance (AsyncState w wl rl, MonadAff m) => MonadAsyncState w s m (AsyncStateT w s) -- | `AsyncStateT` pinned to use `RwLock` type RwLockStateT s m = AsyncStateT RwLock s m