src/TSN/XML/GameInfo.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE GADTs #-}
   3 {-# LANGUAGE QuasiQuotes #-}
   4 {-# LANGUAGE RecordWildCards #-}
   5 {-# LANGUAGE TemplateHaskell #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7
   8 -- | GameInfo represents a collection of DTDs that we don't really
   9 --   handle but want to make available. The raw XML gets stored in the
  10 --   database along with the XML_File_ID, but we don't parse any of it.
  11 --
  12 --   See also: TSN.XML.SportInfo
  13 --
  14 module TSN.XML.GameInfo (
  15   dtds,
  16   parse_xml,
  17   -- * WARNING: these are private but exported to silence warnings
  18   GameInfoConstructor(..) )
  19 where
  20
  21 -- System imports.
  22 import Data.Time.Clock ( UTCTime )
  23 import Database.Groundhog ( migrate )
  24 import Database.Groundhog.TH (
  25   groundhog,
  26   mkPersist )
  27 import Text.XML.HXT.Core ( XmlTree )
  28 import Text.XML.HXT.DOM.ShowXml ( xshow )
  29
  30 -- Local imports.
  31 import TSN.Codegen ( tsn_codegen_config )
  32 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
  33 import TSN.Parse (
  34   parse_message,
  35   parse_xmlfid,
  36   parse_xml_time_stamp )
  37 import TSN.XmlImport ( XmlImport(..) )
  38 import Xml (
  39   FromXml(..),
  40   ToDb(..) )
  41
  42 -- | The DTDs for everything that we consider "Game Info."
  43 --
  44 --   TODO: This is the list from the old implementation. We need to
  45 --   make sure that we are really receiving XML for these DTDs
  46 --   (i.e. the names are correct).
  47 --
  48 dtds :: [String]
  49 dtds =
  50   [ "CBASK_Lineup_XML.dtd",
  51     "cbaskpreviewxml.dtd",
  52     "cflpreviewxml.dtd", -- missing DTD
  53     "Matchup_NBA_NHL_XML.dtd",
  54     "mlbpreviewxml.dtd",
  55     "MLB_Gaming_Matchup_XML.dtd",
  56     "MLB.dtd", -- missing DTD
  57     "MLB_Lineup_XML.dtd",
  58     "MLB_Matchup_XML.dtd",
  59     "MLS_Preview_XML.dtd",
  60     "NBA_Gaming_Matchup_XML.dtd",
  61     "NBA.dtd", -- missing DTD
  62     "NBA_Playoff_Matchup_XML.dtd",
  63     "NBALineupXML.dtd",
  64     "nbapreviewxml.dtd",
  65     "NCAA_FB_Preview_XML.dtd",
  66     "nflpreviewxml.dtd",
  67     "NFL_NCAA_FB_Matchup_XML.dtd",
  68     "nhlpreviewxml.dtd",
  69     "recapxml.dtd",
  70     "WorldBaseballPreviewXML.dtd" -- missing DTD
  71   ]
  72
  73
  74 -- | XML representation of a GameInfo \<message\>.
  75 --
  76 data Message =
  77   Message {
  78     xml_dtd :: String,
  79     xml_xml_file_id :: Int,
  80     xml_time_stamp :: UTCTime,
  81     xml_xml :: String }
  82   deriving (Eq, Show)
  83
  84
  85 -- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot,
  86 --   we fail with an error message.
  87 --
  88 parse_xml :: String -> XmlTree -> Either String Message
  89 parse_xml dtdname xmltree = do
  90   xmlfid <- parse_xmlfid xmltree
  91   timestamp <- parse_xml_time_stamp xmltree
  92   message <- parse_message xmltree
  93   return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message])
  94
  95
  96 -- | Database representation of a 'Message'.
  97 --
  98 data GameInfo =
  99   GameInfo {
 100     db_dtd :: String,
 101     db_xml_file_id :: Int,
 102     db_time_stamp :: UTCTime,
 103     db_xml :: String }
 104
 105
 106 instance ToDb Message where
 107   -- | The database analogue of a 'Message' is an 'GameInfo'.
 108   type Db Message = GameInfo
 109
 110 instance FromXml Message where
 111   -- | The XML to DB conversion is trivial here.
 112   --
 113   from_xml Message{..} = GameInfo {
 114                            db_dtd = xml_dtd,
 115                            db_xml_file_id = xml_xml_file_id,
 116                            db_time_stamp = xml_time_stamp,
 117                            db_xml = xml_xml }
 118
 119
 120 -- | This allows us to insert the XML representation 'Message'
 121 --   directly.
 122 --
 123 instance XmlImport Message
 124
 125
 126 --
 127 -- Database code
 128 --
 129
 130 instance DbImport Message where
 131   dbmigrate _ =
 132     run_dbmigrate $ migrate (undefined :: GameInfo)
 133
 134   -- | We import a 'Message' by inserting the whole thing at
 135   --   once. Nothing fancy going on here.
 136   dbimport msg = do
 137     insert_xml_ msg
 138     return ImportSucceeded
 139
 140 mkPersist tsn_codegen_config [groundhog|
 141 - entity: GameInfo
 142   constructors:
 143     - name: GameInfo
 144       uniques:
 145         - name: unique_game_info
 146           type: constraint
 147           # Prevent multiple imports of the same message.
 148           fields: [db_xml_file_id]
 149 |]