{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

-- | Parse TSN XML for the DTD "newsxml.dtd". Each document contains a
--   root element \<message\> that contains an entire news item.
--
module TSN.News (
  Message,
  news_tests )
where

import Data.Tuple.Curry ( uncurryN )
import Database.Groundhog()
import Database.Groundhog.TH
import Test.Tasty ( TestTree, testGroup )
import Test.Tasty.HUnit ( (@?=), testCase )
import Text.XML.HXT.Core (
  PU,
  XmlPickler(..),
  xp12Tuple,
  xpAttr,
  xpElem,
  xpList,
  xpPair,
  xpPrim,
  xpText,
  xpText0,
  xpTriple,
  xpWrap )


import Xml ( pickle_unpickle )


data MsgId =
  MsgId {
    msg_id_text   :: Int,
    event_id :: String }
  deriving (Eq, Show)

data Location =
  Location {
    city :: String,
    state :: String,
    country :: String }
  deriving (Eq, Show)

data Message =
  Message {
    xml_file_id :: Int,
    msg_id :: MsgId,
    heading :: String,
    category :: String,
    sport :: String,
    url :: String,
    teams :: [String],
    location :: Location,
    sms :: String,
    text :: String,
    continue :: String,
    time_stamp :: String }
  deriving (Eq, Show)


-- mkPersist defaultCodegenConfig [groundhog|
-- - entity: Message
--   dbName: injuries
-- |]


pickle_msg_id :: PU MsgId
pickle_msg_id =
  xpElem "msg_id" $
    xpWrap (from_tuple, to_tuple) $
    xpPair xpPrim (xpAttr "EventId" xpText0)
  where
    from_tuple = uncurryN MsgId
    to_tuple m = (msg_id_text m, event_id m)

instance XmlPickler MsgId where
  xpickle = pickle_msg_id

pickle_location :: PU Location
pickle_location =
  xpElem "listing" $
    xpWrap (from_tuple, to_tuple) $
    xpTriple (xpElem "city" xpText)
             (xpElem "state" xpPrim)
             (xpElem "location" xpText)
  where
    from_tuple = uncurryN Location
    to_tuple l = (city l, state l, country l)

instance XmlPickler Location where
  xpickle = pickle_location


pickle_message :: PU Message
pickle_message =
  xpElem "message" $
    xpWrap (from_tuple, to_tuple) $
    xp12Tuple (xpElem "XML_File_ID" xpPrim)
              pickle_msg_id
              (xpElem "heading" xpText)
              (xpElem "category" xpText)
              (xpElem "sport" xpText)
              (xpElem "url" xpText)
              (xpList $ xpElem "team" xpText)
              (pickle_location)
              (xpElem "sms" xpText)
              (xpElem "text" xpText)
              (xpElem "continue" xpText)
              (xpElem "time_stamp" xpText)
  where
    from_tuple = uncurryN Message
    to_tuple m = (xml_file_id m,
                  msg_id m,
                  heading m,
                  category m,
                  sport m,
                  url m,
                  teams m,
                  location m,
                  sms m,
                  text m,
                  continue m,
                  time_stamp m)

instance XmlPickler Message where
  xpickle = pickle_message



-- * Tasty Tests
news_tests :: TestTree
news_tests =
  testGroup
    "News tests"
    [ test_pickle_of_unpickle_is_identity ]


test_pickle_of_unpickle_is_identity :: TestTree
test_pickle_of_unpickle_is_identity =
  testCase "pickle composed with unpickle is the identity" $ do
    let path = "test/xml/newsxml.xml"
    (expected :: [Message], actual) <- pickle_unpickle "message" path
    actual @?= expected