Allow "TBA" laps in TSN.XML.AutoRacingSchedule.

[dead/htsn-import.git] / src / TSN / XML / AutoRacingSchedule.hs

diff --git a/src/TSN/XML/AutoRacingSchedule.hs b/src/TSN/XML/AutoRacingSchedule.hs
index 62202ddf88dcf0279423ce70fd52fd55351a4aa1..edfcaacb44c919fa6cf507b0fc5f6c0856ebd1f9 100644 (file)
--- a/src/TSN/XML/AutoRacingSchedule.hs
+++ b/src/TSN/XML/AutoRacingSchedule.hs
@@ -1,9 +1,10 @@
+

 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveDataTypeable #-}

+{-# LANGUAGE DeriveGeneric #-}

 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}

-{-# LANGUAGE StandaloneDeriving #-}

 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 


@@ -13,6 +14,7 @@
 --   containing \<RaceResultsListing\>s.
 --
 module TSN.XML.AutoRacingSchedule (
 --   containing \<RaceResultsListing\>s.
 --
 module TSN.XML.AutoRacingSchedule (

+  dtd,

   pickle_message,
   -- * Tests
   auto_racing_schedule_tests,
   pickle_message,
   -- * Tests
   auto_racing_schedule_tests,


@@ -26,18 +28,18 @@ where
 import Control.Monad ( forM_ )
 import Data.Time ( UTCTime(..) )
 import Data.Tuple.Curry ( uncurryN )
 import Control.Monad ( forM_ )
 import Data.Time ( UTCTime(..) )
 import Data.Tuple.Curry ( uncurryN )

+import qualified Data.Vector.HFixed as H ( HVector, cons, convert )

 import Database.Groundhog (
   countAll,
 import Database.Groundhog (
   countAll,

-  executeRaw,
-  migrate,
-  runMigration,
-  silentMigrationLogger )
+  deleteAll,
+  migrate )

 import Database.Groundhog.Core ( DefaultKey )
 import Database.Groundhog.Core ( DefaultKey )

-import Database.Groundhog.Generic ( runDbConn )
+import Database.Groundhog.Generic ( runDbConn, runMigrationSilent )

 import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
   groundhog,
   mkPersist )
 import Database.Groundhog.Sqlite ( withSqliteConn )
 import Database.Groundhog.TH (
   groundhog,
   mkPersist )

+import qualified GHC.Generics as GHC ( Generic )

 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (


@@ -56,9 +58,10 @@ import Text.XML.HXT.Core (
 import TSN.Codegen (
   tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Codegen (
   tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )

-import TSN.Picklers ( xp_date, xp_tba_time, xp_time_stamp )
+import TSN.Picklers ( xp_date_padded, xp_tba_int, xp_tba_time, xp_time_stamp )

 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
 import Xml (
 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
 import Xml (

+  Child(..),

   FromXml(..),
   FromXmlFk(..),
   ToDb(..),
   FromXml(..),
   FromXmlFk(..),
   ToDb(..),


@@ -67,6 +70,11 @@ import Xml (
   unsafe_unpickle )
 
 
   unsafe_unpickle )
 
 

+-- | The DTD to which this module corresponds. Used to invoke dbimport.
+--
+dtd :: String
+dtd = "Auto_Racing_Schedule_XML.dtd"
+

 --
 -- DB/XML data types
 --
 --
 -- DB/XML data types
 --


@@ -99,12 +107,26 @@ data Message =
     xml_complete_through :: String,
     xml_listings :: [AutoRacingScheduleListingXml],
     xml_time_stamp :: UTCTime }
     xml_complete_through :: String,
     xml_listings :: [AutoRacingScheduleListingXml],
     xml_time_stamp :: UTCTime }

-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'H.convert'.
+--
+instance H.HVector Message
+

 
 instance ToDb Message where
 
 instance ToDb Message where

+  -- | The database analogue of a 'Message' is a 'AutoRacingSchedule'.
+  --

   type Db Message = AutoRacingSchedule
 
   type Db Message = AutoRacingSchedule
 

+
+-- | The 'FromXml' instance for 'Message' is required for the
+--   'XmlImport' instance.
+--

 instance FromXml Message where
 instance FromXml Message where

+  -- | To convert a 'Message' to an 'AutoRacingSchedule', we just drop
+  --   the 'xml_listings'.
+  --

   from_xml Message{..} =
     AutoRacingSchedule {
       db_xml_file_id = xml_xml_file_id,
   from_xml Message{..} =
     AutoRacingSchedule {
       db_xml_file_id = xml_xml_file_id,


@@ -115,15 +137,20 @@ instance FromXml Message where
       db_complete_through = xml_complete_through,
       db_time_stamp = xml_time_stamp }
 
       db_complete_through = xml_complete_through,
       db_time_stamp = xml_time_stamp }
 

+
+-- | This allows us to insert the XML representation 'Message'
+--   directly.
+--

 instance XmlImport Message
 
 
 -- * AutoRacingScheduleListing/AutoRacingScheduleListingXml
 
 -- | Database representation of a \<Listing\> contained within a
 instance XmlImport Message
 
 
 -- * AutoRacingScheduleListing/AutoRacingScheduleListingXml
 
 -- | Database representation of a \<Listing\> contained within a

---   \<Message\>. We combine the race date/time into a single
+--   \<message\>. We combine the race date/time into a single

 --   race_time, drop the race results list, and add a foreign key to
 --   our parent.
 --   race_time, drop the race results list, and add a foreign key to
 --   our parent.

+--

 data AutoRacingScheduleListing =
   AutoRacingScheduleListing {
     db_auto_racing_schedules_id :: DefaultKey AutoRacingSchedule,
 data AutoRacingScheduleListing =
   AutoRacingScheduleListing {
     db_auto_racing_schedules_id :: DefaultKey AutoRacingSchedule,


@@ -133,10 +160,11 @@ data AutoRacingScheduleListing =
     db_track_name :: String,
     db_location :: String,
     db_tv_listing :: Maybe String,
     db_track_name :: String,
     db_location :: String,
     db_tv_listing :: Maybe String,

-    db_laps :: Int,
+    db_laps :: Maybe Int,

     db_track_length :: String -- ^ Sometimes the word "miles" shows up.
   }
 
     db_track_length :: String -- ^ Sometimes the word "miles" shows up.
   }
 

+

 -- | XML representation of a \<Listing\> contained within a
 --   \<message\>.
 --
 -- | XML representation of a \<Listing\> contained within a
 --   \<message\>.
 --


@@ -149,24 +177,46 @@ data AutoRacingScheduleListingXml =
     xml_track_name :: String,
     xml_location :: String,
     xml_tv_listing :: Maybe String,
     xml_track_name :: String,
     xml_location :: String,
     xml_tv_listing :: Maybe String,

-    xml_laps :: Int,
-    xml_track_length :: String, -- ^ Sometimes the word \"miles\" shows up.
+    xml_laps :: Maybe Int,
+    xml_track_length :: String, -- ^ Sometimes the word \"miles\" shows up,
+                                --   so we can't do the right thing and use
+                                --   a 'Double'.

     xml_race_results :: [AutoRacingScheduleListingRaceResult] }
     xml_race_results :: [AutoRacingScheduleListingRaceResult] }

-  deriving (Eq, Show)
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'H.convert'.
+--
+instance H.HVector AutoRacingScheduleListingXml
+

 
 -- | Pseudo-accessor to get the race result listings out of a
 
 -- | Pseudo-accessor to get the race result listings out of a

---   'AutoRacingScheduleListingXml'.
+--   'AutoRacingScheduleListingXml'. A poor man's lens.
+--

 result_listings :: AutoRacingScheduleListingXml
                 -> [AutoRacingScheduleListingRaceResultRaceResultListingXml]
 result_listings = (concatMap xml_race_result_listing) . xml_race_results
 
 
 instance ToDb AutoRacingScheduleListingXml where
 result_listings :: AutoRacingScheduleListingXml
                 -> [AutoRacingScheduleListingRaceResultRaceResultListingXml]
 result_listings = (concatMap xml_race_result_listing) . xml_race_results
 
 
 instance ToDb AutoRacingScheduleListingXml where

+  -- | The database analogue of an 'AutoRacingScheduleListingXml' is
+  --   an 'AutoRacingScheduleListing'.
+  --

   type Db AutoRacingScheduleListingXml = AutoRacingScheduleListing
 
   type Db AutoRacingScheduleListingXml = AutoRacingScheduleListing
 

-instance FromXmlFk AutoRacingScheduleListingXml where
+
+instance Child AutoRacingScheduleListingXml where
+  -- | Each 'AutoRacingScheduleListingXml' is contained in (i.e. has a
+  --   foreign key to) a 'AutoRacingSchedule'.
+  --

   type Parent AutoRacingScheduleListingXml = AutoRacingSchedule
 
   type Parent AutoRacingScheduleListingXml = AutoRacingSchedule
 

+
+instance FromXmlFk AutoRacingScheduleListingXml where
+  -- | To convert an 'AutoRacingScheduleListingXml' to an
+  --   'AutoRacingScheduleListing', we add the foreign key and drop
+  --   the 'xml_race_results'. We also mash the date/time together
+  --   into one field.
+  --

   from_xml_fk fk AutoRacingScheduleListingXml{..} =
     AutoRacingScheduleListing {
       db_auto_racing_schedules_id = fk,
   from_xml_fk fk AutoRacingScheduleListingXml{..} =
     AutoRacingScheduleListing {
       db_auto_racing_schedules_id = fk,


@@ -179,12 +229,21 @@ instance FromXmlFk AutoRacingScheduleListingXml where
       db_laps = xml_laps,
       db_track_length = xml_track_length }
     where
       db_laps = xml_laps,
       db_track_length = xml_track_length }
     where

-      -- Take the day part from one, the time from the other.
+      -- | Make the database \"race time\" from the XML
+      --   date/time. Simply take the day part from one and the time
+      --   from the other.
+      --

       make_race_time d Nothing = d
       make_race_time d (Just t) = UTCTime (utctDay d) (utctDayTime t)
 
       make_race_time d Nothing = d
       make_race_time d (Just t) = UTCTime (utctDay d) (utctDayTime t)
 

+
+-- | This allows us to insert the XML representation
+--   'AutoRacingScheduleListingXml' directly.
+--

 instance XmlImportFk AutoRacingScheduleListingXml
 
 instance XmlImportFk AutoRacingScheduleListingXml
 

+
+

 -- * AutoRacingScheduleListingRaceResult
 
 -- | The XML representation of \<message\> -> \<Listing\> ->
 -- * AutoRacingScheduleListingRaceResult
 
 -- | The XML representation of \<message\> -> \<Listing\> ->


@@ -198,53 +257,91 @@ newtype AutoRacingScheduleListingRaceResult =
       [AutoRacingScheduleListingRaceResultRaceResultListingXml] }
   deriving (Eq, Show)
 
       [AutoRacingScheduleListingRaceResultRaceResultListingXml] }
   deriving (Eq, Show)
 

