+-- | 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 \<date\> element contains exactly one
+-- game. In MLB_earlylineXML.dtd, they contain multiple games.
+--
+-- * As a result of the previous difference, the \<note\>s are no
+-- longer in one-to-one correspondence with the games. The
+-- \<note\> elements are thrown in beside the \<game\>s, and we're
+-- supposed to figure out to which \<game\>s they correspond
+-- ourselves. This is the same sort of nonsense going on with
+-- 'TSN.XML.Odds.OddsGameWithNotes'.
+--
+-- * The \<over_under\> element can be empty in
+-- MLB_earlylineXML.dtd (it can't in earlylineXML.dtd).
+--
+-- * Each home/away team in MLB_earlylineXML.dtd has a \<pitcher\>
+-- that isn't present in the regular earlylineXML.dtd.
+--
+-- * In earlylineXML.dtd, the home/away team lines are given as
+-- attributes on the \<teamH\> and \<teamA\> elements
+-- respectively. In MLB_earlylineXML.dtd, the lines can be found
+-- in \<line\> elements that are children of the \<teamH\> and
+-- \<teamA\> elements.
+--
+-- * In earlylineXML.dtd, the team names are given as text within
+-- the \<teamA\> and \<teamH\> 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,
+ runMigration,
+ silentMigrationLogger )
+import Database.Groundhog.Generic ( runDbConn )
+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
+ 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