Add the 'xp_attr_option' pickler and use it to fix tests broken by HXT.

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

diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs
index c3bd6c487532926d499a883c7549580dd9123914..95aecbed22767a28fb03a071e94790ff2e7003b7 100644 (file)
--- a/src/TSN/XML/Odds.hs
+++ b/src/TSN/XML/Odds.hs
@@ -29,6 +29,7 @@ import Control.Applicative ( (<$>) )
 import Control.Monad ( forM_, join )
 import Data.Time ( UTCTime(..) )
 import Data.Tuple.Curry ( uncurryN )
+import qualified Data.Vector.HFixed as H ( HVector, convert )
 import Database.Groundhog (
   (=.),
   (==.),
@@ -36,11 +37,9 @@ import Database.Groundhog (
   deleteAll,
   insert_,
   migrate,
-  runMigration,
-  silentMigrationLogger,
   update )
 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,
@@ -64,11 +63,14 @@ 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 )
-import TSN.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp )
+import TSN.Picklers (
+  xp_attr_option,
+  xp_date_padded,
+  xp_tba_time,
+  xp_time_stamp )
 import TSN.Team ( FromXmlFkTeams(..), Team(..) )
 import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) )
 import Xml (
@@ -128,9 +130,9 @@ data OddsGameCasinoXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic OddsGameCasinoXml
+instance H.HVector OddsGameCasinoXml
 
 
 -- | Try to get a 'Double' out of the 'xml_casino_line' which is a
@@ -179,9 +181,9 @@ data OddsGameTeamStarterXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic OddsGameTeamStarterXml
+instance H.HVector OddsGameTeamStarterXml
 
 
 -- | The XML representation of a \<HomeTeam\> or \<AwayTeam\>, as
@@ -206,9 +208,9 @@ data OddsGameTeamXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic OddsGameTeamXml
+instance H.HVector OddsGameTeamXml
 
 
 instance ToDb OddsGameTeamXml where
@@ -302,9 +304,9 @@ data OddsGameXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic OddsGameXml
+instance H.HVector OddsGameXml
 
 
 -- | Pseudo-field that lets us get the 'OddsGameCasinoXml's out of
@@ -442,9 +444,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
 
 
 -- | Pseudo-field that lets us get the 'OddsGame's out of
@@ -648,9 +650,9 @@ pickle_game_with_notes =
 pickle_casino :: PU OddsGameCasinoXml
 pickle_casino =
   xpElem "Casino" $
-  xpWrap (from_tuple, to_tuple) $
+  xpWrap (from_tuple, H.convert) $
   xpTriple
-    (xpAttr "ClientID" $ xpOption xpInt)
+    (xpAttr "ClientID" $ xp_attr_option)
     (xpAttr "Name" $ xpOption xpText)
     (xpOption xpText)
   where
@@ -662,7 +664,7 @@ pickle_casino =
 pickle_home_team :: PU OddsGameTeamXml
 pickle_home_team =
   xpElem "HomeTeam" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xp6Tuple
         (xpElem "HomeTeamID" xpText)
         (xpElem "HomeRotationNumber" (xpOption xpInt))
@@ -680,7 +682,7 @@ pickle_home_team =
 --
 pickle_starter :: PU OddsGameTeamStarterXml
 pickle_starter =
-  xpWrap (from_tuple, to_tuple) $
+  xpWrap (from_tuple, H.convert) $
     xpPair (xpAttr "ID" xpInt) (xpOption xpText)
   where
     from_tuple = uncurry OddsGameTeamStarterXml
@@ -704,7 +706,7 @@ pickle_away_starter = xpElem "AStarter" pickle_starter
 pickle_away_team :: PU OddsGameTeamXml
 pickle_away_team =
   xpElem "AwayTeam" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
       xp6Tuple
         (xpElem "AwayTeamID" xpText)
         (xpElem "AwayRotationNumber" (xpOption xpInt))
@@ -734,7 +736,7 @@ pickle_over_under =
 pickle_game :: PU OddsGameXml
 pickle_game =
   xpElem "Game" $
-  xpWrap (from_tuple, to_tuple) $
+  xpWrap (from_tuple, H.convert) $
   xp6Tuple
     (xpElem "GameID" xpInt)
     (xpElem "Game_Date" xp_date_padded)
@@ -751,7 +753,7 @@ pickle_game =
 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)
@@ -897,7 +899,7 @@ test_on_delete_cascade = testGroup "cascading delete tests"
       let d = undefined :: OddsGame
       let e = undefined :: OddsGameLine
       actual <- withSqliteConn ":memory:" $ runDbConn $ do
-                  runMigration silentMigrationLogger $ do
+                  runMigrationSilent $ do
                     migrate a
                     migrate b
                     migrate c