MLBEarlyLine.hs

-- | 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 )
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