9 import Rakka.Attachment
11 import Rakka.W3CDateTime
12 import Text.XML.HXT.Arrow
13 import Text.XML.HXT.DOM.TypeDefs
18 tbTitle :: !(Maybe String)
19 , tbExcerpt :: !(Maybe String)
21 , tbBlogName :: !(Maybe String)
29 <trackback title="" url="" blogName="" time="">
35 instance Attachment [TrackBack] where
39 += ( eelem "trackbacks"
47 tbToTree :: ArrowXml a => a TrackBack XmlTree
50 -> let title = case tbTitle tb of
52 Just t -> sattr "title" t
53 excerpt = case tbExcerpt tb of
56 url = sattr "url" (uriToString id (tbURL tb) "")
57 blogName = case tbBlogName tb of
59 Just n -> sattr "blogName" n
60 time = sattr "time" (formatW3CDateTime $ utcToZonedTime utc (tbTime tb))
70 deserializeFromXmlTree
71 = proc doc -> listA (getXPathTreesInDoc "/trackbacks/trackback" >>> treeToTb) -< doc
73 treeToTb :: (ArrowChoice a, ArrowXml a) => a XmlTree TrackBack
76 -> do title <- maybeA (getAttrValue0 "title") -< tree
77 url <- ( getAttrValue0 "url"
79 arr (fromJust . parseURI)
81 time <- ( getAttrValue0 "time"
83 arr (zonedTimeToUTC . fromJust . parseW3CDateTime)
85 blogName <- maybeA (getAttrValue0 "blogName") -< tree
86 excerpt <- maybeA ( getChildren
90 returnA -< TrackBack {
94 , tbBlogName = blogName