+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
import Database.Groundhog.TH (
groundhog,
mkPersist )
+import qualified GHC.Generics as GHC ( Generic )
import Test.Tasty ( TestTree, testGroup )
import Test.Tasty.HUnit ( (@?=), testCase )
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 )
WeatherForecastListingXml {
xml_teams :: String,
xml_weather :: Maybe String }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherForecastListingXml
-- | Database representation of a weather forecast listing. The
WeatherForecastXml {
xml_game_date :: UTCTime,
xml_leagues :: [WeatherLeague] }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherForecastXml
instance ToDb WeatherForecastXml where
-- present in each \<Item\>s.
--
data WeatherDetailedWeatherListingXml =
- WeatherDetailedWeatherListingXml {
- xml_dtl_listing_sport :: String,
- xml_dtl_listing_sport_code :: String,
- xml_items :: [WeatherDetailedWeatherListingItemXml] }
- deriving (Eq, Show)
+ WeatherDetailedWeatherListingXml
+ String -- xml_dtl_listing_sport, unused
+ String -- xml_dtl_listing_sport_code, unused
+ [WeatherDetailedWeatherListingItemXml] -- xml_items
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | Accessor for the third field of WeatherDetailedWeatherListingXml.
+-- We don't use field names to avoid the unused field warnings that
+-- we'd otherwise get for the first two fields.
+--
+xml_items :: WeatherDetailedWeatherListingXml
+ -> [WeatherDetailedWeatherListingItemXml]
+xml_items (WeatherDetailedWeatherListingXml _ _ items) = items
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherDetailedWeatherListingXml
+
-- * WeatherDetailedWeatherListingItem / WeatherDetailedWeatherListingItemXml
xml_description :: Maybe String,
xml_temp_adjust :: Maybe String,
xml_temperature :: Int }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+-- | For 'Generics.to_tuple'.
+--
+instance Generic WeatherDetailedWeatherListingItemXml
+
instance ToDb WeatherDetailedWeatherListingItemXml where
-- | Our database analogue is a 'WeatherDetailedWeatherListingItem'.
type Db WeatherDetailedWeatherListingItemXml =
xml_forecasts :: [WeatherForecastXml],
xml_detailed_weather :: Maybe WeatherDetailedWeatherXml,
xml_time_stamp :: UTCTime }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
+
instance ToDb Message where
-- | The database representation of 'Message' is 'Weather'.
pickle_listing :: PU WeatherForecastListingXml
pickle_listing =
xpElem "listing" $
- xpWrap (from_pair, to_pair) $
+ xpWrap (from_pair, to_tuple) $
xpPair
(xpElem "teams" xpText)
(xpElem "weather" (xpOption xpText))
where
--- from_pair (ts, Nothing) = WeatherForecastListingXml ts (Just "")
from_pair = uncurry WeatherForecastListingXml
- to_pair WeatherForecastListingXml{..} = (xml_teams, xml_weather)
+
-- | Pickler to convert a 'WeatherLeague' to/from XML.
(xpElem "Temperature" xpInt)
where
from_tuple = uncurryN WeatherDetailedWeatherListingItemXml
- to_tuple w = (xml_sport_code w,
- xml_game_id w,
- xml_dtl_game_date w,
- xml_away_team w,
- xml_home_team w,
- xml_weather_type w,
- xml_description w,
- xml_temp_adjust w,
- xml_temperature w)
+
-- | (Un)pickle a 'WeatherDetailedWeatherListingXml'.
(xpList pickle_item)
where
from_tuple = uncurryN WeatherDetailedWeatherListingXml
- to_tuple w = (xml_dtl_listing_sport w,
- xml_dtl_listing_sport_code w,
- xml_items w)
-- | (Un)pickle a 'WeatherDetailedWeatherXml'
(xpElem "time_stamp" xp_time_stamp)
where
from_tuple = uncurryN Message
- to_tuple Message{..} = (xml_xml_file_id,
- xml_heading,
- xml_category,
- xml_sport,
- xml_title,
- xml_forecasts,
- xml_detailed_weather,
- xml_time_stamp)
--