Create a stub for TSN.XML.AutoRacingDriverList.

[dead/htsn-import.git] / src / TSN / XML / AutoRacingDriverList.hs

diff --git a/src/TSN/XML/AutoRacingDriverList.hs b/src/TSN/XML/AutoRacingDriverList.hs
new file mode 100644 (file)
index 0000000..d2c8358
--- /dev/null
+++ b/src/TSN/XML/AutoRacingDriverList.hs
@@ -0,0 +1,169 @@
+{-# 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