Add tests and database code for EarlyLine.

diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs
index 26625e748b2dec6d769ea0be068c5b9b3962b644..3870eb8d139b59a009fcc58c0cceb746cbaa54e7 100644 (file)
--- a/src/TSN/XML/EarlyLine.hs
+++ b/src/TSN/XML/EarlyLine.hs
@@ -8,18 +8,32 @@
 module TSN.XML.EarlyLine (
   dtd,
   pickle_message,
+  -- * Tests
+  early_line_tests,
   -- * WARNING: these are private but exported to silence warnings
   EarlyLineConstructor(..),
   EarlyLineGameConstructor(..) )
 where
 
 -- System imports.
+import Control.Monad ( forM_ )
 import Data.Time ( UTCTime(..) )
 import Data.Tuple.Curry ( uncurryN )
+import Database.Groundhog (
+  countAll,
+  deleteAll,
+  insert_,
+  migrate,
+  runMigration,
+  silentMigrationLogger )
 import Database.Groundhog.Core ( DefaultKey )
+import Database.Groundhog.Generic ( runDbConn )
+import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
   groundhog,
   mkPersist )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
   PU,
   xp4Tuple,
@@ -35,7 +49,7 @@ import Text.XML.HXT.Core (
 
 -- Local imports.
 import TSN.Codegen ( tsn_codegen_config )
-import TSN.DbImport ( DbImport(..) )
+import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers (
   xp_ambiguous_time,
   xp_early_line_date,
@@ -43,7 +57,10 @@ import TSN.Picklers (
 import TSN.XmlImport ( XmlImport(..) )
 import Xml (
   FromXml(..),
-  ToDb(..) )
+  ToDb(..),
+  pickle_unpickle,
+  unpickleable,
+  unsafe_unpickle )
 
 
 -- | The DTD to which this module corresponds. Used to invoke dbimport.
@@ -165,13 +182,42 @@ data EarlyLineGameTeam =
   deriving (Eq, Show)
 
 
+date_to_game :: (DefaultKey EarlyLine) -> EarlyLineDateXml -> EarlyLineGame
+date_to_game fk date =
+  EarlyLineGame {
+    db_early_lines_id = fk,
+    db_game_time = combined_date_time,
+    db_note = (xml_note date),
+    db_away_team = xml_away_team (xml_game date),
+    db_home_team = xml_home_team (xml_game date),
+    db_over_under = xml_over_under (xml_game date) }
+  where
+    date_part = xml_date_value date
+    time_part = xml_game_time (xml_game date)
+    combined_date_time = UTCTime (utctDay date_part) (utctDayTime time_part)
+
 --
 -- * Database stuff
 --
 
 instance DbImport Message where
-  dbmigrate = undefined
-  dbimport = undefined
+  dbmigrate _ =
+    run_dbmigrate $ do
+      migrate (undefined :: EarlyLine)
+      migrate (undefined :: EarlyLineGame)
+
+  dbimport m = do
+    -- Insert the message and obtain its ID.
+    msg_id <- insert_xml m
+
+    -- Now loop through the message's <date>s.
+    forM_ (xml_dates m) $ \date -> do
+      -- Each date only contains one game, so we convert the date to a
+      -- game and then insert the game (keyed to the message).
+      let game = date_to_game msg_id date
+      insert_ game
+
+    return ImportSucceeded
 
 
 mkPersist tsn_codegen_config [groundhog|
@@ -287,3 +333,68 @@ pickle_team =
   where
     from_tuple = uncurryN EarlyLineGameTeam
     to_tuple m = (db_rotation_number m, db_line m, db_team_name m)
+
+
+
+--
+-- * Tasty Tests
+--
+
+-- | A list of all tests for this module.
+--
+early_line_tests :: TestTree
+early_line_tests =
+  testGroup
+    "EarlyLine tests"
+    [ test_on_delete_cascade,
+      test_pickle_of_unpickle_is_identity,
+      test_unpickle_succeeds ]
+
+-- | If we unpickle something and then pickle it, we should wind up
+--   with the same thing we started with. WARNING: success of this
+--   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
+
+
+
+-- | 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
+
+    let expected = True
+    actual @?= expected
+
+
+
+-- | Make sure everything gets deleted when we delete the top-level
+--   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

diff --git a/test/TestSuite.hs b/test/TestSuite.hs
index 985b53c7fc2a6e34b4ae26d2bc8576a86d9bf4f0..ee3814867d718767d203bf2e399fd9ca3b5dd3f1 100644 (file)
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -3,6 +3,7 @@ import Test.Tasty ( TestTree, defaultMain, testGroup )
 import TSN.Picklers ( pickler_tests )
 import TSN.XML.AutoRacingResults ( auto_racing_results_tests )
 import TSN.XML.AutoRacingSchedule ( auto_racing_schedule_tests )
+import TSN.XML.EarlyLine ( early_line_tests )
 import TSN.XML.GameInfo ( game_info_tests )
 import TSN.XML.Heartbeat ( heartbeat_tests )
 import TSN.XML.Injuries ( injuries_tests )
@@ -20,6 +21,7 @@ tests = testGroup
           "All tests"
           [ auto_racing_results_tests,
             auto_racing_schedule_tests,
+            early_line_tests,
             game_info_tests,
             heartbeat_tests,
             injuries_tests,

diff --git a/test/shell/import-duplicates.test b/test/shell/import-duplicates.test
index 8dfddb1c35dd45d6b33890701365337799e32ea6..2e2e27cc86c8380f57b3220e0915618a4726bcda 100644 (file)
--- a/test/shell/import-duplicates.test
+++ b/test/shell/import-duplicates.test
@@ -16,15 +16,15 @@ rm -f shelltest.sqlite3
 # and a newsxml that aren't really supposed to import.
 find ./test/xml -maxdepth 1 -name '*.xml' | wc -l
 >>>
-27
+28
 >>>= 0
 
 # Run the imports again; we should get complaints about the duplicate
-# xml_file_ids. There are 2 errors for each violation, so we expect 2*23
+# xml_file_ids. There are 2 errors for each violation, so we expect 2*24
 # occurrences of the string 'ERROR'.
 ./dist/build/htsn-import/htsn-import -c 'shelltest.sqlite3' test/xml/*.xml 2>&1 | grep ERROR | wc -l
 >>>
-46
+48
 >>>= 0
 
 # Finally, clean up after ourselves.

diff --git a/test/xml/earlylineXML.dtd b/test/xml/earlylineXML.dtd
new file mode 100644 (file)
index 0000000..d5b3b6a
--- /dev/null
+++ b/test/xml/earlylineXML.dtd
@@ -0,0 +1,20 @@
+<!ELEMENT XML_File_ID (#PCDATA)>
+<!ELEMENT heading (#PCDATA)>
+<!ELEMENT category (#PCDATA)>
+<!ELEMENT sport (#PCDATA)>
+<!ELEMENT title (#PCDATA)>
+<!ELEMENT note (#PCDATA)>
+<!ELEMENT time (#PCDATA)>
+<!ELEMENT teamA (#PCDATA)>
+<!ELEMENT teamH (#PCDATA)>
+<!ELEMENT over_under (#PCDATA)>
+<!ELEMENT game ( ( time, teamA, teamH, over_under ) )>
+<!ELEMENT date ( ( note, game ) )>
+<!ELEMENT time_stamp (#PCDATA)>
+<!ELEMENT message ( ( XML_File_ID, heading, category, sport, title, date*, time_stamp ) )>
+
+<!ATTLIST teamA rotation CDATA #REQUIRED>
+<!ATTLIST teamA line CDATA #REQUIRED>
+<!ATTLIST teamH rotation CDATA #REQUIRED>
+<!ATTLIST teamH line CDATA #REQUIRED>
+<!ATTLIST date value CDATA #REQUIRED>

diff --git a/test/xml/earlylineXML.xml b/test/xml/earlylineXML.xml
new file mode 100644 (file)
index 0000000..a061b73
--- /dev/null
+++ b/test/xml/earlylineXML.xml
@@ -0,0 +1 @@
+<?xml version="1.0" standalone="no" ?>\r<!DOCTYPE message PUBLIC "-//TSN//DTD Odds 1.0/EN" "earlylineXML.dtd">\r<message>\r<XML_File_ID>21166989</XML_File_ID>\r<heading>ACO;NBA-EARLY-LINE</heading>\r<category>Odds</category>\r<sport>NBA</sport>\r<title>National Basketball Association Overnight Line</title>\r<date value="SUNDAY, MAY 25TH (05/25/2014)">\r<note>Western Conference Finals - San Antonio leads 2-0</note>\r<game>\r<time>8:30</time>\r<teamA rotation="511" line="">San Antonio</teamA>\r<teamH rotation="512" line="-2">Oklahoma City</teamH>\r<over_under>208</over_under>\r</game>\r</date>\r<date value="MONDAY, MAY 26TH (05/26/2014)">\r<note>Eastern Conference Finals - Miami leads 2-1</note>\r<game>\r<time>8:30</time>\r<teamA rotation="513" line="">Indiana</teamA>\r<teamH rotation="514" line="off">Miami</teamH>\r<over_under>off</over_under>\r</game>\r</date>\r<time_stamp> May 25, 2014, at 09:06 AM ET </time_stamp>\r</message>\r
\ No newline at end of file