{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- | GameInfo represents a collection of DTDs that we don't really -- handle but want to make available. The raw XML gets stored in the -- database along with the XML_File_ID, but we don't parse any of it. -- -- See also: TSN.XML.SportInfo -- module TSN.XML.GameInfo ( dtds, parse_xml, -- * WARNING: these are private but exported to silence warnings GameInfoConstructor(..) ) where -- System imports. import Data.Time.Clock ( UTCTime ) import Database.Groundhog ( migrate ) import Database.Groundhog.TH ( groundhog, mkPersist ) import Text.XML.HXT.Core ( XmlTree ) import Text.XML.HXT.DOM.ShowXml ( xshow ) -- Local imports. import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) import TSN.Parse ( parse_message, parse_xmlfid, parse_xml_time_stamp ) import TSN.XmlImport ( XmlImport(..) ) import Xml ( FromXml(..), ToDb(..) ) -- | The DTDs for everything that we consider "Game Info." -- -- TODO: This is the list from the old implementation. We need to -- make sure that we are really receiving XML for these DTDs -- (i.e. the names are correct). -- dtds :: [String] dtds = [ "CBASK_Lineup_XML.dtd", "cbaskpreviewxml.dtd", "cflpreviewxml.dtd", -- missing DTD "Matchup_NBA_NHL_XML.dtd", "mlbpreviewxml.dtd", "MLB_Gaming_Matchup_XML.dtd", "MLB.dtd", -- missing DTD "MLB_Lineup_XML.dtd", "MLB_Matchup_XML.dtd", "MLS_Preview_XML.dtd", "NBA_Gaming_Matchup_XML.dtd", "NBA.dtd", -- missing DTD "NBA_Playoff_Matchup_XML.dtd", "NBALineupXML.dtd", "nbapreviewxml.dtd", "NCAA_FB_Preview_XML.dtd", "nflpreviewxml.dtd", "NFL_NCAA_FB_Matchup_XML.dtd", "nhlpreviewxml.dtd", "recapxml.dtd", "WorldBaseballPreviewXML.dtd" -- missing DTD ] -- | XML representation of a GameInfo \. -- data Message = Message { xml_dtd :: String, xml_xml_file_id :: Int, xml_time_stamp :: UTCTime, xml_xml :: String } deriving (Eq, Show) -- | Attempt to parse a 'Message' from an 'XmlTree'. If we cannot, -- we fail with an error message. -- parse_xml :: String -> XmlTree -> Either String Message parse_xml dtdname xmltree = do xmlfid <- parse_xmlfid xmltree timestamp <- parse_xml_time_stamp xmltree message <- parse_message xmltree return $ Message dtdname (fromInteger xmlfid) timestamp (xshow [message]) -- | Database representation of a 'Message'. -- data GameInfo = GameInfo { db_dtd :: String, db_xml_file_id :: Int, db_time_stamp :: UTCTime, db_xml :: String } instance ToDb Message where -- | The database analogue of a 'Message' is an 'GameInfo'. type Db Message = GameInfo instance FromXml Message where -- | The XML to DB conversion is trivial here. -- from_xml Message{..} = GameInfo { db_dtd = xml_dtd, db_xml_file_id = xml_xml_file_id, db_time_stamp = xml_time_stamp, db_xml = xml_xml } -- | This allows us to insert the XML representation 'Message' -- directly. -- instance XmlImport Message -- -- Database code -- instance DbImport Message where dbmigrate _ = run_dbmigrate $ migrate (undefined :: GameInfo) -- | We import a 'Message' by inserting the whole thing at -- once. Nothing fancy going on here. dbimport msg = do insert_xml_ msg return ImportSucceeded mkPersist tsn_codegen_config [groundhog| - entity: GameInfo constructors: - name: GameInfo uniques: - name: unique_game_info type: constraint # Prevent multiple imports of the same message. fields: [db_xml_file_id] |]