1 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-# LANGUAGE TemplateHaskell #-}
6 {-# LANGUAGE TypeFamilies #-}
8 -- | Parse TSN XML for the DTD \"jfilexml.dtd\". There's a top-level
9 -- \<message\>, containing a \<gamelist\>, containing
10 -- \<game\>s. Those games contain a bunch of other stuff. The
11 -- \<gamelist\> is pretty irrelevant; we ignore it and pretend that
12 -- a message contains a bunch of games.
14 module TSN.XML.JFile (
19 import Data.Time ( UTCTime(..) )
20 import Data.Tuple.Curry ( uncurryN )
21 import Database.Groundhog ( migrate )
22 import Database.Groundhog.Core ( DefaultKey )
23 import Database.Groundhog.TH (
26 import Text.XML.HXT.Core (
42 import TSN.Codegen ( tsn_codegen_config )
43 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
44 import TSN.Picklers ( xp_date_padded, xp_time, xp_time_stamp )
46 OddsGameAwayTeamXml(..),
47 OddsGameHomeTeamXml(..),
49 import TSN.XmlImport (
60 -- | The DTD to which this module corresponds. Used to invoke dbimport.
71 -- | Database representation of a 'Message'.
75 db_xml_file_id :: Int,
77 db_category :: String,
79 db_time_stamp :: UTCTime }
83 -- | XML Representation of an 'JFile'.
87 xml_xml_file_id :: Int,
88 xml_heading :: String,
89 xml_category :: String,
91 xml_gamelist :: JFileGameListXml,
92 xml_time_stamp :: UTCTime }
96 instance ToDb Message where
97 -- | The database analogue of a 'Message' is a 'JFile'.
99 type Db Message = JFile
102 -- | The 'FromXml' instance for 'Message' is required for the
103 -- 'XmlImport' instance.
105 instance FromXml Message where
106 -- | To convert a 'Message' to an 'JFile', we just drop
107 -- the 'xml_gamelist'.
109 from_xml Message{..} =
111 db_xml_file_id = xml_xml_file_id,
112 db_heading = xml_heading,
113 db_category = xml_category,
114 db_sport = xml_sport,
115 db_time_stamp = xml_time_stamp }
118 -- | This allows us to insert the XML representation 'Message'
121 instance XmlImport Message
124 -- | This is an embedded type within each JFileGame. It has its own
125 -- element, \<Odds_Info\>, but there's only one of them per game. So
126 -- essentially all of these fields belong to a 'JFileGame'. Aaaannnd
127 -- most of them are redundant. We'll (un)pickle them for good
128 -- measure, but in the conversion to the database type, we can drop
129 -- all of the redundant information.
133 db_list_date :: UTCTime,
134 db_home_team_id :: Int, -- redundant (OddsGameTeam)
135 db_away_team_id :: Int, -- redundant (OddsGameTeam)
136 db_home_abbr :: String, -- redundant (OddsGameTeam)
137 db_away_abbr :: String, -- redundant (OddsGameTeam)
138 db_home_team_name :: String, -- redundant (OddsGameTeam)
139 db_away_team_name :: String, -- redundant (OddsGameTeam)
140 db_home_starter :: String,
141 db_away_starter :: String,
142 db_game_date :: UTCTime, -- redundant (JFileGame)
143 db_home_game_key :: Int,
144 db_away_game_key :: Int,
145 db_current_timestamp :: UTCTime,
152 -- * JFileGame/JFileGameXml
154 -- | Database representation of a \<game\> contained within a
155 -- \<message\>, and, implicitly, a \<gamelist\>.
157 -- We've left out the game date, opting instead to combine the
158 -- date/time into the 'db_game_time' field.
162 db_jfile_id :: DefaultKey JFile,
164 db_schedule_id :: Int,
165 db_odds_info :: OddsInfo,
166 db_season_type :: String,
167 db_game_time :: UTCTime,
168 db_vleague :: Maybe String,
169 db_hleague :: Maybe String,
172 db_time_remaining :: Maybe String,
173 db_status :: String }
176 -- | XML representation of a \<game\> contained within a \<message\>,
177 -- and a \<gamelist\>. The Away/Home teams seem to
178 -- coincide with those of 'OddsGame', so we're reusing those for
179 -- now. In the future it may make sense to separate them out into
180 -- just \"Teams\". Note however that they require different picklers!
185 xml_schedule_id :: Int,
186 xml_odds_info :: OddsInfo,
187 xml_season_type :: String,
188 xml_game_date :: UTCTime,
189 xml_game_time :: UTCTime,
190 xml_vteam :: OddsGameAwayTeamXml,
191 xml_vleague :: Maybe String,
192 xml_hteam :: OddsGameHomeTeamXml,
193 xml_hleague :: Maybe String,
196 xml_time_remaining :: Maybe String,
197 xml_status :: String }
201 -- * JFileGameListXml
203 -- | The XML representation of \<message\> -> \<gamelist\>. This
204 -- element serves only to contain \<game\>s, so we don't store the
205 -- intermediate table in the database.
207 newtype JFileGameListXml =
214 instance ToDb JFileGameXml where
215 -- | The database analogue of an 'JFileGameXml' is
218 type Db JFileGameXml = JFileGame
220 instance FromXmlFk JFileGameXml where
221 -- | Each 'JFileGameXml' is contained in (i.e. has a foreign key to)
224 type Parent JFileGameXml = JFile
226 -- | To convert an 'JFileGameXml' to an 'JFileGame', we add the
227 -- foreign key and drop the 'xml_vteam'/'xml_hteam'. We also mash
228 -- the date/time together into one field.
230 from_xml_fk fk JFileGameXml{..} =
233 db_game_id = xml_game_id,
234 db_schedule_id = xml_schedule_id,
235 db_odds_info = xml_odds_info,
236 db_season_type = xml_season_type,
237 db_game_time = xml_game_time,
238 db_vleague = xml_vleague,
239 db_hleague = xml_hleague,
240 db_vscore = xml_vscore,
241 db_hscore = xml_hscore,
242 db_time_remaining = xml_time_remaining,
243 db_status = xml_status }
245 -- | Make the database \"game time\" from the XML
246 -- date/time. Simply take the day part from one and the time
249 make_game_time d Nothing = d
250 make_game_time d (Just t) = UTCTime (utctDay d) (utctDayTime t)
253 -- | This allows us to insert the XML representation
254 -- 'JFileGameXml' directly.
256 instance XmlImportFk JFileGameXml
259 -- * JFileGame_OddsGameTeam
261 -- | Database mapping between games and their home/away teams.
263 data JFileGame_OddsGameTeam =
264 JFileGame_OddsGameTeam {
265 jgogt_jfile_games_id :: DefaultKey JFileGame,
266 jgogt_away_team_id :: DefaultKey OddsGameTeam,
267 jgogt_home_team_id :: DefaultKey OddsGameTeam }
274 instance DbImport Message where
277 migrate (undefined :: JFile)
278 migrate (undefined :: JFileGame)
279 migrate (undefined :: OddsGameTeam)
280 migrate (undefined :: JFileGame_OddsGameTeam)
282 dbimport m = return ImportSucceeded
285 mkPersist tsn_codegen_config [groundhog|
293 # Prevent multiple imports of the same message.
294 fields: [db_xml_file_id]
296 # Many of the OddsInfo fields are redundant and have been left out.
301 - name: db_home_starter
303 - name: db_home_game_key
304 dbName: home_game_key
305 - name: db_away_game_key
306 dbName: away_game_key
307 - name: db_current_timestamp
308 dbName: current_timestamp
324 - {name: list_date, dbName: list_date}
325 - {name: home_starter, dbName: home_starter}
326 - {name: away_starter, dbName: away_starter}
327 - {name: home_game_key, dbName: home_game_key}
328 - {name: away_game_key, dbName: home_game_key}
329 - {name: current_timestamp, dbName: current_timestamp}
330 - {name: live, dbName: live}
331 - {name: notes, dbName: notes}
333 - entity: JFileGame_OddsGameTeam
334 dbName: jfile_games__odds_games_teams
336 - name: JFileGame_OddsGameTeam
338 - name: jgogt_jfile_games_id
341 - name: jgogt_away_team_id
344 - name: jgogt_home_team_id
355 -- | Pickler for the top-level 'Message'.
357 pickle_message :: PU Message
360 xpWrap (from_tuple, to_tuple) $
361 xp6Tuple (xpElem "XML_File_ID" xpInt)
362 (xpElem "heading" xpText)
363 (xpElem "category" xpText)
364 (xpElem "sport" xpText)
366 (xpElem "time_stamp" xp_time_stamp)
368 from_tuple = uncurryN Message
369 to_tuple m = (xml_xml_file_id m,
376 pickle_gamelist :: PU JFileGameListXml
379 xpWrap (to_result, from_result) $ xpList pickle_game
381 to_result = JFileGameListXml
382 from_result = xml_games
387 pickle_game :: PU JFileGameXml
390 xpWrap (from_tuple, to_tuple) $
391 xp14Tuple (xpElem "game_id" xpInt)
392 (xpElem "schedule_id" xpInt)
394 (xpElem "seasontype" xpText)
395 (xpElem "Game_Date" xp_date_padded)
396 (xpElem "Game_Time" xp_time)
398 (xpOption $ xpElem "vleague" xpText)
400 (xpOption $ xpElem "hleague" xpText)
401 (xpElem "vscore" xpInt)
402 (xpElem "hscore" xpInt)
403 (xpOption $ xpElem "time_r" xpText)
406 from_tuple = uncurryN JFileGameXml
407 to_tuple m = (xml_game_id m,
419 xml_time_remaining m,
422 pickle_odds_info = undefined
423 pickle_home_team = undefined
424 pickle_away_team = undefined
425 pickle_status = undefined