xpWrap )
-- Local imports.
-import TSN.Codegen (
- tsn_codegen_config )
+import TSN.Codegen ( tsn_codegen_config )
+import TSN.Database ( insert_or_select )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp )
import TSN.Team ( FromXmlFkTeams(..), Team(..) )
-- with a 'String' and then attempt to 'read' a 'Double' later when we
-- go to insert the thing.
--
+-- The client_id and name shouldn't really be optional, but TSN has
+-- started to send us empty casinos:
+--
+-- \<Casino ClientID=\"\" Name=\"\"\>\</Casino\>
+--
+-- We need to parse these, but we'll silently drop them during the
+-- database import.
+--
data OddsGameCasinoXml =
OddsGameCasinoXml {
- xml_casino_client_id :: Int,
- xml_casino_name :: String,
+ xml_casino_client_id :: Maybe Int,
+ xml_casino_name :: Maybe String,
xml_casino_line :: Maybe String }
deriving (Eq, Show)
instance ToDb OddsGameCasinoXml where
-- | The database representation of an 'OddsGameCasinoXml' is an
- -- 'OddsCasino'.
+ -- 'OddsCasino'. When our XML representation is missing a
+ -- client_id or a name, we want to ignore it. So in that case,
+ -- when we convert to the database type, we want 'Nothing'.
--
- type Db OddsGameCasinoXml = OddsCasino
+ type Db OddsGameCasinoXml = Maybe OddsCasino
instance FromXml OddsGameCasinoXml where
- -- | We convert from XML to the database by dropping the line field.
+ -- | We convert from XML to the database by dropping the
+ -- 'xml_casino_line' field. If either the 'xml_casino_client_id'
+ -- or 'xml_casino_name' is missing ('Nothing'), we'll return
+ -- 'Nothing'.
--
- from_xml OddsGameCasinoXml{..} =
- OddsCasino {
- casino_client_id = xml_casino_client_id,
- casino_name = xml_casino_name }
+ from_xml (OddsGameCasinoXml Nothing _ _) = Nothing
+ from_xml (OddsGameCasinoXml _ Nothing _) = Nothing
+ from_xml (OddsGameCasinoXml (Just c) (Just n) _) =
+ Just OddsCasino { casino_client_id = c, casino_name = n }
--- | This allows us to insert the XML representation 'OddsGameCasinoXml'
--- directly.
---
-instance XmlImport OddsGameCasinoXml
-- * OddsGameTeamXml / OddsGameTeamStarterXml
-- Finally, 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_over_under_casinos game) $ \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 }
-
- insert_ ogl
+ -- freely with empty away/home lines.
+ --
+ -- Before we continue, we drop all casinos that are missing
+ -- either a client_id or name field.
+ --
+ let ou_casinos = filter nonempty_casino $ xml_over_under_casinos game
+
+ forM_ ou_casinos $ \c ->
+ -- Since we already filtered out the casinos without a
+ -- client_id or a name, the database conversion should always
+ -- return (Just something).
+ case (from_xml c) of
+ Nothing -> return () -- Should never happen, we filtered them out.
+ Just casino -> do
+ -- Start by inserting the casino.
+ ou_casino_id <- insert_or_select casino
+
+ -- 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 }
+
+ 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_team_casinos $ xml_away_team game) $ \c -> do
- -- insert, or more likely retrieve the existing, casino
- a_casino_id <- insert_xml_or_select c
+ let away_casinos = filter nonempty_casino $
+ xml_team_casinos (xml_away_team game)
- -- Get a Maybe Double instead of the Maybe String that's in there.
- let away_line = home_away_line c
+ forM_ away_casinos $ \c ->
+ case (from_xml c) of
+ Nothing -> return () -- Should never happen, we filtered them out.
+ Just casino -> do
+ -- insert, or more likely retrieve the existing, casino
+ a_casino_id <- insert_or_select casino
- -- Unconditionally update that casino's away team line with ours.
- update [Ogl_Away_Line =. away_line] $ -- WHERE
- Ogl_Odds_Casinos_Id ==. a_casino_id
+ -- 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_team_casinos $ xml_home_team game) $ \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
+ let home_casinos = filter nonempty_casino $
+ xml_team_casinos (xml_home_team game)
+
+ forM_ home_casinos $ \c ->
+ case (from_xml c) of
+ Nothing -> return () -- Should never happen, we filtered them out.
+ Just casino -> do
+ h_casino_id <- insert_or_select casino
+ 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
+ where
+ nonempty_casino :: OddsGameCasinoXml -> Bool
+ nonempty_casino (OddsGameCasinoXml Nothing _ _) = False
+ nonempty_casino (OddsGameCasinoXml _ Nothing _) = False
+ nonempty_casino _ = True
--
-- Pickling
xpElem "Casino" $
xpWrap (from_tuple, to_tuple) $
xpTriple
- (xpAttr "ClientID" xpInt)
- (xpAttr "Name" xpText)
+ (xpAttr "ClientID" $ xpOption xpInt)
+ (xpAttr "Name" $ xpOption xpText)
(xpOption xpText)
where
from_tuple = uncurryN OddsGameCasinoXml
"test/xml/Odds_XML-missing-starters.xml",
check "pickle composed with unpickle is the identity (TBA game time)"
- "test/xml/Odds_XML-tba-game-time.xml"]
+ "test/xml/Odds_XML-tba-game-time.xml",
+
+ check "pickle composed with unpickle is the identity (empty casino)"
+ "test/xml/Odds_XML-empty-casino.xml" ]
where
check desc path = testCase desc $ do
(expected, actual) <- pickle_unpickle pickle_message path
"test/xml/Odds_XML-missing-starters.xml",
check "unpickling succeeds (TBA game time)"
- "test/xml/Odds_XML-tba-game-time.xml" ]
+ "test/xml/Odds_XML-tba-game-time.xml",
+
+ check "unpickling succeeds (empty casino)"
+ "test/xml/Odds_XML-empty-casino.xml" ]
where
check desc path = testCase desc $ do
actual <- unpickleable path pickle_message
check "deleting odds deleted its children (TBA game time)"
"test/xml/Odds_XML-tba-game-time.xml"
119 -- 5 casinos, 114 teams
+ ,
+ check "deleting odds deleted its children (empty casino)"
+ "test/xml/Odds_XML-empty-casino.xml"
+ 11 -- 5 casinos, 6 teams
]
where
check desc path expected = testCase desc $ do
projects / dead / htsn-import.git / commitdiff