<div dir="auto">What about creating a MonadState instance for the TVar?<div dir="auto"><br></div><div dir="auto">newtype SharedStateT m a = SharedStateT (ReaderT (TVar s) m a)</div><div dir="auto"><br></div><div dir="auto">instance MonadIO m => MonadState s (SharedStateT s m) where</div><div dir="auto">  get = SharedStateT $ liftIO . readTVarIO =<< ask</div><div dir="auto">  put s = SharedStateT $ do</div><div dir="auto">    tvar <- ask</div><div dir="auto">    liftIO . atomically $ writeTVar tvar s</div><div dir="auto">  state f = SharedStateT $ do</div><div dir="auto">    tvar <- ask</div><div dir="auto">    liftIO . atomically $ stateTVar tvar f</div><br><br><div class="gmail_quote" dir="auto"><div dir="ltr" class="gmail_attr">On Thu, 2 Sep 2021, 12:50 am Olaf Klinke, <<a href="mailto:olf@aatal-apotheke.de">olf@aatal-apotheke.de</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Dear Café, <br>
<br>
I have a sequence of state-modifying computations<br>
<br>
action :: MonadUnliftIO m => StateT s m ()<br>
<br>
where the state s should be visible to other threads. Thus I created a<br>
TVar in which I keep track of this state s for other threads to read.<br>
<br>
The type system tells me it can't be done, which suggests I am using<br>
the wrong abstraction. The following type-checks but may be unsafe. <br>
<br>
import Control.Concurrent.STM<br>
import Control.Monad.IO.Unlift<br>
updateStateTVar :: MonadUnliftIO m => TVar s -> StateT s m () -> m ()<br>
updateStateTVar var action = withRunInIO (\inIO -> do<br>
    s0 <- atomically (readTVar var)<br>
    s1 <- inIO (execStateT action s0)<br>
    atomically (writeTVar var s1))<br>
<br>
Yet the splitting into readTVar and writeTVar is dangerous if several<br>
threads have read/write access to the same TVar. I was hoping to write<br>
the above using modifyTVar. However, the action essentially gives me a<br>
Kleisli map<br>
s -> m s<br>
which I somehow have to turn into an <br>
m (s -> s)<br>
but it is not possible in general. (The reverse works for any functor.)<br>
<br>
What should I do? <br>
* Switch to WriterT (Endo s) m?<br>
  This is not as powerful as StateT s m.<br>
* Do everything in the STM monad? But this disallows arbitrary IO<br>
because it would facilitate nested STM transactions. <br>
<br>
The code above is safe, I believe, if only one thread has read/write<br>
access and the others are read-only. Are there type-level abstractions<br>
of this kind? (I suppose one could easily make them with some<br>
newtypes.) <br>
<br>
Thanks in advance for any thoughts on this.<br>
Olaf<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div></div>