Add TSN.XML.AutoRacingResults, unimplemented. Tests currently broken.

diff --git a/htsn-import.cabal b/htsn-import.cabal
index 0a9f2857736f84afa39932bd29812130eefd03ff..b5b151725fe34f315b15595891c86827f2d3be1a 100644 (file)
--- a/htsn-import.cabal
+++ b/htsn-import.cabal
@@ -112,6 +112,7 @@ executable htsn-import
     TSN.Parse
     TSN.Picklers
     TSN.XmlImport
+    TSN.XML.AutoRacingResults
     TSN.XML.AutoRacingSchedule
     TSN.XML.GameInfo
     TSN.XML.Heartbeat

diff --git a/src/Main.hs b/src/Main.hs
index 88d1cfa9898f4b5477ca703376cd0a7d65a508b5..d5f6612611a29f090411e47e1815860f9417dd23 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -45,6 +45,8 @@ import Network.Services.TSN.Report (
   report_info,
   report_error )
 import TSN.DbImport ( DbImport(..), ImportResult(..) )
+import qualified TSN.XML.AutoRacingResults as AutoRacingResults (
+  dtd )
 import qualified TSN.XML.AutoRacingSchedule as AutoRacingSchedule (
   dtd,
   pickle_message )
@@ -161,6 +163,8 @@ import_file cfg path = do
           migrate_and_import m = dbmigrate m >> dbimport m
 
           importer
+            | dtd == AutoRacingResults.dtd = undefined
+
             | dtd == AutoRacingSchedule.dtd = do
                let m = unpickleDoc AutoRacingSchedule.pickle_message xml
                maybe (return $ ImportFailed errmsg) migrate_and_import m

