- do tree <- readFromDocument [ (a_validate , v_0)
- , (a_check_namespaces , v_1)
- , (a_remove_whitespace, v_1)
- ] -< fpath
- parsePage -< (name, tree)
-
-
-parsePage :: (ArrowXml a, ArrowChoice a) => a (PageName, XmlTree) Page
-parsePage
- = proc (name, tree)
- -> do mimeType <- (getXPathTreesInDoc "/page/@type/text()" >>> getText
- >>> arr read) -< tree
-
- isTheme <- (maybeA (getXPathTreesInDoc "/page/@type/text()" >>> getText)
- >>> defaultTo "no"
- >>> parseYesOrNo) -< tree
- isFeed <- (maybeA (getXPathTreesInDoc "/page/@isFeed/text()" >>> getText)
- >>> defaultTo "no"
- >>> parseYesOrNo) -< tree
- isLocked <- (maybeA (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText)
- >>> defaultTo "no"
- >>> parseYesOrNo) -< tree
- isBoring <- (maybeA (getXPathTreesInDoc "/page/@isBoring/text()" >>> getText)
- >>> defaultTo "no"
- >>> parseYesOrNo) -< tree
-
- summary <- (maybeA (getXPathTreesInDoc "/page/summary/text()"
- >>> getText
- >>> deleteIfEmpty)) -< tree
-
- otherLang <- listA (getXPathTreesInDoc "/page/otherLang/link"
- >>>
- (getAttrValue0 "lang"
- &&&
- getAttrValue0 "page")) -< tree
-
- textData <- maybeA (getXPathTreesInDoc "/page/textData" >>> getText) -< tree
- binaryData <- maybeA (getXPathTreesInDoc "/page/binaryData" >>> getText) -< tree
-
- let content = case (textData, binaryData) of
- (Just text, _ ) -> L8.pack text
- (_ , Just binary) -> L8.pack $ B64.decode binary
-
- returnA -< Page {
- pageName = name
- , pageType = mimeType
- , pageIsTheme = isTheme
- , pageIsFeed = isFeed
- , pageIsLocked = isLocked
- , pageIsBoring = isBoring
- , pageRevision = Nothing
- , pageSummary = summary
- , pageOtherLang = otherLang
- , pageContent = content
- }
\ No newline at end of file
+ do tree <- readFromDocument [ (a_validate , v_0)
+ , (a_check_namespaces , v_1)
+ , (a_remove_whitespace, v_1)
+ ] -< fpath
+ lastMod <- arrIO (\ x -> getFileStatus x
+ >>=
+ return . posixSecondsToUTCTime . fromRational . toRational . modificationTime)
+ -< fpath
+ page <- parseXmlizedPage -< (name, tree)
+
+ if isEntity page then
+ returnA -< page {
+ entityRevision = 0
+ , entityLastMod = lastMod
+ }
+ else
+ returnA -< page {
+ redirRevision = 0
+ , redirLastMod = lastMod
+ }