[Fencommits] fenserve: use a get/put/post-based interface internally for reading and writing data
Benja Fallenstein
benja.fallenstein at gmail.com
Thu Mar 29 18:56:06 EEST 2007
Thu Mar 29 18:54:41 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* use a get/put/post-based interface internally for reading and writing data
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs 2007-03-29 18:56:06.000000000 +0300
+++ new-fenserve/FenServe.hs 2007-03-29 18:56:06.000000000 +0300
@@ -89,7 +89,7 @@
addBlock = lift . addBlock
writeEmptyState :: FenServe Node
-writeEmptyState = writeData "ex:" $ Dir (IRI "ex:") []
+writeEmptyState = postData "blk:/" $ Dir (IRI "new:block") []
type Handler = Request -> FenServe Result
@@ -169,43 +169,67 @@
bID (IRI ('b':'l':'k':':':'/':s)) = BlockId $ takeWhile (/= '#') s
bID node = error $ "Not a block IRI: " ++ show node
-readGraph :: StormMonad m => BlockId -> m Graph
-readGraph bid = do bytes <- getBlock bid; let uri = bURI bid
- let (ts, nss) = unsafePerformIO $
- Raptor.bytesToTriples "turtle" bytes uri
- return $ raptorToGraph ts nss uri
-
-writeGraph :: StormMonad m => Graph -> m BlockId
-writeGraph g = do let (ts,nss) = graphToRaptor g; uri = iriStr $ defaultGraph g
- addBlock $ unsafePerformIO $ Raptor.triplesToBytes ts nss uri
+getGraph :: String -> FenServe Graph
+getGraph uri = do bytes <- wget uri
+ let (ts, nss) = unsafePerformIO $
+ Raptor.bytesToTriples "turtle" bytes uri
+ return $ raptorToGraph ts nss uri
+
+showGraph :: Graph -> ByteString
+showGraph g = let (ts,nss) = graphToRaptor g; uri = iriStr $ defaultGraph g
+ in unsafePerformIO $ Raptor.triplesToBytes ts nss uri
+
+putGraph :: Graph -> FenServe ()
+putGraph g = wput (iriStr $ defaultGraph g) (showGraph g)
+
+postGraph :: String -> Graph -> FenServe String
+postGraph uri g = wpost uri (showGraph g)
-readData :: (FromRDF a, StormMonad m) => Node -> m a
-readData node = do graph <- readGraph (bID node)
- return $ fromRDF graph node
-
-writeData :: (ToRDF a, StormMonad m) => String -> a -> m Node
-writeData baseURI value = do
- let (node, ts) = runToRDF baseURI $ toRDF value
- bid <- writeGraph $ toGraph (IRI baseURI) ts
- return $ changeBaseURI baseURI (bURI bid) node
+getData :: FromRDF a => Node -> FenServe a
+getData node = do graph <- getGraph (takeWhile (/= '#') $ iriStr node)
+ return $ fromRDF graph node
+
+putData :: ToRDF a => String -> a -> FenServe Node
+putData uri value = do let (node, ts) = runToRDF uri $ toRDF value
+ putGraph $ toGraph (IRI uri) ts
+ return node
+
+postData :: ToRDF a => String -> a -> FenServe Node
+postData uri value = do let (node, ts) = runToRDF "new:block" $ toRDF value
+ uri' <- postGraph uri $ toGraph (IRI "new:block") ts
+ return $ changeBaseURI "new:block" uri' node
-updateData :: (FromRDF a, ToRDF a, StormMonad m) => EndoM m a -> EndoM m Node
-updateData f node = readData node >>= f >>= writeData (bURI $ bID node)
+updateStormData :: (FromRDF a, ToRDF a) => EndoM FenServe a -> EndoM FenServe Node
+updateStormData f node = getData node >>= f >>= postData "blk:/"
handleRequest :: Request -> FenServe Result
-handleRequest req = let p = splitPath $ path $ rqURI req in do
- e <- getEntry p
- case e of Right (ExecutableEntry code) -> execute code req
- _ -> case rqMethod req of GET -> getURI p req
- PUT -> putURI p req
+handleRequest req = case scheme $ rqURI req of
+ "blk:" -> case rqMethod req of
+ GET -> do bytes <- getBlock (bID $ IRI $ render $ rqURI req)
+ return $ mkResult 200 "application/octet-stream" bytes
+ POST -> do bid <- addBlock (unBody $ rqBody req)
+ return $ setHeader "Location" (bURI bid) $
+ mkResult 201 "text/html" (toUTF "Created.\n")
+ s | s `elem` ["local:",""] -> let p = splitPath $ path $ rqURI req in do
+ e <- getEntry p
+ case e of Right (ExecutableEntry code) -> execute code req
+ _ -> case rqMethod req of GET -> getURI p req
+ PUT -> putURI p req
+ m -> error ("FenServe.handleRequest: unhandled method: " ++ show m)
+ s -> error ("FenServe.handleRequest: cannot handle scheme: " ++ s)
wget :: String -> FenServe ByteString
-wget uri = liftM (ByteString.concat . rsBody) $
- handleRequest $ wrequest uri GET
+wget uri = do r <- handleRequest $ wrequest uri GET
+ return $ ByteString.concat $ rsBody r
wput :: String -> ByteString -> FenServe ()
wput uri body = do handleRequest $ (wrequest uri PUT) { rqBody=Body body }
return ()
+
+wpost :: String -> ByteString -> FenServe String
+wpost uri body = do r <- handleRequest $ (wrequest uri POST) {rqBody=Body body}
+ return $ fromMaybe (error "FenServe.wpost: no Location")
+ (getHeader "Location" r)
wrequest :: String -> Method -> Request
wrequest uri method = case parseURIReference uri of
@@ -223,12 +247,12 @@
getEntry :: [String] -> FenServe (Either String Entry)
getEntry path = do dir <- get; getEntry' path dir where
- getEntry' [x] dir = readData dir >>= f . dirEntries where
+ getEntry' [x] dir = getData dir >>= f . dirEntries where
f entries = case lookup x entries of
Just (DirEntry sub) -> getEntry' [""] sub
Just e -> return $ Right e
Nothing -> return $ Left $ "not found: " ++ x
- getEntry' (x:xs) dir = readData dir >>= f . dirEntries where
+ getEntry' (x:xs) dir = getData dir >>= f . dirEntries where
f entries = case lookup x entries of
Just (DirEntry sub) -> getEntry' xs sub
Just e -> return $ Left $ "is not a dir: " ++ x
@@ -239,7 +263,7 @@
unBody (LargeBody _ _) = error "FenServe.unBody: large body not handled"
putURI :: [String] -> Request -> FenServe Result
-putURI path rq = do b <- liftM bIRI $ addBlock (unBody $ rqBody rq)
+putURI path rq = do b <- liftM IRI $ wpost "blk:/" (unBody $ rqBody rq)
let (e,path') = if List.last path /= ".code"
then (FileEntry b, path)
else (ExecutableEntry b, List.init path)
@@ -248,16 +272,17 @@
putEntry :: [String] -> Entry -> FenServe Result
putEntry path e' = do get >>= putEntry' path >>= put
return $ mkResult 200 "text/html" (toUTF "Ok.\n") where
- putEntry' [x] dir = updateData f' dir where
- f' (Dir n entries) = do entries' <- f entries; return $ Dir n entries'
+ n' = IRI "new:block"
+ putEntry' [x] dir = updateStormData f' dir where
+ f' (Dir n entries) = do entries' <- f entries; return $ Dir n' entries'
f ((n, DirEntry sub) : es) | n == x = do sub' <- putEntry' [""] sub
return ((n, DirEntry sub'):es)
f ((n, e) : es) | n == x = return $ (n,e'):es
| otherwise = do es' <- f es; return $ (n,e):es'
f [] = return [(x, e')]
- putEntry' (x:xs) dir = updateData f' dir where
+ putEntry' (x:xs) dir = updateStormData f' dir where
recurse sub = do sub' <- putEntry' xs sub; return [(x, DirEntry sub')]
- f' (Dir n entries) = do es' <- f entries; return (Dir n es')
+ f' (Dir n entries) = do es' <- f entries; return (Dir n' es')
f ((n, DirEntry sub) : es) | n == x = liftM (++es) (recurse sub)
f ((n, e) : es) | n == x = error ("FIXME: not a dir: " ++ n)
f (e : es) = do es' <- f es; return (e:es')
diff -rN -u old-fenserve/Main.hs new-fenserve/Main.hs
--- old-fenserve/Main.hs 2007-03-29 18:56:06.000000000 +0300
+++ new-fenserve/Main.hs 2007-03-29 18:56:06.000000000 +0300
@@ -65,7 +65,7 @@
-}
pn <- getProgName; let dir = pn++"_storm"
createDirectoryIfMissing True dir
- (_,_,pool) <- runFenServe writeEmptyState (error "Main: shouldn't be evaluated") (Just dir); writePool pool
+ (_,_,pool) <- runFenServe writeEmptyState (error "Main.main: this shouldn't be evaluated") (Just dir); writePool pool
stdHTTP [ debugFilter
--, localhostOnlyFilter
, fenserveHandler dir
diff -rN -u old-fenserve/blog-data.turtle new-fenserve/blog-data.turtle
--- old-fenserve/blog-data.turtle 1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/blog-data.turtle 2007-03-29 18:56:06.000000000 +0300
@@ -0,0 +1 @@
+<ex:blog> <http://purl.org/dc/elements/1.1/title> "Benja's Blog". <ex:blog> <http://purl.org/dc/elements/1.1/description> "Booh.".
diff -rN -u old-fenserve/board-demo.page new-fenserve/board-demo.page
--- old-fenserve/board-demo.page 2007-03-29 18:56:06.000000000 +0300
+++ new-fenserve/board-demo.page 2007-03-29 18:56:06.000000000 +0300
@@ -118,8 +118,7 @@
(p, dcterms_modified, time)]
++ catMaybes [do parent' <- parent -- running in Maybe
return (p, sioc_reply_of, parent')]
- bid <- writeGraph graph'
- putEntry ["testdata","blog"] $ FileEntry $ bIRI bid
+ putGraph graph'
pageHandler (let ?graph = graph' in renderBoard blog) ?req
editHandler :: (?graph :: Graph, ?req :: Request) => Handler
@@ -131,15 +130,12 @@
(p, dc_creator, f "author"),
(p, content_encoded, f "content"),
(p, dcterms_modified, time)]
- bid <- writeGraph graph'
- putEntry ["testdata","blog"] $ FileEntry $ bIRI bid
+ putGraph graph'
pageHandler (let ?graph = graph' in renderBoard blog) ?req
handler req = do
- e <- getEntry ["testdata","blog"]
- graph <- case e of Right (FileEntry r) -> readGraph (bID r)
- _ -> return example
+ graph <- getGraph "local:/testdata/blog"
let ?graph = graph; ?req = req in
case (lookM req "view", rqMethod req) of
More information about the Fencommits
mailing list