{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- | Parse TSN XML for the DTD \"AutoRacingResultsXML.dtd\". -- module TSN.XML.AutoRacingResults ( dtd, -- pickle_message, -- * Tests -- auto_racing_results_tests, -- * WARNING: these are private but exported to silence warnings AutoRacingResultsConstructor(..), AutoRacingResultsListingConstructor(..) ) -- AutoRacingResultsRaceInformationConstructor(..) ) where -- System imports. import Control.Monad ( forM_ ) import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog ( countAll, deleteAll, migrate, runMigration, silentMigrationLogger ) import Database.Groundhog.Core ( DefaultKey ) import Database.Groundhog.Generic ( runDbConn ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, mkPersist ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Text.XML.HXT.Core ( PU, xp7Tuple, xp8Tuple, xp10Tuple, xpElem, xpInt, xpList, xpOption, xpText, xpWrap ) -- Local imports. import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Picklers ( xp_date, xp_tba_time, xp_time_stamp ) import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) import Xml ( FromXml(..), FromXmlFk(..), ToDb(..), pickle_unpickle, unpickleable, unsafe_unpickle ) -- | The DTD to which this module corresponds. Used to invoke dbimport. -- dtd :: String dtd = "AutoRacingResultsXML.dtd" -- -- DB/XML data types -- -- * AutoRacingResults/Message -- | Database representation of a 'Message'. -- data AutoRacingResults = AutoRacingResults { db_xml_file_id :: Int, db_heading :: String, db_category :: String, db_sport :: String, db_title :: String, db_race_id :: Int, db_race_date :: UTCTime, db_track_location :: String, db_laps_remaining :: Int, db_checkered_flag :: Bool, db_time_stamp :: UTCTime } deriving (Eq, Show) -- | XML Representation of an 'AutoRacingResults'. -- data Message = Message { xml_xml_file_id :: Int, xml_heading :: String, xml_category :: String, xml_sport :: String, xml_title :: String, xml_race_id :: Int, xml_race_date :: UTCTime, xml_track_location :: String, xml_laps_remaining :: Int, xml_checkered_flag :: Bool, xml_listings :: [AutoRacingResultsListingXml], -- xml_race_information :: AutoRacingResultsRaceInformation, xml_time_stamp :: UTCTime } deriving (Eq, Show) instance ToDb Message where -- | The database analogue of a 'Message' is a 'AutoRacingResults'. -- type Db Message = AutoRacingResults -- | The 'FromXml' instance for 'Message' is required for the -- 'XmlImport' instance. -- instance FromXml Message where -- | To convert a 'Message' to an 'AutoRacingResults', we just drop -- the 'xml_listings' and 'xml_race_information'. -- from_xml Message{..} = AutoRacingResults { db_xml_file_id = xml_xml_file_id, db_heading = xml_heading, db_category = xml_category, db_sport = xml_sport, db_title = xml_title, db_race_id = xml_race_id, db_race_date = xml_race_date, db_track_location = xml_track_location, db_laps_remaining = xml_laps_remaining, db_checkered_flag = xml_checkered_flag, db_time_stamp = xml_time_stamp } -- | This allows us to insert the XML representation 'Message' -- directly. -- instance XmlImport Message -- * AutoRacingResultsListing/AutoRacingResultsListingXml -- | Database representation of a \