src/TSN/XML/EarlyLine.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE GADTs #-}
   4 {-# LANGUAGE QuasiQuotes #-}
   5 {-# LANGUAGE RecordWildCards #-}
   6 {-# LANGUAGE TemplateHaskell #-}
   7 {-# LANGUAGE TypeFamilies #-}
   8
   9 -- | Parse TSN XML for the DTD \"earlylineXML.dtd\". For that DTD,
  10 --   each \<message\> element contains a bunch of \<date\>s, and those
  11 --   \<date\>s contain a single \<game\>. In the database, we merge
  12 --   the date info into the games, and key the games to the messages.
  13 --
  14 --   Real life is not so simple, however. There is another module,
  15 --   "TSN.XML.MLBEarlyLine" that is something of a subclass of this
  16 --   one. It contains early lines, but only for MLB games. The data
  17 --   types and XML schema are /almost/ the same, but TSN like to make
  18 --   things difficult.
  19 --
  20 --   A full list of the differences is given in that module. In this
  21 --   one, we mention where data types have been twerked a little to
  22 --   support the second document type.
  23 --
  24 module TSN.XML.EarlyLine (
  25   EarlyLine, -- Used in TSN.XML.MLBEarlyLine
  26   EarlyLineGame, -- Used in TSN.XML.MLBEarlyLine
  27   dtd,
  28   pickle_message,
  29   -- * Tests
  30   early_line_tests,
  31   -- * WARNING: these are private but exported to silence warnings
  32   EarlyLineConstructor(..),
  33   EarlyLineGameConstructor(..) )
  34 where
  35
  36 -- System imports.
  37 import Control.Monad ( join )
  38 import Data.Time ( UTCTime(..) )
  39 import Data.Tuple.Curry ( uncurryN )
  40 import qualified Data.Vector.HFixed as H ( HVector, convert )
  41 import Database.Groundhog (
  42   countAll,
  43   deleteAll,
  44   insert_,
  45   migrate )
  46 import Database.Groundhog.Core ( DefaultKey )
  47 import Database.Groundhog.Generic ( runDbConn, runMigrationSilent )
  48 import Database.Groundhog.Sqlite ( withSqliteConn )
  49 import Database.Groundhog.TH (
  50   groundhog,
  51   mkPersist )
  52 import qualified GHC.Generics as GHC ( Generic )
  53 import Test.Tasty ( TestTree, testGroup )
  54 import Test.Tasty.HUnit ( (@?=), testCase )
  55 import Text.XML.HXT.Core (
  56   PU,
  57   xp4Tuple,
  58   xp6Tuple,
  59   xp7Tuple,
  60   xpAttr,
  61   xpElem,
  62   xpInt,
  63   xpList,
  64   xpOption,
  65   xpPair,
  66   xpText,
  67   xpWrap )
  68
  69 -- Local imports.
  70 import Misc ( double_just )
  71 import TSN.Codegen ( tsn_codegen_config )
  72 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
  73 import TSN.Picklers (
  74   xp_ambiguous_time,
  75   xp_attr_option,
  76   xp_early_line_date,
  77   xp_time_stamp )
  78 import TSN.XmlImport ( XmlImport(..) )
  79 import Xml (
  80   FromXml(..),
  81   ToDb(..),
  82   pickle_unpickle,
  83   unpickleable,
  84   unsafe_unpickle )
  85
  86
  87 -- | The DTD to which this module corresponds. Used to invoke dbimport.
  88 --
  89 dtd :: String
  90 dtd = "earlylineXML.dtd"
  91
  92 --
  93 -- * DB/XML data types
  94 --
  95
  96 -- * EarlyLine/Message
  97
  98 -- | Database representation of a 'Message'. It lacks the \<date\>
  99 --   elements since they're really properties of the games that they
 100 --   contain.
 101 --
 102 data EarlyLine =
 103   EarlyLine {
 104     db_xml_file_id :: Int,
 105     db_heading :: String,
 106     db_category :: String,
 107     db_sport :: String,
 108     db_title :: String,
 109     db_time_stamp :: UTCTime }
 110   deriving (Eq, Show)
 111
 112
 113
 114 -- | XML Representation of an 'EarlyLine'. It has the same
 115 --   fields, but in addition contains the 'xml_dates'.
 116 --
 117 data Message =
 118   Message {
 119     xml_xml_file_id :: Int,
 120     xml_heading :: String,
 121     xml_category :: String,
 122     xml_sport :: String,
 123     xml_title :: String,
 124     xml_dates :: [EarlyLineDate],
 125     xml_time_stamp :: UTCTime }
 126   deriving (Eq, GHC.Generic, Show)
 127
 128 -- | For 'H.convert'.
 129 --
 130 instance H.HVector Message
 131
 132
 133 instance ToDb Message where
 134   -- | The database analogue of a 'Message' is an 'EarlyLine'.
 135   --
 136   type Db Message = EarlyLine
 137
 138
 139 -- | The 'FromXml' instance for 'Message' is required for the
 140 --   'XmlImport' instance.
 141 --
 142 instance FromXml Message where
 143   -- | To convert a 'Message' to an 'EarlyLine', we just drop
 144   --   the 'xml_dates'.
 145   --
 146   from_xml Message{..} =
 147     EarlyLine {
 148       db_xml_file_id = xml_xml_file_id,
 149       db_heading = xml_heading,
 150       db_category = xml_category,
 151       db_sport = xml_sport,
 152       db_title = xml_title,
 153       db_time_stamp = xml_time_stamp }
 154
 155
 156 -- | This allows us to insert the XML representation 'Message'
 157 --   directly.
 158 --
 159 instance XmlImport Message
 160
 161
 162
 163 -- * EarlyLineDate / EarlyLineGameWithNote
 164
 165 -- | This is a very sad data type. It exists so that we can
 166 --   successfully unpickle/pickle the MLB_earlylineXML.dtd documents
 167 --   and get back what we started with. In that document type, the
 168 --   dates all have multiple \<game\>s associated with them (as
 169 --   children). But the dates also have multiple \<note\>s as
 170 --   children, and we're supposed to figure out which notes go with
 171 --   which games based on the order that they appear in the XML
 172 --   file. Yeah, right.
 173 --
 174 --   In any case, instead of expecting the games and notes in some
 175 --   nice order, we use this data type to expect \"a game and maybe a
 176 --   note\" multiple times. This will pair the notes with only one
 177 --   game, rather than all of the games that TSN think it should go
 178 --   with. But it allows us to pickle and unpickle correctly at least.
 179 --
 180 data EarlyLineGameWithNote =
 181   EarlyLineGameWithNote
 182     (Maybe String) -- date_note, unused
 183     EarlyLineGameXml -- date_game
 184   deriving (Eq, GHC.Generic, Show)
 185
 186 -- | Accessor for the game within a 'EarlyLineGameWithNote'. We define
 187 --   this ourselves to avoid an unused field warning for date_note.
 188 --
 189 date_game :: EarlyLineGameWithNote -> EarlyLineGameXml
 190 date_game (EarlyLineGameWithNote _ g) = g
 191
 192 -- | For 'H.convert'.
 193 --
 194 instance H.HVector EarlyLineGameWithNote
 195
 196
 197
 198 -- | XML representation of a \<date\>. It has a \"value\" attribute
 199 --   containing the actual date string. As children it contains a
 200 --   (non-optional) note, and a game. The note and date value are
 201 --   properties of the game as far as I can tell.
 202 --
 203 data EarlyLineDate =
 204   EarlyLineDate {
 205     date_value :: UTCTime,
 206     date_games_with_notes :: [EarlyLineGameWithNote] }
 207   deriving (Eq, GHC.Generic, Show)
 208
 209 -- | For 'H.convert'.
 210 --
 211 instance H.HVector EarlyLineDate
 212
 213
 214
 215 -- * EarlyLineGame / EarlyLineGameXml
 216
 217 -- | Database representation of a \<game\> in earlylineXML.dtd and
 218 --   MLB_earlylineXML.dtd. We've had to make a sacrifice here to
 219 --   support both document types. Since it's not possible to pair the
 220 --   \<note\>s with \<game\>s reliably in MLB_earlylineXML.dtd, we
 221 --   have omitted the notes entirely. This is sad, but totally not our
 222 --   fault.
 223 --
 224 --   In earlylineXML.dtd, each \<date\> and thus each \<note\> is
 225 --   paired with exactly one \<game\>, so if we only cared about that
 226 --   document type, we could have retained the notes.
 227 --
 228 --   In earlylinexml.DTD, the over/under is required, but in
 229 --   MLB_earlylinexml.DTD it is not. So another compromise is to have
 230 --   it optional here.
 231 --
 232 --   The 'db_game_time' should be the combined date/time using the
 233 --   date value from the \<game\> element's containing
 234 --   \<date\>. That's why EarlyLineGame isn't an instance of
 235 --   'FromXmlFk': the foreign key isn't enough to construct one, we
 236 --   also need the date.
 237 --
 238 data EarlyLineGame =
 239   EarlyLineGame {
 240     db_early_lines_id :: DefaultKey EarlyLine,
 241     db_game_time :: UTCTime, -- ^ Combined date/time
 242     db_away_team :: EarlyLineGameTeam,
 243     db_home_team :: EarlyLineGameTeam,
 244     db_over_under :: Maybe String }
 245
 246
 247 -- | XML representation of a 'EarlyLineGame'. Comparatively, it lacks
 248 --   only the foreign key to the parent message.
 249 --
 250 data EarlyLineGameXml =
 251   EarlyLineGameXml {
 252     xml_game_time :: Maybe UTCTime, -- ^ Only an ambiguous time string,
 253                                     --   e.g. \"8:30\". Can be empty.
 254     xml_away_team :: EarlyLineGameTeamXml,
 255     xml_home_team :: EarlyLineGameTeamXml,
 256     xml_over_under :: Maybe String }
 257   deriving (Eq, GHC.Generic, Show)
 258
 259
 260 -- | For 'H.convert'.
 261 --
 262 instance H.HVector EarlyLineGameXml
 263
 264
 265 -- * EarlyLineGameTeam / EarlyLineGameTeamXml
 266
 267 -- | Database representation of an EarlyLine team, used in both
 268 --   earlylineXML.dtd and MLB_earlylineXML.dtd. It doubles as an
 269 --   embedded type within the DB representation 'EarlyLineGame'.
 270 --
 271 --   The team name is /not/ optional. However, since we're overloading
 272 --   the XML representation, we're constructing 'db_team_name' name
 273 --   from two Maybes, 'xml_team_name_attr' and
 274 --   'xml_team_name_text'. To ensure type safety (and avoid a runtime
 275 --   crash), we allow the database field to be optional as well.
 276 --
 277 data EarlyLineGameTeam =
 278   EarlyLineGameTeam {
 279     db_rotation_number :: Maybe Int, -- ^ Usually there but sometimes empty.
 280     db_line :: Maybe String, -- ^ Can be blank, a Double, or \"off\".
 281     db_team_name :: Maybe String, -- ^ NOT optional, see the data type docs.
 282     db_pitcher :: Maybe String -- ^ Optional in MLB_earlylineXML.dtd,
 283                                --   always absent in earlylineXML.dtd.
 284     }
 285
 286
 287 -- | This here is an abomination. What we've got is an XML
 288 --   representation, not for either earlylineXML.dtd or
 289 --   MLB_earlylineXML.dtd, but one that will work for /both/. Even
 290 --   though they represent the teams totally differently! Argh!
 291 --
 292 --   The earlylineXML.dtd teams look like,
 293 --
 294 --   \<teamA rotation=\"709\" line=\"\">Miami\</teamA\>
 295 --
 296 --   While the MLB_earlylineXML.dtd teams look like,
 297 --
 298 --   <teamA rotation="901" name="LOS">
 299 --   <pitcher>D.Haren</pitcher>
 300 --   <line>-130</line>
 301 --   </teamA>
 302 --
 303 --   So that's cool. This data type has placeholders that should allow
 304 --   the name/line to appear either as an attribute or as a text
 305 --   node. We'll sort it all out in the conversion to
 306 --   EarlyLineGameTeam.
 307 --
 308 data EarlyLineGameTeamXml =
 309   EarlyLineGameTeamXml {
 310     xml_rotation_number :: Maybe Int,
 311     xml_line_attr :: Maybe String,
 312     xml_team_name_attr :: Maybe String,
 313     xml_team_name_text :: Maybe String,
 314     xml_pitcher :: Maybe String,
 315     xml_line_elem :: Maybe String }
 316   deriving (Eq, Show)
 317
 318
 319
 320 instance ToDb EarlyLineGameTeamXml where
 321   -- | The database analogue of a 'EarlyLineGameTeamXml' is an
 322   --   'EarlyLineGameTeam', although the DB type is merely embedded
 323   --   in another type.
 324   --
 325   type Db EarlyLineGameTeamXml = EarlyLineGameTeam
 326
 327
 328 -- | The 'FromXml' instance for 'EarlyLineGameTeamXml' lets us convert
 329 --   it to a 'EarlyLineGameTeam' easily.
 330 --
 331 instance FromXml EarlyLineGameTeamXml where
 332   -- | To convert a 'EarlyLineGameTeamXml' to an 'EarlyLineGameTeam',
 333   --   we figure how its fields were represented and choose the ones
 334   --   that are populated. For example if the \"line\" attribute was
 335   --   there, we'll use it, but if now, we'll use the \<line\>
 336   --   element.
 337   --
 338   from_xml EarlyLineGameTeamXml{..} =
 339     EarlyLineGameTeam {
 340       db_rotation_number = xml_rotation_number,
 341       db_line = merge xml_line_attr xml_line_elem,
 342       db_team_name = merge xml_team_name_attr xml_team_name_text,
 343       db_pitcher = xml_pitcher }
 344     where
 345       merge :: Maybe String -> Maybe String -> Maybe String
 346       merge Nothing y = y
 347       merge x Nothing = x
 348       merge _ _ = Nothing
 349
 350
 351
 352
 353 -- | Convert an 'EarlyLineDate' into a list of 'EarlyLineGame's. Each
 354 --   date has one or more games, and the fields that belong to the date
 355 --   should really be in the game anyway. So the database
 356 --   representation of a game has the combined fields of the XML
 357 --   date/game.
 358 --
 359 --   This function gets the games out of a date, and then sticks the
 360 --   date value inside the games. It also adds the foreign key
 361 --   reference to the games' parent message, and returns the result.
 362 --
 363 --   This would convert a single date to a single game if we only
 364 --   needed to support earlylineXML.dtd and not MLB_earlylineXML.dtd.
 365 --
 366 date_to_games :: (DefaultKey EarlyLine) -> EarlyLineDate -> [EarlyLineGame]
 367 date_to_games fk date =
 368   map convert_game games_only
 369   where
 370     -- | Get the list of games out of a date (i.e. drop the notes).
 371     --
 372     games_only :: [EarlyLineGameXml]
 373     games_only = (map date_game (date_games_with_notes date))
 374
 375     -- | Stick the date value into the given game. If our
 376     --   'EarlyLineGameXml' has an 'xml_game_time', then we combine it
 377     --   with the day portion of the supplied @date@. If not, then we
 378     --   just use @date as-is.
 379     --
 380     combine_date_time :: Maybe UTCTime -> UTCTime
 381     combine_date_time (Just t) =
 382       UTCTime (utctDay $ date_value date) (utctDayTime t)
 383     combine_date_time Nothing = date_value date
 384
 385     -- | Convert an XML game to a database one.
 386     --
 387     convert_game :: EarlyLineGameXml -> EarlyLineGame
 388     convert_game EarlyLineGameXml{..} =
 389       EarlyLineGame {
 390         db_early_lines_id = fk,
 391         db_game_time = combine_date_time xml_game_time,
 392         db_away_team = from_xml xml_away_team,
 393         db_home_team = from_xml xml_home_team,
 394         db_over_under = xml_over_under }
 395
 396
 397 --
 398 -- * Database stuff
 399 --
 400
 401 instance DbImport Message where
 402   dbmigrate _ =
 403     run_dbmigrate $ do
 404       migrate (undefined :: EarlyLine)
 405       migrate (undefined :: EarlyLineGame)
 406
 407   dbimport m = do
 408     -- Insert the message and obtain its ID.
 409     msg_id <- insert_xml m
 410
 411     -- Create a function that will turn a list of dates into a list of
 412     -- games by converting each date to its own list of games, and
 413     -- then concatenating all of the game lists together.
 414     let convert_dates_to_games = concatMap (date_to_games msg_id)
 415
 416     -- Now use it to make dem games.
 417     let games = convert_dates_to_games (xml_dates m)
 418
 419     -- And insert all of them
 420     mapM_ insert_ games
 421
 422     return ImportSucceeded
 423
 424
 425 mkPersist tsn_codegen_config [groundhog|
 426
 427 - entity: EarlyLine
 428   dbName: early_lines
 429   constructors:
 430     - name: EarlyLine
 431       uniques:
 432         - name: unique_early_lines
 433           type: constraint
 434           # Prevent multiple imports of the same message.
 435           fields: [db_xml_file_id]
 436
 437
 438 - entity: EarlyLineGame
 439   dbName: early_lines_games
 440   constructors:
 441     - name: EarlyLineGame
 442       fields:
 443         - name: db_early_lines_id
 444           reference:
 445             onDelete: cascade
 446         - name: db_away_team
 447           embeddedType:
 448             - {name: rotation_number, dbName: away_team_rotation_number}
 449             - {name: line, dbName: away_team_line}
 450             - {name: team_name, dbName: away_team_name}
 451             - {name: pitcher, dbName: away_team_pitcher}
 452         - name: db_home_team
 453           embeddedType:
 454             - {name: rotation_number, dbName: home_team_rotation_number}
 455             - {name: line, dbName: home_team_line}
 456             - {name: team_name, dbName: home_team_name}
 457             - {name: pitcher, dbName: home_team_pitcher}
 458
 459 - embedded: EarlyLineGameTeam
 460   fields:
 461     - name: db_rotation_number
 462       dbName: rotation_number
 463     - name: db_line
 464       dbName: line
 465     - name: db_team_name
 466       dbName: team_name
 467     - name: db_pitcher
 468       dbName: pitcher
 469 |]
 470
 471
 472
 473 --
 474 -- * Pickling
 475 --
 476
 477
 478 -- | Pickler for the top-level 'Message'.
 479 --
 480 pickle_message :: PU Message
 481 pickle_message =
 482   xpElem "message" $
 483     xpWrap (from_tuple, H.convert) $
 484     xp7Tuple (xpElem "XML_File_ID" xpInt)
 485              (xpElem "heading" xpText)
 486              (xpElem "category" xpText)
 487              (xpElem "sport" xpText)
 488              (xpElem "title" xpText)
 489              (xpList pickle_date)
 490              (xpElem "time_stamp" xp_time_stamp)
 491   where
 492     from_tuple = uncurryN Message
 493
 494
 495
 496 -- | Pickler for a '\<note\> followed by a \<game\>. We turn them into
 497 --   a 'EarlyLineGameWithNote'.
 498 --
 499 pickle_game_with_note :: PU EarlyLineGameWithNote
 500 pickle_game_with_note =
 501   xpWrap (from_tuple, H.convert) $
 502     xpPair (xpOption $ xpElem "note" xpText)
 503            pickle_game
 504   where
 505     from_tuple = uncurry EarlyLineGameWithNote
 506
 507
 508 -- | Pickler for the \<date\> elements within each \<message\>.
 509 --
 510 pickle_date :: PU EarlyLineDate
 511 pickle_date =
 512   xpElem "date" $
 513     xpWrap (from_tuple, H.convert) $
 514     xpPair (xpAttr "value" xp_early_line_date)
 515            (xpList pickle_game_with_note)
 516   where
 517     from_tuple = uncurry EarlyLineDate
 518
 519
 520
 521 -- | Pickler for the \<game\> elements within each \<date\>.
 522 --
 523 pickle_game :: PU EarlyLineGameXml
 524 pickle_game =
 525   xpElem "game" $
 526     xpWrap (from_tuple, H.convert) $
 527     xp4Tuple (xpElem "time" (xpOption xp_ambiguous_time))
 528              pickle_away_team
 529              pickle_home_team
 530              (xpElem "over_under" (xpOption xpText))
 531   where
 532     from_tuple = uncurryN EarlyLineGameXml
 533
 534
 535
 536 -- | Pickle an away team (\<teamA\>) element within a \<game\>. Most
 537 --   of the work (common with the home team pickler) is done by
 538 --   'pickle_team'.
 539 --
 540 pickle_away_team :: PU EarlyLineGameTeamXml
 541 pickle_away_team = xpElem "teamA" pickle_team
 542
 543
 544 -- | Pickle a home team (\<teamH\>) element within a \<game\>. Most
 545 --   of the work (common with theaway team pickler) is done by
 546 --   'pickle_team'.
 547 --
 548 pickle_home_team :: PU EarlyLineGameTeamXml
 549 pickle_home_team = xpElem "teamH" pickle_team
 550
 551
 552 -- | Team pickling common to both 'pickle_away_team' and
 553 --   'pickle_home_team'. Handles everything inside the \<teamA\> and
 554 --   \<teamH\> elements. We try to parse the line/name as both an
 555 --   attribute and an element in order to accomodate
 556 --   MLB_earlylineXML.dtd.
 557 --
 558 --   The \"line\" and \"pitcher\" fields wind up being double-Maybes,
 559 --   since they can be empty even if they exist.
 560 --
 561 pickle_team :: PU EarlyLineGameTeamXml
 562 pickle_team =
 563   xpWrap (from_tuple, to_tuple') $
 564   xp6Tuple (xpAttr "rotation" xp_attr_option)
 565            (xpOption $ xpAttr "line" (xpOption xpText))
 566            (xpOption $ xpAttr "name" xpText)
 567            (xpOption xpText)
 568            (xpOption $ xpElem "pitcher" (xpOption xpText))
 569            (xpOption $ xpElem "line" (xpOption xpText))
 570   where
 571     from_tuple (u,v,w,x,y,z) =
 572       EarlyLineGameTeamXml u (join v) w x (join y) (join z)
 573
 574     to_tuple' (EarlyLineGameTeamXml u v w x y z) =
 575       (u, double_just v, w, x, double_just y, double_just z)
 576
 577
 578
 579
 580 --
 581 -- * Tasty Tests
 582 --
 583
 584 -- | A list of all tests for this module.
 585 --
 586 early_line_tests :: TestTree
 587 early_line_tests =
 588   testGroup
 589     "EarlyLine tests"
 590     [ test_on_delete_cascade,
 591       test_pickle_of_unpickle_is_identity,
 592       test_unpickle_succeeds ]
 593
 594 -- | If we unpickle something and then pickle it, we should wind up
 595 --   with the same thing we started with. WARNING: success of this
 596 --   test does not mean that unpickling succeeded.
 597 --
 598 test_pickle_of_unpickle_is_identity :: TestTree
 599 test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
 600   [ check "pickle composed with unpickle is the identity"
 601           "test/xml/earlylineXML.xml",
 602
 603     check "pickle composed with unpickle is the identity (empty game time)"
 604           "test/xml/earlylineXML-empty-game-time.xml" ]
 605   where
 606     check desc path = testCase desc $ do
 607       (expected, actual) <- pickle_unpickle pickle_message path
 608       actual @?= expected
 609
 610
 611
 612 -- | Make sure we can actually unpickle these things.
 613 --
 614 test_unpickle_succeeds :: TestTree
 615 test_unpickle_succeeds = testGroup "unpickle tests"
 616   [ check "unpickling succeeds"
 617           "test/xml/earlylineXML.xml",
 618
 619     check "unpickling succeeds (empty game time)"
 620           "test/xml/earlylineXML-empty-game-time.xml" ]
 621   where
 622     check desc path = testCase desc $ do
 623       actual <- unpickleable path pickle_message
 624       let expected = True
 625       actual @?= expected
 626
 627
 628
 629 -- | Make sure everything gets deleted when we delete the top-level
 630 --   record.
 631 --
 632 test_on_delete_cascade :: TestTree
 633 test_on_delete_cascade = testGroup "cascading delete tests"
 634   [ check "deleting early_lines deletes its children"
 635           "test/xml/earlylineXML.xml",
 636
 637     check "deleting early_lines deletes its children (empty game time)"
 638           "test/xml/earlylineXML-empty-game-time.xml" ]
 639   where
 640     check desc path = testCase desc $ do
 641       results <- unsafe_unpickle path pickle_message
 642       let a = undefined :: EarlyLine
 643       let b = undefined :: EarlyLineGame
 644
 645       actual <- withSqliteConn ":memory:" $ runDbConn $ do
 646                   runMigrationSilent $ do
 647                     migrate a
 648                     migrate b
 649                   _ <- dbimport results
 650                   deleteAll a
 651                   count_a <- countAll a
 652                   count_b <- countAll b
 653                   return $ sum [count_a, count_b]
 654       let expected = 0
 655       actual @?= expected