[Fencommits] fenserve: monadify getURI also

[Benja Fallenstein]

Sun Mar 18 15:34:24 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * monadify getURI also
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	2007-03-22 19:49:22.000000000 +0200
+++ new-fenserve/FenServe.hs	2007-03-22 19:49:22.000000000 +0200
@@ -125,7 +125,8 @@
 main :: IO ()
 main = stdHTTP
   [ debugFilter
-  , h asPath GET $ ok $ \uri () -> get >>= return . Right . getURI uri
+  , h asPath GET $ ok $ \uri () -> do
+       (b,p) <- get; return $ Right $ fst $ runStormIO (getURI uri b) p
   , h asPath PUT $ ok $ \uri () -> do 
       Request { rqBody=Body body } <- getEvent
       modify (\(b,p) -> runStormIO (putURI uri body b) p); return $ Right "Ok."
@@ -143,17 +144,15 @@
 readGraph :: BlockId -> StormIO Graph
 readGraph bid = liftM (setGraphURI $ bURI bid) $ readBlock bid
 
-getURI :: [String] -> (BlockId, Pool) -> ByteString
-getURI [x] (bid,pool) = f entries where
-    Dir _ entries = fst $ runStormIO (readBlock bid) pool
-    f (FileEntry n r : _ ) | n == x = fst $ runStormIO (getBlock (bID r)) pool
+getURI :: [String] -> BlockId -> StormIO ByteString
+getURI [x] bid = readBlock bid >>= f . dirEntries where
+    f (FileEntry n r : _ ) | n == x = getBlock (bID r)
     f (_             : es) = f es
-    f []                   = toUTF $ "not found: " ++ x
-getURI (x:xs) (bid,pool) = f entries where
-    Dir _ entries = fst $ runStormIO (readBlock bid) pool
-    f (DirEntry n sub : _ ) | n == x = getURI xs (bID sub, pool)
+    f []                   = return $ toUTF $ "not found: " ++ x
+getURI (x:xs) bid = readBlock bid >>= f . dirEntries where
+    f (DirEntry n sub : _ ) | n == x = getURI xs (bID sub)
     f (_              : es) = f es
-    f []                    = toUTF $ "dir not found: " ++ x
+    f []                    = return $ toUTF $ "dir not found: " ++ x
 
 {-
 updateData :: (FromRDF a, ToRDF a) => (a -> a) -> Node -> Endo (BlockId,Pool)