X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FPage.hs;h=16835d5aafd79e247d227e557e93d77eb267e0ea;hb=0447be1b59496ca4266226ed52d264009cf41899;hp=9883b576f9be232abb5a715735c5c9109c004d6a;hpb=bf15724655b75bf1b8f0fdabb111c158a91680a8;p=Rakka.git diff --git a/Rakka/Page.hs b/Rakka/Page.hs index 9883b57..16835d5 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -60,6 +60,7 @@ data Page = Redirection { redirName :: !PageName , redirDest :: !PageName + , redirIsLocked :: !Bool , redirRevision :: RevNum , redirLastMod :: UTCTime , redirUpdateInfo :: Maybe UpdateInfo @@ -71,7 +72,6 @@ data Page , entityIsTheme :: !Bool -- text/css 以外では無意味 , entityIsFeed :: !Bool -- text/x-rakka 以外では無意味 , entityIsLocked :: !Bool - , entityIsBoring :: !Bool , entityIsBinary :: !Bool , entityRevision :: RevNum , entityLastMod :: UTCTime @@ -92,13 +92,13 @@ data UpdateInfo isRedirect :: Page -> Bool -isRedirect (Redirection _ _ _ _ _) = True -isRedirect _ = False +isRedirect (Redirection _ _ _ _ _ _) = True +isRedirect _ = False isEntity :: Page -> Bool -isEntity (Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _) = True -isEntity _ = False +isEntity (Entity _ _ _ _ _ _ _ _ _ _ _ _ _) = True +isEntity _ = False pageName :: Page -> PageName @@ -265,7 +265,6 @@ xmlizePage -> none ) += sattr "isLocked" (yesOrNo $ entityIsLocked page) - += sattr "isBoring" (yesOrNo $ entityIsBoring page) += sattr "isBinary" (yesOrNo $ entityIsBinary page) += sattr "revision" (show $ entityRevision page) += sattr "lastModified" (formatW3CDateTime lastMod) @@ -299,11 +298,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 @@ -325,8 +327,6 @@ parseEntity >>> parseYesOrNo) -< tree isLocked <- (withDefault (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText) "no" >>> parseYesOrNo) -< tree - isBoring <- (withDefault (getXPathTreesInDoc "/page/@isBoring/text()" >>> getText) "no" - >>> parseYesOrNo) -< tree summary <- (maybeA (getXPathTreesInDoc "/page/summary/text()" >>> getText @@ -362,7 +362,6 @@ parseEntity , entityIsTheme = isTheme , entityIsFeed = isFeed , entityIsLocked = isLocked - , entityIsBoring = isBoring , entityIsBinary = isBinary , entityRevision = undefined , entityLastMod = undefined @@ -376,9 +375,9 @@ parseEntity parseUpdateInfo :: (ArrowXml a, ArrowChoice a) => a XmlTree UpdateInfo parseUpdateInfo = proc tree - -> do uInfo <- getXPathTreesInDoc "/*/updateInfo" -< tree + -> do uInfo <- getXPathTreesInDoc "/page/updateInfo" -< tree oldRev <- (getAttrValue0 "oldRevision" >>> arr read) -< uInfo - oldName <- maybeA (getXPathTrees "/move/@from/text()" >>> getText) -< uInfo + oldName <- maybeA (getXPathTrees "/updateInfo/move/@from/text()" >>> getText) -< uInfo returnA -< UpdateInfo { uiOldRevision = oldRev , uiOldName = oldName