X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FAutoRacingSchedule.hs;h=69b9b35d4219166c4b33f29fd2f1f4e2ae8106b8;hb=b4a055e1a6a7139fef50dc1f6ff6e8762ea5724e;hp=ab1c29ef01db05be044eabb0055eb91635558039;hpb=a0853ebe00e630b7d50f97949d4dd45c602bd454;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs index ab1c29e..69b9b35 100644 --- a/src/TSN/XML/AutoRacingSchedule.hs +++ b/src/TSN/XML/AutoRacingSchedule.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -29,7 +28,7 @@ import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog ( countAll, - executeRaw, + deleteAll, migrate, runMigration, silentMigrationLogger ) @@ -57,9 +56,10 @@ import Text.XML.HXT.Core ( 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.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp ) import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) import Xml ( + Child(..), FromXml(..), FromXmlFk(..), ToDb(..), @@ -141,7 +141,7 @@ instance XmlImport Message -- * AutoRacingScheduleListing/AutoRacingScheduleListingXml -- | Database representation of a \ contained within a --- \. We combine the race date/time into a single +-- \. We combine the race date/time into a single -- race_time, drop the race results list, and add a foreign key to -- our parent. -- @@ -193,12 +193,15 @@ instance ToDb AutoRacingScheduleListingXml where -- type Db AutoRacingScheduleListingXml = AutoRacingScheduleListing -instance FromXmlFk AutoRacingScheduleListingXml where + +instance Child AutoRacingScheduleListingXml where -- | Each 'AutoRacingScheduleListingXml' is contained in (i.e. has a -- foreign key to) a 'AutoRacingSchedule'. -- type Parent AutoRacingScheduleListingXml = AutoRacingSchedule + +instance FromXmlFk AutoRacingScheduleListingXml where -- | To convert an 'AutoRacingScheduleListingXml' to an -- 'AutoRacingScheduleListing', we add the foreign key and drop -- the 'xml_race_results'. We also mash the date/time together @@ -245,8 +248,7 @@ newtype AutoRacingScheduleListingRaceResult = deriving (Eq, Show) --- * AutoRacingScheduleListingRaceResultRaceResultListing / --- AutoRacingScheduleListingRaceResultRaceResultListingXml +-- * AutoRacingScheduleListingRaceResultRaceResultListing / AutoRacingScheduleListingRaceResultRaceResultListingXml -- -- Sorry about the names yo. -- @@ -264,7 +266,8 @@ data AutoRacingScheduleListingRaceResultRaceResultListing = db_leading_laps :: Int, db_listing_laps :: Int, -- ^ Avoid clash with race's \"laps\" field. db_earnings :: String, -- ^ This should be an Int, but can have commas. - db_status :: String } + db_status :: Maybe String -- ^ They can be empty + } -- | XML Representation of an @@ -278,7 +281,8 @@ data AutoRacingScheduleListingRaceResultRaceResultListingXml = xml_leading_laps :: Int, xml_listing_laps :: Int, -- ^ Avoid clash with race's \"laps\" field. xml_earnings :: String, -- ^ Should be an 'Int', but can have commas. - xml_status :: String } + xml_status :: Maybe String -- ^ They can be empty + } deriving (Eq, Show) @@ -291,7 +295,7 @@ instance ToDb AutoRacingScheduleListingRaceResultRaceResultListingXml where AutoRacingScheduleListingRaceResultRaceResultListing -instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where +instance Child AutoRacingScheduleListingRaceResultRaceResultListingXml where -- | Each 'AutoRacingScheduleListingRaceResultRaceResultListingXml' -- is contained in (i.e. has a foreign key to) an -- 'AutoRacingScheduleListing'. We skip the intermediate @@ -300,6 +304,8 @@ instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where type Parent AutoRacingScheduleListingRaceResultRaceResultListingXml = AutoRacingScheduleListing + +instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where -- | To convert an -- 'AutoRacingScheduleListingRaceResultRaceResultListingXml' to an -- 'AutoRacingScheduleListingRaceResultRaceResultListing', we just @@ -314,7 +320,7 @@ instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where db_leading_laps = xml_leading_laps, db_listing_laps = xml_listing_laps, db_earnings = xml_earnings, - db_status = xml_earnings } + db_status = xml_status } -- | This allows us to insert the XML representation @@ -420,7 +426,7 @@ pickle_listing = xpElem "Listing" $ xpWrap (from_tuple, to_tuple) $ xp10Tuple (xpElem "RaceID" xpInt) - (xpElem "Race_Date" xp_date) + (xpElem "Race_Date" xp_date_padded) (xpElem "Race_Time" xp_tba_time) (xpElem "RaceName" xpText) (xpElem "TrackName" xpText) @@ -470,7 +476,7 @@ pickle_race_results_listing = (xpElem "LeadingLaps" xpInt) (xpElem "Laps" xpInt) (xpElem "Earnings" xpText) - (xpElem "Status" xpText) + (xpElem "Status" (xpOption xpText)) where from_tuple = uncurryN AutoRacingScheduleListingRaceResultRaceResultListingXml @@ -555,8 +561,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" migrate b migrate c _ <- dbimport sched - -- No idea how 'delete' works, so do this instead. - executeRaw False "DELETE FROM auto_racing_schedules;" [] + deleteAll a count_a <- countAll a count_b <- countAll b count_c <- countAll c