[Fencommits] fenserve: make work

Benja Fallenstein benja.fallenstein at gmail.com
Thu Mar 22 19:49:08 EET 2007


Thu Mar 22 05:32:56 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * make work
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	2007-03-22 19:49:07.000000000 +0200
+++ new-fenserve/FenServe.hs	2007-03-22 19:49:07.000000000 +0200
@@ -196,46 +196,18 @@
 updateData f node = readData node >>= f >>= writeData (bURI $ bID node)
 
 handlePath :: [String] -> Request -> FenServe Result
-handlePath path req = do get -> dir
-                         (r, dir') <- handlePath' dir path req
-                         put dir'; return r where
-  notFound err = return $ (mkResult 404 "text/html" $ toUTF err, [])
-  handlePath' d [x] req = do
-      Dir _ entries <- readData d; (r, entries') <- f entries
-      d' <- writeData (bURI $ bID d) (Dir d entries'); return (r,d') where
-    f es@(FileEntry       n r : _) | x `elem` [n,n++".code"] = case rqMethod req of
-             GET -> do s <- getBlock (bID r)
-                       return (mkResult 200 "text/html" s, es)
-             PUT -> f (tail es)
-    f es@(ExecutableEntry n c : _) | n == x = do result <- execute c req
-                                                 return (result, es)
-    f    (e              : es) = do (r,es') <- f es; return (r,e:es')
-    f    []                    = case rqMethod req of
-             GET -> notFound $ "not found: " ++ x
-             PUT -> do r <- liftM bIRI $ addBlock (unBody $ rqBody req)
-                       return (mkResult 200 "text/html" (toUTF "Ok.\n"),
-                               if ".code" `List.isSuffixOf` x
-                               then [ExecutableEntry (take (length x - 5) x) r]
-                               else [FileEntry x r])
-  handlePath' d (x:xs) req = do
-      Dir _ entries <- readData d; (r, entries') <- f entries
-      d' <- writeData (bURI $ bID d) (Dir d entries'); return (r,d') where
-    f (DirEntry n sub : es) | n == x = do (r,sub') <- handlePath' sub xs req
-                                          return (r, DirEntry n sub' : es)
-    f (e              : es) = do (r,es') <- f es; return (r,e:es')
-    f []                    = case rqMethod req of
-             PUT -> do (r,sub) <- handlePath' (fst emptyState) xs req
-                       return (r, [DirEntry x sub])
-             _ -> notFound $ "dir not found: " ++ x
+handlePath path req = do 
+    e <- getEntry path
+    case e of Right (ExecutableEntry _ code) -> execute code req
+              _ -> case rqMethod req of GET -> getURI path req
+                                        PUT -> putURI path req
       
-{-
 getURI :: [String] -> Request -> FenServe Result
 getURI path req = getEntry path >>= \entry -> case entry of
-        Left err -> 
+        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
@@ -253,7 +225,6 @@
 unBody (Body b) = b
 unBody (LargeBody _ _) = error "FenServe.unBody: large body not handled"
 
-{-
 putURI :: [String] -> Request -> FenServe Result
 putURI path rq = addBlock (unBody $ rqBody rq) >>= putBlock path . bIRI
 
@@ -276,7 +247,6 @@
     f (DirEntry n sub : es) | n == x = liftM (++es) (recurse sub)
     f (e              : es) = do es' <- f es; return (e:es')
     f []                    = recurse (fst $ emptyState)
--}
 
 --------------------------------------------------------------------------
 -- Running executable resources




More information about the Fencommits mailing list