fix: docs, add runWith

This commit is contained in:
orion 2023-11-11 14:00:35 -06:00
parent 3b567f9cf6
commit f58fa86d93
Signed by: orion
GPG Key ID: 6D4165AE4C928719

View File

@ -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