src/TSN/XML/AutoRacingResults.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   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 \"AutoRacingResultsXML.dtd\". Each
  10 --   \<message\> element contains a \<Race_Information\> and a bunch of
  11 --   \<Listing\>s.
  12 --
  13 module TSN.XML.AutoRacingResults (
  14   dtd,
  15   pickle_message,
  16   -- * Tests
  17   auto_racing_results_tests,
  18   -- * WARNING: these are private but exported to silence warnings
  19   AutoRacingResultsConstructor(..),
  20   AutoRacingResultsListingConstructor(..),
  21   AutoRacingResultsRaceInformationConstructor(..) )
  22 where
  23
  24 -- System imports.
  25 import Control.Monad ( forM_ )
  26 import Data.Data ( Data )
  27 import Data.Time ( UTCTime(..) )
  28 import Data.Tuple.Curry ( uncurryN )
  29 import Data.Typeable ( Typeable )
  30 import Database.Groundhog (
  31   countAll,
  32   deleteAll,
  33   migrate,
  34   runMigration,
  35   silentMigrationLogger )
  36 import Database.Groundhog.Core ( DefaultKey )
  37 import Database.Groundhog.Generic ( runDbConn )
  38 import Database.Groundhog.Sqlite ( withSqliteConn )
  39 import Database.Groundhog.TH (
  40   groundhog,
  41   mkPersist )
  42 import Test.Tasty ( TestTree, testGroup )
  43 import Test.Tasty.HUnit ( (@?=), testCase )
  44 import Text.XML.HXT.Core (
  45   PU,
  46   xp11Tuple,
  47   xp13Tuple,
  48   xpAttr,
  49   xpElem,
  50   xpInt,
  51   xpList,
  52   xpOption,
  53   xpPair,
  54   xpPrim,
  55   xpText,
  56   xpTriple,
  57   xpWrap )
  58
  59 -- Local imports.
  60 import TSN.Codegen ( tsn_codegen_config )
  61 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
  62 import TSN.Picklers (
  63   xp_earnings,
  64   xp_fracpart_only_double,
  65   xp_datetime,
  66   xp_time_stamp )
  67 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
  68 import Xml (
  69   Child(..),
  70   FromXml(..),
  71   FromXmlFk(..),
  72   ToDb(..),
  73   pickle_unpickle,
  74   unpickleable,
  75   unsafe_unpickle )
  76
  77
  78 -- | The DTD to which this module corresponds. Used to invoke dbimport.
  79 --
  80 dtd :: String
  81 dtd = "AutoRacingResultsXML.dtd"
  82
  83 --
  84 -- DB/XML data types
  85 --
  86
  87 -- * AutoRacingResults/Message
  88
  89 -- | Database representation of a 'Message'. Comparatively, it lacks
  90 --   the listings and race information since they are linked via a
  91 --   foreign key.
  92 --
  93 data AutoRacingResults =
  94   AutoRacingResults {
  95     db_xml_file_id :: Int,
  96     db_heading :: String,
  97     db_category :: String,
  98     db_sport :: String,
  99     db_race_id :: Int,
 100     db_race_date :: UTCTime,
 101     db_title :: String,
 102     db_track_location :: String,
 103     db_laps_remaining :: Int,
 104     db_checkered_flag :: Bool,
 105     db_time_stamp :: UTCTime }
 106   deriving (Eq, Show)
 107
 108
 109
 110 -- | XML Representation of an 'AutoRacingResults'. It has the same
 111 --   fields, but in addition contains the 'xml_listings' and
 112 --   'xml_race_information'.
 113 --
 114 data Message =
 115   Message {
 116     xml_xml_file_id :: Int,
 117     xml_heading :: String,
 118     xml_category :: String,
 119     xml_sport :: String,
 120     xml_race_id :: Int,
 121     xml_race_date :: UTCTime,
 122     xml_title :: String,
 123     xml_track_location :: String,
 124     xml_laps_remaining :: Int,
 125     xml_checkered_flag :: Bool,
 126     xml_listings :: [AutoRacingResultsListingXml],
 127     xml_race_information :: AutoRacingResultsRaceInformationXml,
 128     xml_time_stamp :: UTCTime }
 129   deriving (Eq, Show)
 130
 131
 132 instance ToDb Message where
 133   -- | The database analogue of a 'Message' is a 'AutoRacingResults'.
 134   --
 135   type Db Message = AutoRacingResults
 136
 137
 138 -- | The 'FromXml' instance for 'Message' is required for the
 139 --   'XmlImport' instance.
 140 --
 141 instance FromXml Message where
 142   -- | To convert a 'Message' to an 'AutoRacingResults', we just drop
 143   --   the 'xml_listings' and 'xml_race_information'.
 144   --
 145   from_xml Message{..} =
 146     AutoRacingResults {
 147       db_xml_file_id = xml_xml_file_id,
 148       db_heading = xml_heading,
 149       db_category = xml_category,
 150       db_sport = xml_sport,
 151       db_race_id = xml_race_id,
 152       db_race_date = xml_race_date,
 153       db_title = xml_title,
 154       db_track_location = xml_track_location,
 155       db_laps_remaining = xml_laps_remaining,
 156       db_checkered_flag = xml_checkered_flag,
 157       db_time_stamp = xml_time_stamp }
 158
 159
 160 -- | This allows us to insert the XML representation 'Message'
 161 --   directly.
 162 --
 163 instance XmlImport Message
 164
 165
 166 -- * AutoRacingResultsListing/AutoRacingResultsListingXml
 167
 168 -- | Database representation of a \<Listing\> contained within a
 169 --   \<message\>.
 170 --
 171 data AutoRacingResultsListing =
 172   AutoRacingResultsListing {
 173     db_auto_racing_results_id :: DefaultKey AutoRacingResults,
 174     db_finish_position :: Int,
 175     db_starting_position :: Int,
 176     db_car_number :: Int,
 177     db_driver_id :: Int,
 178     db_driver :: String,
 179     db_car_make :: String,
 180     db_points :: Int,
 181     db_laps_completed :: Int,
 182     db_laps_leading :: Int,
 183     db_status :: Maybe String,
 184     db_dnf :: Maybe Bool,
 185     db_nc :: Maybe Bool,
 186     db_earnings :: Maybe Int }
 187
 188
 189 -- | XML representation of a \<Listing\> contained within a
 190 --   \<message\>.
 191 --
 192 data AutoRacingResultsListingXml =
 193   AutoRacingResultsListingXml {
 194     xml_finish_position :: Int,
 195     xml_starting_position :: Int,
 196     xml_car_number :: Int,
 197     xml_driver_id :: Int,
 198     xml_driver :: String,
 199     xml_car_make :: String,
 200     xml_points :: Int,
 201     xml_laps_completed :: Int,
 202     xml_laps_leading :: Int,
 203     xml_status :: Maybe String,
 204     xml_dnf :: Maybe Bool,
 205     xml_nc :: Maybe Bool,
 206     xml_earnings :: Maybe Int }
 207   deriving (Eq, Show)
 208
 209
 210 instance ToDb AutoRacingResultsListingXml where
 211   -- | The database analogue of an 'AutoRacingResultsListingXml' is
 212   --   an 'AutoRacingResultsListing'.
 213   --
 214   type Db AutoRacingResultsListingXml = AutoRacingResultsListing
 215
 216
 217 instance Child AutoRacingResultsListingXml where
 218   -- | Each 'AutoRacingResultsListingXml' is contained in (i.e. has a
 219   --   foreign key to) a 'AutoRacingResults'.
 220   --
 221   type Parent AutoRacingResultsListingXml = AutoRacingResults
 222
 223
 224 instance FromXmlFk AutoRacingResultsListingXml where
 225   -- | To convert an 'AutoRacingResultsListingXml' to an
 226   --   'AutoRacingResultsListing', we add the foreign key and copy
 227   --   everything else verbatim.
 228   --
 229   from_xml_fk fk AutoRacingResultsListingXml{..} =
 230     AutoRacingResultsListing {
 231       db_auto_racing_results_id = fk,
 232       db_finish_position = xml_finish_position,
 233       db_starting_position = xml_starting_position,
 234       db_car_number = xml_car_number,
 235       db_driver_id = xml_driver_id,
 236       db_driver = xml_driver,
 237       db_car_make = xml_car_make,
 238       db_points = xml_points,
 239       db_laps_completed = xml_laps_completed,
 240       db_laps_leading = xml_laps_leading,
 241       db_status = xml_status,
 242       db_dnf = xml_dnf,
 243       db_nc = xml_nc,
 244       db_earnings = xml_earnings }
 245
 246
 247 -- | This allows us to insert the XML representation
 248 --   'AutoRacingResultsListingXml' directly.
 249 --
 250 instance XmlImportFk AutoRacingResultsListingXml
 251
 252
 253
 254 -- * AutoRacingResultsRaceInformation / AutoRacingResultsRaceInformationXml
 255
 256 -- | The \<Most_Laps_Leading\> child of \<Race_Information\> always
 257 --   contains exactly three fields, so we just embed those three into
 258 --   the 'AutoRacingResultsRaceInformation' type. We (pointlessly) use
 259 --   the \"db_\" prefix since our field namer is going to strip of
 260 --   everything before the first underscore.
 261 --
 262 data MostLapsLeading =
 263   MostLapsLeading {
 264     db_most_laps_leading_driver_id :: Int,
 265     db_most_laps_leading_driver :: String,
 266     db_most_laps_leading_number_of_laps :: Int }
 267   deriving (Data, Eq, Show, Typeable)
 268
 269
 270 -- | Database representation of a \<Race_Information\> contained
 271 --   within a \<message\>.
 272 --
 273 data AutoRacingResultsRaceInformation =
 274   AutoRacingResultsRaceInformation {
 275     -- Note the apostrophe to disambiguate it from the
 276     -- AutoRacingResultsListing field.
 277     db_auto_racing_results_id' :: DefaultKey AutoRacingResults,
 278     db_track_length :: String, -- ^ Usually a Double, but sometimes a String,
 279                                --   like \"1.25 miles\".
 280     db_track_length_kph :: Double,
 281     db_laps :: Int,
 282     db_average_speed_mph :: Maybe Double,
 283     db_average_speed_kph :: Maybe Double,
 284     db_average_speed :: Maybe Double,
 285     db_time_of_race :: Maybe String,
 286     db_margin_of_victory :: Maybe String,
 287     db_cautions :: Maybe String,
 288     db_lead_changes :: Maybe String,
 289     db_lap_leaders :: Maybe String,
 290     db_most_laps_leading :: MostLapsLeading }
 291
 292
 293 -- | XML representation of a \<Listing\> contained within a
 294 --   \<message\>.
 295 --
 296 data AutoRacingResultsRaceInformationXml =
 297   AutoRacingResultsRaceInformationXml {
 298     xml_track_length :: String,
 299     xml_track_length_kph :: Double,
 300     xml_laps :: Int,
 301     xml_average_speed_mph :: Maybe Double,
 302     xml_average_speed_kph :: Maybe Double,
 303     xml_average_speed :: Maybe Double,
 304     xml_time_of_race :: Maybe String,
 305     xml_margin_of_victory :: Maybe String,
 306     xml_cautions :: Maybe String,
 307     xml_lead_changes :: Maybe String,
 308     xml_lap_leaders :: Maybe String,
 309     xml_most_laps_leading :: MostLapsLeading }
 310   deriving (Eq,Show)
 311
 312
 313 instance ToDb AutoRacingResultsRaceInformationXml where
 314   -- | The database analogue of an
 315   --   'AutoRacingResultsRaceInformationXml' is an
 316   --   'AutoRacingResultsRaceInformation'.
 317   --
 318   type Db AutoRacingResultsRaceInformationXml =
 319     AutoRacingResultsRaceInformation
 320
 321
 322 instance Child AutoRacingResultsRaceInformationXml where
 323   -- | Each 'AutoRacingResultsRaceInformationXml' is contained in
 324   --   (i.e. has a foreign key to) a 'AutoRacingResults'.
 325   --
 326   type Parent AutoRacingResultsRaceInformationXml = AutoRacingResults
 327
 328
 329 instance FromXmlFk AutoRacingResultsRaceInformationXml where
 330   -- | To convert an 'AutoRacingResultsRaceInformationXml' to an
 331   --   'AutoRacingResultsRaceInformartion', we add the foreign key and
 332   --   copy everything else verbatim.
 333   --
 334   from_xml_fk fk AutoRacingResultsRaceInformationXml{..} =
 335     AutoRacingResultsRaceInformation {
 336       db_auto_racing_results_id' = fk,
 337       db_track_length = xml_track_length,
 338       db_track_length_kph = xml_track_length_kph,
 339       db_laps = xml_laps,
 340       db_average_speed_mph = xml_average_speed_mph,
 341       db_average_speed_kph = xml_average_speed_kph,
 342       db_average_speed = xml_average_speed,
 343       db_time_of_race = xml_time_of_race,
 344       db_margin_of_victory = xml_margin_of_victory,
 345       db_cautions = xml_cautions,
 346       db_lead_changes = xml_lead_changes,
 347       db_lap_leaders = xml_lap_leaders,
 348       db_most_laps_leading = xml_most_laps_leading }
 349
 350
 351 -- | This allows us to insert the XML representation
 352 --   'AutoRacingResultsRaceInformationXml' directly.
 353 --
 354 instance XmlImportFk AutoRacingResultsRaceInformationXml
 355
 356
 357
 358 --
 359 -- * Database stuff.
 360 --
 361
 362 instance DbImport Message where
 363   dbmigrate _ =
 364     run_dbmigrate $ do
 365       migrate (undefined :: AutoRacingResults)
 366       migrate (undefined :: AutoRacingResultsListing)
 367       migrate (undefined :: AutoRacingResultsRaceInformation)
 368
 369   -- | We insert the message, then use its ID to insert the listings
 370   --   and race information.
 371   dbimport m = do
 372     msg_id <- insert_xml m
 373
 374     insert_xml_fk_ msg_id (xml_race_information m)
 375
 376     forM_ (xml_listings m) $ insert_xml_fk_ msg_id
 377
 378     return ImportSucceeded
 379
 380
 381
 382 mkPersist tsn_codegen_config [groundhog|
 383 - entity: AutoRacingResults
 384   dbName: auto_racing_results
 385   constructors:
 386     - name: AutoRacingResults
 387       uniques:
 388         - name: unique_auto_racing_results
 389           type: constraint
 390           # Prevent multiple imports of the same message.
 391           fields: [db_xml_file_id]
 392
 393
 394 - entity: AutoRacingResultsListing
 395   dbName: auto_racing_results_listings
 396   constructors:
 397     - name: AutoRacingResultsListing
 398       fields:
 399         - name: db_auto_racing_results_id
 400           reference:
 401             onDelete: cascade
 402
 403   # Note the apostrophe in the foreign key. This is to disambiguate
 404   # it from the AutoRacingResultsListing foreign key of the same name.
 405   # We strip it out of the dbName.
 406 - entity: AutoRacingResultsRaceInformation
 407   dbName: auto_racing_results_race_information
 408   constructors:
 409     - name: AutoRacingResultsRaceInformation
 410       fields:
 411         - name: db_auto_racing_results_id'
 412           dbName: auto_racing_results_id
 413           reference:
 414             onDelete: cascade
 415         - name: db_most_laps_leading
 416           embeddedType:
 417             - {name: most_laps_leading_driver_id,
 418                dbName: most_laps_leading_driver_id}
 419             - {name: most_laps_leading_driver,
 420                dbName: most_laps_leading_driver}
 421
 422 - embedded: MostLapsLeading
 423   fields:
 424     - name: db_most_laps_leading_driver_id
 425       dbName: most_laps_leading_driver_id
 426     - name: db_most_laps_leading_driver
 427       dbName: most_laps_leading_driver
 428     - name: db_most_laps_leading_number_of_laps
 429       dbName: most_laps_leading_number_of_laps
 430 |]
 431
 432
 433 ---
 434 --- Pickling
 435 ---
 436
 437 -- | Pickler for the \<Listing\>s contained within \<message\>s.
 438 --
 439 pickle_listing :: PU AutoRacingResultsListingXml
 440 pickle_listing =
 441   xpElem "Listing" $
 442     xpWrap (from_tuple, to_tuple) $
 443     xp13Tuple (xpElem "FinishPosition" xpInt)
 444               (xpElem "StartingPosition" xpInt)
 445               (xpElem "CarNumber" xpInt)
 446               (xpElem "DriverID" xpInt)
 447               (xpElem "Driver" xpText)
 448               (xpElem "CarMake" xpText)
 449               (xpElem "Points" xpInt)
 450               (xpElem "Laps_Completed" xpInt)
 451               (xpElem "Laps_Leading" xpInt)
 452               (xpElem "Status" $ xpOption xpText)
 453               (xpOption $ xpElem "DNF" xpPrim)
 454               (xpOption $ xpElem "NC" xpPrim)
 455               (xpElem "Earnings" xp_earnings)
 456   where
 457     from_tuple = uncurryN AutoRacingResultsListingXml
 458     to_tuple m = (xml_finish_position m,
 459                   xml_starting_position m,
 460                   xml_car_number m,
 461                   xml_driver_id m,
 462                   xml_driver m,
 463                   xml_car_make m,
 464                   xml_points m,
 465                   xml_laps_completed m,
 466                   xml_laps_leading m,
 467                   xml_status m,
 468                   xml_dnf m,
 469                   xml_nc m,
 470                   xml_earnings m)
 471
 472
 473 -- | Pickler for the top-level 'Message'.
 474 --
 475 pickle_message :: PU Message
 476 pickle_message =
 477   xpElem "message" $
 478     xpWrap (from_tuple, to_tuple) $
 479     xp13Tuple (xpElem "XML_File_ID" xpInt)
 480               (xpElem "heading" xpText)
 481               (xpElem "category" xpText)
 482               (xpElem "sport" xpText)
 483               (xpElem "RaceID" xpInt)
 484               (xpElem "RaceDate" xp_datetime)
 485               (xpElem "Title" xpText)
 486               (xpElem "Track_Location" xpText)
 487               (xpElem "Laps_Remaining" xpInt)
 488               (xpElem "Checkered_Flag" xpPrim)
 489               (xpList pickle_listing)
 490               pickle_race_information
 491               (xpElem "time_stamp" xp_time_stamp)
 492   where
 493     from_tuple = uncurryN Message
 494     to_tuple m = (xml_xml_file_id m,
 495                   xml_heading m,
 496                   xml_category m,
 497                   xml_sport m,
 498                   xml_race_id m,
 499                   xml_race_date m,
 500                   xml_title m,
 501                   xml_track_location m,
 502                   xml_laps_remaining m,
 503                   xml_checkered_flag m,
 504                   xml_listings m,
 505                   xml_race_information m,
 506                   xml_time_stamp m)
 507
 508
 509 -- | Pickler for the \<Most_Laps_Leading\> child of a
 510 --   \<Race_Information\>.
 511 --
 512 pickle_most_laps_leading :: PU MostLapsLeading
 513 pickle_most_laps_leading =
 514   xpElem "Most_Laps_Leading" $
 515     xpWrap (from_tuple, to_tuple) $
 516     xpTriple (xpElem "DriverID" xpInt)
 517              (xpElem "Driver" xpText)
 518              (xpElem "NumberOfLaps" xpInt)
 519   where
 520     from_tuple = uncurryN MostLapsLeading
 521     to_tuple m = (db_most_laps_leading_driver_id m,
 522                   db_most_laps_leading_driver m,
 523                   db_most_laps_leading_number_of_laps m)
 524
 525
 526 -- | Pickler for the \<Race_Information\> child of \<message\>.
 527 --
 528 pickle_race_information :: PU AutoRacingResultsRaceInformationXml
 529 pickle_race_information =
 530   xpElem "Race_Information" $
 531     xpWrap (from_tuple, to_tuple) $
 532     xp11Tuple (-- I can't think of another way to get both the
 533                -- TrackLength and its KPH attribute. So we shove them
 534                -- both in a 2-tuple. This should probably be an embedded type!
 535                  xpElem "TrackLength" $
 536                    xpPair xpText
 537                           (xpAttr "KPH" xp_fracpart_only_double) )
 538               (xpElem "Laps" xpInt)
 539               (xpOption $ xpElem "AverageSpeedMPH" xpPrim)
 540               (xpOption $ xpElem "AverageSpeedKPH" xpPrim)
 541               (xpOption $ xpElem "AverageSpeed" xpPrim)
 542               (xpOption $ xpElem "TimeOfRace" xpText)
 543               (xpOption $ xpElem "MarginOfVictory" xpText)
 544               (xpOption $ xpElem "Cautions" xpText)
 545               (xpOption $ xpElem "LeadChanges" xpText)
 546               (xpOption $ xpElem "LapLeaders" xpText)
 547               pickle_most_laps_leading
 548   where
 549     -- Derp. Since the first two are paired, we have to
 550     -- manually unpack the bazillion arguments.
 551     from_tuple ((x1,x2),x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) =
 552         AutoRacingResultsRaceInformationXml
 553           x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
 554
 555     -- And here we have to re-pair the first two.
 556     to_tuple m = ((xml_track_length m, xml_track_length_kph m),
 557                   xml_laps m,
 558                   xml_average_speed_mph m,
 559                   xml_average_speed_kph m,
 560                   xml_average_speed m,
 561                   xml_time_of_race m,
 562                   xml_margin_of_victory m,
 563                   xml_cautions m,
 564                   xml_lead_changes m,
 565                   xml_lap_leaders m,
 566                   xml_most_laps_leading m)
 567
 568 --
 569 -- * Tasty Tests
 570 --
 571
 572 -- | A list of all tests for this module.
 573 --
 574 auto_racing_results_tests :: TestTree
 575 auto_racing_results_tests =
 576   testGroup
 577     "AutoRacingResults tests"
 578     [ test_on_delete_cascade,
 579       test_pickle_of_unpickle_is_identity,
 580       test_unpickle_succeeds ]
 581
 582 -- | If we unpickle something and then pickle it, we should wind up
 583 --   with the same thing we started with. WARNING: success of this
 584 --   test does not mean that unpickling succeeded.
 585 --
 586 test_pickle_of_unpickle_is_identity :: TestTree
 587 test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $
 588   [ check "pickle composed with unpickle is the identity"
 589           "test/xml/AutoRacingResultsXML.xml",
 590
 591     check "pickle composed with unpickle is the identity (fractional KPH)"
 592           "test/xml/AutoRacingResultsXML-fractional-kph.xml" ]
 593   where
 594     check desc path = testCase desc $ do
 595       (expected, actual) <- pickle_unpickle pickle_message path
 596       actual @?= expected
 597
 598
 599
 600 -- | Make sure we can actually unpickle these things.
 601 --
 602 test_unpickle_succeeds :: TestTree
 603 test_unpickle_succeeds = testGroup "unpickle tests" $
 604   [ check "unpickling succeeds"
 605           "test/xml/AutoRacingResultsXML.xml",
 606
 607     check "unpickling succeeds (fractional KPH)"
 608           "test/xml/AutoRacingResultsXML-fractional-kph.xml" ]
 609   where
 610     check desc path = testCase desc $ do
 611       actual <- unpickleable path pickle_message
 612       let expected = True
 613       actual @?= expected
 614
 615
 616
 617 -- | Make sure everything gets deleted when we delete the top-level
 618 --   record.
 619 --
 620 test_on_delete_cascade :: TestTree
 621 test_on_delete_cascade = testGroup "cascading delete tests" $
 622   [ check "deleting auto_racing_results deletes its children"
 623           "test/xml/AutoRacingResultsXML.xml",
 624
 625     check "deleting auto_racing_results deletes its children (fractional KPH)"
 626           "test/xml/AutoRacingResultsXML-fractional-kph.xml" ]
 627   where
 628     check desc path = testCase desc $ do
 629       results <- unsafe_unpickle path pickle_message
 630       let a = undefined :: AutoRacingResults
 631       let b = undefined :: AutoRacingResultsListing
 632       let c = undefined :: AutoRacingResultsRaceInformation
 633
 634       actual <- withSqliteConn ":memory:" $ runDbConn $ do
 635                   runMigration silentMigrationLogger $ do
 636                     migrate a
 637                     migrate b
 638                     migrate c
 639                   _ <- dbimport results
 640                   deleteAll a
 641                   count_a <- countAll a
 642                   count_b <- countAll b
 643                   count_c <- countAll c
 644                   return $ sum [count_a, count_b, count_c]
 645       let expected = 0
 646       actual @?= expected