diff --git a/src/TSN/XML/AutoRacingResults.hs b/src/TSN/XML/AutoRacingResults.hs
new file mode 100644 (file)
index 0000000..f8221bb
--- /dev/null
+++ b/src/TSN/XML/AutoRacingResults.hs
@@ -0,0 +1,263 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Parse TSN XML for the DTD \"AutoRacingResultsXML.dtd\".
+--
+module TSN.XML.AutoRacingResults (
+  dtd,
+--  pickle_message,
+  -- * Tests
+--  auto_racing_results_tests,
+  -- * WARNING: these are private but exported to silence warnings
+  AutoRacingResultsConstructor(..),
+  AutoRacingResultsListingConstructor(..) )
+--  AutoRacingResultsRaceInformationConstructor(..) )
+where
+
+-- System imports.
+import Control.Monad ( forM_ )
+import Data.Time ( UTCTime(..) )
+import Data.Tuple.Curry ( uncurryN )
+import Database.Groundhog (
+  countAll,
+  deleteAll,
+  migrate,
+  runMigration,
+  silentMigrationLogger )
+import Database.Groundhog.Core ( DefaultKey )
+import Database.Groundhog.Generic ( runDbConn )
+import Database.Groundhog.Sqlite ( withSqliteConn )
+import Database.Groundhog.TH (
+  groundhog,
+  mkPersist )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Text.XML.HXT.Core (
+  PU,
+  xp7Tuple,
+  xp8Tuple,
+  xp10Tuple,
+  xpElem,
+  xpInt,
+  xpList,
+  xpOption,
+  xpText,
+  xpWrap )
+
+-- Local imports.
+import TSN.Codegen (
+  tsn_codegen_config )
+import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
+import TSN.Picklers ( xp_date, xp_tba_time, xp_time_stamp )
+import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
+import Xml (
+  FromXml(..),
+  FromXmlFk(..),
+  ToDb(..),
+  pickle_unpickle,
+  unpickleable,
+  unsafe_unpickle )
+
+
+-- | The DTD to which this module corresponds. Used to invoke dbimport.
+--
+dtd :: String
+dtd = "AutoRacingResultsXML.dtd"
+
+--
+-- DB/XML data types
+--
+
+-- * AutoRacingResults/Message
+
+-- | Database representation of a 'Message'.
+--
+data AutoRacingResults =
+  AutoRacingResults {
+    db_xml_file_id :: Int,
+    db_heading :: String,
+    db_category :: String,
+    db_sport :: String,
+    db_title :: String,
+    db_race_id :: Int,
+    db_race_date :: UTCTime,
+    db_track_location :: String,
+    db_laps_remaining :: Int,
+    db_checkered_flag :: Bool,
+    db_time_stamp :: UTCTime }
+  deriving (Eq, Show)
+
+
+
+-- | XML Representation of an 'AutoRacingResults'.
+--
+data Message =
+  Message {
+    xml_xml_file_id :: Int,
+    xml_heading :: String,
+    xml_category :: String,
+    xml_sport :: String,
+    xml_title :: String,
+    xml_race_id :: Int,
+    xml_race_date :: UTCTime,
+    xml_track_location :: String,
+    xml_laps_remaining :: Int,
+    xml_checkered_flag :: Bool,
+    xml_listings :: [AutoRacingResultsListingXml],
+--    xml_race_information :: AutoRacingResultsRaceInformation,
+    xml_time_stamp :: UTCTime }
+  deriving (Eq, Show)
+
+
+instance ToDb Message where
+  -- | The database analogue of a 'Message' is a 'AutoRacingResults'.
+  --
+  type Db Message = AutoRacingResults
+
+
+-- | The 'FromXml' instance for 'Message' is required for the
+--   'XmlImport' instance.
+--
+instance FromXml Message where
+  -- | To convert a 'Message' to an 'AutoRacingResults', we just drop
+  --   the 'xml_listings' and 'xml_race_information'.
+  --
+  from_xml Message{..} =
+    AutoRacingResults {
+      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_race_id = xml_race_id,
+      db_race_date = xml_race_date,
+      db_track_location = xml_track_location,
+      db_laps_remaining = xml_laps_remaining,
+      db_checkered_flag = xml_checkered_flag,
+      db_time_stamp = xml_time_stamp }
+
+
+-- | This allows us to insert the XML representation 'Message'
+--   directly.
+--
+instance XmlImport Message
+
+
+-- * AutoRacingResultsListing/AutoRacingResultsListingXml
+
+-- | Database representation of a \<Listing\> contained within a
+--   \<Message\>.
+--
+data AutoRacingResultsListing =
+  AutoRacingResultsListing {
+    db_auto_racing_results_id :: DefaultKey AutoRacingResults,
+    db_finish_position :: Int,
+    db_starting_position :: Int,
+    db_car_number :: Int,
+    db_driver_id :: Int,
+    db_driver :: String,
+    db_car_make :: String,
+    db_points :: Int,
+    db_laps_completed :: Int,
+    db_laps_leading :: Int,
+    db_status :: Int,
+    db_dnf :: Maybe Bool,
+    db_nc :: Maybe Bool,
+    db_earnings :: Maybe Int }
+
+
+-- | XML representation of a \<Listing\> contained within a
+--   \<message\>.
+--
+data AutoRacingResultsListingXml =
+  AutoRacingResultsListingXml {
+    xml_finish_position :: Int,
+    xml_starting_position :: Int,
+    xml_car_number :: Int,
+    xml_driver_id :: Int,
+    xml_driver :: String,
+    xml_car_make :: String,
+    xml_points :: Int,
+    xml_laps_completed :: Int,
+    xml_laps_leading :: Int,
+    xml_status :: Int,
+    xml_dnf :: Maybe Bool,
+    xml_nc :: Maybe Bool,
+    xml_earnings :: Maybe Int }
+  deriving (Eq, Show)
+
+
+instance ToDb AutoRacingResultsListingXml where
+  -- | The database analogue of an 'AutoRacingResultsListingXml' is
+  --   an 'AutoRacingResultsListing'.
+  --
+  type Db AutoRacingResultsListingXml = AutoRacingResultsListing
+
+instance FromXmlFk AutoRacingResultsListingXml where
+  -- | Each 'AutoRacingResultsListingXml' is contained in (i.e. has a
+  --   foreign key to) a 'AutoRacingResults'.
+  --
+  type Parent AutoRacingResultsListingXml = AutoRacingResults
+
+  -- | To convert an 'AutoRacingResultsListingXml' to an
+  --   'AutoRacingResultsListing', we add the foreign key and copy
+  --   everything else verbatim.
+  --
+  from_xml_fk fk AutoRacingResultsListingXml{..} =
+    AutoRacingResultsListing {
+      db_auto_racing_results_id = fk,
+      db_finish_position = xml_finish_position,
+      db_starting_position = xml_starting_position,
+      db_car_number = xml_car_number,
+      db_driver_id = xml_driver_id,
+      db_driver = xml_driver,
+      db_car_make = xml_car_make,
+      db_points = xml_points,
+      db_laps_completed = xml_laps_completed,
+      db_laps_leading = xml_laps_leading,
+      db_status = xml_status,
+      db_dnf = xml_dnf,
+      db_nc = xml_nc,
+      db_earnings = xml_earnings }
+
+
+-- | This allows us to insert the XML representation
+--   'AutoRacingResultsListingXml' directly.
+--
+instance XmlImportFk AutoRacingResultsListingXml
+
+
+
+
+---
+--- Database stuff.
+---
+
+
+mkPersist tsn_codegen_config [groundhog|
+- entity: AutoRacingResults
+  dbName: auto_racing_results
+  constructors:
+    - name: AutoRacingResults
+      uniques:
+        - name: unique_auto_racing_schedule
+          type: constraint
+          # Prevent multiple imports of the same message.
+          fields: [db_xml_file_id]
+
+
+- entity: AutoRacingResultsListing
+  dbName: auto_racing_results_listings
+  constructors:
+    - name: AutoRacingResultsListing
+      fields:
+        - name: db_auto_racing_results_id
+          reference:
+            onDelete: cascade
+|]

