X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FOdds.hs;h=bab8c28ee8e66a30ab05ac87a6c6bf5d26337ebf;hb=c5d61081ad0d95950ca06761978d240632c44510;hp=3e231c2ba3c9653b32b02795dc926df6f6b2d288;hpb=d476419274cdf2997d768444cecc47922a902fdf;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs index 3e231c2..bab8c28 100644 --- a/src/TSN/XML/Odds.hs +++ b/src/TSN/XML/Odds.hs @@ -16,7 +16,6 @@ module TSN.XML.Odds ( -- * Tests odds_tests, -- * WARNING: these are private but exported to silence warnings - Odds_OddsGameConstructor(..), OddsCasinoConstructor(..), OddsConstructor(..), OddsGame_OddsGameTeamConstructor(..), @@ -27,13 +26,12 @@ where -- System imports. import Control.Monad ( forM_, join ) -import Data.Time ( UTCTime ) +import Data.Time ( UTCTime(..) ) import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog ( (=.), (==.), insert_, - insertByAll, migrate, update ) import Database.Groundhog.Core ( DefaultKey ) @@ -62,11 +60,36 @@ import Text.XML.HXT.Core ( import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) -import TSN.Picklers ( xp_date, xp_team_id, xp_time ) -import TSN.XmlImport ( XmlImport(..) ) -import Xml ( FromXml(..), pickle_unpickle, unpickleable ) +import TSN.Picklers ( xp_date, xp_time, xp_time_stamp ) +import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) +import Xml ( + FromXml(..), + FromXmlFk(..), + ToDb(..), + pickle_unpickle, + unpickleable ) +-- +-- DB/XML data types +-- + +-- * OddsGameCasino/OddsGameCasinoXml + + +-- | The casinos should have their own table, but the lines don't +-- belong in that table (there should be another table joining the +-- casinos and the thing the lines are for together.) +-- +-- We drop the 'Game' prefix because the Casinos really aren't +-- children of the games; the XML just makes it seem that way. +-- +data OddsCasino = + OddsCasino { + casino_client_id :: Int, + casino_name :: String } + deriving (Eq, Show) + -- | The home/away lines are 'Double's, but the over/under lines are -- textual. If we want to use one data type for both, we have to go @@ -88,65 +111,73 @@ home_away_line :: OddsGameCasinoXml -> Maybe Double home_away_line = join . (fmap readMaybe) . xml_casino_line --- | The casinos should have their own table, but the lines don't --- belong in that table (there should be another table joining the --- casinos and the thing the lines are for together.) --- --- We drop the 'Game' prefix because the Casinos really aren't --- children of the games; the XML just makes it seem that way. --- -data OddsCasino = - OddsCasino { - casino_client_id :: Int, - casino_name :: String } - deriving (Eq, Show) - -instance FromXml OddsGameCasinoXml where +instance ToDb OddsGameCasinoXml where -- | The database representation of an 'OddsGameCasinoXml' is an -- 'OddsCasino'. -- type Db OddsGameCasinoXml = OddsCasino + +instance FromXml OddsGameCasinoXml where -- | We convert from XML to the database by dropping the line field. from_xml OddsGameCasinoXml{..} = OddsCasino { casino_client_id = xml_casino_client_id, casino_name = xml_casino_name } + -- | This allows us to call 'insert_xml' on an 'OddsGameCasinoXml' -- without first converting it to the database representation. instance XmlImport OddsGameCasinoXml +-- * OddsGameTeam + + -- | The database representation of teams as they appear in odds -- games. -- data OddsGameTeam = OddsGameTeam { - db_team_id :: String, -- ^ The home/away team IDs are 3 characters + db_team_id :: String, -- ^ The home/away team IDs are + -- three characters but Postgres + -- imposes no performance penalty + -- on lengthless text fields, so + -- we ignore the probable upper + -- bound of three characters. db_abbr :: String, db_team_name :: String } deriving (Eq, Show) +-- * OddsGameHomeTeam/OddsGameHomeTeamXml + -- | The XML representation of a \, as found in \s. -- data OddsGameHomeTeamXml = OddsGameHomeTeamXml { - xml_home_team_id :: String, -- ^ These are three-character IDs. + xml_home_team_id :: String, -- ^ The home/away team IDs + -- are three characters but + -- Postgres imposes no + -- performance penalty on + -- lengthless text fields, + -- so we ignore the probable + -- upper bound of three + -- characters. xml_home_rotation_number :: Int, xml_home_abbr :: String, xml_home_team_name :: String, xml_home_casinos :: [OddsGameCasinoXml] } deriving (Eq, Show) -instance FromXml OddsGameHomeTeamXml where +instance ToDb OddsGameHomeTeamXml where -- | The database representation of an 'OddsGameHomeTeamXml' is an -- 'OddsGameTeam'. -- type Db OddsGameHomeTeamXml = OddsGameTeam +instance FromXml OddsGameHomeTeamXml where -- | We convert from XML to the database by dropping the lines and -- rotation number (which are specific to the games, not the teams -- themselves). @@ -164,23 +195,31 @@ instance FromXml OddsGameHomeTeamXml where instance XmlImport OddsGameHomeTeamXml where --- | -- | The XML representation of a \, as found in \s. +-- * OddsGameAwayTeam/OddsGameAwayTeamXml + +-- | The XML representation of a \, as found in \s. -- data OddsGameAwayTeamXml = OddsGameAwayTeamXml { - xml_away_team_id :: String, -- ^ These are 3 character IDs. + xml_away_team_id :: String, -- ^ The home/away team IDs are + -- three characters but Postgres + -- imposes no performance penalty + -- on lengthless text fields, so + -- we ignore the probable upper + -- bound of three characters xml_away_rotation_number :: Int, xml_away_abbr :: String, xml_away_team_name :: String, xml_away_casinos :: [OddsGameCasinoXml] } deriving (Eq, Show) -instance FromXml OddsGameAwayTeamXml where +instance ToDb OddsGameAwayTeamXml where -- | The database representation of an 'OddsGameAwayTeamXml' is an -- 'OddsGameTeam'. -- type Db OddsGameAwayTeamXml = OddsGameTeam +instance FromXml OddsGameAwayTeamXml where -- | We convert from XML to the database by dropping the lines and -- rotation number (which are specific to the games, not the teams -- themselves). @@ -197,6 +236,8 @@ instance FromXml OddsGameAwayTeamXml where instance XmlImport OddsGameAwayTeamXml where +-- * OddsGame_OddsGameTeam + -- | Database mapping between games and their home/away teams. data OddsGame_OddsGameTeam = OddsGame_OddsGameTeam { @@ -205,6 +246,8 @@ data OddsGame_OddsGameTeam = ogogt_home_team_id :: DefaultKey OddsGameTeam } +-- * OddsGameOverUnderXml + -- | XML representation of the over/under. A wrapper around a bunch of -- casino elements. -- @@ -213,6 +256,8 @@ newtype OddsGameOverUnderXml = deriving (Eq, Show) +-- * OddsGameLine + -- | This database representation of the casino lines can't be -- constructed from the one in the XML. The casinos within -- Game>HomeTeam, Game>AwayTeam, and Game>Over_Under are all more or @@ -233,26 +278,28 @@ data OddsGameLine = ogl_home_line :: Maybe Double } +-- * OddsGame/OddsGameXml + -- | Database representation of a game. We retain the rotation number -- of the home/away teams, since those are specific to the game and -- not the teams. -- data OddsGame = OddsGame { + db_odds_id :: DefaultKey Odds, db_game_id :: Int, - db_game_date :: UTCTime, - db_game_time :: UTCTime, + db_game_time :: UTCTime, -- ^ Contains both the date and time. db_game_away_team_rotation_number :: Int, db_game_home_team_rotation_number :: Int } - deriving (Eq, Show) + -- | XML representation of a game. -- data OddsGameXml = OddsGameXml { xml_game_id :: Int, - xml_game_date :: UTCTime, - xml_game_time :: UTCTime, + xml_game_date :: UTCTime, -- ^ Contains only the date + xml_game_time :: UTCTime, -- ^ Contains only the time xml_game_away_team :: OddsGameAwayTeamXml, xml_game_home_team :: OddsGameHomeTeamXml, xml_game_over_under :: OddsGameOverUnderXml } @@ -265,47 +312,41 @@ xml_game_over_under_casinos :: OddsGameXml -> [OddsGameCasinoXml] xml_game_over_under_casinos = xml_casinos . xml_game_over_under -instance FromXml OddsGameXml where +instance ToDb OddsGameXml where -- | The database representation of an 'OddsGameXml' is an -- 'OddsGame'. -- type Db OddsGameXml = OddsGame +instance FromXmlFk OddsGameXml where + type Parent OddsGameXml = Odds + -- | To convert from the XML representation to the database one, we -- drop the home/away teams and the casino lines, but retain the -- home/away rotation numbers. -- - from_xml OddsGameXml{..} = + from_xml_fk fk OddsGameXml{..} = OddsGame { + db_odds_id = fk, db_game_id = xml_game_id, - db_game_date = xml_game_date, - db_game_time = xml_game_time, + + db_game_time = UTCTime + (utctDay xml_game_date) -- Take the day part from one, + (utctDayTime xml_game_time), -- the time from the other. + db_game_away_team_rotation_number = (xml_away_rotation_number xml_game_away_team), + db_game_home_team_rotation_number = (xml_home_rotation_number xml_game_home_team) } --- | This lets us call 'insert_xml' directly on an 'OddsGameXml' +-- | This lets us call 'insert_xml_fk' directly on an 'OddsGameXml' -- without converting it to the database representation explicitly. -- -instance XmlImport OddsGameXml +instance XmlImportFk OddsGameXml --- | Database and representation of the top-level Odds object (a --- 'Message'). -data Odds = - Odds { - db_sport :: String, - db_title :: String, - db_line_time :: String } - - --- | Map 'Odds' to their children 'OddsGame's. --- -data Odds_OddsGame = Odds_OddsGame - (DefaultKey Odds) - (DefaultKey OddsGame) - +-- * OddsGameWithNotes -- | This is our best guess at what occurs in the Odds_XML -- documents. It looks like each consecutive set of games can @@ -326,6 +367,23 @@ data OddsGameWithNotes = game :: OddsGameXml } deriving (Eq, Show) + +-- * Odds/Message + +-- | Database and representation of the top-level Odds object (a +-- 'Message'). +data Odds = + Odds { + db_xml_file_id :: Int, + db_sport :: String, + db_title :: String, + db_line_time :: String, -- ^ We don't parse these as a 'UTCTime' + -- because their timezones are ambiguous + -- (and the date is less than useful when + -- it might be off by an hour). + db_time_stamp :: UTCTime } + + -- | The XML representation of 'Odds'. data Message = Message { @@ -336,7 +394,7 @@ data Message = xml_title :: String, xml_line_time :: String, xml_games_with_notes :: [OddsGameWithNotes], - xml_time_stamp :: String } + xml_time_stamp :: UTCTime } deriving (Eq, Show) -- | Pseudo-field that lets us get the 'OddsGame's out of @@ -346,19 +404,22 @@ xml_games :: Message -> [OddsGameXml] xml_games m = map game (xml_games_with_notes m) -instance FromXml Message where +instance ToDb Message where -- | The database representation of a 'Message' is 'Odds'. -- type Db Message = Odds +instance FromXml Message where -- | To convert from the XML representation to the database one, we -- just drop a bunch of fields. -- from_xml Message{..} = Odds { + db_xml_file_id = xml_xml_file_id, db_sport = xml_sport, db_title = xml_title, - db_line_time = xml_line_time } + db_line_time = xml_line_time, + db_time_stamp = xml_time_stamp } -- | This lets us call 'insert_xml' on a Message directly, without -- having to convert it to its database representation explicitly. @@ -366,11 +427,21 @@ instance FromXml Message where instance XmlImport Message +-- +-- Database code +-- -- Groundhog database schema. This must come before the DbImport --- instance definition. +-- instance definition. Don't know why. mkPersist tsn_codegen_config [groundhog| - entity: Odds + constructors: + - name: Odds + uniques: + - name: unique_odds + type: constraint + # Prevent multiple imports of the same message. + fields: [db_xml_file_id] - entity: OddsCasino dbName: odds_casinos @@ -385,9 +456,6 @@ mkPersist tsn_codegen_config [groundhog| dbName: odds_games_teams constructors: - name: OddsGameTeam - fields: - - name: db_team_id - type: varchar(3) # We've only seen 3, so far... uniques: - name: unique_odds_games_team type: constraint @@ -398,26 +466,37 @@ mkPersist tsn_codegen_config [groundhog| dbName: odds_games constructors: - name: OddsGame - uniques: - - name: unique_odds_game - type: constraint - fields: [db_game_id] + fields: + - name: db_odds_id + reference: + onDelete: cascade - entity: OddsGameLine dbName: odds_games_lines - -- entity: Odds_OddsGame - dbName: odds__odds_games constructors: - - name: Odds_OddsGame + - name: OddsGameLine fields: - - name: odds_OddsGame0 # Default created by mkNormalFieldName - dbName: odds_id - - name: odds_OddsGame1 # Default created by mkNormalFieldName - dbName: odds_games_id + - name: ogl_odds_games_id + references: + onDelete: cascade + - name: ogl_odds_casinos_id + references: + onDelete: cascade - entity: OddsGame_OddsGameTeam dbName: odds_games__odds_games_teams + constructors: + - name: OddsGame_OddsGameTeam + fields: + - name: ogogt_odds_games_id + reference: + onDelete: cascade + - name: ogogt_away_team_id + reference: + onDelete: cascade + - name: ogogt_home_team_id + reference: + onDelete: cascade |] instance DbImport Message where @@ -427,7 +506,6 @@ instance DbImport Message where migrate (undefined :: OddsCasino) migrate (undefined :: OddsGameTeam) migrate (undefined :: OddsGame) - migrate (undefined :: Odds_OddsGame) migrate (undefined :: OddsGame_OddsGameTeam) migrate (undefined :: OddsGameLine) @@ -435,19 +513,17 @@ instance DbImport Message where -- Insert the root "odds" element and acquire its primary key (id). odds_id <- insert_xml m - -- Next, we insert the home and away teams. We do this before - -- inserting the game itself because the game has two foreign keys - -- pointing to odds_games_teams. forM_ (xml_games m) $ \g -> do - game_id <- insert_xml_or_select g - -- Insert a record into odds__odds_game mapping this game - -- to its parent in the odds table. - insert_ (Odds_OddsGame odds_id game_id) - + -- Next, we insert the home and away teams. We do this before + -- inserting the game itself because the game has two foreign keys + -- pointing to odds_games_teams. -- Next to insert the home and away teams. away_team_id <- insert_xml_or_select (xml_game_away_team g) home_team_id <- insert_xml_or_select (xml_game_home_team g) + -- Now insert the game, keyed to the "odds", + game_id <- insert_xml_fk odds_id g + -- Insert a record into odds_games__odds_games_teams mapping the -- home/away teams to this game. Use the full record syntax -- because the types would let us mix up the home/away teams. @@ -472,12 +548,12 @@ instance DbImport Message where ogl_away_line = Nothing, ogl_home_line = Nothing } - insertByAll ogl + insert_ ogl -- ...but then when we insert the home/away team lines, we -- prefer to update the existing entry rather than overwrite it -- or add a new record. - forM_ (xml_away_casinos $ xml_game_away_team g) $ \c ->do + forM_ (xml_away_casinos $ xml_game_away_team g) $ \c -> do -- insert, or more likely retrieve the existing, casino a_casino_id <- insert_xml_or_select c @@ -499,6 +575,11 @@ instance DbImport Message where return ImportSucceeded + +-- +-- Pickling +-- + -- | Pickler for an 'OddsGame' optionally preceded by some notes. -- pickle_game_with_notes :: PU OddsGameWithNotes @@ -537,7 +618,7 @@ pickle_home_team = xpElem "HomeTeam" $ xpWrap (from_tuple, to_tuple) $ xp5Tuple - (xpElem "HomeTeamID" xp_team_id) + (xpElem "HomeTeamID" xpText) (xpElem "HomeRotationNumber" xpInt) (xpElem "HomeAbbr" xpText) (xpElem "HomeTeamName" xpText) @@ -559,7 +640,7 @@ pickle_away_team = xpElem "AwayTeam" $ xpWrap (from_tuple, to_tuple) $ xp5Tuple - (xpElem "AwayTeamID" xp_team_id) + (xpElem "AwayTeamID" xpText) (xpElem "AwayRotationNumber" xpInt) (xpElem "AwayAbbr" xpText) (xpElem "AwayTeamName" xpText) @@ -624,7 +705,7 @@ pickle_message = (xpElem "Title" xpText) (xpElem "Line_Time" xpText) (xpList pickle_game_with_notes) - (xpElem "time_stamp" xpText) + (xpElem "time_stamp" xp_time_stamp) where from_tuple = uncurryN Message to_tuple m = (xml_xml_file_id m, @@ -652,7 +733,7 @@ odds_tests = -- | If we unpickle something and then pickle it, we should wind up --- with the same thing we started with. WARNING: succeess of this +-- with the same thing we started with. WARNING: success of this -- test does not mean that unpickling succeeded. -- test_pickle_of_unpickle_is_identity :: TestTree