X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FAutoRacingDriverList.hs;h=9d9e090a662fe96da230e8ff9d57422c6597d307;hb=1f04fd8786215141dad63099dc6f48d17b7ac96c;hp=327c358bcc1ed305d1b016cc5b462825c3162825;hpb=c864af7aa8a195cf441904479c416202590e9375;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/AutoRacingDriverList.hs b/src/TSN/XML/AutoRacingDriverList.hs index 327c358..9d9e090 100644 --- a/src/TSN/XML/AutoRacingDriverList.hs +++ b/src/TSN/XML/AutoRacingDriverList.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} @@ -36,6 +37,7 @@ import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, mkPersist ) +import qualified GHC.Generics as GHC ( Generic ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Text.XML.HXT.Core ( @@ -50,6 +52,7 @@ 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 ) @@ -101,7 +104,11 @@ data Message = xml_title :: String, xml_listings :: [AutoRacingDriverListListingXml], xml_time_stamp :: UTCTime } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + +-- | For 'Generics.to_tuple'. +-- +instance Generic Message instance ToDb Message where @@ -150,6 +157,12 @@ data AutoRacingDriverListListing = db_nationality :: Maybe String, db_car_number :: Int, db_car :: String } + deriving ( GHC.Generic ) + +-- | For 'Generics.prepend'. +-- +instance Generic AutoRacingDriverListListing + -- | XML representation of a \ contained within a -- \. @@ -165,8 +178,11 @@ data AutoRacingDriverListListingXml = xml_nationality :: Maybe String, xml_car_number :: Int, xml_car :: String } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) +-- | For 'Generics.to_tuple'. +-- +instance Generic AutoRacingDriverListListingXml instance ToDb AutoRacingDriverListListingXml where -- | The database analogue of an 'AutoRacingDriverListListingXml' is @@ -187,18 +203,8 @@ instance FromXmlFk AutoRacingDriverListListingXml where -- 'AutoRacingDriverListListing', we add the foreign key and copy -- everything else verbatim. -- - from_xml_fk fk AutoRacingDriverListListingXml{..} = - AutoRacingDriverListListing { - db_auto_racing_driver_lists_id = fk, - db_driver_id = xml_driver_id, - db_driver = xml_driver, - db_height = xml_height, - db_weight = xml_weight, - db_date_of_birth = xml_date_of_birth, - db_hometown = xml_hometown, - db_nationality = xml_nationality, - db_car_number = xml_car_number, - db_car = xml_car } + from_xml_fk = prepend + -- | This allows us to insert the XML representation @@ -272,15 +278,6 @@ pickle_listing = (xpElem "Car" xpText) where from_tuple = uncurryN AutoRacingDriverListListingXml - to_tuple m = (xml_driver_id m, - xml_driver m, - xml_height m, - xml_weight m, - xml_date_of_birth m, - xml_hometown m, - xml_nationality m, - xml_car_number m, - xml_car m) -- | Pickler for the top-level 'Message'. -- @@ -297,13 +294,6 @@ pickle_message = (xpElem "time_stamp" xp_time_stamp) where from_tuple = uncurryN Message - to_tuple m = (xml_xml_file_id m, - xml_heading m, - xml_category m, - xml_sport m, - xml_title m, - xml_listings m, - xml_time_stamp m)