src/TSN/XML/AutoRacingDriverList.hs

   1 {-# LANGUAGE RecordWildCards #-}
   2 {-# LANGUAGE TypeFamilies #-}
   3
   4
   5 -- | Parse TSN XML for the DTD \"AutoRacingDriverList.dtd\". Each
   6 --   \<message\> element contains a bunch of \<Listing\>s, each of
   7 --   which describes a driver/car.
   8 --
   9 module TSN.XML.AutoRacingDriverList (
  10   dtd,
  11   pickle_message )
  12 where
  13
  14 -- System imports.
  15 import Data.Time ( UTCTime(..) )
  16 import Database.Groundhog.Core ( DefaultKey )
  17 import Text.XML.HXT.Core ( PU )
  18
  19 -- Local imports.
  20 import TSN.DbImport ( DbImport(..) )
  21 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
  22 import Xml (
  23   Child(..),
  24   FromXml(..),
  25   FromXmlFk(..),
  26   ToDb(..) )
  27
  28 -- | The DTD to which this module corresponds. Used to invoke dbimport.
  29 --
  30 dtd :: String
  31 dtd = "AutoRacingDriverList.dtd"
  32
  33 --
  34 -- DB/XML data types
  35 --
  36
  37 -- * AutoRacingDriverList/Message
  38
  39 -- | Database representation of a 'Message'. Comparatively, it lacks
  40 --   only the listings.
  41 --
  42 data AutoRacingDriverList =
  43   AutoRacingDriverList {
  44     db_xml_file_id :: Int,
  45     db_heading :: String,
  46     db_category :: String,
  47     db_sport :: String,
  48     db_title :: String,
  49     db_time_stamp :: UTCTime }
  50   deriving (Eq, Show)
  51
  52
  53
  54 -- | XML Representation of an 'AutoRacingDriverList'. It has the same
  55 --   fields, but in addition contains the 'xml_listings'.
  56 --
  57 data Message =
  58   Message {
  59     xml_xml_file_id :: Int,
  60     xml_heading :: String,
  61     xml_category :: String,
  62     xml_sport :: String,
  63     xml_title :: String,
  64     xml_listings :: [AutoRacingDriverListListingXml],
  65     xml_time_stamp :: UTCTime }
  66   deriving (Eq, Show)
  67
  68
  69 instance ToDb Message where
  70   -- | The database analogue of a 'Message' is a 'AutoRacingDriverList'.
  71   --
  72   type Db Message = AutoRacingDriverList
  73
  74
  75 -- | The 'FromXml' instance for 'Message' is required for the
  76 --   'XmlImport' instance.
  77 --
  78 instance FromXml Message where
  79   -- | To convert a 'Message' to an 'AutoRacingDriverList', we just drop
  80   --   the 'xml_listings'.
  81   --
  82   from_xml Message{..} =
  83     AutoRacingDriverList {
  84       db_xml_file_id = xml_xml_file_id,
  85       db_heading = xml_heading,
  86       db_category = xml_category,
  87       db_sport = xml_sport,
  88       db_title = xml_title,
  89       db_time_stamp = xml_time_stamp }
  90
  91
  92 -- | This allows us to insert the XML representation 'Message'
  93 --   directly.
  94 --
  95 instance XmlImport Message
  96
  97
  98 -- * AutoRacingDriverListListing / AutoRacingDriverListListingXml
  99
 100 -- | Database representation of a \<Listing\> contained within a
 101 --   \<message\>.
 102 --
 103 data AutoRacingDriverListListing =
 104   AutoRacingDriverListListing {
 105     db_auto_racing_driver_list_id :: DefaultKey AutoRacingDriverList,
 106     db_driver_id :: Int,
 107     db_driver :: String,
 108     db_height :: Maybe String,
 109     db_weight :: Int,
 110     db_date_of_birth :: UTCTime,
 111     db_hometown :: String,
 112     db_nationality :: String,
 113     db_car_number :: Int,
 114     db_car :: String }
 115
 116 -- | XML representation of a \<Listing\> contained within a
 117 --   \<message\>.
 118 --
 119 data AutoRacingDriverListListingXml =
 120   AutoRacingDriverListListingXml {
 121     xml_driver_id :: Int,
 122     xml_driver :: String,
 123     xml_height :: Maybe String,
 124     xml_weight :: Int,
 125     xml_date_of_birth :: UTCTime,
 126     xml_hometown :: String,
 127     xml_nationality :: String,
 128     xml_car_number :: Int,
 129     xml_car :: String }
 130   deriving (Eq, Show)
 131
 132
 133 instance ToDb AutoRacingDriverListListingXml where
 134   -- | The database analogue of an 'AutoRacingDriverListListingXml' is
 135   --   an 'AutoRacingDriverListListing'.
 136   --
 137   type Db AutoRacingDriverListListingXml = AutoRacingDriverListListing
 138
 139
 140 instance Child AutoRacingDriverListListingXml where
 141   -- | Each 'AutoRacingDriverListListingXml' is contained in (i.e. has a
 142   --   foreign key to) a 'AutoRacingDriverList'.
 143   --
 144   type Parent AutoRacingDriverListListingXml = AutoRacingDriverList
 145
 146
 147 instance FromXmlFk AutoRacingDriverListListingXml where
 148   -- | To convert an 'AutoRacingDriverListListingXml' to an
 149   --   'AutoRacingDriverListListing', we add the foreign key and copy
 150   --   everything else verbatim.
 151   --
 152   from_xml_fk fk AutoRacingDriverListListingXml{..} =
 153     AutoRacingDriverListListing {
 154       db_auto_racing_driver_list_id = fk,
 155       db_driver_id = xml_driver_id,
 156       db_driver = xml_driver,
 157       db_height = xml_height,
 158       db_weight = xml_weight,
 159       db_date_of_birth = xml_date_of_birth,
 160       db_hometown = xml_hometown,
 161       db_nationality = xml_nationality,
 162       db_car_number = xml_car_number,
 163       db_car = xml_car }
 164
 165
 166 -- | This allows us to insert the XML representation
 167 --   'AutoRacingDriverListListingXml' directly.
 168 --
 169 instance XmlImportFk AutoRacingDriverListListingXml