[Fencommits] fenserve: fix getResource and putResource

[Benja Fallenstein]

Thu Apr  5 20:19:46 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * fix getResource and putResource
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	2007-04-05 20:21:13.000000000 +0300
+++ new-fenserve/FenServe.hs	2007-04-05 20:21:13.000000000 +0300
@@ -102,9 +102,8 @@
     handleResource :: Handler }
     
 type Resolvers = Map Node Resolver
-data Resolver = forall a. (FromRDF a, ToRDF a) =>
-                Resolver (Resolvers -> a -> (a -> FenServe ()) -> [String] 
-                       -> FenServe Resource)
+data Resolver = Resolver (Resolvers -> Node -> (Node -> FenServe ()) 
+                       -> [String] -> FenServe Resource)
 
 writeEmptyState :: FenServe Node
 writeEmptyState = addData $ Dir (Map.empty)
@@ -150,13 +149,14 @@
 instance ToRDF File where
   toRDF (File n) = toResourceRDF fs_File [addRDFConn fs_representation toRDF n]
 
-resolveFile rs (File n) put' [] = return $ Resource {
-    getResource = getData n,
-    putResource = \x -> addData x >>= put' . File,
+resolveFile rs node put' [] = do File n <- getData node; return $ Resource {
+    getResource = getData node,
+    putResource = \x -> addData x >>= put',
     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)
+        PUT -> do bid <- addBlock (unBody $ rqBody req)
+                  addData (File $ bIRI bid) >>= put'
                   return $ mkResult 200 "text/html" (toUTF "Ok.\n")
     }
                        
@@ -171,13 +171,14 @@
              (toRDFPair fs_filename toRDF fs_spec toRDF) (Map.toList m)
         ]
 
-resolveDir rs (Dir m) put' (p:ps) = case Map.lookup p m of
-    Just n -> resolve' rs n (\n' -> put' $ Dir $ Map.insert p n' m) ps
-    Nothing -> do emptyBlock <- liftM bIRI $ addBlock ByteString.empty
-                  resolveFile rs (File emptyBlock)
-                                 (\f' -> do n' <- addData f'
-                                            put' $ Dir $ Map.insert p n' m) ps
-resolveDir rs dir put' [] = resolveDir rs dir put' [""]
+resolveDir rs node put' (p:ps) = do 
+    Dir m <- getData node; case Map.lookup p m of
+        Just n -> resolve' rs n (\n' -> put' =<< (addData $ Dir $ Map.insert p n' m)) ps
+        Nothing -> do emptyBlock <- liftM bIRI $ addBlock ByteString.empty
+                      emptyFile <- addData (File emptyBlock)
+                      resolveFile rs emptyFile
+                        (\n' -> put' =<< addData (Dir $ Map.insert p n' m)) ps
+resolveDir rs node put' [] = resolveDir rs node put' [""]
 
 
 --------------------------------------------------------------------------