[Haskell-cafe] Replacing RDMS - global lock and STM preventing retrying?

[Marc Weber]

What would be the right way to go to replace RDBMS (postgres/ mysql) etc
using haskell only for small to medium sized (web)applications?
I guess one way to go is using STM.
But what happens if you have some tables each row represented as TVar
and you'd like to do a full backup? Some occasionally occuring updates
on single rows will make the atomic action get all rows and write them
to disk retry again and again? Is there a way to make the update action
retry in this case?
And then you can implement something like: Try it 20 times, if the aciton
doesn't succeed aquire global lock ! Wow.

Has anyone already implemented such a RDBMS replacement?
Anyone interested in working on this?

Marc Weber

One solution I came up within minutes :) I love haskell. You write it
down fix error and it works :)
Would you prefer another way to solve this?

--packages: containers, binary, stm, mtl, random
module Main where
import System.IO.Unsafe
import Random
import Control.Concurrent
import Control.Monad
import Control.Concurrent.STM
import Control.Monad.Trans

-- running count of actions. if set to -1 a transaction has aquired global lock 
globalLock = unsafePerformIO $ newTVarIO (0::Int)

modifyTVar tvar f = do
  v <- readTVar tvar
  writeTVar tvar $ f v

-- of course this should be in it's own monad to force using this function
-- myAtomically: aquires global lock
-- of course I don't need 5 atomically calls, but this way an action will not be retried if only the global count changes
myAtomically aquireGlobalLock stmAction =
  if aquireGlobalLock
    then do
      atomically $ do
        runningCount <- readTVar globalLock
        when (runningCount /= 0) retry
        writeTVar globalLock (negate 1)
        -- other  actions should be retrying
      atomically $ do 
        stmAction
        writeTVar globalLock 0
  else do
      atomically $ do
        runningCount <- readTVar globalLock
        when (runningCount == (negate 1)) retry
        modifyTVar globalLock (+1)
      atomically stmAction
      atomically $ modifyTVar globalLock (\x -> x -1)

-- log utility printing start / stop of an action 
stsp :: (MonadIO m) =>  String -> m r ->  m r
stsp msg act = do
  liftIO $ putStrLn $ "start: " ++ msg
  r <- act
  liftIO $ putStrLn $ "stop: " ++ msg
  return r

data Table rec = Table { table :: [TVar rec] }

newTable rowcount = liftM Table $ mapM newTVarIO [(1::Int)..rowcount]

dumpTable fn t = do
  dat <- myAtomically True $ mapM readTVar $ table t
  writeFile fn $ show dat

disturb t@(Table (row:_)) = do
  stsp "disturbing" $ do
    v <- randomRIO (0,1000000)
    myAtomically False  $ writeTVar row v
  threadDelay 1000000
  disturb t -- loop 

main = do
  stsp "application" $ do
    table <- newTable 100000
    forkIO $ disturb table
    stsp "dumping" $ dumpTable "dump" table