X-Git-Url: https://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FEarlyLine.hs;h=71379f9759f905b47c71a7f57303e5c8f5120b9e;hb=3584cc9d62f48df2042fb29abeb9ef40933d9f2a;hp=5aa2254614d5ca16ecba341c59e2c4843d5f81c4;hpb=6674a915d50cc41e4c5b12e42f2fcbb65e2bf195;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs
index 5aa2254..71379f9 100644
--- a/src/TSN/XML/EarlyLine.hs
+++ b/src/TSN/XML/EarlyLine.hs
@@ -227,7 +227,8 @@ data EarlyLineGame =
 --
 data EarlyLineGameXml =
   EarlyLineGameXml {
-    xml_game_time :: UTCTime, -- ^ Only an ambiguous time string, e.g. \"8:30\"
+    xml_game_time :: Maybe UTCTime, -- ^ Only an ambiguous time string,
+                                    --   e.g. \"8:30\". Can be empty.
     xml_away_team :: EarlyLineGameTeamXml,
     xml_home_team :: EarlyLineGameTeamXml,
     xml_over_under :: Maybe String }
@@ -249,7 +250,7 @@ data EarlyLineGameXml =
 --
 data EarlyLineGameTeam =
   EarlyLineGameTeam {
-    db_rotation_number :: Int,
+    db_rotation_number :: Maybe Int, -- ^ Usually there but sometimes empty.
     db_line :: Maybe String, -- ^ Can be blank, a Double, or \"off\".
     db_team_name :: Maybe String, -- ^ NOT optional, see the data type docs.
     db_pitcher :: Maybe String -- ^ Optional in MLB_earlylineXML.dtd,
@@ -280,7 +281,7 @@ data EarlyLineGameTeam =
 --
 data EarlyLineGameTeamXml =
   EarlyLineGameTeamXml {
-    xml_rotation_number :: Int,
+    xml_rotation_number :: Maybe Int,
     xml_line_attr :: Maybe String,
     xml_team_name_attr :: Maybe String,
     xml_team_name_text :: Maybe String,
@@ -345,11 +346,15 @@ date_to_games fk date =
     games_only :: [EarlyLineGameXml]
     games_only = (map date_game (date_games_with_notes date))
 
-    -- | Stick the date value into the given game.
+    -- | Stick the date value into the given game. If our
+    --   'EarlyLineGameXml' has an 'xml_game_time', then we combine it
+    --   with the day portion of the supplied @date@. If not, then we
+    --   just use @date as-is.
     --
     combine_date_time :: EarlyLineGameXml -> UTCTime
-    combine_date_time elgx =
-      UTCTime (utctDay $ date_value date) (utctDayTime $ xml_game_time elgx)
+    combine_date_time (EarlyLineGameXml (Just t) _ _ _) =
+      UTCTime (utctDay $ date_value date) (utctDayTime t)
+    combine_date_time (EarlyLineGameXml Nothing _ _ _ ) = date_value date
 
     -- | Convert an XML game to a database one.
     --
@@ -502,7 +507,7 @@ pickle_game :: PU EarlyLineGameXml
 pickle_game =
   xpElem "game" $
     xpWrap (from_tuple, to_tuple) $
-    xp4Tuple (xpElem "time" xp_ambiguous_time)
+    xp4Tuple (xpElem "time" (xpOption xp_ambiguous_time))
              pickle_away_team
              pickle_home_team
              (xpElem "over_under" (xpOption xpText))
@@ -543,7 +548,7 @@ pickle_home_team = xpElem "teamH" pickle_team
 pickle_team :: PU EarlyLineGameTeamXml
 pickle_team =
   xpWrap (from_tuple, to_tuple) $
-  xp6Tuple (xpAttr "rotation" xpInt)
+  xp6Tuple (xpAttr "rotation" (xpOption xpInt))
            (xpOption $ xpAttr "line" (xpOption xpText))
            (xpOption $ xpAttr "name" xpText)
            (xpOption xpText)
@@ -582,24 +587,33 @@ early_line_tests =
 --   test does not mean that unpickling succeeded.
 --
 test_pickle_of_unpickle_is_identity :: TestTree
-test_pickle_of_unpickle_is_identity =
-  testCase "pickle composed with unpickle is the identity" $ do
-    let path = "test/xml/earlylineXML.xml"
-    (expected, actual) <- pickle_unpickle pickle_message path
-    actual @?= expected
+test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $
+  [ check "pickle composed with unpickle is the identity"
+          "test/xml/earlylineXML.xml",
+
+    check "pickle composed with unpickle is the identity (empty game time)"
+          "test/xml/earlylineXML-empty-game-time.xml" ]
+  where
+    check desc path = testCase desc $ do
+      (expected, actual) <- pickle_unpickle pickle_message path
+      actual @?= expected
 
 
 
 -- | Make sure we can actually unpickle these things.
 --
 test_unpickle_succeeds :: TestTree
-test_unpickle_succeeds =
-  testCase "unpickling succeeds" $ do
-    let path = "test/xml/earlylineXML.xml"
-    actual <- unpickleable path pickle_message
+test_unpickle_succeeds = testGroup "unpickle tests" $
+  [ check "unpickling succeeds"
+          "test/xml/earlylineXML.xml",
 
-    let expected = True
-    actual @?= expected
+    check "unpickling succeeds (empty game time)"
+          "test/xml/earlylineXML-empty-game-time.xml" ]
+  where
+    check desc path = testCase desc $ do
+      actual <- unpickleable path pickle_message
+      let expected = True
+      actual @?= expected
 
 
 
@@ -607,21 +621,26 @@ test_unpickle_succeeds =
 --   record.
 --
 test_on_delete_cascade :: TestTree
-test_on_delete_cascade =
-  testCase "deleting early_lines deletes its children" $ do
-    let path = "test/xml/earlylineXML.xml"
-    results <- unsafe_unpickle path pickle_message
-    let a = undefined :: EarlyLine
-    let b = undefined :: EarlyLineGame
-
-    actual <- withSqliteConn ":memory:" $ runDbConn $ do
-                runMigration silentMigrationLogger $ do
-                  migrate a
-                  migrate b
-                _ <- dbimport results
-                deleteAll a
-                count_a <- countAll a
-                count_b <- countAll b
-                return $ sum [count_a, count_b]
-    let expected = 0
-    actual @?= expected
+test_on_delete_cascade = testGroup "cascading delete tests" $
+  [ check "deleting early_lines deletes its children"
+          "test/xml/earlylineXML.xml",
+
+    check "deleting early_lines deletes its children (empty game time)"
+          "test/xml/earlylineXML-empty-game-time.xml" ]
+  where
+    check desc path = testCase desc $ do
+      results <- unsafe_unpickle path pickle_message
+      let a = undefined :: EarlyLine
+      let b = undefined :: EarlyLineGame
+
+      actual <- withSqliteConn ":memory:" $ runDbConn $ do
+                  runMigration silentMigrationLogger $ do
+                    migrate a
+                    migrate b
+                  _ <- dbimport results
+                  deleteAll a
+                  count_a <- countAll a
+                  count_b <- countAll b
+                  return $ sum [count_a, count_b]
+      let expected = 0
+      actual @?= expected