X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FAutoRacingSchedule.hs;h=64132bcb0f1ad7bf07903d7c9200eb81051371c1;hb=32147474ba5c91452eeb532381f63e88c257a982;hp=1cbcbc1bfd2e1fa70fd2eedc58eab178ddf970eb;hpb=52b420301965efe58a60672832c93b5046695cd0;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs index 1cbcbc1..64132bc 100644 --- a/src/TSN/XML/AutoRacingSchedule.hs +++ b/src/TSN/XML/AutoRacingSchedule.hs @@ -28,14 +28,13 @@ 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, - migrate, - runMigration, - silentMigrationLogger ) + migrate ) import Database.Groundhog.Core ( DefaultKey ) -import Database.Groundhog.Generic ( runDbConn ) +import Database.Groundhog.Generic ( runDbConn, runMigrationSilent ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, @@ -56,7 +55,6 @@ import Text.XML.HXT.Core ( xpWrap ) -- Local imports. -import Generics ( Generic(..), prepend, to_tuple ) import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) @@ -111,9 +109,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 @@ -186,9 +184,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 @@ -283,9 +281,9 @@ data AutoRacingScheduleListingRaceResultRaceResultListing = } deriving ( GHC.Generic ) --- | For 'Generics.prepend'. +-- | For 'H.cons'. -- -instance Generic AutoRacingScheduleListingRaceResultRaceResultListing +instance H.HVector AutoRacingScheduleListingRaceResultRaceResultListing -- | XML Representation of an @@ -304,9 +302,9 @@ data AutoRacingScheduleListingRaceResultRaceResultListingXml = } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert'. -- -instance Generic AutoRacingScheduleListingRaceResultRaceResultListingXml +instance H.HVector AutoRacingScheduleListingRaceResultRaceResultListingXml instance ToDb AutoRacingScheduleListingRaceResultRaceResultListingXml where @@ -334,7 +332,7 @@ instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where -- 'AutoRacingScheduleListingRaceResultRaceResultListing', we just -- add the foreign key to the parent 'AutoRacingScheduleListing'. -- - from_xml_fk = prepend + from_xml_fk = H.cons -- | This allows us to insert the XML representation @@ -412,7 +410,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) @@ -430,7 +428,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) @@ -466,7 +464,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) @@ -545,7 +543,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" let c = undefined :: AutoRacingScheduleListingRaceResultRaceResultListing actual <- withSqliteConn ":memory:" $ runDbConn $ do - runMigration silentMigrationLogger $ do + runMigrationSilent $ do migrate a migrate b migrate c