1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE QuasiQuotes #-}
5 {-# LANGUAGE RecordWildCards #-}
6 {-# LANGUAGE StandaloneDeriving #-}
7 {-# LANGUAGE TemplateHaskell #-}
8 {-# LANGUAGE TypeFamilies #-}
10 -- | Parse TSN XML for the DTD \"AutoRacingResultsXML.dtd\".
12 module TSN.XML.AutoRacingResults (
16 -- auto_racing_results_tests,
17 -- * WARNING: these are private but exported to silence warnings
18 AutoRacingResultsConstructor(..),
19 AutoRacingResultsListingConstructor(..) )
20 -- AutoRacingResultsRaceInformationConstructor(..) )
24 import Control.Monad ( forM_ )
25 import Data.Time ( UTCTime(..) )
26 import Data.Tuple.Curry ( uncurryN )
27 import Database.Groundhog (
32 silentMigrationLogger )
33 import Database.Groundhog.Core ( DefaultKey )
34 import Database.Groundhog.Generic ( runDbConn )
35 import Database.Groundhog.Sqlite ( withSqliteConn )
36 import Database.Groundhog.TH (
39 import Test.Tasty ( TestTree, testGroup )
40 import Test.Tasty.HUnit ( (@?=), testCase )
41 import Text.XML.HXT.Core (
56 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
57 import TSN.Picklers ( xp_date, xp_tba_time, xp_time_stamp )
58 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
68 -- | The DTD to which this module corresponds. Used to invoke dbimport.
71 dtd = "AutoRacingResultsXML.dtd"
77 -- * AutoRacingResults/Message
79 -- | Database representation of a 'Message'.
81 data AutoRacingResults =
83 db_xml_file_id :: Int,
85 db_category :: String,
89 db_race_date :: UTCTime,
90 db_track_location :: String,
91 db_laps_remaining :: Int,
92 db_checkered_flag :: Bool,
93 db_time_stamp :: UTCTime }
98 -- | XML Representation of an 'AutoRacingResults'.
102 xml_xml_file_id :: Int,
103 xml_heading :: String,
104 xml_category :: String,
108 xml_race_date :: UTCTime,
109 xml_track_location :: String,
110 xml_laps_remaining :: Int,
111 xml_checkered_flag :: Bool,
112 xml_listings :: [AutoRacingResultsListingXml],
113 -- xml_race_information :: AutoRacingResultsRaceInformation,
114 xml_time_stamp :: UTCTime }
118 instance ToDb Message where
119 -- | The database analogue of a 'Message' is a 'AutoRacingResults'.
121 type Db Message = AutoRacingResults
124 -- | The 'FromXml' instance for 'Message' is required for the
125 -- 'XmlImport' instance.
127 instance FromXml Message where
128 -- | To convert a 'Message' to an 'AutoRacingResults', we just drop
129 -- the 'xml_listings' and 'xml_race_information'.
131 from_xml Message{..} =
133 db_xml_file_id = xml_xml_file_id,
134 db_heading = xml_heading,
135 db_category = xml_category,
136 db_sport = xml_sport,
137 db_title = xml_title,
138 db_race_id = xml_race_id,
139 db_race_date = xml_race_date,
140 db_track_location = xml_track_location,
141 db_laps_remaining = xml_laps_remaining,
142 db_checkered_flag = xml_checkered_flag,
143 db_time_stamp = xml_time_stamp }
146 -- | This allows us to insert the XML representation 'Message'
149 instance XmlImport Message
152 -- * AutoRacingResultsListing/AutoRacingResultsListingXml
154 -- | Database representation of a \<Listing\> contained within a
157 data AutoRacingResultsListing =
158 AutoRacingResultsListing {
159 db_auto_racing_results_id :: DefaultKey AutoRacingResults,
160 db_finish_position :: Int,
161 db_starting_position :: Int,
162 db_car_number :: Int,
165 db_car_make :: String,
167 db_laps_completed :: Int,
168 db_laps_leading :: Int,
170 db_dnf :: Maybe Bool,
172 db_earnings :: Maybe Int }
175 -- | XML representation of a \<Listing\> contained within a
178 data AutoRacingResultsListingXml =
179 AutoRacingResultsListingXml {
180 xml_finish_position :: Int,
181 xml_starting_position :: Int,
182 xml_car_number :: Int,
183 xml_driver_id :: Int,
184 xml_driver :: String,
185 xml_car_make :: String,
187 xml_laps_completed :: Int,
188 xml_laps_leading :: Int,
190 xml_dnf :: Maybe Bool,
191 xml_nc :: Maybe Bool,
192 xml_earnings :: Maybe Int }
196 instance ToDb AutoRacingResultsListingXml where
197 -- | The database analogue of an 'AutoRacingResultsListingXml' is
198 -- an 'AutoRacingResultsListing'.
200 type Db AutoRacingResultsListingXml = AutoRacingResultsListing
202 instance FromXmlFk AutoRacingResultsListingXml where
203 -- | Each 'AutoRacingResultsListingXml' is contained in (i.e. has a
204 -- foreign key to) a 'AutoRacingResults'.
206 type Parent AutoRacingResultsListingXml = AutoRacingResults
208 -- | To convert an 'AutoRacingResultsListingXml' to an
209 -- 'AutoRacingResultsListing', we add the foreign key and copy
210 -- everything else verbatim.
212 from_xml_fk fk AutoRacingResultsListingXml{..} =
213 AutoRacingResultsListing {
214 db_auto_racing_results_id = fk,
215 db_finish_position = xml_finish_position,
216 db_starting_position = xml_starting_position,
217 db_car_number = xml_car_number,
218 db_driver_id = xml_driver_id,
219 db_driver = xml_driver,
220 db_car_make = xml_car_make,
221 db_points = xml_points,
222 db_laps_completed = xml_laps_completed,
223 db_laps_leading = xml_laps_leading,
224 db_status = xml_status,
227 db_earnings = xml_earnings }
230 -- | This allows us to insert the XML representation
231 -- 'AutoRacingResultsListingXml' directly.
233 instance XmlImportFk AutoRacingResultsListingXml
243 mkPersist tsn_codegen_config [groundhog|
244 - entity: AutoRacingResults
245 dbName: auto_racing_results
247 - name: AutoRacingResults
249 - name: unique_auto_racing_schedule
251 # Prevent multiple imports of the same message.
252 fields: [db_xml_file_id]
255 - entity: AutoRacingResultsListing
256 dbName: auto_racing_results_listings
258 - name: AutoRacingResultsListing
260 - name: db_auto_racing_results_id