[Fencommits] fenserve: make board example load the graph from storm if it's there

[Benja Fallenstein]

Thu Mar 22 02:20:58 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * make board example load the graph from storm if it's there
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	2007-03-22 19:49:10.000000000 +0200
+++ new-fenserve/FenServe.hs	2007-03-22 19:49:10.000000000 +0200
@@ -196,19 +196,22 @@
 updateData f node = readData node >>= f >>= writeData (bURI $ bID node)
 
 getURI :: [String] -> Request -> FenServe Result
-getURI path req = do dir <- get; getURI' path dir where
-  getURI' [x] dir = readData dir >>= f . dirEntries where
-    f (FileEntry n r : _ )       | n == x = getBlock (bID r) >>= return .
-                                                mkResult 200 "text/html"
-    f (ExecutableEntry n c : _ ) | n == x = execute c req
-    f (_                   : es) = f es
-    f []                         = return $ mkResult 404 "text/html" $
-                                       toUTF $ "not found: " ++ x
-  getURI' (x:xs) dir = readData dir >>= f . dirEntries where
-    f (DirEntry n sub : _ ) | n == x = getURI' xs sub
+getURI path req = getEntry path >>= \entry -> case entry of
+        Left err -> return $ mkResult 404 "text/html" $ toUTF err
+        Right (FileEntry n r) -> do s <- getBlock (bID r)
+                                    return $ mkResult 200 "text/html" s
+        Right (ExecutableEntry n c) -> execute c req
+
+getEntry :: [String] -> FenServe (Either String Entry)
+getEntry path = do dir <- get; getEntry' path dir where
+  getEntry' [x] dir = readData dir >>= f . dirEntries where
+    f (e@(FileEntry n _)       : _ ) | n == x = return $ Right e
+    f (e@(ExecutableEntry n _) : _ ) | n == x = return $ Right e
+    f []                             = return $ Left $ "not found: " ++ x
+  getEntry' (x:xs) dir = readData dir >>= f . dirEntries where
+    f (DirEntry n sub : _ ) | n == x = getEntry' xs sub
     f (_              : es) = f es
-    f []                    = return $ mkResult 404 "text/html" $
-                                  toUTF $ "dir not found: " ++ x
+    f []                    = return $ Left $ "dir not found: " ++ x
     
 execute :: Node -> Request -> FenServe Result
 execute code req = do
@@ -252,10 +255,12 @@
 unBody (LargeBody _ _) = error "FenServe.unBody: large body not handled"
 
 putURI :: [String] -> Request -> FenServe Result
-putURI path rq = do dir <- get; rid <- addBlock (unBody $ rqBody rq)
-                    putURI' path (bIRI rid) dir >>= put
-                    return $ mkResult 200 "text/html" (toUTF "Ok.\n") where
-  putURI' [x] r dir = updateData f' dir where
+putURI path rq = addBlock (unBody $ rqBody rq) >>= putBlock path . bIRI
+
+putBlock :: [String] -> Node -> FenServe Result
+putBlock path r = do get >>= putBlock' path r >>= put
+                     return $ mkResult 200 "text/html" (toUTF "Ok.\n") where
+  putBlock' [x] r dir = updateData f' dir where
     f' (Dir n entries) = return $ Dir n (f entries)
     f (FileEntry       n _ : es) | n == x = FileEntry n r : es
                                  | n ++ ".code" == x = ExecutableEntry n r : es
@@ -265,8 +270,8 @@
     f []                         | ".code" `List.isSuffixOf` x 
                                  = [ExecutableEntry (take (length x - 5) x) r]
                                  | otherwise = [FileEntry x r]
-  putURI' (x:xs) r dir = updateData f' dir where
-    recurse sub = do sub' <- putURI' xs r sub; return [DirEntry x sub']
+  putBlock' (x:xs) r dir = updateData f' dir where
+    recurse sub = do sub' <- putBlock' xs r sub; return [DirEntry x sub']
     f' (Dir n entries) = do es' <- f entries; return (Dir n es')
     f (DirEntry n sub : es) | n == x = liftM (++es) (recurse sub)
     f (e              : es) = do es' <- f es; return (e:es')
diff -rN -u old-fenserve/board-demo.page new-fenserve/board-demo.page
--- old-fenserve/board-demo.page	2007-03-22 19:49:10.000000000 +0200
+++ new-fenserve/board-demo.page	2007-03-22 19:49:10.000000000 +0200
@@ -31,7 +31,7 @@
 lit s = Literal s Plain
 blog = IRI "ex:blog"; post = IRI "ex:post"
 
-example = toGraph (IRI "ex:graph") [
+example = toGraph (IRI "bah:graph") [
     (blog, dc_title, lit "Benja's Blog"),
     (blog, dc_description, lit "Benja Fallenstein"),
     (post, dc_title, lit "Hi there!"),
@@ -68,4 +68,12 @@
     </body>
     </html>
 
-handler = pageHandler $ let ?graph = example in renderBoard blog
+handler req = do 
+    e <- getEntry ["testdata","blog"]
+    bid <- case e of
+        Right (FileEntry _ r) -> return (bID r)
+        _ -> do bid <- writeGraph example
+                putBlock ["testdata","blog"] (bIRI bid)
+                return bid
+    graph <- readGraph bid
+    flip pageHandler req $ let ?graph = graph in renderBoard blog