From fcc8c66fa433134d374f9347329ffa122ad0e4be Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 28 Oct 2014 21:23:41 -0400
Subject: [PATCH] Allow empty game <time> elements (with a test case) in
 TSN.XML.EarlyLine.

---
 doc/man1/htsn-import.1                    |  4 ++
 src/TSN/XML/EarlyLine.hs                  | 87 ++++++++++++++---------
 test/shell/import-duplicates.test         |  4 +-
 test/xml/earlylineXML-empty-game-time.xml |  1 +
 4 files changed, 60 insertions(+), 36 deletions(-)
 create mode 100644 test/xml/earlylineXML-empty-game-time.xml

diff --git a/doc/man1/htsn-import.1 b/doc/man1/htsn-import.1
index f07d0f1..bdb5046 100644
--- a/doc/man1/htsn-import.1
+++ b/doc/man1/htsn-import.1
@@ -439,6 +439,10 @@ don't have any other information upon which to base a guess. Even if
 one ignores the UTC time zone, the time can possibly be off by 12
 hours (due to the a.m./p.m. issue).
 
+The game <time> elements can also be empty. Since we store the
+combined game date/time in one field, these games will appear to begin
+at midnight on the day they occur.
+
 .IP \[bu]
 \fIjfilexml.dtd\fR
 
diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs
index 5aa2254..b0d118d 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 }
@@ -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))
@@ -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
diff --git a/test/shell/import-duplicates.test b/test/shell/import-duplicates.test
index 39ef412..1cc7bd6 100644
--- a/test/shell/import-duplicates.test
+++ b/test/shell/import-duplicates.test
@@ -16,7 +16,7 @@ rm -f shelltest.sqlite3
 # and a newsxml that aren't really supposed to import.
 find ./test/xml -maxdepth 1 -name '*.xml' | wc -l
 >>>
-38
+39
 >>>= 0
 
 # Run the imports again; we should get complaints about the duplicate
@@ -26,7 +26,7 @@ find ./test/xml -maxdepth 1 -name '*.xml' | wc -l
 # know, sorry.
 ./dist/build/htsn-import/htsn-import -c 'shelltest.sqlite3' test/xml/*.xml 2>&1 | grep ERROR | wc -l
 >>>
-68
+70
 >>>= 0
 
 # Finally, clean up after ourselves.
diff --git a/test/xml/earlylineXML-empty-game-time.xml b/test/xml/earlylineXML-empty-game-time.xml
new file mode 100644
index 0000000..84dced7
--- /dev/null
+++ b/test/xml/earlylineXML-empty-game-time.xml
@@ -0,0 +1 @@
+<?xml version="1.0" standalone="no" ?>
<!DOCTYPE message PUBLIC "-//TSN//DTD Odds 1.0/EN" "earlylineXML.dtd">
<message>
<XML_File_ID>22064237</XML_File_ID>
<heading>ADO;NHL-EARLY-LINE</heading>
<category>Odds</category>
<sport>NHL</sport>
<title>National Hockey League Overnight Line</title>
<date value="TUESDAY, OCTOBER 28TH (10/28/2014)">
<game>
<time></time>
<teamA rotation="" line=""></teamA>
<teamH rotation="001" line="">Ottawa</teamH>
<over_under></over_under>
</game>
<game>
<time></time>
<teamA rotation="" line="5.5u">Over/Under:</teamA>
<teamH rotation="" line=""></teamH>
<over_under></over_under>
</game>
<game>
<time></time>
<teamA rotation="004" line="-170">Pittsburgh</teamA>
<teamH rotation="" line="5.5u">Over/Under:</teamH>
<over_under></over_under>
</game>
<game>
<time>7:00</time>
<teamA rotation="005" line="">Los Angeles</teamA>
<teamH rotation="006" line="off">Philadelphia</teamH>
<over_under></over_under>
</game>
<game>
<time>7:00</time>
<teamA rotation="007" line="">Winnipeg</teamA>
<teamH rotation="008" line="-160">NY Islanders</teamH>
<over_under>5.5o</over_under>
</game>
<game>
<time>7:00</time>
<teamA rotation="009" line="">Minnesota</teamA>
<teamH rotation="010" line="-160">Boston</teamH>
<over_under>5u</over_under>
</game>
<game>
<time>7:30</time>
<teamA rotation="011" line="">Buffalo</teamA>
<teamH rotation="012" line="-220">Toronto</teamH>
<over_under>5.5u</over_under>
</game>
<game>
<time>7:30</time>
<teamA rotation="013" line="">Arizona</teamA>
<teamH rotation="014" line="-170">Tampa Bay</teamH>
<over_under>5.5p</over_under>
</game>
<game>
<time>8:30</time>
<teamA rotation="015" line="">St. Louis</teamA>
<teamH rotation="016" line="-120">Dallas</teamH>
<over_under>5o</over_under>
</game>
<game>
<time>8:30</time>
<teamA rotation="017" line="">Anaheim</teamA>
<teamH rotation="018" line="-150">Chicago</teamH>
<over_under>5.5u</over_under>
</game>
<game>
<time>9:00</time>
<teamA rotation="019" line="-120">San Jose</teamA>
<teamH rotation="020" line="">Colorado</teamH>
<over_under>5.5p</over_under>
</game>
<game>
<time>9:00</time>
<teamA rotation="021" line="">Montreal</teamA>
<teamH rotation="022" line="off">Calgary</teamH>
<over_under></over_under>
</game>
<game>
<time>10:00</time>
<teamA rotation="023" line="">Carolina</teamA>
<teamH rotation="024" line="-220">Vancouver</teamH>
<over_under>5.5u</over_under>
</game>
</date>
<time_stamp> October 27, 2014, at 02:44 PM ET </time_stamp>
</message>
\ No newline at end of file
-- 
2.43.2