--- * AutoRacingScheduleListingRaceResultRaceResultListing /
---   AutoRacingScheduleListingRaceResultRaceResultListingXml

 
 

+-- * AutoRacingScheduleListingRaceResultRaceResultListing / AutoRacingScheduleListingRaceResultRaceResultListingXml
+--
+--   Sorry about the names yo.
+--
+
+-- | Database representation of \<RaceResultListing\> within
+--   \<RaceResults\> within \<Listing\> within... \<message\>!
+--   The leading underscores prevent unused field warnings.
+--

 data AutoRacingScheduleListingRaceResultRaceResultListing =
   AutoRacingScheduleListingRaceResultRaceResultListing {
 data AutoRacingScheduleListingRaceResultRaceResultListing =
   AutoRacingScheduleListingRaceResultRaceResultListing {

-    db_auto_racing_schedules_listings_id ::
+    _db_auto_racing_schedules_listings_id ::

       DefaultKey AutoRacingScheduleListing,
       DefaultKey AutoRacingScheduleListing,

-    db_finish_position :: Int,
-    db_driver_id :: Int,
-    db_name :: String,
-    db_leading_laps :: Int,
-    db_listing_laps :: Int, -- Avoid clash with race's "laps" field.
-    db_earnings :: String, -- Should be an int, but they use commas.
-    db_status :: String }
+    _db_finish_position :: Int,
+    _db_driver_id :: Int,
+    _db_name :: String,
+    _db_leading_laps :: Int,
+    _db_listing_laps :: Int, -- ^ Avoid clash with race's \"laps\" field.
+    _db_earnings :: String,  -- ^ This should be an Int, but can have commas.
+    _db_status :: Maybe String -- ^ They can be empty
+    }
+  deriving ( GHC.Generic )
+
+-- | For 'H.cons'.
+--
+instance H.HVector AutoRacingScheduleListingRaceResultRaceResultListing
+

 
 

