I am currently playing with the Bryan O'Sullivan's resource-pool library and have a question regarding extending the withResource function.
I want to change the signature of the withResource function from (MonadBaseControl IO m) => Pool a -> (a -> m b) -> m b to (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b.
What I want to achieve is, that the action should return (Bool, b) tuple, where the boolean value indicates if the borrowed resource should
be put back into the pool or destroyed.
Now my current implementation looks like this:
withResource :: forall m a b. (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b
{-# SPECIALIZE withResource :: Pool a -> (a -> IO (Bool,b)) -> IO b #-}
withResource pool act = fmap snd result
where
result :: m (Bool, b)
result = control $ \runInIO -> mask $ \restore -> do
resource <- takeResource pool
ret <- restore (runInIO (act resource)) `onException`
destroyResource pool resource
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
if keep
then liftBaseWith . const $ putResource pool resource
else liftBaseWith . const $ destroyResource pool resource
return ret
And I have a feeling, that this is not how it is supposed to look like...
Maybe I am not using the MonadBaseControl API right.
What do you guys think of this and how can I improve it to be more idiomatic?
I have a feeling that there is a fundamental problem with this approach. For monads for which StM M a is equal/isomorphic to a it will work. But for other monads there will be a problem. Let's consider MaybeT IO. An action of type a -> MaybeT IO (Bool, b) can fail, so there will be no Bool value produced. And the code in
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
...
won't be executed, the control flow will stop at restoreM. And for ListT IO it'll be even worse, as putResource and destroyResource will be executed multiple times. Consider this sample program, which is a simplified version of your function:
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, RankNTypes, TupleSections #-}
import Control.Monad
import Control.Monad.Trans.Control
import Control.Monad.Trans.List
foo :: forall m b . (MonadBaseControl IO m) => m (Bool, b) -> m b
foo act = fmap snd result
where
result :: m (Bool, b)
result = control $ \runInIO -> do
ret <- runInIO act
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
if keep
then liftBaseWith . const $ putStrLn "return"
else liftBaseWith . const $ putStrLn "destroy"
return ret
main :: IO ()
main = void . runListT $ foo f
where
f = msum $ map (return . (, ())) [ False, True, False, True ]
It'll print
destroy
return
destroy
return
And for an empty list, nothing gets printed, which means no cleanup would be called in your function.
I have to say I'm not sure how to achieve your goal in a better way. I'd try to explore in the direction of signature
withResource :: forall m a b. (MonadBaseControl IO m)
=> Pool a -> (a -> IO () -> m b) -> m b
where the IO () argument would be a function, that when executed, invalidates the current resource and marks it to be destroyed. (Or, for better convenience, replace IO () with lifted m ()). Then internally, as it's IO-based, I'd just create a helper MVar that'd be reset by calling
the function, and at the end, based on the value, either return or destroy the resource.
Related
I am attempting to build a slackbot using this library: https://hackage.haskell.org/package/slack-api, just to learn a little bit more haskell, and hopefully, finally understand monads -_-.
I then have the following types:
data BotState = BotState
{
_appState :: AppState
}
makeLenses ''BotState
type AppState = HM.Map String ChannelState
emptyState :: AppState
emptyState = HM.empty
data ChannelState = ChannelState
{ _counter :: Int}
type Bot = Slack.Slack BotState
and I run my bot with:
initApp = lookupEnv "SLACK_API_TOKEN" >>=
\apiToken -> case apiToken of
Nothing -> throwM ApiTokenMissingException
Just t -> void $ Slack.runBot (Slack.SlackConfig t) runApp $ BotState emptyState
where:
runApp :: Slack.Event -> Bot ()
runApp m#(Slack.Message cid uid body _ _ _) = sendMessage cid "GAH I CAN HAZ CHZBURGHER!"
This runs fine, now I wish to add the ability to update the system state (by incrementing the counter, or in other ways).
so I add a modifyState function to my Bot:
modifyState :: (AppState -> AppState) -> Bot ()
modifyState f = uses Slack.userState $ view appState >>=
\state -> modifying Slack.userState $ set appState $ f state
This breaks with:
No instance for (Control.Monad.State.Class.MonadState
(Slack.SlackState BotState) ((->) BotState))
arising from a use of ‘modifying’
In the expression: modifying Slack.userState
In the expression:
modifying Slack.userState $ set appState $ f state
In the second argument of ‘(>>=)’, namely
‘\ state -> modifying Slack.userState $ set appState $ f state’
Which makes sense given the signature for modifying:
modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()
However, upon looking at the documentation for Slack.userState:
userState :: forall s s. Lens (SlackState s) (SlackState s) s s Source
And then:
data SlackState s
... Constructor ...
Instances
Show s => Show (SlackState s)Source
MonadState (SlackState s) (Slack s)Source
So then why isn't the BotState already an instance of MonadState? How could I fix this?
$ operator has fixity 0, while >>= has fixity 1, so code like this would work:
main :: IO ()
main = do
putStrLn "hello world" >>= \_ -> putStrLn "hi"
But not this one:
main :: IO ()
main = do
putStrLn $ "hello world" >>= \_ -> putStrLn "hi"
It's being interpreted as:
main :: IO ()
main = do
putStrLn ("hello world" >>= \_ -> putStrLn "hi")
To see fixity info, use ghci's :info command:
:info $
($) ::
forall (r :: ghc-prim-0.5.0.0:GHC.Types.RuntimeRep) a (b :: TYPE
r).
(a -> b) -> a -> b
-- Defined in ‘GHC.Base’
infixr 0 $
:info >>=
class Applicative m => Monad (m :: * -> *) where
(>>=) :: m a -> (a -> m b) -> m b
...
-- Defined in ‘GHC.Base’
infixl 1 >>=
Also, if you're not sure, good old parentheses are always here for the rescue :)
I have a function that I want to use a Maybe val with. Usually I would do func <$> val. But now suppose that func uses the IO monad. func <$> val will return a Maybe (IO ()). So instead I had to define a new operator:
(<$$>) :: Monad m => (a -> m b) -> Maybe a -> m ()
(<$$>) func (Just val) = func val >> return ()
(<$$>) func Nothing = return ()
So now I can write func <$$> val, but is there a better way to do it?
mapM_ from Data.Foldable is probably the best match:
Prelude Data.Foldable> :set -XScopedTypeVariables
Prelude Data.Foldable> :t \f (a :: Maybe a) -> Data.Foldable.mapM_ f a
\f (a :: Maybe a) -> Data.Foldable.mapM_ f a
:: Monad m => (a -> m b) -> Maybe a -> m ()
If you'd like a more specialised type there's also maybe:
Prelude> :t \f -> maybe (return ()) (f $)
\f -> maybe (return ()) (f $)
:: Monad m => (a -> m ()) -> Maybe a -> m ()
Your <$$> is traverse_ from Data.Foldable.
Is a one-liner always better? Here's how purity of undefined can be useful:
(<$$>) g x = maybe (return undefined) g x >> return ()
Example:
Prelude> print <$$> (Just 1)
1
Prelude> print <$$> Nothing
Prelude>
If you have a lot of this in your code, it might be worth employing the MaybeT transformer:
(\func val -> liftIO . func =<< MaybeT (return val) )
:: (a -> IO b) -> Maybe b -> MaybeT IO b
That doesn't immediately bring you any further than plain IO (Maybe ()), but it composes nicely.
Context: This question is specifically in reference to Control.Lens (version 3.9.1 at the time of this writing)
I've been using the lens library and it is very nice to be able to read and write to a piece (or pieces for traversals) of a structure. I then had a though about whether a lens could be used against an external database. Of course, I would then need to execute in the IO Monad. So to generalize:
Question:
Given a getter, (s -> m a) and an setter (b -> s -> m t) where m is a Monad, is possible to construct Lens s t a b where the Functor of the lens is now contained to also be a Monad? Would it still be possible to compose these with (.) with other "purely functional" lenses?
Example:
Could I make Lens (MVar a) (MVar b) a b using readMVar and withMVar?
Alternative:
Is there an equivalent to Control.Lens for containers in the IO monad such as MVar or IORef (or STDIN)?
I've been thinking about this idea for some time, which I'd call mutable lenses. So far, I haven't made it into a package, let me know, if you'd benefit from it.
First let's recall the generalized van Laarhoven Lenses (after some imports we'll need later):
{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString as BS
import Data.Functor.Constant
import Data.Functor.Identity
import Data.Traversable (Traversable)
import qualified Data.Traversable as T
import Control.Monad
import Control.Monad.STM
import Control.Concurrent.STM.TVar
type Lens s t a b = forall f . (Functor f) => (a -> f b) -> (s -> f t)
type Lens' s a = Lens s s a a
we can create such a lens from a "getter" and a "setter" as
mkLens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
mkLens g s f x = fmap (s x) (f (g x))
and get a "getter"/"setter" from a lens back as
get :: Lens s t a b -> (s -> a)
get l = getConstant . l Constant
set :: Lens s t a b -> (s -> b -> t)
set l x v = runIdentity $ l (const $ Identity v) x
as an example, the following lens accesses the first element of a pair:
_1 :: Lens' (a, b) a
_1 = mkLens fst (\(x, y) x' -> (x', y))
-- or directly: _1 f (a,c) = (\b -> (b,c)) `fmap` f a
Now how a mutable lens should work? Getting some container's content involves a monadic action. And setting a value doesn't change the container, it remains the same, just as a mutable piece of memory does. So the result of a mutable lens will have to be monadic, and instead of the return type container t we'll have just (). Moreover, the Functor constraint isn't enough, since we need to interleave it with monadic computations. Therefore, we'll need Traversable:
type MutableLensM m s a b
= forall f . (Traversable f) => (a -> f b) -> (s -> m (f ()))
type MutableLensM' m s a
= MutableLensM m s a a
(Traversable is to monadic computations what Functor is to pure computations).
Again, we create helper functions
mkLensM :: (Monad m) => (s -> m a) -> (s -> b -> m ())
-> MutableLensM m s a b
mkLensM g s f x = g x >>= T.mapM (s x) . f
mget :: (Monad m) => MutableLensM m s a b -> s -> m a
mget l s = liftM getConstant $ l Constant s
mset :: (Monad m) => MutableLensM m s a b -> s -> b -> m ()
mset l s v = liftM runIdentity $ l (const $ Identity v) s
As an example, let's create a mutable lens from a TVar within STM:
alterTVar :: MutableLensM' STM (TVar a) a
alterTVar = mkLensM readTVar writeTVar
These lenses are one-sidedly directly composable with Lens, for example
alterTVar . _1 :: MutableLensM' STM (TVar (a, b)) a
Notes:
Mutable lenses could be made more powerful if we allow that the modifying function to include effects:
type MutableLensM2 m s a b
= (Traversable f) => (a -> m (f b)) -> (s -> m (f ()))
type MutableLensM2' m s a
= MutableLensM2 m s a a
mkLensM2 :: (Monad m) => (s -> m a) -> (s -> b -> m ())
-> MutableLensM2 m s a b
mkLensM2 g s f x = g x >>= f >>= T.mapM (s x)
However, it has two major drawbacks:
It isn't composable with pure Lens.
Since the inner action is arbitrary, it allows you to shoot yourself in the foot by mutating this (or other) lens during the mutating operation itself.
There are other possibilities for monadic lenses. For example, we can create a monadic copy-on-write lens that preserves the original container (just as Lens does), but where the operation involves some monadic action:
type LensCOW m s t a b
= forall f . (Traversable f) => (a -> f b) -> (s -> m (f t))
I've made jLens - a Java library for mutable lenses, but the API is of course far from being as nice as Haskell lenses.
No, you can not constrain the "Functor of the lens" to also be a Monad. The type for a Lens requires that it be compatible with all Functors:
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
This reads in English something like: A Lens is a function, which, for all types f where f is a Functor, takes an (a -> f b) and returns an s -> f t. The key part of that is that it must provide such a function for every Functor f, not just some subset of them that happen to be Monads.
Edit:
You could make a Lens (MVar a) (MVar b) a b, since none of s t a, or b are constrained. What would the types on the getter and setter needed to construct it be then? The type of the getter would be (MVar a -> a), which I believe could only be implemented as \_ -> undefined, since there's nothing that extracts the value from an MVar except as IO a. The setter would be (MVar a -> b -> MVar b), which we also can't define since there's nothing that makes an MVar except as IO (MVar b).
This suggests that instead we could instead make the type Lens (MVar a) (IO (MVar b)) (IO a) b. This would be an interesting avenue to pursue further with some actual code and a compiler, which I don't have right now. To combine that with other "purely functional" lenses, we'd probably want some sort of lift to lift the lens into a monad, something like liftLM :: (Monad m) => Lens s t a b -> Lens s (m t) (m a) b.
Code that compiles (2nd edit):
In order to be able to use the Lens s t a b as a Getter s a we must have s ~ t and a ~ b. This limits our type of useful lenses lifted over some Monad to the widest type for s and t and the widest type for a and b. If we substitute b ~ a into out possible type we would have Lens (MVar a) (IO (MVar a)) (IO a) a, but we still need MVar a ~ IO (MVar a) and IO a ~ a. We take the wides of each of these types, and choose Lens (IO (MVar a)) (IO (MVar a)) (IO a) (IO a), which Control.Lens.Lens lets us write as Lens' (IO (MVar a)) (IO a). Following this line of reasoning, we can make a complete system for combining "purely functional" lenses with lenses on monadic values. The operation to lift a "purely function" lens, liftLensM, then has the type (Monad m) => Lens' s a -> LensF' m s a, where LensF' f s a ~ Lens' (f s) (f a).
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Main (
main
) where
import Control.Lens
import Control.Concurrent.MVar
main = do
-- Using MVar
putStrLn "Ordinary MVar"
var <- newMVar 1
output var
swapMVar var 2
output var
-- Using mvarLens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO"
value <- (return var) ^. mvarLens
putStrLn $ show value
set mvarLens (return 3) (return var)
output var
-- Debugging lens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO that also debugs"
value <- readM (debug mvarLens) var
putStrLn $ show value
setM (debug mvarLens) 4 var
output var
-- Debugging crazy box lens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs"
value <- readM ((debug mvarLens) . (debug (liftLensM boxLens))) var
putStrLn $ show value
setM ((debug mvarLens) . (debug (liftLensM boxLens))) (Box 5) var
output var
where
output = \v -> (readMVar v) >>= (putStrLn . show)
-- Types to write higher lenses easily
type LensF f s t a b = Lens (f s) (f t) (f a) (f b)
type LensF' f s a = Lens' (f s) (f a)
type GetterF f s a = Getter (f s) (f a)
type SetterF f s t a b = Setter (f s) (f t) (f a) (f b)
-- Lenses for MVars
setMVar :: IO (MVar a) -> IO a -> IO (MVar a)
setMVar ioVar ioValue = do
var <- ioVar
value <- ioValue
swapMVar var value
return var
getMVar :: IO (MVar a) -> IO a
getMVar ioVar = do
var <- ioVar
readMVar var
-- (flip (>>=)) readMVar
mvarLens :: LensF' IO (MVar a) a
mvarLens = lens getMVar setMVar
-- Lift a Lens' to a Lens' on monadic values
liftLensM :: (Monad m) => Lens' s a -> LensF' m s a
liftLensM pureLens = lens getM setM
where
getM mS = do
s <- mS
return (s^.pureLens)
setM mS mValue = do
s <- mS
value <- mValue
return (set pureLens value s)
-- Output when a Lens' is used in IO
debug :: (Show a) => LensF' IO s a -> LensF' IO s a
debug l = lens debugGet debugSet
where
debugGet ioS = do
value <- ioS^.l
putStrLn $ show $ "Getting " ++ (show value)
return value
debugSet ioS ioValue = do
value <- ioValue
putStrLn $ show $ "Setting " ++ (show value)
set l (return value) ioS
-- Easier way to use lenses in a monad (if you don't like writing return for each argument)
readM :: (Monad m) => GetterF m s a -> s -> m a
readM l s = (return s) ^. l
setM :: (Monad m) => SetterF m s t a b -> b -> s -> m t
setM l b s = set l (return b) (return s)
-- Another example lens
newtype Boxed a = Box {
unBox :: a
} deriving Show
boxLens :: Lens' a (Boxed a)
boxLens = lens Box (\_ -> unBox)
This code produces the following output:
Ordinary MVar
1
2
MVar accessed through a LensF' IO
2
3
MVar accessed through a LensF' IO that also debugs
"Getting 3"
3
"Setting 4"
4
MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs
"Getting 4"
"Getting Box {unBox = 4}"
Box {unBox = 4}
"Setting Box {unBox = 5}"
"Getting 4"
"Setting 5"
5
There's probably a better way to write liftLensM without resorting to using lens, (^.), set and do notation. Something seems wrong about building lenses by extracting the getter and setter and calling lens on a new getter and setter.
I wasn't able to figure out how to reuse a lens as both a getter and a setter. readM (debug mvarLens) and setM (debug mvarLens) both work just fine, but any construct like 'let debugMVarLens = debug mvarLens' loses either the fact it works as a Getter, the fact it works as a Setter, or the knowledge that Int is an instance of show so it can me used for debug. I'd love to see a better way of writing this part.
I had the same problem. I tried the methods in Petr and Cirdec's answers but never got to the point I wanted to. Started working on the problem, and at the end, I published the references library on hackage with a generalization of lenses.
I followed the idea of the yall library to parameterize the references with monad types. As a result there is an mvar reference in Control.Reference.Predefined. It is an IO reference, so an access to the referenced value is done in an IO action.
There are also other applications of this library, it is not restricted to IO. An additional feature is to add references (so adding _1 and _2 tuple accessors will give a both traversal, that accesses both fields). It can also be used to release resources after accessing them, so it can be used to manipulate files safely.
The usage is like this:
test =
do result <- newEmptyMVar
terminator <- newEmptyMVar
forkIO $ (result ^? mvar) >>= print >> (mvar .= ()) terminator >> return ()
hello <- newMVar (Just "World")
forkIO $ ((mvar & just & _tail & _tail) %~= ('_':) $ hello) >> return ()
forkIO $ ((mvar & just & element 1) .= 'u' $ hello) >> return ()
forkIO $ ((mvar & just) %~= ("Hello" ++) $ hello) >> return ()
x <- runMaybeT $ hello ^? (mvar & just)
mvar .= x $ result
terminator ^? mvar
The operator & combines lenses, ^? is generalized to handle references of any monad, not just a referenced value that may not exist. The %~= operator is an update of a monadic reference with a pure function.
Why does this function have the type:
deleteAllMp4sExcluding :: [Char] -> IO (IO ())
instead of deleteAllMp4sExcluding :: [Char] -> IO ()
Also, how could I rewrite this so that it would have a simpler definition?
Here is the function definition:
import System.FilePath.Glob
import qualified Data.String.Utils as S
deleteAllMp4sExcluding videoFileName =
let dirGlob = globDir [compile "*"] "."
f = filter (\s -> S.endswith ".mp4" s && (/=) videoFileName s) . head . fst
lst = f <$> dirGlob
in mapM_ removeFile <$> lst
<$> when applied to IOs has type (a -> b) -> IO a -> IO b. So since mapM_ removeFile has type [FilePath] -> IO (), b in this case is IO (), so the result type becomes IO (IO ()).
To avoid nesting like this, you should not use <$> when the function you're trying to apply produces an IO value. Rather you should use >>= or, if you don't want to change the order of the operands, =<<.
Riffing on sepp2k's answer, this is an excellent example to show the difference between Functor and Monad.
The standard Haskell definition of Monad goes something like this (simplified):
class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
However, this is not the only way the class could have been defined. An alternative runs like this:
class Functor m => Monad m where
return :: a -> m a
join :: m (m a) -> m a
Given that, you can define >>= in terms of fmap and join:
(>>=) :: Monad m => m a -> (a -> m b) -> m b
ma >>= f = join (f <$> ma)
We'll look at this in a simplified sketch of the problem you're running into. What you're doing can be schematized like this:
ma :: IO a
f :: a -> IO b
f <$> ma :: IO (IO b)
Now you're stuck because you need an IO b, and the Functor class has no operation that will get you there from IO (IO b). The only way to get where you want is to dip into Monad, and the join operation is precisely what solves it:
join (f <$> ma) :: IO b
But by the join/<$> definition of >>=, this is the same as:
ma >>= f :: IO a
Note that the Control.Monad library comes with a version of join (written in terms of return and (>>=)); you could put that in your function to get the result you want. But the better thing to do is to recognize that what you're trying to do is fundamentally monadic, and thus that <$> is not the right tool for the job. You're feeding the result of one action to another; that intrinsically requires you to use Monad.
IORefs, MVars, and TVars can be used to wrap a shared variable in a concurrent context. I've studied concurrent haskell for a while and now I've encounted some questions. After searching on stackoverflow and read through some related question, my questions are not fully resolved.
According to the IORef documentation,"Extending the atomicity to multiple IORefs is problematic", can someone help to explain why a single IORef is safe but more than one IORefs are problematic?
modifyMVar is "exception-safe, but only atomic if there are no other producers for this MVar". See MVar's documentation. The source code show that modifyMVar does only compose a getMVar and putMVar sequencially, indicating that it's note thread-safe if there is another producer. But if there is no producer and all threads behave in the "takeMVar then putMVar" way, then is it thread-safe to simply use modifyMVar ?
To give a concrete situation, I'll show the actual problem. I've some shared variables which are never empty and I want them be mutable states so some threads can simultaneously modify these variables.
OK, it seems tha TVar solve everything clearly. But I'm not satisfied with it and I'm eager for answers to the questions above. Any help are appreciated.
-------------- re: #GabrielGonzalez BFS interface code ------------------
Code below is my BFS interface using state monad.
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
module Data.Graph.Par.Class where
import Data.Ix
import Data.Monoid
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans.State
class (Ix (Vertex g), Ord (Edge g), Ord (Path g)) => ParGraph g where
type Vertex g :: *
type Edge g :: *
-- type Path g :: * -- useless
type VertexProperty g :: *
type EdgeProperty g :: *
edges :: g a -> IO [Edge g]
vertexes :: g a -> IO [Vertex g]
adjacencies :: g a -> Vertex g -> IO [Vertex g]
vertexProperty :: Vertex g -> g a -> IO (VertexProperty g)
edgeProperty :: Edge g -> g a -> IO (EdgeProperty g)
atomicModifyVertexProperty :: (VertexProperty g -> IO (VertexProperty g)) ->
Vertex g -> g a -> IO (g a) -- fixed
spanForest :: ParGraph g => [Vertex g] -> StateT (g a) IO ()
spanForest roots = parallelise (map spanTree roots) -- parallel version
spanForestSeq :: ParGraph g => [Vertex g] -> StateT (g a) IO ()
spanForestSeq roots = forM_ roots spanTree -- sequencial version
spanTree :: ParGraph g => Vertex g -> StateT (g a) IO ()
spanTree root = spanTreeOneStep root >>= \res -> case res of
[] -> return ()
adjs -> spanForestSeq adjs
spanTreeOneStep :: ParGraph g => Vertex g -> StateT (g a) IO [Vertex g]
spanTreeOneStep v = StateT $ \g -> adjacencies g v >>= \adjs -> return (adjs, g)
parallelise :: (ParGraph g, Monoid b) => [StateT (g a) IO b] -> StateT (g a) IO b
parallelise [] = return mempty
parallelise ss = syncGraphOp $ map forkGraphOp ss
forkGraphOp :: (ParGraph g, Monoid b) => StateT (g a) IO b -> StateT (g a) IO (MVar b)
forkGraphOp t = do
s <- get
mv <- mapStateT (forkHelper s) t
return mv
where
forkHelper s x = do
mv <- newEmptyMVar
forkIO $ x >>= \(b, s) -> putMVar mv b
return (mv, s)
syncGraphOp :: (ParGraph g, Monoid b) => [StateT (g a) IO (MVar b)] -> StateT (g a) IO b
syncGraphOp [] = return mempty
syncGraphOp ss = collectMVars ss >>= waitResults
where
collectMVars [] = return []
collectMVars (x:xs) = do
mvx <- x
mvxs <- collectMVars xs
return (mvx:mvxs)
waitResults mvs = StateT $ \g -> forM mvs takeMVar >>= \res -> return ((mconcat res), g)
Modern processors offer a compare-and-swap instruction that atomically modifies a single pointer. I expect if you track down deep enough, you will find that this instruction is the one used to implement atomicModifyIORef. It is therefore easy to provide atomic access to a single pointer. However, because there isn't such hardware support for more than one pointer, whatever you need will have to be done in software. This typically involves inventing and manually enforcing a protocol in all your threads -- which is complicated and error-prone.
Yes, if all threads agree to only use the "single takeMVar followed by a single putMVar" behavior, then modifyMVar is safe.