From: Michael Orlitzky Date: Wed, 23 Jul 2014 15:44:12 +0000 (-0400) Subject: Add tests and database code for EarlyLine. X-Git-Tag: 0.0.9~13 X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=commitdiff_plain;h=6ddadf57fcafa71709c6b8db565f71725b58b3e1 Add tests and database code for EarlyLine. --- diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs index 26625e7..3870eb8 100644 --- 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 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 985b53c..ee38148 100644 --- 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 8dfddb1..2e2e27c 100644 --- 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 index 0000000..d5b3b6a --- /dev/null +++ b/test/xml/earlylineXML.dtd @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/test/xml/earlylineXML.xml b/test/xml/earlylineXML.xml new file mode 100644 index 0000000..a061b73 --- /dev/null +++ b/test/xml/earlylineXML.xml @@ -0,0 +1 @@ + 21166989 ACO;NBA-EARLY-LINE Odds NBA National Basketball Association Overnight Line Western Conference Finals - San Antonio leads 2-0 San Antonio Oklahoma City 208 Eastern Conference Finals - Miami leads 2-1 Indiana Miami off May 25, 2014, at 09:06 AM ET \ No newline at end of file