+-- | XML Representation of an
+--   'AutoRacingScheduleListingRaceResultRaceResultListing'.
+--   The leading underscores prevent unused field warnings.
+--

 data AutoRacingScheduleListingRaceResultRaceResultListingXml =
   AutoRacingScheduleListingRaceResultRaceResultListingXml {
 data AutoRacingScheduleListingRaceResultRaceResultListingXml =
   AutoRacingScheduleListingRaceResultRaceResultListingXml {

-    xml_finish_position :: Int,
-    xml_driver_id :: Int,
-    xml_name :: String,
-    xml_leading_laps :: Int,
-    xml_listing_laps :: Int, -- Avoid clash with race's "laps" field.
-    xml_earnings :: String, -- Should be an int, but they use commas.
-    xml_status :: String }
-  deriving (Eq, Show)
+    _xml_finish_position :: Int,
+    _xml_driver_id :: Int,
+    _xml_name :: String,
+    _xml_leading_laps :: Int,
+    _xml_listing_laps :: Int, -- ^ Avoids clash with race's \"laps\" field.
+    _xml_earnings :: String,  -- ^ Should be an 'Int', but can have commas.
+    _xml_status :: Maybe String -- ^ They can be empty
+    }
+  deriving (Eq, GHC.Generic, Show)
+
+-- | For 'H.convert'.
+--
+instance H.HVector AutoRacingScheduleListingRaceResultRaceResultListingXml
+

 
 instance ToDb AutoRacingScheduleListingRaceResultRaceResultListingXml where
 
 instance ToDb AutoRacingScheduleListingRaceResultRaceResultListingXml where

