[Fencommits] fenserve: work towards efficient data structures in storm

[Benja Fallenstein]

Fri Apr  6 15:01:44 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * work towards efficient data structures in storm
diff -rN -u old-fenserve/StormData.hs new-fenserve/StormData.hs
--- old-fenserve/StormData.hs	2007-04-06 15:01:59.000000000 +0300
+++ new-fenserve/StormData.hs	2007-04-06 15:02:00.000000000 +0300
@@ -26,8 +26,11 @@
 
 import Control.Monad
 
+import Data.Binary (Binary)
+import qualified Data.Binary as Binary
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Lazy as Lazy
 
 import System.IO.Unsafe (unsafePerformIO)
 
@@ -85,3 +88,56 @@
 modifyStormRef :: (FromRDF a, ToRDF a, StormMonad m) =>
                   EndoM m a -> EndoM m (StormRef a)
 modifyStormRef f r = readStormRef r >>= f >>= newStormRef
+
+
+----------------------------------------------------------------------------
+-- Binary data
+----------------------------------------------------------------------------
+
+data Binary a => BinRef a = BinRef BlockId
+
+getBinary :: (Binary a, StormMonad m) => BlockId -> m a
+getBinary bid = liftM (Binary.decode . Lazy.pack . ByteString.unpack) $
+                getBlock bid
+                
+readBinRef :: (Binary a, StormMonad m) => BinRef a -> m a
+readBinRef (BinRef bid) = getBinary bid
+
+addBinary :: (Binary a, StormMonad m) => a -> m BlockId
+addBinary = addBlock . ByteString.pack . Lazy.unpack . Binary.encode
+
+newBinRef :: (Binary a, StormMonad m) => a -> m (BinRef a)
+newBinRef = liftM BinRef . addBinary
+
+modifyBinRef :: (Binary a, StormMonad m) => EndoM m a -> EndoM m (BinRef a)
+modifyBinRef f r = readBinRef r >>= f >>= newBinRef
+
+
+----------------------------------------------------------------------------
+-- Data structures: Append-only log
+----------------------------------------------------------------------------
+
+data Binary a => Pair a = Pair (BinRef a) (BinRef a)
+
+instance Binary (Pair a) where -- XXX
+
+data Binary a => Log a = Empty 
+                       | Zero (BinRef (Log (Pair a)))
+                       | One (BinRef a) (BinRef (Log (Pair a)))
+
+instance Binary (Log a) where -- XXX
+
+first :: (Binary a, StormMonad m) => Pair a -> m a
+first (Pair r _) = readBinRef r
+
+second :: (Binary a, StormMonad m) => Pair a -> m a
+second (Pair _ r) = readBinRef r
+
+appendLog :: (Binary a, StormMonad m) => a -> Log a -> m (Log a)
+appendLog x Empty       = do rx <- newBinRef x; re <- newBinRef Empty
+                             return (One rx re)
+appendLog x (Zero rs)   = do rx <- newBinRef x
+                             return (One rx rs)
+appendLog x (One ry rs) = do rx <- newBinRef x
+                             rs' <- modifyBinRef (appendLog $ Pair rx ry) rs
+                             return (Zero rs')
diff -rN -u old-fenserve/fenserve.cabal new-fenserve/fenserve.cabal
--- old-fenserve/fenserve.cabal	2007-04-06 15:01:59.000000000 +0300
+++ new-fenserve/fenserve.cabal	2007-04-06 15:02:00.000000000 +0300
@@ -5,7 +5,7 @@
 Author:         Benja Fallenstein
 Maintainer:     fenfire-dev at nongnu.org
 Build-Depends:  base, mtl, network, HAppS, fenfire, glib, plugins,
-                haskell-src-exts, unix
+                haskell-src-exts, unix, binary
 Exposed-Modules: FenServe, Storm, PagePrelude, SHA1
 
 Executable:     fenserve