diff --git a/test/xml/AutoRacingResultsXML.dtd b/test/xml/AutoRacingResultsXML.dtd
new file mode 100644 (file)
index 0000000..3eba627
--- /dev/null
+++ b/test/xml/AutoRacingResultsXML.dtd
@@ -0,0 +1,41 @@
+<!ELEMENT XML_File_ID (#PCDATA)>
+<!ELEMENT heading (#PCDATA)>
+<!ELEMENT category (#PCDATA)>
+<!ELEMENT sport (#PCDATA)>
+<!ELEMENT RaceID (#PCDATA)>
+<!ELEMENT RaceDate (#PCDATA)>
+<!ELEMENT Title (#PCDATA)>
+<!ELEMENT Track_Location (#PCDATA)>
+<!ELEMENT Laps_Remaining (#PCDATA)>
+<!ELEMENT Checkered_Flag (#PCDATA)>
+<!ELEMENT FinishPosition (#PCDATA)>
+<!ELEMENT StartingPosition (#PCDATA)>
+<!ELEMENT CarNumber (#PCDATA)>
+<!ELEMENT DriverID (#PCDATA)>
+<!ELEMENT Driver (#PCDATA)>
+<!ELEMENT CarMake (#PCDATA)>
+<!ELEMENT Points (#PCDATA)>
+<!ELEMENT Laps_Completed (#PCDATA)>
+<!ELEMENT Laps_Leading (#PCDATA)>
+<!ELEMENT Status (#PCDATA)>
+<!ELEMENT DNF (#PCDATA)>
+<!ELEMENT Earnings (#PCDATA)>
+<!ELEMENT Listing ( FinishPosition, StartingPosition, CarNumber, DriverID, Driver, CarMake, Points, Laps_Completed, Laps_Leading, Status, ( DNF | NC ), Earnings )>
+<!ELEMENT TrackLength (#PCDATA)>
+<!ELEMENT Laps (#PCDATA)>
+<!ELEMENT NumberOfLaps (#PCDATA)>
+<!ELEMENT Most_Laps_Leading ( DriverID, Driver, NumberOfLaps )>
+<!ELEMENT Race_Information ( TrackLength, Laps, AverageSpeedMPH?, AverageSpeedKPH?, AverageSpeed?, TimeOfRace?, MarginOfVictory?, Cautions?, LeadChanges?, LapLeaders?, Most_Laps_Leading )>
+<!ELEMENT time_stamp (#PCDATA)>
+<!ELEMENT message ( ( XML_File_ID, heading, category, sport, RaceID, RaceDate, Title, Track_Location, Laps_Remaining, Checkered_Flag, Listing*, Race_Information, time_stamp ) )>
+<!ELEMENT AverageSpeedMPH (#PCDATA)>
+<!ELEMENT AverageSpeedKPH (#PCDATA)>
+<!ELEMENT AverageSpeed (#PCDATA)>
+<!ELEMENT TimeOfRace (#PCDATA)>
+<!ELEMENT MarginOfVictory (#PCDATA)>
+<!ELEMENT Cautions (#PCDATA)>
+<!ELEMENT LeadChanges (#PCDATA)>
+<!ELEMENT LapLeaders (#PCDATA)>
+<!ELEMENT NC (#PCDATA)>
+
+<!ATTLIST TrackLength KPH CDATA #REQUIRED>

diff --git a/test/xml/AutoRacingResultsXML.xml b/test/xml/AutoRacingResultsXML.xml
new file mode 100644 (file)
index 0000000..0046b44
--- /dev/null
+++ b/test/xml/AutoRacingResultsXML.xml
@@ -0,0 +1 @@
+<?xml version="1.0" standalone="no" ?>\r<!DOCTYPE message PUBLIC "-//TSN//DTD Leader 1.0/EN" "AutoRacingResultsXML.dtd">\r<message>\r<XML_File_ID>21162271</XML_File_ID>\r<heading>ASX%BUSCH-FINAL-RESULTS</heading>\r<category>Statistics</category>\r<sport>NASCAR-B</sport>\r<RaceID>1716</RaceID>\r<RaceDate>5/24/2014 2:45:00 PM</RaceDate>\r<Title>NASCAR - Nationwide - History 300 - Final Results</Title>\r<Track_Location>Charlotte Motor Speedway - Concord, NC</Track_Location>\r<Laps_Remaining>80</Laps_Remaining>\r<Checkered_Flag>False</Checkered_Flag>\r<Listing>\r<FinishPosition>1</FinishPosition>\r<StartingPosition>3</StartingPosition>\r<CarNumber>42</CarNumber>\r<DriverID>965</DriverID>\r<Driver>Kyle Larson</Driver>\r<CarMake>Chevrolet</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>2</FinishPosition>\r<StartingPosition>2</StartingPosition>\r<CarNumber>22</CarNumber>\r<DriverID>433</DriverID>\r<Driver>Brad Keselowski</Driver>\r<CarMake>Ford</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>3</FinishPosition>\r<StartingPosition>6</StartingPosition>\r<CarNumber>2</CarNumber>\r<DriverID>1269</DriverID>\r<Driver>Brian Scott</Driver>\r<CarMake>Chevrolet</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>4</FinishPosition>\r<StartingPosition>5</StartingPosition>\r<CarNumber>5</CarNumber>\r<DriverID>25</DriverID>\r<Driver>Kevin Harvick</Driver>\r<CarMake>Chevrolet</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>5</FinishPosition>\r<StartingPosition>7</StartingPosition>\r<CarNumber>20</CarNumber>\r<DriverID>28</DriverID>\r<Driver>Matt Kenseth</Driver>\r<CarMake>Toyota</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>6</FinishPosition>\r<StartingPosition>1</StartingPosition>\r<CarNumber>54</CarNumber>\r<DriverID>304</DriverID>\r<Driver>Kyle Busch</Driver>\r<CarMake>Toyota</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>7</FinishPosition>\r<StartingPosition>8</StartingPosition>\r<CarNumber>7</CarNumber>\r<DriverID>207</DriverID>\r<Driver>Regan Smith</Driver>\r<CarMake>Chevrolet</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>8</FinishPosition>\r<StartingPosition>16</StartingPosition>\r<CarNumber>6</CarNumber>\r<DriverID>1343</DriverID>\r<Driver>Trevor Bayne</Driver>\r<CarMake>Ford</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>9</FinishPosition>\r<StartingPosition>13</StartingPosition>\r<CarNumber>60</CarNumber>\r<DriverID>653</DriverID>\r<Driver>Chris Buescher</Driver>\r<CarMake>Ford</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Listing>\r<FinishPosition>10</FinishPosition>\r<StartingPosition>11</StartingPosition>\r<CarNumber>3</CarNumber>\r<DriverID>1061</DriverID>\r<Driver>Ty Dillon</Driver>\r<CarMake>Chevrolet</CarMake>\r<Points>0</Points>\r<Laps_Completed>120</Laps_Completed>\r<Laps_Leading>0</Laps_Leading>\r<Status></Status>\r<DNF>False</DNF>\r<Earnings>TBA</Earnings>\r</Listing>\r<Race_Information>\r<TrackLength KPH="2.414">1.5</TrackLength>\r<Laps>200</Laps>\r<Most_Laps_Leading>\r<DriverID>965</DriverID>\r<Driver>Kyle Larson</Driver>\r<NumberOfLaps>0</NumberOfLaps>\r</Most_Laps_Leading>\r</Race_Information>\r<time_stamp> May 24, 2014, at 04:18 PM ET </time_stamp>\r</message>\r
\ No newline at end of file