more improvements related to redirection

[Rakka.git] / Rakka / Storage / Repos.hs

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 0b53568b4290e9b0d433d71a291fbf1fec9b35d1..f8ac5ddcea7e9a3c587a5477a5c2c6762b936487 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -6,6 +6,7 @@ module Rakka.Storage.Repos
     )
     where
 
+import           Codec.Binary.UTF8.String
 import           Control.Exception
 import           Control.Monad
 import           Data.List
@@ -101,12 +102,12 @@ loadPageInRepository repos name rev
       path = mkPagePath name
 
       loadPage' :: Rev Page
-      loadPage' = do redirect <- getNodeProp path "rakka:redirect"
-                     case redirect of
-                       Nothing
-                           -> loadPageEntity
-                       Just _
+      loadPage' = do mType <- liftM (fmap (read . chomp)) (getNodeProp path "svn:mime-type")
+                     case mType of
+                       Just (MIMEType "application" "x-rakka-redirection" _)
                            -> loadPageRedirect
+                       _
+                           -> loadPageEntity
 
       loadPageEntity :: Rev Page
       loadPageEntity
@@ -148,7 +149,23 @@ loadPageInRepository repos name rev
                           }
       
       loadPageRedirect :: Rev Page
-      loadPageRedirect = fail "FIXME: loadPageRedirect: not implemented"
+      loadPageRedirect
+          = do hist    <- getNodeHistory True path
+               content <- getFileContents path
+
+               let pageRev = fst $ head hist
+                   dest    = chomp $ decodeString content
+
+               lastMod <- getRevisionProp "svn:date"
+                          >>= return . fromJust . parseW3CDateTime . chomp . fromJust
+
+               return Redirection {
+                            redirName       = name
+                          , redirDest       = dest
+                          , redirRevision   = pageRev
+                          , redirLastMod    = zonedTimeToUTC lastMod
+                          , redirUpdateInfo = undefined
+                          }
 
 
 putPageIntoRepository :: Repository -> Page -> IO StatusCode
@@ -207,7 +224,18 @@ putPageIntoRepository repos page
 
       updatePageRedirect :: PageName -> Txn ()
       updatePageRedirect name
-          = fail "FIXME: updatePageRedirect: not implemented yet"
+          = do let path = mkPagePath name
+               setNodeProp path "svn:mime-type"   (Just "application/x-rakka-redirection")
+               setNodeProp path "rakka:lang"      Nothing
+               setNodeProp path "rakka:fileName"  Nothing
+               setNodeProp path "rakka:isTheme"   Nothing
+               setNodeProp path "rakka:isFeed"    Nothing
+               setNodeProp path "rakka:isLocked"  Nothing
+               setNodeProp path "rakka:isBoring"  Nothing
+               setNodeProp path "rakka:isBinary"  Nothing
+               setNodeProp path "rakka:summary"   Nothing
+               setNodeProp path "rakka:otherLang" Nothing
+               applyText path Nothing (encodeString (redirDest page) ++ "\n")
 
       updatePageEntity :: PageName -> Txn ()
       updatePageEntity name
@@ -230,7 +258,7 @@ putPageIntoRepository repos page
                applyTextLBS path Nothing (entityContent page)
 
       encodeFlag :: Bool -> Maybe String
-      encodeFlag True  = Just "*\n"
+      encodeFlag True  = Just "*"
       encodeFlag False = Nothing