-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