[Haskell-beginners] STM and IO

[Quentin Moser]

On Thu, 9 Apr 2009 10:33:35 +0100
"emmanuel.delaborde" <emmanuel.delaborde at cimex.com> wrote:

> Hello list
> 
> I am trying to use STM for shared access to a file
> 
> I first used a TVar to to accumulate the text returned by the threads
> and write TVar's content to a file after a delay (how do you ensure  
> all threads have terminated by the way, that would be more robust
> than using an arbitrary delay)
> 
> 
> -- this works
> main = do
>      let fname = "store.txt"
>      store <- atomically $ newTVar ""
>      forkIO $ 10 `replicateM_` (thread store)
>      threadDelay 800000
>      txt <- atomically (readTVar store)
>      writeFile fname txt
> 
> thread :: TVar (String) -> IO ()
> thread store = atomically ( readTVar store >>= writeTVar store . (++
> " some text "))
> 
> 
> But when I try to concurrently write to the file, I get into troubles.
> I keep the file handle in a TMVar, hoping than just one thread at a  
> time will be able to use that handle
> but nothing gets written to "store.txt" ? Is my IO too lazy ?
> 
> 
> -- this does not work
> main = do
>     let fname = "store.txt"
>     fh <- openFile fname ReadWriteMode
>     store <- atomically $ newTMVar fh
>     forkIO $ 10 `replicateM_` (writeTo store)
> 
> writeTo :: TMVar (Handle) -> IO ()
> writeTo store = do
>     fh <- atomically $ takeTMVar store
>     text <- hGetContents fh
>     hPutStr fh (text ++ " some text ")
>     atomically $ putTMVar store fh
> 
> 
> Thank you
> 

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.

As strange as it seems, I don't think the standard libraries provide an
easy way to do this, but you can implement it yourself.

Here's an example inspired by the documentation of Control.Concurrent:

> import Control.Concurrent
> import Control.Exception (finally)
>
> myFork :: IO () -> IO (MVar ())
> myFork a = do v <- newEmptyMVar
>               a `finally` (putMVar v ())
>
> myWait :: MVar () -> IO ()
> myWait = readMVar

With this, you could rewrite your main like this:

> main = do
>     let fname = "store.txt"
>     fh <- openFile fname ReadWriteMode
>     store <- atomically $ newTMVar fh
>     waitMe <- myFork $ 10 `replicateM_` (writeTo store)
>     myWait waitMe


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.

To create 10 threads, you should fork inside the replicateM, not
outside. Here's how you could correct this (again using myFork and
myWait from above):

> main = do
>     let fname = "store.txt"
>     fh <- openFile fname ReadWriteMode
>     store <- atomically $ newTMVar fh
>     waitMes <- 10 `replicateM` (myFork $ writeTo store))
>     mapM_ myWait waitMes

(make sure you use replicateM and not replicateM_ or you'll get a type
error)


Note: I haven't tried running any of this code, but it seems simple
enough to be confident in.