)
where
+import Codec.Binary.UTF8.String
import Control.Exception
import Control.Monad
import Data.List
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
}
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
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
applyTextLBS path Nothing (entityContent page)
encodeFlag :: Bool -> Maybe String
- encodeFlag True = Just "*\n"
+ encodeFlag True = Just "*"
encodeFlag False = Nothing