[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