Migrate TSN.XML.Weather to fixed-vector-hetero.

diff --git a/src/TSN/XML/Weather.hs b/src/TSN/XML/Weather.hs
index 1d17fb017ba130522df58c217f70ee82b0798b8b..4c95566652b4b7a47b24967923f779414fd02825 100644 (file)
--- a/src/TSN/XML/Weather.hs
+++ b/src/TSN/XML/Weather.hs
@@ -28,6 +28,7 @@ where
 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,
   deleteAll,
@@ -69,7 +70,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 )
@@ -108,9 +108,9 @@ data WeatherForecastListingXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic WeatherForecastListingXml
+instance H.HVector WeatherForecastListingXml
 
 
 -- | Database representation of a weather forecast listing. The
@@ -178,9 +178,9 @@ data WeatherForecastXml =
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic WeatherForecastXml
+instance H.HVector WeatherForecastXml
 
 
 instance ToDb WeatherForecastXml where
@@ -202,6 +202,8 @@ instance FromXmlFk WeatherForecastXml where
   --   add the foreign key to the containing 'Weather', and copy the
   --   game date.
   --
+  --   This is so short it's pointless to do it generically.
+  --
   from_xml_fk fk WeatherForecastXml{..} =
     WeatherForecast {
       db_weather_id  = fk,
@@ -251,9 +253,9 @@ xml_items :: WeatherDetailedWeatherListingXml
 xml_items (WeatherDetailedWeatherListingXml _ _ items) = items
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic WeatherDetailedWeatherListingXml
+instance H.HVector WeatherDetailedWeatherListingXml
 
 
 -- * WeatherDetailedWeatherListingItem / WeatherDetailedWeatherListingItemXml
@@ -265,41 +267,51 @@ instance Generic WeatherDetailedWeatherListingXml
 --   We also drop the sport name, because it's given in the parent
 --   'Weather'.
 --
+--   The leading underscores prevent unused field warnings.
+--
 data WeatherDetailedWeatherListingItem =
   WeatherDetailedWeatherListingItem {
-    db_dtl_weather_id :: DefaultKey Weather, -- ^ Avoid name collision by
+    _db_dtl_weather_id :: DefaultKey Weather, -- ^ Avoid name collision by
                                              --   using \"dtl\" prefix.
-    db_sport_code :: String,
-    db_game_id :: Int,
-    db_dtl_game_date :: UTCTime, -- ^ Avoid name clash with \"dtl\" prefix
-    db_away_team :: String,
-    db_home_team :: String,
-    db_weather_type :: Int,
-    db_description :: Maybe String,
-    db_temp_adjust :: Maybe String,
-    db_temperature :: Int }
+    _db_sport_code :: String,
+    _db_game_id :: Int,
+    _db_dtl_game_date :: UTCTime, -- ^ Avoid name clash with \"dtl\" prefix
+    _db_away_team :: String,
+    _db_home_team :: String,
+    _db_weather_type :: Int,
+    _db_description :: Maybe String,
+    _db_temp_adjust :: Maybe String,
+    _db_temperature :: Int }
+  deriving ( GHC.Generic )
+
+-- | For 'H.cons' and 'H.convert'.
+--
+instance H.HVector WeatherDetailedWeatherListingItem
 
 
 -- | XML representation of a detailed weather item. Same as the
 --   database representation, only without the foreign key and the
 --   sport name that comes from the containing listing.
+--
+--   The leading underscores prevent unused field warnings.
+--
 data WeatherDetailedWeatherListingItemXml =
   WeatherDetailedWeatherListingItemXml {
-    xml_sport_code :: String,
-    xml_game_id :: Int,
-    xml_dtl_game_date :: UTCTime,
-    xml_away_team :: String,
-    xml_home_team :: String,
-    xml_weather_type :: Int,
-    xml_description :: Maybe String,
-    xml_temp_adjust :: Maybe String,
-    xml_temperature :: Int }
+    _xml_sport_code :: String,
+    _xml_game_id :: Int,
+    _xml_dtl_game_date :: UTCTime,
+    _xml_away_team :: String,
+    _xml_home_team :: String,
+    _xml_weather_type :: Int,
+    _xml_description :: Maybe String,
+    _xml_temp_adjust :: Maybe String,
+    _xml_temperature :: Int }
   deriving (Eq, GHC.Generic, Show)
 
 
--- | For 'Generics.to_tuple'.
+-- | For 'H.convert'.
 --
-instance Generic WeatherDetailedWeatherListingItemXml
+instance H.HVector WeatherDetailedWeatherListingItemXml
 
 instance ToDb WeatherDetailedWeatherListingItemXml where
   -- | Our database analogue is a 'WeatherDetailedWeatherListingItem'.
@@ -314,18 +326,7 @@ instance Child WeatherDetailedWeatherListingItemXml where
 instance FromXmlFk WeatherDetailedWeatherListingItemXml where
   -- | To convert from the XML to database representation, we simply
   --   add the foreign key (to Weather) and copy the rest of the fields.
-  from_xml_fk fk WeatherDetailedWeatherListingItemXml{..} =
-    WeatherDetailedWeatherListingItem {
-      db_dtl_weather_id = fk,
-      db_sport_code = xml_sport_code,
-      db_game_id = xml_game_id,
-      db_dtl_game_date = xml_dtl_game_date,
-      db_away_team = xml_away_team,
-      db_home_team = xml_home_team,
-      db_weather_type = xml_weather_type,
-      db_description = xml_description,
-      db_temp_adjust = xml_temp_adjust,
-      db_temperature = xml_temperature }
+  from_xml_fk = H.cons
 
 -- | This allows us to insert the XML representation directly without
 --   having to do the manual XML -\> DB conversion.
@@ -361,9 +362,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
@@ -427,11 +428,11 @@ mkPersist tsn_codegen_config [groundhog|
   constructors:
     - name: WeatherDetailedWeatherListingItem
       fields:
-        - name: db_dtl_weather_id
+        - name: _db_dtl_weather_id
           dbName: weather_id
           reference:
             onDelete: cascade
-        - name: db_dtl_game_date
+        - name: _db_dtl_game_date
           dbName: game_date
 
 |]
@@ -541,7 +542,7 @@ instance DbImport Message where
 pickle_listing :: PU WeatherForecastListingXml
 pickle_listing =
   xpElem "listing" $
-    xpWrap (from_pair, to_tuple) $
+    xpWrap (from_pair, H.convert) $
       xpPair
         (xpElem "teams" xpText)
         (xpElem "weather" (xpOption xpText))
@@ -585,7 +586,7 @@ pickle_forecast =
 pickle_item :: PU WeatherDetailedWeatherListingItemXml
 pickle_item =
   xpElem "Item" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xp9Tuple (xpElem "Sportcode" xpText)
              (xpElem "GameID" xpInt)
              (xpElem "Gamedate" xp_datetime)
@@ -605,7 +606,7 @@ pickle_item =
 pickle_dw_listing :: PU WeatherDetailedWeatherListingXml
 pickle_dw_listing =
   xpElem "DW_Listing" $
-    xpWrap (from_tuple, to_tuple) $
+    xpWrap (from_tuple, H.convert) $
     xpTriple (xpAttr "SportCode" xpText)
              (xpAttr "Sport" xpText)
              (xpList pickle_item)
@@ -627,7 +628,7 @@ pickle_detailed_weather =
 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)