src/TSN/XML/MLBEarlyLine.hs

   1 -- | Parse TSN XML for the DTD \"MLB_earlylineXML.dtd\". This module
   2 --   is unique (so far) in that it is almost entirely a subclass of
   3 --   another module, "TSN.XML.EarlyLine". The database representations
   4 --   should be almost identical, and the XML schema /could/ be
   5 --   similar, but instead, welcome to the jungle baby. Here are the
   6 --   differences:
   7 --
   8 --   * In earlylineXML.dtd, each \<date\> element contains exactly one
   9 --     game. In MLB_earlylineXML.dtd, they contain multiple games.
  10 --
  11 --   * As a result of the previous difference, the \<note\>s are no
  12 --     longer in one-to-one correspondence with the games. The
  13 --     \<note\> elements are thrown in beside the \<game\>s, and we're
  14 --     supposed to figure out to which \<game\>s they correspond
  15 --     ourselves. This is the same sort of nonsense going on with
  16 --     'TSN.XML.Odds.OddsGameWithNotes'.
  17 --
  18 --    * The \<over_under\> element can be empty in
  19 --      MLB_earlylineXML.dtd (it can't in earlylineXML.dtd).
  20 --
  21 --   * Each home/away team in MLB_earlylineXML.dtd has a \<pitcher\>
  22 --     that isn't present in the regular earlylineXML.dtd.
  23 --
  24 --   * In earlylineXML.dtd, the home/away team lines are given as
  25 --     attributes on the \<teamH\> and \<teamA\> elements
  26 --     respectively. In MLB_earlylineXML.dtd, the lines can be found
  27 --     in \<line\> elements that are children of the \<teamH\> and
  28 --     \<teamA\> elements.
  29 --
  30 --   * In earlylineXML.dtd, the team names are given as text within
  31 --     the \<teamA\> and \<teamH\> elements. In MLB_earlylineXML.dtd,
  32 --     they are instead given as attributes on those respective
  33 --     elements.
  34 --
  35 --   Most of these difficulties have been worked around in
  36 --   "TSN.XML.EarlyLine", so this module could be kept somewhat boring.
  37 --
  38 module TSN.XML.MLBEarlyLine (
  39   dtd,
  40   mlb_early_line_tests,
  41   module TSN.XML.EarlyLine -- This re-exports the EarlyLine and EarlyLineGame
  42                            -- constructors unnecessarily. Whatever.
  43   )
  44 where
  45
  46 -- System imports (needed only for tests)
  47 import Database.Groundhog (
  48   countAll,
  49   deleteAll,
  50   migrate,
  51   runMigration,
  52   silentMigrationLogger )
  53 import Database.Groundhog.Generic ( runDbConn )
  54 import Database.Groundhog.Sqlite ( withSqliteConn )
  55 import Test.Tasty ( TestTree, testGroup )
  56 import Test.Tasty.HUnit ( (@?=), testCase )
  57
  58
  59 -- Local imports.
  60 import TSN.DbImport ( DbImport( dbimport ) )
  61 import TSN.XML.EarlyLine ( EarlyLine, EarlyLineGame, pickle_message )
  62 import Xml (
  63   pickle_unpickle,
  64   unpickleable,
  65   unsafe_unpickle )
  66
  67
  68 -- | The DTD to which this module corresponds. Used to invoke dbimport.
  69 --
  70 dtd :: String
  71 dtd = "MLB_earlylineXML.dtd"
  72
  73
  74
  75 --
  76 -- * Tasty Tests
  77 --
  78
  79 -- | A list of all tests for this module.
  80 --
  81 mlb_early_line_tests :: TestTree
  82 mlb_early_line_tests =
  83   testGroup
  84     "MLBEarlyLine tests"
  85     [ test_on_delete_cascade,
  86       test_pickle_of_unpickle_is_identity,
  87       test_unpickle_succeeds ]
  88
  89 -- | If we unpickle something and then pickle it, we should wind up
  90 --   with the same thing we started with. WARNING: success of this
  91 --   test does not mean that unpickling succeeded.
  92 --
  93 test_pickle_of_unpickle_is_identity :: TestTree
  94 test_pickle_of_unpickle_is_identity =
  95   testCase "pickle composed with unpickle is the identity" $ do
  96     let path = "test/xml/MLB_earlylineXML.xml"
  97     (expected, actual) <- pickle_unpickle pickle_message path
  98     actual @?= expected
  99
 100
 101
 102 -- | Make sure we can actually unpickle these things.
 103 --
 104 test_unpickle_succeeds :: TestTree
 105 test_unpickle_succeeds =
 106   testCase "unpickling succeeds" $ do
 107     let path = "test/xml/MLB_earlylineXML.xml"
 108     actual <- unpickleable path pickle_message
 109
 110     let expected = True
 111     actual @?= expected
 112
 113
 114
 115 -- | Make sure everything gets deleted when we delete the top-level
 116 --   record.
 117 --
 118 test_on_delete_cascade :: TestTree
 119 test_on_delete_cascade =
 120   testCase "deleting (MLB) early_lines deletes its children" $ do
 121     let path = "test/xml/MLB_earlylineXML.xml"
 122     results <- unsafe_unpickle path pickle_message
 123     let a = undefined :: EarlyLine
 124     let b = undefined :: EarlyLineGame
 125
 126     actual <- withSqliteConn ":memory:" $ runDbConn $ do
 127                 runMigration silentMigrationLogger $ do
 128                   migrate a
 129                   migrate b
 130                 _ <- dbimport results
 131                 deleteAll a
 132                 count_a <- countAll a
 133                 count_b <- countAll b
 134                 return $ sum [count_a, count_b]
 135     let expected = 0
 136     actual @?= expected