From f58fa86d930e47449c390e4ace99f2b6eeaaecc8 Mon Sep 17 00:00:00 2001
From: Orion Kindel <orionkindel@gmail.com>
Date: Sat, 11 Nov 2023 14:00:35 -0600
Subject: [PATCH] fix: docs, add runWith

---
 src/Control.Monad.State.Async.purs | 137 ++++++++++++++++++++++++-----
 1 file changed, 116 insertions(+), 21 deletions(-)

diff --git a/src/Control.Monad.State.Async.purs b/src/Control.Monad.State.Async.purs
index fb70cf9..6a73799 100644
--- a/src/Control.Monad.State.Async.purs
+++ b/src/Control.Monad.State.Async.purs
@@ -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