+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+
+
+-- | Parse TSN XML for the DTD \"AutoRacingDriverList.dtd\". Each
+-- \<message\> element contains a bunch of \<Listing\>s, each of
+-- which describes a driver/car.
+--
+module TSN.XML.AutoRacingDriverList (
+ dtd,
+ pickle_message )
+where
+
+-- System imports.
+import Data.Time ( UTCTime(..) )
+import Database.Groundhog.Core ( DefaultKey )
+import Text.XML.HXT.Core ( PU )
+
+-- Local imports.
+import TSN.DbImport ( DbImport(..) )
+import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
+import Xml (
+ Child(..),
+ FromXml(..),
+ FromXmlFk(..),
+ ToDb(..) )
+
+-- | The DTD to which this module corresponds. Used to invoke dbimport.
+--
+dtd :: String
+dtd = "AutoRacingDriverList.dtd"
+
+--
+-- DB/XML data types
+--
+
+-- * AutoRacingDriverList/Message
+
+-- | Database representation of a 'Message'. Comparatively, it lacks
+-- only the listings.
+--
+data AutoRacingDriverList =
+ AutoRacingDriverList {
+ db_xml_file_id :: Int,
+ db_heading :: String,
+ db_category :: String,
+ db_sport :: String,
+ db_title :: String,
+ db_time_stamp :: UTCTime }
+ deriving (Eq, Show)
+
+
+
+-- | XML Representation of an 'AutoRacingDriverList'. It has the same
+-- fields, but in addition contains the 'xml_listings'.
+--
+data Message =
+ Message {
+ xml_xml_file_id :: Int,
+ xml_heading :: String,
+ xml_category :: String,
+ xml_sport :: String,
+ xml_title :: String,
+ xml_listings :: [AutoRacingDriverListListingXml],
+ xml_time_stamp :: UTCTime }
+ deriving (Eq, Show)
+
+
+instance ToDb Message where
+ -- | The database analogue of a 'Message' is a 'AutoRacingDriverList'.
+ --
+ type Db Message = AutoRacingDriverList
+
+
+-- | The 'FromXml' instance for 'Message' is required for the
+-- 'XmlImport' instance.
+--
+instance FromXml Message where
+ -- | To convert a 'Message' to an 'AutoRacingDriverList', we just drop
+ -- the 'xml_listings'.
+ --
+ from_xml Message{..} =
+ AutoRacingDriverList {
+ db_xml_file_id = xml_xml_file_id,
+ db_heading = xml_heading,
+ db_category = xml_category,
+ db_sport = xml_sport,
+ db_title = xml_title,
+ db_time_stamp = xml_time_stamp }
+
+
+-- | This allows us to insert the XML representation 'Message'
+-- directly.
+--
+instance XmlImport Message
+
+
+-- * AutoRacingDriverListListing / AutoRacingDriverListListingXml
+
+-- | Database representation of a \<Listing\> contained within a
+-- \<message\>.
+--
+data AutoRacingDriverListListing =
+ AutoRacingDriverListListing {
+ db_auto_racing_driver_list_id :: DefaultKey AutoRacingDriverList,
+ db_driver_id :: Int,
+ db_driver :: String,
+ db_height :: Maybe String,
+ db_weight :: Int,
+ db_date_of_birth :: UTCTime,
+ db_hometown :: String,
+ db_nationality :: String,
+ db_car_number :: Int,
+ db_car :: String }
+
+-- | XML representation of a \<Listing\> contained within a
+-- \<message\>.
+--
+data AutoRacingDriverListListingXml =
+ AutoRacingDriverListListingXml {
+ xml_driver_id :: Int,
+ xml_driver :: String,
+ xml_height :: Maybe String,
+ xml_weight :: Int,
+ xml_date_of_birth :: UTCTime,
+ xml_hometown :: String,
+ xml_nationality :: String,
+ xml_car_number :: Int,
+ xml_car :: String }
+ deriving (Eq, Show)
+
+
+instance ToDb AutoRacingDriverListListingXml where
+ -- | The database analogue of an 'AutoRacingDriverListListingXml' is
+ -- an 'AutoRacingDriverListListing'.
+ --
+ type Db AutoRacingDriverListListingXml = AutoRacingDriverListListing
+
+
+instance Child AutoRacingDriverListListingXml where
+ -- | Each 'AutoRacingDriverListListingXml' is contained in (i.e. has a
+ -- foreign key to) a 'AutoRacingDriverList'.
+ --
+ type Parent AutoRacingDriverListListingXml = AutoRacingDriverList
+
+
+instance FromXmlFk AutoRacingDriverListListingXml where
+ -- | To convert an 'AutoRacingDriverListListingXml' to an
+ -- 'AutoRacingDriverListListing', we add the foreign key and copy
+ -- everything else verbatim.
+ --
+ from_xml_fk fk AutoRacingDriverListListingXml{..} =
+ AutoRacingDriverListListing {
+ db_auto_racing_driver_list_id = fk,
+ db_driver_id = xml_driver_id,
+ db_driver = xml_driver,
+ db_height = xml_height,
+ db_weight = xml_weight,
+ db_date_of_birth = xml_date_of_birth,
+ db_hometown = xml_hometown,
+ db_nationality = xml_nationality,
+ db_car_number = xml_car_number,
+ db_car = xml_car }
+
+
+-- | This allows us to insert the XML representation
+-- 'AutoRacingDriverListListingXml' directly.
+--
+instance XmlImportFk AutoRacingDriverListListingXml