module Rakka.TrackBack
    ( TrackBack(..)
    )
    where

import           Data.Maybe
import           Data.Time
import           Network.URI
import           Rakka.Attachment
import           Rakka.Utils
import           Rakka.W3CDateTime
import           Text.XML.HXT.Arrow
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 -> listA (getXPathTreesInDoc "/trackbacks/trackback" >>> treeToTb) -< doc
        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
                                }