7 import Control.Arrow.ArrowList
8 import Control.Arrow.ArrowTree
12 import Rakka.Attachment
14 import Rakka.W3CDateTime
15 import Text.XML.HXT.Arrow.XmlArrow
16 import Text.XML.HXT.Arrow.XmlNodeSet
17 import Text.XML.HXT.DOM.TypeDefs
22 tbTitle :: !(Maybe String)
23 , tbExcerpt :: !(Maybe String)
25 , tbBlogName :: !(Maybe String)
33 <trackback title="" url="" blogName="" time="">
39 instance Attachment [TrackBack] where
43 += ( eelem "trackbacks"
51 tbToTree :: ArrowXml a => a TrackBack XmlTree
54 -> let title = case tbTitle tb of
56 Just t -> sattr "title" t
57 excerpt = case tbExcerpt tb of
60 url = sattr "url" (uriToString id (tbURL tb) "")
61 blogName = case tbBlogName tb of
63 Just n -> sattr "blogName" n
64 time = sattr "time" (formatW3CDateTime $ utcToZonedTime utc (tbTime tb))
74 deserializeFromXmlTree
75 = proc doc -> listA (getXPathTreesInDoc "/trackbacks/trackback" >>> treeToTb) -< doc
77 treeToTb :: (ArrowChoice a, ArrowXml a) => a XmlTree TrackBack
80 -> do title <- maybeA (getAttrValue0 "title") -< tree
81 url <- ( getAttrValue0 "url"
83 arr (fromJust . parseURI)
85 time <- ( getAttrValue0 "time"
87 arr (zonedTimeToUTC . fromJust . parseW3CDateTime)
89 blogName <- maybeA (getAttrValue0 "blogName") -< tree
90 excerpt <- maybeA ( getChildren
94 returnA -< TrackBack {
98 , tbBlogName = blogName