src/TSN/XML/JFile.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE GADTs #-}
   3 {-# LANGUAGE QuasiQuotes #-}
   4 {-# LANGUAGE RecordWildCards #-}
   5 {-# LANGUAGE TemplateHaskell #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7
   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.
  13 --
  14 module TSN.XML.JFile (
  15   dtd )
  16 where
  17
  18 -- System imports
  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 (
  24   groundhog,
  25   mkPersist )
  26 import Text.XML.HXT.Core (
  27   PU,
  28   xp6Tuple,
  29   xp7Tuple,
  30   xp8Tuple,
  31   xp10Tuple,
  32   xp14Tuple,
  33   xpElem,
  34   xpInt,
  35   xpList,
  36   xpOption,
  37   xpText,
  38   xpWrap )
  39
  40
  41 -- Local imports
  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 )
  45 import TSN.XML.Odds (
  46   OddsGameAwayTeamXml(..),
  47   OddsGameHomeTeamXml(..),
  48   OddsGameTeam(..) )
  49 import TSN.XmlImport (
  50   XmlImport(..),
  51   XmlImportFk(..) )
  52
  53 import Xml (
  54   FromXml(..),
  55   FromXmlFk(..),
  56   ToDb(..) )
  57
  58
  59
  60 -- | The DTD to which this module corresponds. Used to invoke dbimport.
  61 --
  62 dtd :: String
  63 dtd = "jfilexml.dtd"
  64
  65 --
  66 -- DB/XML data types
  67 --
  68
  69 -- * JFile/Message
  70
  71 -- | Database representation of a 'Message'.
  72 --
  73 data JFile =
  74   JFile {
  75     db_xml_file_id :: Int,
  76     db_heading :: String,
  77     db_category :: String,
  78     db_sport :: String,
  79     db_time_stamp :: UTCTime }
  80
  81
  82
  83 -- | XML Representation of an 'JFile'.
  84 --
  85 data Message =
  86   Message {
  87     xml_xml_file_id :: Int,
  88     xml_heading :: String,
  89     xml_category :: String,
  90     xml_sport :: String,
  91     xml_gamelist :: JFileGameListXml,
  92     xml_time_stamp :: UTCTime }
  93   deriving (Eq, Show)
  94
  95
  96 instance ToDb Message where
  97   -- | The database analogue of a 'Message' is a 'JFile'.
  98   --
  99   type Db Message = JFile
 100
 101
 102 -- | The 'FromXml' instance for 'Message' is required for the
 103 --   'XmlImport' instance.
 104 --
 105 instance FromXml Message where
 106   -- | To convert a 'Message' to an 'JFile', we just drop
 107   --   the 'xml_gamelist'.
 108   --
 109   from_xml Message{..} =
 110     JFile {
 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 }
 116
 117
 118 -- | This allows us to insert the XML representation 'Message'
 119 --   directly.
 120 --
 121 instance XmlImport Message
 122
 123
 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.
 130 --
 131 data OddsInfo =
 132   OddsInfo {
 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,
 146     db_live :: Bool,
 147     db_notes :: String }
 148   deriving (Eq, Show)
 149
 150
 151
 152 -- * JFileGame/JFileGameXml
 153
 154 -- | Database representation of a \<game\> contained within a
 155 --   \<message\>, and, implicitly, a \<gamelist\>.
 156 --
 157 --   We've left out the game date, opting instead to combine the
 158 --   date/time into the 'db_game_time' field.
 159 --
 160 data JFileGame =
 161   JFileGame {
 162     db_jfile_id :: DefaultKey JFile,
 163     db_game_id :: Int,
 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,
 170     db_vscore :: Int,
 171     db_hscore :: Int,
 172     db_time_remaining :: Maybe String,
 173     db_status :: String }
 174
 175
 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!
 181 --
 182 data JFileGameXml =
 183   JFileGameXml {
 184     xml_game_id :: Int,
 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,
 194     xml_vscore :: Int,
 195     xml_hscore :: Int,
 196     xml_time_remaining :: Maybe String,
 197     xml_status :: String }
 198   deriving (Eq, Show)
 199
 200
 201 -- * JFileGameListXml
 202
 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.
 206 --
 207 newtype JFileGameListXml =
 208   JFileGameListXml {
 209     xml_games ::
 210       [JFileGameXml] }
 211   deriving (Eq, Show)
 212
 213
 214 instance ToDb JFileGameXml where
 215   -- | The database analogue of an 'JFileGameXml' is
 216   --   an 'JFileGame'.
 217   --
 218   type Db JFileGameXml = JFileGame
 219
 220 instance FromXmlFk JFileGameXml where
 221   -- | Each 'JFileGameXml' is contained in (i.e. has a foreign key to)
 222   --   a 'JFile'.
 223   --
 224   type Parent JFileGameXml = JFile
 225
 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.
 229   --
 230   from_xml_fk fk JFileGameXml{..} =
 231     JFileGame {
 232       db_jfile_id = fk,
 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 }
 244     where
 245       -- | Make the database \"game time\" from the XML
 246       --   date/time. Simply take the day part from one and the time
 247       --   from the other.
 248       --
 249       make_game_time d Nothing = d
 250       make_game_time d (Just t) = UTCTime (utctDay d) (utctDayTime t)
 251
 252
 253 -- | This allows us to insert the XML representation
 254 --   'JFileGameXml' directly.
 255 --
 256 instance XmlImportFk JFileGameXml
 257
 258
 259 -- * JFileGame_OddsGameTeam
 260
 261 -- | Database mapping between games and their home/away teams.
 262 --
 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 }
 268
 269
 270 ---
 271 --- Database stuff.
 272 ---
 273
 274 instance DbImport Message where
 275   dbmigrate _ =
 276     run_dbmigrate $ do
 277       migrate (undefined :: JFile)
 278       migrate (undefined :: JFileGame)
 279       migrate (undefined :: OddsGameTeam)
 280       migrate (undefined :: JFileGame_OddsGameTeam)
 281
 282   dbimport m = return ImportSucceeded
 283
 284
 285 mkPersist tsn_codegen_config [groundhog|
 286 - entity: JFile
 287   dbName: jfile
 288   constructors:
 289     - name: JFile
 290       uniques:
 291         - name: unique_jfile
 292           type: constraint
 293           # Prevent multiple imports of the same message.
 294           fields: [db_xml_file_id]
 295
 296 # Many of the OddsInfo fields are redundant and have been left out.
 297 - embedded: OddsInfo
 298   fields:
 299     - name: db_list_date
 300       dbName: list_date
 301     - name: db_home_starter
 302       dbName: 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
 309     - name: db_live
 310       dbName: live
 311     - name: db_notes
 312       dbName: notes
 313
 314 - entity: JFileGame
 315   dbName: jfile_games
 316   constructors:
 317     - name: JFileGame
 318       fields:
 319         - name: db_jfile_id
 320           reference:
 321             onDelete: cascade
 322         - name: db_odds_info
 323           embeddedType:
 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}
 332
 333 - entity: JFileGame_OddsGameTeam
 334   dbName: jfile_games__odds_games_teams
 335   constructors:
 336     - name: JFileGame_OddsGameTeam
 337       fields:
 338         - name: jgogt_jfile_games_id
 339           reference:
 340             onDelete: cascade
 341         - name: jgogt_away_team_id
 342           reference:
 343             onDelete: cascade
 344         - name: jgogt_home_team_id
 345           reference:
 346             onDelete: cascade
 347 |]
 348
 349
 350
 351 ---
 352 --- Pickling
 353 ---
 354
 355 -- | Pickler for the top-level 'Message'.
 356 --
 357 pickle_message :: PU Message
 358 pickle_message =
 359   xpElem "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)
 365              pickle_gamelist
 366              (xpElem "time_stamp" xp_time_stamp)
 367   where
 368     from_tuple = uncurryN Message
 369     to_tuple m = (xml_xml_file_id m,
 370                   xml_heading m,
 371                   xml_category m,
 372                   xml_sport m,
 373                   xml_gamelist m,
 374                   xml_time_stamp m)
 375
 376 pickle_gamelist :: PU JFileGameListXml
 377 pickle_gamelist =
 378   xpElem "gamelist" $
 379     xpWrap (to_result, from_result) $ xpList pickle_game
 380   where
 381     to_result = JFileGameListXml
 382     from_result = xml_games
 383
 384
 385
 386
 387 pickle_game :: PU JFileGameXml
 388 pickle_game =
 389   xpElem "game" $
 390     xpWrap (from_tuple, to_tuple) $
 391     xp14Tuple (xpElem "game_id" xpInt)
 392               (xpElem "schedule_id" xpInt)
 393               pickle_odds_info
 394               (xpElem "seasontype" xpText)
 395               (xpElem "Game_Date" xp_date_padded)
 396               (xpElem "Game_Time" xp_time)
 397               pickle_away_team
 398               (xpOption $ xpElem "vleague" xpText)
 399               pickle_home_team
 400               (xpOption $ xpElem "hleague" xpText)
 401               (xpElem "vscore" xpInt)
 402               (xpElem "hscore" xpInt)
 403               (xpOption $ xpElem "time_r" xpText)
 404               pickle_status
 405   where
 406     from_tuple = uncurryN JFileGameXml
 407     to_tuple m = (xml_game_id m,
 408                   xml_schedule_id m,
 409                   xml_odds_info m,
 410                   xml_season_type m,
 411                   xml_game_date m,
 412                   xml_game_time m,
 413                   xml_vteam m,
 414                   xml_vleague m,
 415                   xml_hteam m,
 416                   xml_hleague m,
 417                   xml_vscore m,
 418                   xml_hscore m,
 419                   xml_time_remaining m,
 420                   xml_status m)
 421
 422 pickle_odds_info = undefined
 423 pickle_home_team = undefined
 424 pickle_away_team = undefined
 425 pickle_status = undefined