-- | Parse TSN XML for the DTD \"MLB_earlylineXML.dtd\". This module -- is unique (so far) in that it is almost entirely a subclass of -- another module, "TSN.XML.EarlyLine". The database representations -- should be almost identical, and the XML schema /could/ be -- similar, but instead, welcome to the jungle baby. Here are the -- differences: -- -- * In earlylineXML.dtd, each \ element contains exactly one -- game. In MLB_earlylineXML.dtd, they contain multiple games. -- -- * As a result of the previous difference, the \s are no -- longer in one-to-one correspondence with the games. The -- \ elements are thrown in beside the \s, and we're -- supposed to figure out to which \s they correspond -- ourselves. This is the same sort of nonsense going on with -- 'TSN.XML.Odds.OddsGameWithNotes'. -- -- * The \ element can be empty in -- MLB_earlylineXML.dtd (it can't in earlylineXML.dtd). -- -- * Each home/away team in MLB_earlylineXML.dtd has a \ -- that isn't present in the regular earlylineXML.dtd. -- -- * In earlylineXML.dtd, the home/away team lines are given as -- attributes on the \ and \ elements -- respectively. In MLB_earlylineXML.dtd, the lines can be found -- in \ elements that are children of the \ and -- \ elements. -- -- * In earlylineXML.dtd, the team names are given as text within -- the \ and \ elements. In MLB_earlylineXML.dtd, -- they are instead given as attributes on those respective -- elements. -- -- Most of these difficulties have been worked around in -- "TSN.XML.EarlyLine", so this module could be kept somewhat boring. -- module TSN.XML.MLBEarlyLine ( dtd, mlb_early_line_tests, module TSN.XML.EarlyLine -- This re-exports the EarlyLine and EarlyLineGame -- constructors unnecessarily. Whatever. ) where -- System imports (needed only for tests) import Database.Groundhog ( countAll, deleteAll, migrate ) import Database.Groundhog.Generic ( runDbConn, runMigrationSilent ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) -- Local imports. import TSN.DbImport ( DbImport( dbimport ) ) import TSN.XML.EarlyLine ( EarlyLine, EarlyLineGame, pickle_message ) import Xml ( pickle_unpickle, unpickleable, unsafe_unpickle ) -- | The DTD to which this module corresponds. Used to invoke dbimport. -- dtd :: String dtd = "MLB_earlylineXML.dtd" -- -- * Tasty Tests -- -- | A list of all tests for this module. -- mlb_early_line_tests :: TestTree mlb_early_line_tests = testGroup "MLBEarlyLine 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/MLB_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/MLB_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 (MLB) early_lines deletes its children" $ do let path = "test/xml/MLB_earlylineXML.xml" results <- unsafe_unpickle path pickle_message let a = undefined :: EarlyLine let b = undefined :: EarlyLineGame actual <- withSqliteConn ":memory:" $ runDbConn $ do runMigrationSilent $ 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