From: Quentin Moser <
quentin.moser@unifr.ch>
Subject: Re: [Haskell-beginners] STM and IO
Your problem has nothing to do with lazyness; Haskell simply kills all
other threads when the main thread returns from main. You have to
somehow wait for them to complete in main or they won't have time to
run.
Doh!
I've been bitten before...
Now onto the second problem: ignore me if I'm wrong, but it seems your
intent is to spawn 10 threads that will each try to run (writeTo store)
once. What your current code does is spawn one thread that sequentially
runs writeTo 10 times.
yes you are right of course
Note: I haven't tried running any of this code, but it seems simple
enough to be confident in.
module Main where
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import System.IO
import Control.Exception (finally)
myFork :: IO () -> IO (MVar ())
myFork a = do
v <- newEmptyMVar
a `finally` (putMVar v ())
return v -- to honor the return type
myWait :: MVar () -> IO ()
myWait = readMVar
main = do
let fname = "store.txt"
fh <- openFile fname ReadWriteMode
store <- atomically $ newTMVar fh
waitMes <- 10 `replicateM` (myFork $ writeTo store)
mapM_ myWait waitMes
writeTo :: TMVar (Handle) -> IO ()
writeTo store = do
fh <- atomically $ takeTMVar store
text <- hGetContents fh
hPutStr fh (text ++ " some text ")
atomically $ putTMVar store fh
Now I get the following error : test3: store.txt: hPutStr: illegal operation (handle is closed)
reading the doc about hGetContents, I found that : "Computation hGetContents hdl returns the list of characters corresponding to the unread portion of the channel or file managed by hdl, which is put into an intermediate state, semi-closed. In this state, hdl is effectively closed"
Intuitively I'd want to write something like : writeTo filename = atomically (do { s <- readFile filename ; writeFile filename (s ++ "blah") })
but the type system prevents me from doing IO within STM
I do not know how to go about sharing access to a file between multiple threads using STM... any pointers ?
Thanks
E.