[Haskell-cafe] Why Haskell?

YueCompl compl.yue at icloud.com
Mon Mar 29 13:19:11 UTC 2021


Thanks for the insights, I was not aware of this approach before. 

But with STM as the base monad, I feel like to have lost the ability to delimit transaction boundaries at will, which is the essential tool STM offers. I can only think of doing that from IO via `atomically`, but that way we are dragged back to write transaction composing code in IO, so will lose effect tracking.

I dunno but is there a way to delimit STM transactions without IO?

> On 2021-03-29, at 19:50, Viktor Dukhovni <ietf-dane at dukhovni.org> wrote:
> 
> STM is not a monad transformer, but it is a fine base monad, just like
> Identity, IO or ST.  Here's a contrived example of (StateT Int STM Int):
> 
>    import Control.Concurrent.STM
>    import Control.Monad (when)
>    import Control.Monad.Trans.State.Strict
>    import Control.Monad.Trans.Class (lift)
> 
>    --
>    main :: IO ()
>    main = do
>       tv <- newTVarIO 0
>       y <- atomically $ flip evalStateT 0 $ do
>           x <- get
>           lift $ do
>               modifyTVar tv (\a -> a + x + 1)
>               y <- readTVar tv
>               when (y > 10) retry
>               return y
>       print y
> 
> So any or all of RWST work with STM, but you typically want to keep your
> STM transactions small and simple, so this is not a place where one
> would generally run wild with fancy stacks that do non-trivial
> additional computation.
> 
> Indeed Monad Transformers are not Monads, they're always stacked on top
> of some base monad.  The turtles don't go all the way down.
> 
> A practical example of STM-like Monad's can be found in Hasql, where
> database operations run in a Monad that ensures that they have no
> side-effects that would prevent the transaction from being retried on
> deadlock detection.  This is also a base Monad, where if you like
> you can stack more (pure) transformers.
> 
> Which reminds me that ExceptT can be useful in such Monads, which
> avoid throwing impure exceptions.  And is used in Hasql, where
> the operations tend to be more expensive than in STM, and any
> overhead from layering ExceptT or similar is quite small.
> 
> -- 
>    Viktor.
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.



More information about the Haskell-Cafe mailing list