+  -- | The database representation of an
+  --   'AutoRacingScheduleListingRaceResultRaceResultListingXml' is an
+  --   'AutoRacingScheduleListingRaceResultRaceResultListing'.
+  --

   type Db AutoRacingScheduleListingRaceResultRaceResultListingXml =
     AutoRacingScheduleListingRaceResultRaceResultListing
 
   type Db AutoRacingScheduleListingRaceResultRaceResultListingXml =
     AutoRacingScheduleListingRaceResultRaceResultListing
 

-instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where
+
+instance Child AutoRacingScheduleListingRaceResultRaceResultListingXml where
+  -- | Each 'AutoRacingScheduleListingRaceResultRaceResultListingXml'
+  --   is contained in (i.e. has a foreign key to) an
+  --   'AutoRacingScheduleListing'. We skip the intermediate
+  --   \<RaceResults\>.
+  --

   type Parent AutoRacingScheduleListingRaceResultRaceResultListingXml =
     AutoRacingScheduleListing
 
   type Parent AutoRacingScheduleListingRaceResultRaceResultListingXml =
     AutoRacingScheduleListing
 

-  from_xml_fk fk AutoRacingScheduleListingRaceResultRaceResultListingXml{..} =
-    AutoRacingScheduleListingRaceResultRaceResultListing {
-      db_auto_racing_schedules_listings_id = fk,
-      db_finish_position = xml_finish_position,
-      db_driver_id = xml_driver_id,
-      db_name = xml_name,
-      db_leading_laps = xml_leading_laps,
-      db_listing_laps = xml_listing_laps,
-      db_earnings = xml_earnings,
-      db_status = xml_earnings }

 
 

