[Fencommits] fenserve: incremental progress towards fenfire reimpl
Benja Fallenstein
benja.fallenstein at gmail.com
Thu Apr 5 17:37:55 EEST 2007
Thu Apr 5 17:37:04 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* incremental progress towards fenfire reimpl
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs 2007-04-05 17:37:55.000000000 +0300
+++ new-fenserve/FenServe.hs 2007-04-05 17:37:55.000000000 +0300
@@ -58,14 +58,13 @@
fs = "http://fenfire.org/2007/fenserve#"
fs_Directory = IRI "http://fenfire.org/2007/fenserve#Directory"
-fs_DirEntry = IRI "http://fenfire.org/2007/fenserve#DirEntry"
-fs_FileEntry = IRI "http://fenfire.org/2007/fenserve#FileEntry"
-fs_ExecutableEntry = IRI "http://fenfire.org/2007/fenserve#ExecutableEntry"
+fs_File = IRI "http://fenfire.org/2007/fenserve#File"
+fs_Executable = IRI "http://fenfire.org/2007/fenserve#Executable"
fs_FirstVersion = IRI "http://fenfire.org/2007/fenserve#FirstVersion"
fs_previousVersion = IRI "http://fenfire.org/2007/fenserve#previousVersion"
-fs_entries = IRI "http://fenfire.org/2007/fenserve#entries"
+fs_entry = IRI "http://fenfire.org/2007/fenserve#entry"
fs_filename = IRI "http://fenfire.org/2007/fenserve#filename"
-fs_subdir = IRI "http://fenfire.org/2007/fenserve#subdir"
+fs_spec = IRI "http://fenfire.org/2007/fenserve#spec"
fs_representation = IRI "http://fenfire.org/2007/fenserve#representation"
fs_code = IRI "http://fenfire.org/2007/fenserve#code"
fs_mimeType = IRI "http://fenfire.org/2007/fenserve#mimeType"
@@ -91,6 +90,10 @@
rsCode=code, rsFlags=nullRsFlags, rsBody=[body], rsHeaders = Headers $
Map.singleton (toUTF "Content-type") (toUTF mimeType) }
+unBody NoBody = ByteString.empty
+unBody (Body b) = b
+unBody (LargeBody _ _) = error "FenServe.unBody: large body not handled"
+
type Handler = Request -> FenServe Result
data Resource = Resource {
@@ -103,12 +106,13 @@
Resolver (Resolvers -> a -> (a -> FenServe ()) -> [String]
-> FenServe Resource)
-{-
+writeEmptyState :: FenServe Node
+writeEmptyState = addData $ Dir (Map.empty)
+
instance StartState Node where
startStateM =
runFenServe writeEmptyState e Nothing >>= \(r,_,_) -> return r where
e = error "FenServe.(StartState Node): this shouldn't be evaluated"
--}
instance Serialize Node where
typeString _ = "FenServe.State"
@@ -124,75 +128,45 @@
resolve' :: Resolvers -> Node -> (Node -> FenServe ()) -> [String] -> FenServe Resource
resolve' rs n put' p = do g <- getGraph n; ty <- mquery (n, fs_type, X) g
Resolver r <- Map.lookup ty rs
- r rs (fromRDF g n) (\x -> addData x >>= put') p
+ let Right spec = fromRDF g n
+ r rs spec (\x -> addData x >>= put') p
-defaultResolvers = Map.fromList [(fs_Directory, Resolver resolveDir)]
+defaultResolvers = Map.fromList [(fs_Directory, Resolver resolveDir),
+ (fs_File, Resolver resolveFile)]
handleRequest :: Request -> FenServe Result
handleRequest req = do let p = splitPath $ path $ rqURI req
r <- resolve defaultResolvers p
handleResource r req
+data File = File Node
+
+instance FromRDF File where fromRDF = error "FenServe: XXX"
+instance ToRDF File where toRDF = error "FenServe: XXX"
+
+resolveFile rs (File n) put' [] = return $ Resource {
+ getResource = getData n,
+ putResource = \x -> addData x >>= put' . File,
+ handleResource = \req -> case rqMethod req of
+ GET -> do bytes <- getBlock (bID n)
+ return $ mkResult 200 "text/html" bytes
+ PUT -> do bid <- addBlock (unBody $ rqBody req); put' (File $ bIRI bid)
+ return $ mkResult 200 "text/html" (toUTF "Ok.\n")
+ }
+
data Directory = Dir (Map String Node)
-instance FromRDF Directory where fromRDF = error "FenServe: XXX"
-instance ToRDF Directory where toRDF = error "FenServe: XXX"
+instance FromRDF Directory where
+ fromRDF g n = fmap (Dir . Map.fromList) $ fromRDFConns fs_entry
+ (fromRDFPair fs_filename fromRDF fs_spec fromRDF) g n
+instance ToRDF Directory where
+ toRDF (Dir m) = toRDFConns fs_entry
+ (toRDFPair fs_filename toRDF fs_spec toRDF) (Map.toList m)
resolveDir rs (Dir m) put' (p:ps) =
resolve' rs (m Map.! p) (\n -> put' $ Dir $ Map.insert p n m) ps
-
-
-{-
-getURI :: [String] -> Request -> FenServe Result
-getURI path req = getEntry path >>= \entry -> case entry of
- Left err -> return $ mkResult 404 "text/html" (toUTF err)
- Right (FileEntry r) -> do s <- getBlock (bID r)
- return $ mkResult 200 "text/html" s
- Right (ExecutableEntry c) -> execute c req
-
-getEntry :: [String] -> FenServe (Either String Entry)
-getEntry path = do dir <- get; getEntry' path dir 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 = 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
- Nothing -> return $ Left $ "dir not found: " ++ x
-
-unBody NoBody = ByteString.empty
-unBody (Body b) = b
-unBody (LargeBody _ _) = error "FenServe.unBody: large body not handled"
+resolveDir rs dir put' [] = resolveDir rs dir put' [""]
-putURI :: [String] -> Request -> FenServe Result
-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)
- putEntry path' e
-
-putEntry :: [String] -> Entry -> FenServe Result
-putEntry path e' = do get >>= putEntry' path >>= put
- return $ mkResult 200 "text/html" (toUTF "Ok.\n") where
- 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 = 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 ((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')
- f [] = writeEmptyState >>= recurse
--}
--------------------------------------------------------------------------
-- Running executable resources
diff -rN -u old-fenserve/StormData.hs new-fenserve/StormData.hs
--- old-fenserve/StormData.hs 2007-04-05 17:37:55.000000000 +0300
+++ new-fenserve/StormData.hs 2007-04-05 17:37:55.000000000 +0300
@@ -36,7 +36,7 @@
-- UnreadStormRef Node | ReadStormRef Node a | UnserializedStormRef a
instance FromRDF (StormRef a) where
- fromRDF _ n = StormRef n
+ fromRDF _ n = return $ StormRef n
instance ToRDF (StormRef a) where
toRDF (StormRef n) = return n
@@ -61,7 +61,8 @@
return $ raptorToGraph ts nss (iriStr n)
getData :: (FromRDF a, StormMonad m) => Node -> m a
-getData n = do g <- getGraph n; return $ fromRDF g n
+getData n = do g <- getGraph n; Right x <- return $ fromRDF g n
+ return x
readStormRef :: (FromRDF a, ToRDF a, StormMonad m) => StormRef a -> m a
readStormRef (StormRef n) = getData n
@@ -74,8 +75,8 @@
addGraph g = liftM bIRI $ addBlock (showGraph g)
addData :: (ToRDF a, StormMonad m) => a -> m Node
-addData value = do let (node, ts) = runToRDF "new:block" $ toRDF value
- node' <- addGraph $ toGraph (IRI "new:block") ts
+addData value = do let (node, g) = runToRDF (IRI "new:block") $ toRDF value
+ node' <- addGraph g
return $ changeBaseURI "new:block" (iriStr node') node
newStormRef :: (FromRDF a, ToRDF a, StormMonad m) => a -> m (StormRef a)
More information about the Fencommits
mailing list