mirror of
https://github.com/srid/ema.git
synced 2024-11-25 20:12:20 +03:00
Fix LVar.set to work with empty TMVars
This commit is contained in:
parent
613194d359
commit
542b753167
@ -55,7 +55,13 @@ get v =
|
||||
|
||||
-- | Set the @LVar@ value; listeners from @listen@ are automatically notifed.
|
||||
set :: MonadIO m => LVar a -> a -> m ()
|
||||
set v = modify v . const
|
||||
set v val = do
|
||||
atomically $ do
|
||||
let var = lvarCurrent v
|
||||
isEmptyTMVar var >>= \case
|
||||
True -> putTMVar var val
|
||||
False -> void $ swapTMVar var val
|
||||
notifyListeners v
|
||||
|
||||
-- | Modify the @LVar@ value; listeners from @listen@ are automatically
|
||||
-- notified.
|
||||
@ -67,12 +73,12 @@ modify v f = do
|
||||
curr <- readTMVar (lvarCurrent v)
|
||||
void $ swapTMVar (lvarCurrent v) (f curr)
|
||||
notifyListeners v
|
||||
where
|
||||
notifyListeners :: LVar a -> STM ()
|
||||
notifyListeners v' = do
|
||||
subs <- readTMVar $ lvarListeners v'
|
||||
forM_ (Map.elems subs) $ \subVar -> do
|
||||
tryPutTMVar subVar ()
|
||||
|
||||
notifyListeners :: LVar a -> STM ()
|
||||
notifyListeners v' = do
|
||||
subs <- readTMVar $ lvarListeners v'
|
||||
forM_ (Map.elems subs) $ \subVar -> do
|
||||
tryPutTMVar subVar ()
|
||||
|
||||
-- | Listen to changes to the @LVar@, as they are set by @set@ or @modify@
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user