+instance FromXmlFk AutoRacingScheduleListingRaceResultRaceResultListingXml where
+  -- | To convert an
+  --   'AutoRacingScheduleListingRaceResultRaceResultListingXml' to an
+  --   'AutoRacingScheduleListingRaceResultRaceResultListing', we just
+  --   add the foreign key to the parent 'AutoRacingScheduleListing'.
+  --
+  from_xml_fk = H.cons
+
+
+-- | This allows us to insert the XML representation
+--   'AutoRacingScheduleListingRaceResultRaceResultListingXml'
+--   directly.
+--

 instance XmlImportFk AutoRacingScheduleListingRaceResultRaceResultListingXml
 
 instance XmlImportFk AutoRacingScheduleListingRaceResultRaceResultListingXml
 

+

 ---
 --- Database stuff.
 ---
 ---
 --- Database stuff.
 ---


@@ -257,6 +354,10 @@ instance DbImport Message where
       migrate (undefined
                  :: AutoRacingScheduleListingRaceResultRaceResultListing)
 
       migrate (undefined
                  :: AutoRacingScheduleListingRaceResultRaceResultListing)
 

+
+  -- | We insert the message, then use its ID to insert the listings,
+  --   using their IDs to insert the race result listings.
+  --

   dbimport m = do
     msg_id <- insert_xml m
 
   dbimport m = do
     msg_id <- insert_xml m
 


@@ -274,7 +375,7 @@ mkPersist tsn_codegen_config [groundhog|
   constructors:
     - name: AutoRacingSchedule
       uniques:
   constructors:
     - name: AutoRacingSchedule
       uniques:

-        - name: unique_auto_racing_schedule
+        - name: unique_auto_racing_schedules

           type: constraint
           # Prevent multiple imports of the same message.
           fields: [db_xml_file_id]
           type: constraint
           # Prevent multiple imports of the same message.
           fields: [db_xml_file_id]


@@ -293,7 +394,7 @@ mkPersist tsn_codegen_config [groundhog|
   constructors:
     - name: AutoRacingScheduleListingRaceResultRaceResultListing
       fields:
   constructors:
     - name: AutoRacingScheduleListingRaceResultRaceResultListing
       fields:

-        - name: db_auto_racing_schedules_listings_id
+        - name: _db_auto_racing_schedules_listings_id

           reference:
             onDelete: cascade
 |]
           reference:
             onDelete: cascade
 |]


@@ -309,7 +410,7 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $

-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $

     xp8Tuple (xpElem "XML_File_ID" xpInt)
              (xpElem "heading" xpText)
              (xpElem "category" xpText)
     xp8Tuple (xpElem "XML_File_ID" xpInt)
              (xpElem "heading" xpText)
              (xpElem "category" xpText)


