]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blobdiff - src/TSN/XML/EarlyLine.hs
Update all silent migrations for groundhog-0.7.
[dead/htsn-import.git] / src / TSN / XML / EarlyLine.hs
index 88c8634e7484236d9a33e0e5096becb04455c0a7..796418f716b865c66afa38b1ab6b38e4f1bbf2bc 100644 (file)
@@ -37,15 +37,14 @@ where
 import Control.Monad ( join )
 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,
@@ -68,7 +67,6 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 -- Local imports.
-import Generics ( Generic(..), to_tuple )
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers (
@@ -125,9 +123,9 @@ data Message =
     xml_time_stamp :: UTCTime }
   deriving (Eq, GHC.Generic, Show)
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic Message
+instance H.HVector Message
 
 
 instance ToDb Message where
@@ -189,9 +187,9 @@ data EarlyLineGameWithNote =
 date_game :: EarlyLineGameWithNote -> EarlyLineGameXml
 date_game (EarlyLineGameWithNote _ g) = g
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic EarlyLineGameWithNote
+instance H.HVector EarlyLineGameWithNote
 
 
 
@@ -206,9 +204,9 @@ data EarlyLineDate =
     date_games_with_notes :: [EarlyLineGameWithNote] }
   deriving (Eq, GHC.Generic, Show)
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic EarlyLineDate
+instance H.HVector EarlyLineDate
 
 
 
@@ -257,9 +255,9 @@ data EarlyLineGameXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic EarlyLineGameXml
+instance H.HVector EarlyLineGameXml
 
 
 -- * EarlyLineGameTeam / EarlyLineGameTeamXml
@@ -480,7 +478,7 @@ mkPersist tsn_codegen_config [groundhog|
 pickle_message :: PU Message
 pickle_message =
   xpElem "message" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp7Tuple (xpElem "XML_File_ID" xpInt)
              (xpElem "heading" xpText)
              (xpElem "category" xpText)
@@ -498,7 +496,7 @@ pickle_message =
 --
 pickle_game_with_note :: PU EarlyLineGameWithNote
 pickle_game_with_note =
-  xpWrap (from_tuple, to_tuple) $
+  xpWrap (from_tuple, H.convert) $
     xpPair (xpOption $ xpElem "note" xpText)
            pickle_game
   where
@@ -510,7 +508,7 @@ pickle_game_with_note =
 pickle_date :: PU EarlyLineDate
 pickle_date =
   xpElem "date" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xpPair (xpAttr "value" xp_early_line_date)
            (xpList pickle_game_with_note)
   where
@@ -523,7 +521,7 @@ pickle_date =
 pickle_game :: PU EarlyLineGameXml
 pickle_game =
   xpElem "game" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp4Tuple (xpElem "time" (xpOption xp_ambiguous_time))
              pickle_away_team
              pickle_home_team
@@ -600,7 +598,7 @@ early_line_tests =
 --   test does not mean that unpickling succeeded.
 --
 test_pickle_of_unpickle_is_identity :: TestTree
-test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $
+test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests"
   [ check "pickle composed with unpickle is the identity"
           "test/xml/earlylineXML.xml",
 
@@ -616,7 +614,7 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $
 -- | Make sure we can actually unpickle these things.
 --
 test_unpickle_succeeds :: TestTree
-test_unpickle_succeeds = testGroup "unpickle tests" $
+test_unpickle_succeeds = testGroup "unpickle tests"
   [ check "unpickling succeeds"
           "test/xml/earlylineXML.xml",
 
@@ -634,7 +632,7 @@ test_unpickle_succeeds = testGroup "unpickle tests" $
 --   record.
 --
 test_on_delete_cascade :: TestTree
-test_on_delete_cascade = testGroup "cascading delete tests" $
+test_on_delete_cascade = testGroup "cascading delete tests"
   [ check "deleting early_lines deletes its children"
           "test/xml/earlylineXML.xml",
 
@@ -647,7 +645,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" $
       let b = undefined :: EarlyLineGame
 
       actual <- withSqliteConn ":memory:" $ runDbConn $ do
-                  runMigration silentMigrationLogger $ do
+                  runMigrationSilent $ do
                     migrate a
                     migrate b
                   _ <- dbimport results