+module Rakka.TrackBack
+ ( TrackBack(..)
+ )
+ where
+
+import Control.Arrow
+import Control.Arrow.ArrowList
+import Control.Arrow.ArrowTree
+import Data.Maybe
+import Data.Time
+import Network.URI
+import Rakka.Attachment
+import Rakka.Utils
+import Rakka.W3CDateTime
+import Text.XML.HXT.Arrow.XmlArrow
+import Text.XML.HXT.Arrow.XmlNodeSet
+import Text.XML.HXT.DOM.TypeDefs
+
+
+data TrackBack
+ = TrackBack {
+ tbTitle :: !(Maybe String)
+ , tbExcerpt :: !(Maybe String)
+ , tbURL :: !URI
+ , tbBlogName :: !(Maybe String)
+ , tbTime :: !UTCTime
+ }
+ deriving (Show, Eq)
+
+
+{-
+ <trackbacks>
+ <trackback title="" url="" blogName="" time="">
+ excerpt...
+ </trackback>
+ ...
+ </trackbacks>
+-}
+instance Attachment [TrackBack] where
+ serializeToXmlTree
+ = proc trackbacks
+ -> ( eelem "/"
+ += ( eelem "trackbacks"
+ += ( arrL id
+ >>>
+ tbToTree
+ )
+ )
+ ) -< trackbacks
+ where
+ tbToTree :: ArrowXml a => a TrackBack XmlTree
+ tbToTree
+ = proc tb
+ -> let title = case tbTitle tb of
+ Nothing -> none
+ Just t -> sattr "title" t
+ excerpt = case tbExcerpt tb of
+ Nothing -> none
+ Just e -> txt e
+ url = sattr "url" (uriToString id (tbURL tb) "")
+ blogName = case tbBlogName tb of
+ Nothing -> none
+ Just n -> sattr "blogName" n
+ time = sattr "time" (formatW3CDateTime $ utcToZonedTime utc (tbTime tb))
+ in
+ ( eelem "trackback"
+ += title
+ += url
+ += blogName
+ += time
+ += excerpt
+ ) -<< ()
+
+ deserializeFromXmlTree
+ = proc doc
+ -> do tree <- getXPathTreesInDoc "/trackbacks/trackback" -< doc
+ tb <- treeToTb -< tree
+ listA this -< tb
+ where
+ treeToTb :: (ArrowChoice a, ArrowXml a) => a XmlTree TrackBack
+ treeToTb
+ = proc tree
+ -> do title <- maybeA (getAttrValue0 "title") -< tree
+ url <- ( getAttrValue0 "url"
+ >>>
+ arr (fromJust . parseURI)
+ ) -< tree
+ time <- ( getAttrValue0 "time"
+ >>>
+ arr (zonedTimeToUTC . fromJust . parseW3CDateTime)
+ ) -< tree
+ blogName <- maybeA (getAttrValue0 "blogName") -< tree
+ excerpt <- maybeA ( getChildren
+ >>>
+ getText
+ ) -< tree
+ returnA -< TrackBack {
+ tbTitle = title
+ , tbExcerpt = excerpt
+ , tbURL = url
+ , tbBlogName = blogName
+ , tbTime = time
+ }
\ No newline at end of file