X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FOdds.hs;h=619debca3e9079e809ed53400fa30f932a68019d;hb=693c0f45aff513b42d6d612c0a93fddc8f5c3cca;hp=fed7fa11a3fcc6066e3b2eda4c184c0039dba9f5;hpb=3a8d465bcc6f36b6e7601cf1902e575171aa7beb;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs
index fed7fa1..619debc 100644
--- a/src/TSN/XML/Odds.hs
+++ b/src/TSN/XML/Odds.hs
@@ -64,7 +64,7 @@ import Text.XML.HXT.Core (
 import TSN.Codegen (
   tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
-import TSN.Picklers ( xp_date_padded, xp_time, xp_time_stamp )
+import TSN.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp )
 import TSN.Team ( FromXmlFkTeams(..), Team(..) )
 import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) )
 import Xml (
@@ -251,7 +251,7 @@ data OddsGame =
     db_away_team_id      :: DefaultKey Team,
     db_home_team_id      :: DefaultKey Team,
     db_game_id           :: Int,
-    db_game_time         :: UTCTime, -- ^ Contains both the date and time.
+    db_game_time         :: Maybe UTCTime, -- ^ Contains both the date and time.
     db_away_team_rotation_number :: Maybe Int,
     db_home_team_rotation_number :: Maybe Int,
     db_away_team_starter_id :: Maybe Int,
@@ -266,7 +266,7 @@ data OddsGameXml =
   OddsGameXml {
     xml_game_id         :: Int,
     xml_game_date       :: UTCTime, -- ^ Contains only the date
-    xml_game_time       :: UTCTime, -- ^ Contains only the time
+    xml_game_time       :: Maybe UTCTime, -- ^ Contains only the time
     xml_away_team  :: OddsGameTeamXml,
     xml_home_team  :: OddsGameTeamXml,
     xml_over_under :: OddsGameOverUnderXml }
@@ -306,9 +306,7 @@ instance FromXmlFkTeams OddsGameXml where
       db_home_team_id = fk_home,
       db_game_id   = xml_game_id,
 
-      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_time = make_game_time xml_game_date xml_game_time,
 
       db_away_team_rotation_number =
         (xml_team_rotation_number xml_away_team),
@@ -331,6 +329,16 @@ instance FromXmlFkTeams OddsGameXml where
       -- so we combine the two maybes with join.
       db_home_team_starter_name = join
         (xml_starter_name <$> xml_team_starter xml_home_team) }
+    where
+      -- | Construct the database game time from the XML \<Game_Date\>
+      --   and \<Game_Time\> elements. The \<Game_Time\> elements
+      --   sometimes have a value of \"TBA\"; in that case, we don't
+      --   want to pretend that we know the time by setting it to
+      --   e.g. midnight, so instead we make the entire date/time
+      --   Nothing.
+      make_game_time :: UTCTime -> Maybe UTCTime -> Maybe UTCTime
+      make_game_time _ Nothing = Nothing
+      make_game_time d (Just t) = Just $ UTCTime (utctDay d) (utctDayTime t)
 
 
 -- | This lets us insert the XML representation 'OddsGameXml' directly.
@@ -680,7 +688,7 @@ pickle_game =
   xp6Tuple
     (xpElem "GameID" xpInt)
     (xpElem "Game_Date" xp_date_padded)
-    (xpElem "Game_Time" xp_time)
+    (xpElem "Game_Time" xp_tba_time)
     pickle_away_team
     pickle_home_team
     pickle_over_under
@@ -758,7 +766,10 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
           "test/xml/Odds_XML-league-name.xml",
 
     check "pickle composed with unpickle is the identity (missing starters)"
-          "test/xml/Odds_XML-missing-starters.xml" ]
+          "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"]
   where
     check desc path = testCase desc $ do
       (expected, actual) <- pickle_unpickle pickle_message path
@@ -785,7 +796,10 @@ test_unpickle_succeeds = testGroup "unpickle tests"
           "test/xml/Odds_XML-league-name.xml",
 
     check "unpickling succeeds (missing starters)"
-          "test/xml/Odds_XML-missing-starters.xml" ]
+          "test/xml/Odds_XML-missing-starters.xml",
+
+    check "unpickling succeeds (TBA game time)"
+          "test/xml/Odds_XML-tba-game-time.xml" ]
   where
     check desc path = testCase desc $ do
       actual <- unpickleable path pickle_message
@@ -824,6 +838,10 @@ test_on_delete_cascade = testGroup "cascading delete tests"
     check "deleting odds deleted its children (missing starters)"
           "test/xml/Odds_XML-missing-starters.xml"
           7 -- 5 casinos, 2 teams
+    ,
+    check "deleting odds deleted its children (TBA game time)"
+          "test/xml/Odds_XML-tba-game-time.xml"
+          119 -- 5 casinos, 114 teams
     ]
   where
     check desc path expected = testCase desc $ do