more improvements related to redirection

[Rakka.git] / Rakka / Resource / PageEntity.hs

diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs
index 19e9768f7bd02e92039b85e6cf2ea4fc4438edec..1a8eb03c4d07e750760193e12035c9e360ff5f6f 100644 (file)
--- a/Rakka/Resource/PageEntity.hs
+++ b/Rakka/Resource/PageEntity.hs
@@ -52,21 +52,21 @@ handleGet env name
             Nothing
                 -> handlePageNotFound env -< name
 
-            Just redir@(Redirection _ _ _ _)
+            Just redir@(Redirection _ _ _ _ _)
                 -> handleRedirect env -< redir
 
-            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
                 -> handleGetEntity env -< entity
 
 {-
   HTTP/1.1 302 Found
-  Location: http://example.org/Destination?from=Source
+  Location: http://example.org/Destination#Redirect:Source
 -}
 handleRedirect :: (ArrowXml a, ArrowIO a) => Environment -> a Page (Resource ())
 handleRedirect env
     = proc redir
     -> do BaseURI baseURI <- getSysConfA (envSysConf env) -< ()
-          returnA -< redirect Found (mkPageURI baseURI $ redirName redir) -- FIXME
+          returnA -< redirect Found (mkPageURI baseURI $ redirDest redir) -- FIXME
 
 
 handleGetEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a Page (Resource ())
@@ -76,12 +76,12 @@ handleGetEntity env
           returnA -< do -- text/x-rakka の場合は、内容が動的に生成され
                         -- てゐる可能性があるので、ETag も
                         -- Last-Modified も返す事が出來ない。
-                        case pageType page of
+                        case entityType page of
                           MIMEType "text" "x-rakka" _
                               -> return ()
-                          _   -> case pageRevision page of
-                                   0   -> foundTimeStamp (pageLastMod page) -- 0 はデフォルトページ
-                                   rev -> foundEntity (strongETag $ show rev) (pageLastMod page)
+                          _   -> case entityRevision page of
+                                   0   -> foundTimeStamp (entityLastMod page) -- 0 はデフォルトページ
+                                   rev -> foundEntity (strongETag $ show rev) (entityLastMod page)
 
                         outputXmlPage tree (entityToXHTML env)
 
@@ -269,7 +269,8 @@ notFoundToXHTML env
 
 
 handlePut :: Environment -> PageName -> Resource ()
-handlePut _env _name
-    = do xml <- input defaultLimit
-         setContentType $ read "text/xml"
-         output xml
+handlePut env name
+    = runXmlA env "rakka-page-1.0.rng" $ proc tree
+    -> do page   <- parseXmlizedPage -< (name, tree)
+          status <- putPageA (envStorage env) -< page
+          returnA  -< setStatus status