+-- | Pseudo-field that lets us get the 'OddsGame's out of
+-- 'xml_games_with_notes'.
+--
+xml_games :: Message -> [OddsGameXml]
+xml_games m = map game (xml_games_with_notes m)
+
+
+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_sport = xml_sport,
+ db_title = xml_title,
+ db_line_time = xml_line_time }
+
+-- | This lets us call 'insert_xml' on a Message directly, without
+-- having to convert it to its database representation explicitly.
+--
+instance XmlImport Message
+
+
+
+-- Groundhog database schema. This must come before the DbImport
+-- instance definition.
+mkPersist tsn_codegen_config [groundhog|
+- entity: Odds
+
+- entity: OddsCasino
+ dbName: odds_casinos
+ constructors:
+ - name: OddsCasino
+ uniques:
+ - name: unique_odds_casino
+ type: constraint
+ fields: [casino_client_id]
+
+- entity: OddsGameTeam
+ dbName: odds_games_teams
+ constructors:
+ - name: OddsGameTeam
+ uniques:
+ - name: unique_odds_games_team
+ type: constraint
+ fields: [db_team_id]
+
+
+- entity: OddsGame
+ dbName: odds_games
+ constructors:
+ - name: OddsGame
+ uniques:
+ - name: unique_odds_game
+ type: constraint
+ fields: [db_game_id]
+
+- entity: OddsGameLine
+ dbName: odds_games_lines
+
+- entity: Odds_OddsGame
+ dbName: odds__odds_games
+ constructors:
+ - name: Odds_OddsGame
+ fields:
+ - name: odds_OddsGame0 # Default created by mkNormalFieldName
+ dbName: odds_id
+ reference:
+ onDelete: cascade
+ - name: odds_OddsGame1 # Default created by mkNormalFieldName
+ dbName: odds_games_id
+ reference:
+ 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
+ dbmigrate _=
+ run_dbmigrate $ do
+ migrate (undefined :: Odds)
+ migrate (undefined :: OddsCasino)
+ migrate (undefined :: OddsGameTeam)
+ migrate (undefined :: OddsGame)
+ migrate (undefined :: Odds_OddsGame)
+ migrate (undefined :: OddsGame_OddsGameTeam)
+ migrate (undefined :: OddsGameLine)
+
+ dbimport m = do
+ -- 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 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)
+
+ -- 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.
+ insert_ OddsGame_OddsGameTeam {
+ ogogt_odds_games_id = game_id,
+ ogogt_away_team_id = away_team_id,
+ ogogt_home_team_id = home_team_id }
+
+ -- Finaly, we insert the lines. The over/under entries for this
+ -- game and the lines for the casinos all wind up in the same
+ -- table, odds_games_lines. We can insert the over/under entries
+ -- freely with empty away/home lines:
+ forM_ (xml_game_over_under_casinos g) $ \c -> do
+ -- Start by inderting the casino.
+ ou_casino_id <- insert_xml_or_select c
+
+ -- Now add the over/under entry with the casino's id.
+ let ogl = OddsGameLine {
+ ogl_odds_games_id = game_id,
+ ogl_odds_casinos_id = ou_casino_id,
+ ogl_over_under = (xml_casino_line c),
+ ogl_away_line = Nothing,
+ ogl_home_line = Nothing }
+
+ insertByAll 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
+ -- insert, or more likely retrieve the existing, casino
+ a_casino_id <- insert_xml_or_select c
+
+ -- Get a Maybe Double instead of the Maybe String that's in there.
+ let away_line = home_away_line c
+
+ -- Unconditionally update that casino's away team line with ours.
+ update [Ogl_Away_Line =. away_line] $ -- WHERE
+ Ogl_Odds_Casinos_Id ==. a_casino_id
+
+ -- Repeat all that for the home team.
+ forM_ (xml_home_casinos $ xml_game_home_team g) $ \c ->do
+ h_casino_id <- insert_xml_or_select c
+ let home_line = home_away_line c
+ update [Ogl_Home_Line =. home_line] $ -- WHERE
+ Ogl_Odds_Casinos_Id ==. h_casino_id
+
+ return game_id
+
+ return ImportSucceeded
+
+-- | Pickler for an 'OddsGame' optionally preceded by some notes.
+--
+pickle_game_with_notes :: PU OddsGameWithNotes
+pickle_game_with_notes =
+ xpWrap (from_pair, to_pair) $
+ xpPair
+ (xpList $ xpElem "Notes" xpText)
+ pickle_game
+ where
+ from_pair = uncurry OddsGameWithNotes
+ to_pair OddsGameWithNotes{..} = (notes, game)
+