Update all silent migrations for groundhog-0.7.

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

diff --git a/src/TSN/XML/ScheduleChanges.hs b/src/TSN/XML/ScheduleChanges.hs
index 4d7730d5d3efb2625bfb4d678aed33e90d5eb747..fd5641cdbc15660f6235c6a17dbcb369be68ec06 100644 (file)
--- a/src/TSN/XML/ScheduleChanges.hs
+++ b/src/TSN/XML/ScheduleChanges.hs
@@ -26,15 +26,14 @@ where
 import Control.Monad ( forM_ )
 import Data.Time ( UTCTime(..) )
 import Data.Tuple.Curry ( uncurryN )
+import qualified Data.Vector.HFixed as H ( HVector, convert )
 import Database.Groundhog (
   countAll,
   deleteAll,
   insert_,
-  migrate,
-  runMigration,
-  silentMigrationLogger )
+  migrate )
 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,
@@ -56,7 +55,6 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
-import Generics ( Generic(..), to_tuple )
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.Database ( insert_or_select )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
@@ -110,9 +108,9 @@ data ScheduleChangeXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic ScheduleChangeXml
+instance H.HVector ScheduleChangeXml
 
 
 -- | XML representation of a 'ScheduleChanges'. It has the same
@@ -129,9 +127,9 @@ data Message =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic Message
+instance H.HVector Message
 
 
 instance ToDb Message where
@@ -169,13 +167,19 @@ instance XmlImport Message
 --   like, \<status numeral=\"4\"\>FINAL\</status\> within the XML,
 --   but they're in one-to-one correspondence with the listings.
 --
+--   The leading underscores prevent unused field warnings.
+--
 data ScheduleChangesListingStatus =
   ScheduleChangesListingStatus {
-    db_status_numeral :: Int,
-    db_status         :: Maybe String } -- Yes, they can be empty.
-  deriving (Eq, Show)
+    _db_status_numeral :: Int,
+    _db_status         :: Maybe String } -- Yes, they can be empty.
+  deriving (Eq, GHC.Generic, Show)
 
 
+-- | For 'H.convert'.
+--
+instance H.HVector ScheduleChangesListingStatus
+
 
 -- | Database representation of a \<SC_Listing\> contained within a
 --   \<Schedule_Change\>, within a \<message\>. During the transition
@@ -222,9 +226,9 @@ data ScheduleChangesListingXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic ScheduleChangesListingXml
+instance H.HVector ScheduleChangesListingXml
 
 
 instance ToDb ScheduleChangesListingXml where
@@ -345,9 +349,9 @@ mkPersist tsn_codegen_config [groundhog|
 
 - embedded: ScheduleChangesListingStatus
   fields:
-    - name: db_status_numeral
+    - name: _db_status_numeral
       dbName: status_numeral
-    - name: db_status
+    - name: _db_status
       dbName: status
 
 |]
@@ -389,22 +393,19 @@ pickle_home_team =
 pickle_status :: PU ScheduleChangesListingStatus
 pickle_status =
   xpElem "status" $
-    xpWrap (from_tuple, to_tuple') $
+    xpWrap (from_tuple, H.convert) $
     xpPair (xpAttr "numeral" xpInt)
            (xpOption xpText)
   where
     from_tuple = uncurry ScheduleChangesListingStatus
 
-    -- Avouid unused field warnings.
-    to_tuple' ScheduleChangesListingStatus{..} =
-      (db_status_numeral, db_status)
 
 -- | An (un)pickler for the \<SC_Listing\> elements.
 --
 pickle_listing :: PU ScheduleChangesListingXml
 pickle_listing =
   xpElem "SC_Listing" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp11Tuple (xpAttr "type" xpText)
               (xpElem "Schedule_ID" xpInt)
               (xpElem "Game_Date" xp_date_padded)
@@ -425,7 +426,7 @@ pickle_listing =
 pickle_schedule_change :: PU ScheduleChangeXml
 pickle_schedule_change =
   xpElem "Schedule_Change" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xpPair (xpAttr "Sport" xpText)
            (xpList pickle_listing)
   where
@@ -437,7 +438,7 @@ pickle_schedule_change =
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp6Tuple (xpElem "XML_File_ID" xpInt)
              (xpElem "heading" xpText)
              (xpElem "category" xpText)
@@ -501,7 +502,7 @@ test_on_delete_cascade =
     let c = undefined :: ScheduleChangesListing
 
     actual <- withSqliteConn ":memory:" $ runDbConn $ do
-                runMigration silentMigrationLogger $ do
+                runMigrationSilent $ do
                   migrate a
                   migrate b
                   migrate c