@@ -320,43 +421,31 @@ pickle_message =
              (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message
              (xpElem "time_stamp" xp_time_stamp)
   where
     from_tuple = uncurryN Message

-    to_tuple m = (xml_xml_file_id m,
-                  xml_heading m,
-                  xml_category m,
-                  xml_sport m,
-                  xml_title m,
-                  xml_complete_through m,
-                  xml_listings m,
-                  xml_time_stamp m)

 
 
 
 

+-- | Convert an 'AutoRacingScheduleListingXml' to/from XML.
+--

 pickle_listing :: PU AutoRacingScheduleListingXml
 pickle_listing =
   xpElem "Listing" $
 pickle_listing :: PU AutoRacingScheduleListingXml
 pickle_listing =
   xpElem "Listing" $

-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $

       xp10Tuple (xpElem "RaceID" xpInt)
       xp10Tuple (xpElem "RaceID" xpInt)

-                (xpElem "Race_Date" xp_date)
+                (xpElem "Race_Date" xp_date_padded)

                 (xpElem "Race_Time" xp_tba_time)
                 (xpElem "RaceName" xpText)
                 (xpElem "TrackName" xpText)
                 (xpElem "Location" xpText)
                 (xpElem "TV_Listing" $ xpOption xpText)
                 (xpElem "Race_Time" xp_tba_time)
                 (xpElem "RaceName" xpText)
                 (xpElem "TrackName" xpText)
                 (xpElem "Location" xpText)
                 (xpElem "TV_Listing" $ xpOption xpText)

-                (xpElem "Laps" xpInt)
+                (xpElem "Laps" xp_tba_int)

                 (xpElem "TrackLength" xpText)
                 (xpList pickle_race_results)
   where
     from_tuple = uncurryN AutoRacingScheduleListingXml
                 (xpElem "TrackLength" xpText)
                 (xpList pickle_race_results)
   where
     from_tuple = uncurryN AutoRacingScheduleListingXml

-    to_tuple m = (xml_race_id m,
-                  xml_race_date m,
-                  xml_race_time m,
-                  xml_race_name m,
-                  xml_track_name m,
-                  xml_location m,
-                  xml_tv_listing m,
-                  xml_laps m,
-                  xml_track_length m,
-                  xml_race_results m)

 
 

+
+
+-- | Convert an 'AutoRacingScheduleListingRaceResult' to/from XML.
+--

 pickle_race_results :: PU AutoRacingScheduleListingRaceResult
 pickle_race_results =
   xpElem "RaceResults" $
 pickle_race_results :: PU AutoRacingScheduleListingRaceResult
 pickle_race_results =
   xpElem "RaceResults" $


@@ -366,30 +455,27 @@ pickle_race_results =
     to_result = AutoRacingScheduleListingRaceResult
     from_result = xml_race_result_listing
 
     to_result = AutoRacingScheduleListingRaceResult
     from_result = xml_race_result_listing
 

+
+-- | Convert an
+--   'AutoRacingScheduleListingRaceResultRaceResultListingXml' to/from
+--   XML.
+--

 pickle_race_results_listing ::
   PU AutoRacingScheduleListingRaceResultRaceResultListingXml
 pickle_race_results_listing =
   xpElem "RaceResultsListing" $
 pickle_race_results_listing ::
   PU AutoRacingScheduleListingRaceResultRaceResultListingXml
 pickle_race_results_listing =
   xpElem "RaceResultsListing" $

-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $

       xp7Tuple (xpElem "FinishPosition" xpInt)
                (xpElem "DriverID" xpInt)
                (xpElem "Name" xpText)
                (xpElem "LeadingLaps" xpInt)
                (xpElem "Laps" xpInt)
                (xpElem "Earnings" xpText)
       xp7Tuple (xpElem "FinishPosition" xpInt)
                (xpElem "DriverID" xpInt)
                (xpElem "Name" xpText)
                (xpElem "LeadingLaps" xpInt)
                (xpElem "Laps" xpInt)
                (xpElem "Earnings" xpText)

-               (xpElem "Status" xpText)
+               (xpElem "Status" (xpOption xpText))

   where
     from_tuple =
       uncurryN AutoRacingScheduleListingRaceResultRaceResultListingXml
 
   where
     from_tuple =
       uncurryN AutoRacingScheduleListingRaceResultRaceResultListingXml
 

-    to_tuple m = (xml_finish_position m,
-                  xml_driver_id m,
-                  xml_name m,
-                  xml_leading_laps m,
-                  xml_listing_laps m,
-                  xml_earnings m,
-                  xml_status m)
-

 
 --
 -- Tasty Tests
 
 --
 -- Tasty Tests


@@ -457,13 +543,12 @@ test_on_delete_cascade = testGroup "cascading delete tests"
       let c = undefined :: AutoRacingScheduleListingRaceResultRaceResultListing
 
       actual <- withSqliteConn ":memory:" $ runDbConn $ do
       let c = undefined :: AutoRacingScheduleListingRaceResultRaceResultListing
 
       actual <- withSqliteConn ":memory:" $ runDbConn $ do

-                  runMigration silentMigrationLogger $ do
+                  runMigrationSilent $ do

                     migrate a
                     migrate b
                     migrate c
                   _ <- dbimport sched
                     migrate a
                     migrate b
                     migrate c
                   _ <- dbimport sched

-                  -- No idea how 'delete' works, so do this instead.
-                  executeRaw False "DELETE FROM auto_racing_schedules;" []
+                  deleteAll a

                   count_a <- countAll a
                   count_b <- countAll b
                   count_c <- countAll c
                   count_a <- countAll a
                   count_b <- countAll b
                   count_c <- countAll c