From: Michael Orlitzky Date: Fri, 24 Jan 2014 04:35:39 +0000 (-0500) Subject: Document the new TSN.XML.AutoRacingSchedule module. X-Git-Tag: 0.0.4~15 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=d2f5d93b2b68f581d4cb4eabecc556c01762d370;p=dead%2Fhtsn-import.git Document the new TSN.XML.AutoRacingSchedule module. --- diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs index 62202dd..27b73ef 100644 --- a/src/TSN/XML/AutoRacingSchedule.hs +++ b/src/TSN/XML/AutoRacingSchedule.hs @@ -101,10 +101,20 @@ data Message = xml_time_stamp :: UTCTime } deriving (Eq, Show) + instance ToDb Message where + -- | The database analogue of a 'Message' is a 'AutoRacingSchedule'. + -- type Db Message = AutoRacingSchedule + +-- | The 'FromXml' instance for 'Message' is required for the +-- 'XmlImport' instance. +-- instance FromXml Message where + -- | To convert a 'Message' to an 'AutoRacingSchedule', we just drop + -- the 'xml_listings'. + -- from_xml Message{..} = AutoRacingSchedule { db_xml_file_id = xml_xml_file_id, @@ -115,6 +125,10 @@ instance FromXml Message where db_complete_through = xml_complete_through, db_time_stamp = xml_time_stamp } + +-- | This allows us to insert the XML representation 'Message' +-- directly. +-- instance XmlImport Message @@ -124,6 +138,7 @@ instance XmlImport Message -- \. We combine the race date/time into a single -- race_time, drop the race results list, and add a foreign key to -- our parent. +-- data AutoRacingScheduleListing = AutoRacingScheduleListing { db_auto_racing_schedules_id :: DefaultKey AutoRacingSchedule, @@ -137,6 +152,7 @@ data AutoRacingScheduleListing = db_track_length :: String -- ^ Sometimes the word "miles" shows up. } + -- | XML representation of a \ contained within a -- \. -- @@ -150,23 +166,38 @@ data AutoRacingScheduleListingXml = xml_location :: String, xml_tv_listing :: Maybe String, xml_laps :: Int, - xml_track_length :: String, -- ^ Sometimes the word \"miles\" shows up. + xml_track_length :: String, -- ^ Sometimes the word \"miles\" shows up, + -- so we can't do the right thing and use + -- a 'Double'. xml_race_results :: [AutoRacingScheduleListingRaceResult] } deriving (Eq, Show) + -- | Pseudo-accessor to get the race result listings out of a --- 'AutoRacingScheduleListingXml'. +-- 'AutoRacingScheduleListingXml'. A poor man's lens. +-- result_listings :: AutoRacingScheduleListingXml -> [AutoRacingScheduleListingRaceResultRaceResultListingXml] result_listings = (concatMap xml_race_result_listing) . xml_race_results instance ToDb AutoRacingScheduleListingXml where + -- | The database analogue of an 'AutoRacingScheduleListingXml' is + -- an 'AutoRacingScheduleListing'. + -- type Db AutoRacingScheduleListingXml = AutoRacingScheduleListing instance FromXmlFk AutoRacingScheduleListingXml where + -- | Each 'AutoRacingScheduleListingXml' is contained in (i.e. has a + -- foreign key to) a 'AutoRacingSchedule'. + -- type Parent AutoRacingScheduleListingXml = AutoRacingSchedule + -- | 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 + -- into one field. + -- from_xml_fk fk AutoRacingScheduleListingXml{..} = AutoRacingScheduleListing { db_auto_racing_schedules_id = fk, @@ -179,12 +210,21 @@ instance FromXmlFk AutoRacingScheduleListingXml where db_laps = xml_laps, db_track_length = xml_track_length } where - -- Take the day part from one, the time from the other. + -- | Make the database \"race time\" from the XML + -- date/time. Simply take the day part from one and the time + -- from the other. + -- make_race_time d Nothing = d make_race_time d (Just t) = UTCTime (utctDay d) (utctDayTime t) + +-- | This allows us to insert the XML representation +-- 'AutoRacingScheduleListingXml' directly. +-- instance XmlImportFk AutoRacingScheduleListingXml + + -- * AutoRacingScheduleListingRaceResult -- | The XML representation of \ -> \ -> @@ -198,9 +238,16 @@ newtype AutoRacingScheduleListingRaceResult = [AutoRacingScheduleListingRaceResultRaceResultListingXml] } deriving (Eq, Show) + -- * AutoRacingScheduleListingRaceResultRaceResultListing / -- AutoRacingScheduleListingRaceResultRaceResultListingXml +-- +-- Sorry about the names yo. +-- +-- | Database representation of \ within +-- \ within \ within... \! +-- data AutoRacingScheduleListingRaceResultRaceResultListing = AutoRacingScheduleListingRaceResultRaceResultListing { db_auto_racing_schedules_listings_id :: @@ -209,29 +256,49 @@ data AutoRacingScheduleListingRaceResultRaceResultListing = db_driver_id :: Int, db_name :: String, db_leading_laps :: Int, - db_listing_laps :: Int, -- Avoid clash with race's "laps" field. - db_earnings :: String, -- Should be an int, but they use commas. + 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 } + +-- | XML Representation of an +-- 'AutoRacingScheduleListingRaceResultRaceResultListing'. +-- data AutoRacingScheduleListingRaceResultRaceResultListingXml = AutoRacingScheduleListingRaceResultRaceResultListingXml { xml_finish_position :: Int, xml_driver_id :: Int, xml_name :: String, xml_leading_laps :: Int, - xml_listing_laps :: Int, -- Avoid clash with race's "laps" field. - xml_earnings :: String, -- Should be an int, but they use commas. + 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 } deriving (Eq, Show) + instance ToDb AutoRacingScheduleListingRaceResultRaceResultListingXml where + -- | The database representation of an + -- 'AutoRacingScheduleListingRaceResultRaceResultListingXml' is an + -- 'AutoRacingScheduleListingRaceResultRaceResultListing'. + -- type Db AutoRacingScheduleListingRaceResultRaceResultListingXml = AutoRacingScheduleListingRaceResultRaceResultListing + instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where + -- | Each 'AutoRacingScheduleListingRaceResultRaceResultListingXml' + -- is contained in (i.e. has a foreign key to) an + -- 'AutoRacingScheduleListing'. We skip the intermediate + -- \. + -- type Parent AutoRacingScheduleListingRaceResultRaceResultListingXml = AutoRacingScheduleListing + -- | To convert an + -- 'AutoRacingScheduleListingRaceResultRaceResultListingXml' to an + -- 'AutoRacingScheduleListingRaceResultRaceResultListing', we just + -- add the foreign key to the parent 'AutoRacingScheduleListing'. + -- from_xml_fk fk AutoRacingScheduleListingRaceResultRaceResultListingXml{..} = AutoRacingScheduleListingRaceResultRaceResultListing { db_auto_racing_schedules_listings_id = fk, @@ -243,8 +310,14 @@ instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where db_earnings = xml_earnings, db_status = xml_earnings } + +-- | This allows us to insert the XML representation +-- 'AutoRacingScheduleListingRaceResultRaceResultListingXml' +-- directly. +-- instance XmlImportFk AutoRacingScheduleListingRaceResultRaceResultListingXml + --- --- Database stuff. --- @@ -257,6 +330,10 @@ instance DbImport Message where migrate (undefined :: AutoRacingScheduleListingRaceResultRaceResultListing) + + -- | We insert the message, then use its ID to insert the listings, + -- using their IDs to insert the race result listings. + -- dbimport m = do msg_id <- insert_xml m @@ -330,6 +407,8 @@ pickle_message = xml_time_stamp m) +-- | Convert an 'AutoRacingScheduleListingXml' to/from XML. +-- pickle_listing :: PU AutoRacingScheduleListingXml pickle_listing = xpElem "Listing" $ @@ -357,6 +436,9 @@ pickle_listing = xml_track_length m, xml_race_results m) + +-- | Convert an 'AutoRacingScheduleListingRaceResult' to/from XML. +-- pickle_race_results :: PU AutoRacingScheduleListingRaceResult pickle_race_results = xpElem "RaceResults" $ @@ -366,6 +448,11 @@ pickle_race_results = to_result = AutoRacingScheduleListingRaceResult from_result = xml_race_result_listing + +-- | Convert an +-- 'AutoRacingScheduleListingRaceResultRaceResultListingXml' to/from +-- XML. +-- pickle_race_results_listing :: PU AutoRacingScheduleListingRaceResultRaceResultListingXml pickle_race_results_listing =