[Fencommits] fenserve: a working version based on rdf!

[Benja Fallenstein]

Sun Mar 18 17:52:02 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * a working version based on rdf!
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	2007-03-22 19:49:19.000000000 +0200
+++ new-fenserve/FenServe.hs	2007-03-22 19:49:19.000000000 +0200
@@ -31,6 +31,7 @@
 
 import qualified Data.ByteString as ByteString
 import Data.ByteString (ByteString)
+import Data.Generics
 import qualified Data.Map as Map
 import Data.Map (Map)
 import qualified Data.Set as Set
@@ -65,8 +66,10 @@
 data Directory = Dir { dirNode :: Node, dirEntries :: [Entry] } deriving (Show, Read)
 
 emptyState :: Ptr
-emptyState = runStormIO (liftM bIRI $ writeBlock (Dir (IRI "#dir") []))
-                        Map.empty
+emptyState = flip runStormIO Map.empty $ do 
+    let (node, ts) = runToRDF "ex:foo" $ toRDF $ Dir (IRI "ex:foo#dir") []
+    bid <- writeGraph $ setGraphURI "ex:foo" $ listToGraph $ Set.toList ts
+    return $ changeBaseURI "ex:foo" (bURI bid) node
 
 type Ptr = (Node, Pool)
 
@@ -107,7 +110,7 @@
         x | x == fs_DirEntry -> do
             let nameR = rget fs_filename node g
             name <- readRDF g nameR
-            let subdir = rget fs_representation node g
+            let subdir = rget fs_subdir node g
             tellTs [ (node, fs_filename, nameR), 
                      (node, fs_subdir, subdir) ]
             return $ DirEntry name subdir
@@ -143,29 +146,39 @@
 
 bID :: Node -> BlockId
 bID (IRI ('b':'l':'k':':':s)) = BlockId $ takeWhile (/= '#') s
+bID node = error $ "Not a block IRI: " ++ show node
   
-readGraph :: Node -> StormIO Graph
-readGraph gNode = liftM (setGraphURI $ nodeStr gNode) $ readBlock (bID gNode)
+readGraph :: BlockId -> StormIO Graph
+readGraph bid = do triples <- readBlock bid; let uri = bURI bid
+                   let triples' = everywhere (mkT $ absolutizeNode uri) triples
+                   return $ setGraphURI uri $ listToGraph $ triples'
+
+writeGraph :: Graph -> StormIO BlockId
+writeGraph graph = let triples = graphToList graph; uri = graphURI graph
+                       triples' = everywhere (mkT $ relativizeNode uri) triples
+                    in writeBlock triples'
+                    
+readData :: FromRDF a => Node -> StormIO a
+readData node = do graph <- readGraph (bID node)
+                   return $ fromRDF graph node
 
 getURI :: [String] -> Node -> StormIO ByteString
-getURI [x] dir = readBlock (bID dir) >>= f . dirEntries where
+getURI [x] dir = readData dir >>= f . dirEntries where
     f (FileEntry n r : _ ) | n == x = getBlock (bID r)
     f (_             : es) = f es
     f []                   = return $ toUTF $ "not found: " ++ x
-getURI (x:xs) dir = readBlock (bID dir) >>= f . dirEntries where
+getURI (x:xs) dir = readData dir >>= f . dirEntries where
     f (DirEntry n sub : _ ) | n == x = getURI xs sub
     f (_              : es) = f es
     f []                    = return $ toUTF $ "dir not found: " ++ x
 
-{-
-updateData :: (FromRDF a, ToRDF a) => (a -> a) -> Node -> Endo (BlockId,Pool)
-updateData f node (bid,pool) = let graph = readGraph (bid, pool)
-                                   graph' = updateRDF f node graph
-                                in writeGraph graph' pool
--}
-
-updateData :: (Read a, Show a) => EndoM StormIO a -> EndoM StormIO Node
-updateData f node = return . bIRI =<< writeBlock =<< f =<< readBlock (bID node)
+updateData :: (FromRDF a, ToRDF a) => EndoM StormIO a -> EndoM StormIO Node
+updateData f node = do 
+    value' <- f =<< readData node; let uri = bURI (bID node)
+    let (node',ts) = runToRDF uri $ toRDF value'
+        graph' = setGraphURI uri $ listToGraph $ Set.toList ts
+    bid' <- writeGraph graph'
+    return $ changeBaseURI uri (bURI bid') node'
 
 putURI :: [String] -> ByteString -> Node -> StormIO Node
 putURI path s dir = do rid <- addBlock s; putURI' path (bIRI rid) dir where