X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FAutoRacingDriverList.hs;h=482c1f3835699f30fcff5a1716714353d4890e8f;hb=32147474ba5c91452eeb532381f63e88c257a982;hp=af4fb854ae0cf76544d893db0c5e35794ba875ad;hpb=99eced1fcde33e5c5c63d8ae2853bda50eefec83;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/AutoRacingDriverList.hs b/src/TSN/XML/AutoRacingDriverList.hs index af4fb85..482c1f3 100644 --- a/src/TSN/XML/AutoRacingDriverList.hs +++ b/src/TSN/XML/AutoRacingDriverList.hs @@ -25,14 +25,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, @@ -52,7 +51,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 ) import TSN.Picklers ( xp_date, xp_time_stamp ) @@ -106,9 +104,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 @@ -160,9 +158,9 @@ data AutoRacingDriverListListing = _db_car :: String } deriving ( GHC.Generic ) --- | For 'Generics.prepend'. +-- | For 'H.convert'. -- -instance Generic AutoRacingDriverListListing +instance H.HVector AutoRacingDriverListListing -- | XML representation of a \ contained within a @@ -181,9 +179,9 @@ data AutoRacingDriverListListingXml = _xml_car :: String } deriving (Eq, GHC.Generic, Show) --- | For 'Generics.to_tuple'. +-- | For 'H.convert' and 'H.cons'. -- -instance Generic AutoRacingDriverListListingXml +instance H.HVector AutoRacingDriverListListingXml instance ToDb AutoRacingDriverListListingXml where -- | The database analogue of an 'AutoRacingDriverListListingXml' is @@ -204,7 +202,7 @@ instance FromXmlFk AutoRacingDriverListListingXml where -- 'AutoRacingDriverListListing', we add the foreign key and copy -- everything else verbatim. -- - from_xml_fk = prepend + from_xml_fk = H.cons @@ -267,7 +265,7 @@ mkPersist tsn_codegen_config [groundhog| pickle_listing :: PU AutoRacingDriverListListingXml pickle_listing = xpElem "Listing" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp9Tuple (xpElem "DriverID" xpInt) (xpElem "Driver" xpText) (xpElem "Height" $ xpOption xpText) @@ -285,7 +283,7 @@ pickle_listing = pickle_message :: PU Message pickle_message = xpElem "message" $ - xpWrap (from_tuple, to_tuple) $ + xpWrap (from_tuple, H.convert) $ xp7Tuple (xpElem "XML_File_ID" xpInt) (xpElem "heading" xpText) (xpElem "category" xpText) @@ -354,7 +352,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" let b = undefined :: AutoRacingDriverListListing actual <- withSqliteConn ":memory:" $ runDbConn $ do - runMigration silentMigrationLogger $ do + runMigrationSilent $ do migrate a migrate b _ <- dbimport results