From 6c80f59ac0ba3dc60fee9f9c24f64460bd1e41ea Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Fri, 2 Jan 2015 17:24:07 -0500 Subject: [PATCH] Migrate TSN.XML.Weather to fixed-vector-hetero. --- src/TSN/XML/Weather.hs | 97 +++++++++++++++++++++--------------------- 1 file changed, 49 insertions(+), 48 deletions(-) diff --git a/src/TSN/XML/Weather.hs b/src/TSN/XML/Weather.hs index 1d17fb0..4c95566 100644 --- 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) -- 2.43.2