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

-- | Parse TSN XML for the DTD "injuriesxml.dtd". Each document
--   contains a root element \<message\> that in turn contains zero or
--   more \<listing\>s.
--
--   The listings will be mapped to a database table called "injuries"
--   automatically. The root message is not retained.
--
module TSN.Injuries (
  Listing,
  Message( listings ) )
where

import Data.Tuple.Curry ( uncurryN )
import Database.Groundhog()
import Database.Groundhog.TH
import Text.XML.HXT.Core (
  PU,
  XmlPickler(..),
  xp4Tuple,
  xp6Tuple,
  xpElem,
  xpList,
  xpPrim,
  xpText,
  xpWrap )


data Listing =
  Listing {
    team :: String,
    teamno :: Int,
    injuries :: String,
    updated :: Bool }
  deriving (Show)

data Message =
  Message {
    xml_file_id :: Int,
    heading :: String,
    category :: String,
    sport :: String,
    listings :: [Listing],
    time_stamp :: String }
  deriving (Show)


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


pickle_listing :: PU Listing
pickle_listing =
  xpElem "listing" $
    xpWrap (from_tuple, to_tuple) $
    xp4Tuple (xpElem "team" xpText)
             (xpElem "teamno" xpPrim)
             (xpElem "injuries" xpText)
             (xpElem "updated" xpPrim)
  where
    from_tuple = uncurryN Listing
    to_tuple l = (team l, teamno l, injuries l, updated l)

instance XmlPickler Listing where
  xpickle = pickle_listing


pickle_message :: PU Message
pickle_message =
  xpElem "message" $
    xpWrap (from_tuple, to_tuple) $
    xp6Tuple (xpElem "XML_File_ID" xpPrim)
             (xpElem "heading" xpText)
             (xpElem "category" xpText)
             (xpElem "sport" xpText)
             (xpList pickle_listing)
             (xpElem "time_stamp" xpText)
  where
    from_tuple = uncurryN Message
    to_tuple m = (xml_file_id m,
                  heading m,
                  category m,
                  sport m,
                  listings m,
                  time_stamp m)

instance XmlPickler Message where
  xpickle = pickle_message