[Fencommits] fenserve: code to read back the append-only logs from the previous commit

[Benja Fallenstein]

Fri Apr  6 15:30:47 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * code to read back the append-only logs from the previous commit
diff -rN -u old-fenserve/StormData.hs new-fenserve/StormData.hs
--- old-fenserve/StormData.hs	2007-04-06 15:30:58.000000000 +0300
+++ new-fenserve/StormData.hs	2007-04-06 15:30:58.000000000 +0300
@@ -141,3 +141,31 @@
 appendLog x (One ry rs) = do rx <- newBinRef x
                              rs' <- modifyBinRef (appendLog $ Pair rx ry) rs
                              return (Zero rs')
+
+data MList m a = MNil | MCons a (m (MList m a))
+
+infixr 5 .++.
+
+(.++.) :: Monad m => m (MList m a) -> m (MList m a) -> m (MList m a)
+m1 .++. m2 = do l1 <- m1
+                case l1 of MNil -> m2
+                           MCons x xs -> return $ MCons x (xs .++. m2)
+                           
+mtake :: Monad m => Int -> MList m a -> m [a]
+mtake 0 _ = return []
+mtake _ MNil = return []
+mtake n (MCons x mxs) = liftM (x:) (mxs >>= mtake (n-1))
+
+readLog :: (Binary a, StormMonad m) => Log a -> m (MList m a)
+readLog log = withLog (\x l -> return (MCons x l)) log (return MNil) where
+    withPair :: (Binary a, StormMonad m) => 
+                (a -> Endo (m (MList m b))) -> Pair a -> Endo (m (MList m b))
+    withPair f (Pair rx ry) ml = 
+        do x <- readBinRef rx; f x $ do y <- readBinRef ry; f y ml
+
+    withLog :: (Binary a, StormMonad m) =>
+               (a -> Endo (m (MList m b))) -> Log a -> Endo (m (MList m b))
+    withLog f Empty ml = ml
+    withLog f (Zero rs) ml = do s <- readBinRef rs; withLog (withPair f) s ml
+    withLog f (One rx rs) ml = do s <- readBinRef rs; withLog (withPair f) s $
+                                      do x <- readBinRef rx; f x ml