mult.ifario.us

Pepe Iborra left a comment on my entry on STM and IO about the use unsafeIOToSTM that spurred me to do some more reading and ask a few questions by email. (Better yet, people who knew the answers were kind enough to respond.)

Better without unsafeIOToSTM

The consensus was to avoid the use of unsafeIOToSTM and just combine the IO actions in the IO monad. This changes things around a bit but in a good way; refactoring (if the word applies in this scenario) only took about 15 minutes.

Disregarding the suggestion to use TMVar for the moment, here are some revisions. (If you look at TMVar, the source is more informative than the documentation.)

First, check_out and check_in need to change, and storing an entry to disk can get simpler:

check_out :: TVar Holder -> IO Holder
check_out h = atomically ( do { h' <- readTVar h
                              ; if locked h'
                                then retry
                                else writeTVar h (lock h')
                              ; return h' } )

check_in :: TVar Holder -> Holder -> IO ()
check_in h' h = atomically ( do { h'' <- readTVar h'
                                ; if (locked h'')
                                  then writeTVar h' (unlock h)
                                  else error "Internal error." } )

store :: Holder -> IO Holder
store h = do { let e = entry h
              ; do writeFile (fname e) ((show e) ++ "\n")
              ; return h }

And two additional utility functions:

onHolders :: (Entry -> Entry) -> (Holder -> Holder)
onHolders f = \ (Holder e l) -> Holder (f e) l

s_apply :: (Entry -> Entry) -> TVar Holder -> IO ()
s_apply f h' = check_out h'
               >>= (store' . onHolders f)
               >>= (check_in h')

(The ">>=" in IO is sequencing where the output of each step is passed to the next as input.) The flow of s_apply is as follows:

1. "Check out" the entry by setting the locked field to True and then pass the Holder to the next step.
2. Apply the function f to the Entry wrapped in the Holder, write the result to disk, and pass it along.
3. "Check in" the entry by setting the locked field to True and writing the new value into the TVar.

Publishing and unpublishing a persistent Entry now has the appealingly simple form:

s_publish :: TVar Holder -> IO ()
s_publish = s_apply publish

s_unpublish :: TVar Holder -> IO ()
s_unpublish = s_apply unpublish

Even Better with bracket

An anonymous commenter pointed out bracket, a function that has the same semantics as try { ... } finally { ... } in Java. The bracket function has the signature:

bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c

In the analogy with try/finally from Java, the IO a would occur before the try, like lock'ing a Lock in the usual idiom. The result of the initial computation is passed both to the inner computation and to the final computation, so the application of the function (e.g., publish) would need to be grouped with the check_out operation if the published Entry was to be the one checked back in. For my purposes, bracketOnError is preferable, since it only executes the fallback action if the inner action (i.e., the last argument) fails. With bracketOnError added and a little more clean-up from another pass over the code, everything gets a little simpler yet:

store :: Entry -> IO Entry
store e = do { writeFile (fname e) ((show e) ++ "\n")
             ; return e }

check_out :: TVar Holder -> IO Entry
check_out h = atomically ( do { h' <- readTVar h
                              ; if locked h'
                                then retry
                                else writeTVar h (lock h')
                              ; return $ entry h' } )

check_in :: TVar Holder -> Entry -> IO ()
check_in h' e = atomically ( do { h'' <- readTVar h'
                                ; if (locked h'')
                                  then writeTVar h' (Holder e False)
                                  else error "Programmer error." } )

s_apply :: (Entry -> Entry) -> TVar Holder -> IO ()
s_apply f h' = bracketOnError (check_out h')
               (\e -> (store.f) e >>= (check_in h'))
               (check_in h')

With s_publish as before, this does the right thing in the event of an error while writing:

*Main> th <- atomically ( newTVar (Holder (Entry "foo" False) False ))
*Main> s_show th
"Holder {entry = Entry {entry_id = \"foo\", published = False}, locked = False}"

*Main> :! chmod -w entry-foo.hb
*Main> do s_publish th
*** Exception: entry-foo.hb: openFile: permission denied (Permission denied)
*Main> s_show th
"Holder {entry = Entry {entry_id = \"foo\", published = False}, locked = False}"

*Main> :! chmod +w entry-foo.hb
*Main> do s_publish th
*Main> s_show th
"Holder {entry = Entry {entry_id = \"foo\", published = True}, locked = False}"

Whither TMVar?

From the TMVar source code comments:

A 'TMVar' is a synchronising variable, used for communication between concurrent threads. It can be thought of as a a box, which may be empty or full.

The idea would be that when an Entry was locked, its TMVar "box" would be empty, to be filled with a TVar wrapping the new value after the operation was completed. Other threads (e.g., threads rendering page views or feeds) need to be able to read values while output is being performed, so I don't think that a TMVar is what I'm after in this case.