X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FPage.hs;h=ec43df852c2d252ab758bfffe0e0e22ecf981c9d;hb=f57c5c5ae6c95e68b11400718e7ce5de4ea1317a;hp=0affbf52f3b700bceb02e38a1770ad0d19165981;hpb=bc8616eec0bcac3102860c76f93ebfd0da24c2d6;p=Rakka.git

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 0affbf5..ec43df8 100644
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -20,6 +20,7 @@ module Rakka.Page
     , mkObjectURI
     , mkFragmentURI
     , mkAuxiliaryURI
+    , mkFeedURI
     , mkRakkaURI
 
     , xmlizePage
@@ -60,6 +61,7 @@ data Page
     = Redirection {
         redirName       :: !PageName
       , redirDest       :: !PageName
+      , redirIsLocked   :: !Bool
       , redirRevision   :: RevNum
       , redirLastMod    :: UTCTime
       , redirUpdateInfo :: Maybe UpdateInfo
@@ -91,8 +93,8 @@ data UpdateInfo
 
 
 isRedirect :: Page -> Bool
-isRedirect (Redirection _ _ _ _ _) = True
-isRedirect _                       = False
+isRedirect (Redirection _ _ _ _ _ _) = True
+isRedirect _                         = False
 
 
 isEntity :: Page -> Bool
@@ -180,6 +182,13 @@ mkAuxiliaryURI baseURI basePath name
       }
 
 
+mkFeedURI :: URI -> PageName -> URI
+mkFeedURI baseURI name
+    = baseURI {
+        uriPath = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".rdf"]
+      }
+
+
 mkRakkaURI :: PageName -> URI
 mkRakkaURI name = URI {
                     uriScheme    = "rakka:"
@@ -239,6 +248,7 @@ xmlizePage
                   += ( eelem "page"
                        += sattr "name"     (redirName page)
                        += sattr "redirect" (redirDest page)
+                       += sattr "isLocked" (yesOrNo $ redirIsLocked page)
                        += sattr "revision" (show $ redirRevision page)
                        += sattr "lastModified" (formatW3CDateTime lastMod)
                      )) -<< ()
@@ -297,11 +307,14 @@ parseXmlizedPage
     = proc (name, tree)
     -> do updateInfo <- maybeA parseUpdateInfo -< tree
           redirect   <- maybeA (getXPathTreesInDoc "/page/@redirect/text()" >>> getText) -< tree
+          isLocked   <- (withDefault (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText) "no"
+                         >>> parseYesOrNo) -< tree
           case redirect of
             Nothing   -> parseEntity -< (name, tree)
             Just dest -> returnA     -< (Redirection {
                                            redirName       = name
                                          , redirDest       = dest
+                                         , redirIsLocked   = isLocked
                                          , redirRevision   = undefined
                                          , redirLastMod    = undefined
                                          , redirUpdateInfo = updateInfo
@@ -340,7 +353,7 @@ parseEntity
           let (isBinary, content)
                   = case (textData, binaryData) of
                       (Just text, Nothing    ) -> (False, L.pack $ UTF8.encode text )
-                      (Nothing  , Just binary) -> (True , L.pack $ B64.decode binary)
+                      (Nothing  , Just binary) -> (True , L.pack $ fromJust $ B64.decode $ dropWhitespace binary)
                       _                        -> error "one of textData or binaryData is required"
               mimeType
                   =  if isBinary then
@@ -366,6 +379,14 @@ parseEntity
                       , entityContent    = content
                       , entityUpdateInfo = updateInfo
                       }
+    where
+      dropWhitespace :: String -> String
+      dropWhitespace [] = []
+      dropWhitespace (x:xs)
+          | x == ' ' || x == '\t' || x == '\n'
+              = dropWhitespace xs
+          | otherwise
+              = x : dropWhitespace xs
 
 
 parseUpdateInfo :: (ArrowXml a, ArrowChoice a) => a XmlTree UpdateInfo