fix: docs, add runWith
This commit is contained in:
parent
3b567f9cf6
commit
f58fa86d93
@ -12,8 +12,8 @@ import Control.Monad.Trans.Class (class MonadTrans, lift)
|
||||
import Control.Parallel (class Parallel, parallel, sequential)
|
||||
import Data.Async.Class (class AsyncState)
|
||||
import Data.Async.Class as State
|
||||
import Data.Async.Mutex (Mutex(..))
|
||||
import Data.Async.RwLock (RwLock(..))
|
||||
import Data.Async.Mutex (Mutex)
|
||||
import Data.Async.RwLock (RwLock)
|
||||
import Data.Maybe (Maybe)
|
||||
import Data.Newtype (class Newtype, unwrap, wrap)
|
||||
import Data.Traversable (for, for_)
|
||||
@ -22,25 +22,60 @@ import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Effect.Aff.Class (class MonadAff)
|
||||
import Effect.Class (class MonadEffect)
|
||||
|
||||
-- | A monadic context with some mutable state `s`
|
||||
-- | that is in a concurrency-safe `AsyncState` wrapper `w`
|
||||
-- | Computations with a mutable value of type `s` that may be evaluated in parallel
|
||||
-- |
|
||||
-- | Supports the following operations:
|
||||
-- | - `asyncTryRead` - Read the state as it is now, returning `Nothing` if the resource is currently locked
|
||||
-- | - `asyncRead` - Read the state, blocking if the resource is locked
|
||||
-- | - `asyncWrite` - Map the state's value, blocking if the resource is locked
|
||||
-- | - `ask` - Direct access to the low-level `AsyncState`
|
||||
-- | 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
|
||||
|
||||
asyncTryRead :: forall w wl rl s m t. MonadAsyncState w wl rl s m t => t m (Maybe s)
|
||||
asyncTryRead = do
|
||||
state <- ask
|
||||
readLock :: Maybe (rl s) <- State.tryLock state
|
||||
snap <- for readLock (State.read state)
|
||||
for_ readLock (State.unlock state)
|
||||
pure snap
|
||||
|
||||
-- | 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
|
||||
asyncWrite f = do
|
||||
state <- ask
|
||||
@ -51,9 +86,36 @@ asyncWrite f = do
|
||||
State.unlock state lock
|
||||
fst <$> liftEither e
|
||||
|
||||
-- | Non-blocking version of `asyncWrite`
|
||||
-- |
|
||||
-- | 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)
|
||||
asyncTryWrite f = do
|
||||
state <- ask
|
||||
lockM :: Maybe (wl s) <- State.tryLock state
|
||||
for lockM \lock -> do
|
||||
s <- State.read state lock
|
||||
e <- try $ lift $ f s
|
||||
for_ e (State.write state lock <<< snd)
|
||||
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
|
||||
asyncModify f = asyncWrite (map (unit /\ _) <<< f)
|
||||
|
||||
-- | Non-blocking version of `asyncModify`
|
||||
-- |
|
||||
-- | 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)
|
||||
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
|
||||
asyncRead f = do
|
||||
state <- ask
|
||||
@ -63,10 +125,33 @@ asyncRead f = do
|
||||
State.unlock state lock
|
||||
liftEither e
|
||||
|
||||
-- | Non-blocking version of `asyncRead`
|
||||
-- |
|
||||
-- | 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)
|
||||
asyncTryRead f = do
|
||||
state <- ask
|
||||
lockM :: Maybe (rl s) <- State.tryLock state
|
||||
for lockM \lock -> do
|
||||
s <- State.read state lock
|
||||
e <- try $ lift $ f s
|
||||
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 /\ _)
|
||||
|
||||
-- | Implementor of `MonadAsyncState` usable with any `AsyncState` structure.
|
||||
-- | 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)
|
||||
|
||||
@ -101,14 +186,24 @@ instance (MonadBracket e f m) => MonadBracket e f (AsyncStateT w s m) where
|
||||
|
||||
instance (AsyncState w wl rl, MonadAff m) => MonadAsyncState w wl rl s m (AsyncStateT w s)
|
||||
|
||||
-- | `AsyncStateT` pinned to use `RwLock`
|
||||
type RwLockStateT s m = AsyncStateT RwLock s m
|
||||
|
||||
-- | `AsyncStateT` pinned to use `Mutex`
|
||||
type MutexStateT s m = AsyncStateT Mutex s m
|
||||
|
||||
-- | Run a computation with shared access to an existing cell
|
||||
runWith :: forall w wl rl s m ma. MonadAff m => AsyncState w wl rl => w s -> AsyncStateT w s m ma -> m ma
|
||||
runWith cell (AsyncStateT (ReaderT f)) = f cell
|
||||
|
||||
-- | Run a computation by creating a new cell from an initial state
|
||||
runAsyncState :: forall w wl rl s m ma. MonadAff m => AsyncState w wl rl => s -> AsyncStateT w s m ma -> m ma
|
||||
runAsyncState s (AsyncStateT (ReaderT f)) = f =<< State.boxed s
|
||||
runAsyncState s m = (flip runWith) m =<< State.boxed s
|
||||
|
||||
-- | `runAsyncState` pinned to `Mutex`
|
||||
runMutexState :: forall s m ma. MonadAff m => s -> MutexStateT s m ma -> m ma
|
||||
runMutexState s (AsyncStateT (ReaderT f)) = f =<< State.boxed s
|
||||
runMutexState = runAsyncState
|
||||
|
||||
-- | `runAsyncState` pinned to `RwLock`
|
||||
runRwLockState :: forall s m ma. MonadAff m => s -> RwLockStateT s m ma -> m ma
|
||||
runRwLockState s (AsyncStateT (ReaderT f)) = f =<< State.boxed s
|
||||
runRwLockState = runAsyncState
|
||||
|
Loading…
Reference in New Issue
Block a user