X-Git-Url: https://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FAutoRacingSchedule.hs;h=39cfeb9e111b9e7a8c5b51b4f5c8ebde64bacfd9;hb=6429dcd2920c497c3df08e1ca2cc6de59fb57043;hp=d4a726b4fc5eece3dadad3dd2b7246b740fabbbf;hpb=7d4e1e7142bc3d80efab03d983cb2915d9a893db;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs index d4a726b..39cfeb9 100644 --- a/src/TSN/XML/AutoRacingSchedule.hs +++ b/src/TSN/XML/AutoRacingSchedule.hs @@ -1,3 +1,4 @@ + {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} @@ -27,6 +28,7 @@ where import Control.Monad ( forM_ ) import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) +import qualified Data.Vector.HFixed as H ( HVector, cons, convert ) import Database.Groundhog ( countAll, deleteAll, @@ -55,7 +57,6 @@ import Text.XML.HXT.Core ( xpWrap ) -- Local imports. -import Generics ( Generic(..), to_tuple ) import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) @@ -110,9 +111,9 @@ data Message = xml_time_stamp :: UTCTime } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic Message +instance H.HVector Message instance ToDb Message where @@ -185,9 +186,9 @@ data AutoRacingScheduleListingXml = xml_race_results :: [AutoRacingScheduleListingRaceResult] } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic AutoRacingScheduleListingXml +instance H.HVector AutoRacingScheduleListingXml -- | Pseudo-accessor to get the race result listings out of a @@ -266,39 +267,46 @@ newtype AutoRacingScheduleListingRaceResult = -- | Database representation of \ within -- \ within \ within... \! +-- The leading underscores prevent unused field warnings. -- data AutoRacingScheduleListingRaceResultRaceResultListing = AutoRacingScheduleListingRaceResultRaceResultListing { - db_auto_racing_schedules_listings_id :: + _db_auto_racing_schedules_listings_id :: DefaultKey AutoRacingScheduleListing, - db_finish_position :: Int, - 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, -- ^ This should be an Int, but can have commas. - db_status :: Maybe String -- ^ They can be empty + _db_finish_position :: Int, + _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, -- ^ This should be an Int, but can have commas. + _db_status :: Maybe String -- ^ They can be empty } + deriving ( GHC.Generic ) + +-- | For 'H.cons'. +-- +instance H.HVector AutoRacingScheduleListingRaceResultRaceResultListing -- | XML Representation of an -- 'AutoRacingScheduleListingRaceResultRaceResultListing'. +-- The leading underscores prevent unused field warnings. -- 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 can have commas. - xml_status :: Maybe String -- ^ They can be empty + _xml_finish_position :: Int, + _xml_driver_id :: Int, + _xml_name :: String, + _xml_leading_laps :: Int, + _xml_listing_laps :: Int, -- ^ Avoids clash with race's \"laps\" field. + _xml_earnings :: String, -- ^ Should be an 'Int', but can have commas. + _xml_status :: Maybe String -- ^ They can be empty } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic AutoRacingScheduleListingRaceResultRaceResultListingXml +instance H.HVector AutoRacingScheduleListingRaceResultRaceResultListingXml instance ToDb AutoRacingScheduleListingRaceResultRaceResultListingXml where @@ -326,16 +334,7 @@ instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where -- 'AutoRacingScheduleListingRaceResultRaceResultListing', we just -- add the foreign key to the parent 'AutoRacingScheduleListing'. -- - from_xml_fk fk AutoRacingScheduleListingRaceResultRaceResultListingXml{..} = - AutoRacingScheduleListingRaceResultRaceResultListing { - db_auto_racing_schedules_listings_id = fk, - db_finish_position = xml_finish_position, - db_driver_id = xml_driver_id, - db_name = xml_name, - db_leading_laps = xml_leading_laps, - db_listing_laps = xml_listing_laps, - db_earnings = xml_earnings, - db_status = xml_status } + from_xml_fk = H.cons -- | This allows us to insert the XML representation @@ -397,7 +396,7 @@ mkPersist tsn_codegen_config [groundhog| constructors: - name: AutoRacingScheduleListingRaceResultRaceResultListing fields: - - name: db_auto_racing_schedules_listings_id + - name: _db_auto_racing_schedules_listings_id reference: onDelete: cascade |] @@ -413,7 +412,7 @@ mkPersist tsn_codegen_config [groundhog| pickle_message :: PU Message pickle_message = xpElem "message" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp8Tuple (xpElem "XML_File_ID" xpInt) (xpElem "heading" xpText) (xpElem "category" xpText) @@ -431,7 +430,7 @@ pickle_message = pickle_listing :: PU AutoRacingScheduleListingXml pickle_listing = xpElem "Listing" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp10Tuple (xpElem "RaceID" xpInt) (xpElem "Race_Date" xp_date_padded) (xpElem "Race_Time" xp_tba_time) @@ -467,7 +466,7 @@ pickle_race_results_listing :: PU AutoRacingScheduleListingRaceResultRaceResultListingXml pickle_race_results_listing = xpElem "RaceResultsListing" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp7Tuple (xpElem "FinishPosition" xpInt) (xpElem "DriverID" xpInt) (xpElem "Name" xpText)