From f75c0f795fbc7e92cecdd40f1b224b092d0ceb81 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 30 Dec 2014 14:03:40 -0500 Subject: [PATCH] Use Generics.to_tuple in TSN.XML.Odds. --- src/TSN/XML/Odds.hs | 85 ++++++++++++++++++++++----------------------- 1 file changed, 41 insertions(+), 44 deletions(-) diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs index 128b5b4..c3bd6c4 100644 --- a/src/TSN/XML/Odds.hs +++ b/src/TSN/XML/Odds.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternGuards #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} @@ -43,6 +45,7 @@ import Database.Groundhog.Sqlite ( withSqliteConn ) 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.Read ( readMaybe ) @@ -61,6 +64,7 @@ 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 ) @@ -121,7 +125,12 @@ data OddsGameCasinoXml = xml_casino_client_id :: Maybe Int, xml_casino_name :: Maybe String, xml_casino_line :: Maybe String } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic OddsGameCasinoXml -- | Try to get a 'Double' out of the 'xml_casino_line' which is a @@ -167,7 +176,12 @@ data OddsGameTeamStarterXml = OddsGameTeamStarterXml { xml_starter_id :: Int, xml_starter_name :: Maybe String } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic OddsGameTeamStarterXml -- | The XML representation of a \ or \, as @@ -189,7 +203,13 @@ data OddsGameTeamXml = xml_team_name :: String, xml_team_starter :: Maybe OddsGameTeamStarterXml, xml_team_casinos :: [OddsGameCasinoXml] } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic OddsGameTeamXml + instance ToDb OddsGameTeamXml where -- | The database representation of an 'OddsGameTeamXml' is an @@ -279,7 +299,13 @@ data OddsGameXml = xml_away_team :: OddsGameTeamXml, xml_home_team :: OddsGameTeamXml, xml_over_under :: OddsGameOverUnderXml } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic OddsGameXml + -- | Pseudo-field that lets us get the 'OddsGameCasinoXml's out of -- xml_over_under. @@ -414,7 +440,12 @@ data Message = xml_line_time :: String, xml_games_with_notes :: [OddsGameWithNotes], xml_time_stamp :: UTCTime } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + +-- | For 'Generics.to_tuple'. +-- +instance Generic Message + -- | Pseudo-field that lets us get the 'OddsGame's out of -- 'xml_games_with_notes'. @@ -589,9 +620,10 @@ instance DbImport Message where where nonempty_casino :: OddsGameCasinoXml -> Bool - nonempty_casino (OddsGameCasinoXml Nothing _ _) = False - nonempty_casino (OddsGameCasinoXml _ Nothing _) = False - nonempty_casino _ = True + nonempty_casino OddsGameCasinoXml{..} + | Nothing <- xml_casino_client_id = False + | Nothing <- xml_casino_name = False + | otherwise = True -- -- Pickling @@ -623,10 +655,6 @@ pickle_casino = (xpOption xpText) where from_tuple = uncurryN OddsGameCasinoXml - -- Use record wildcards to avoid unused field warnings. - to_tuple OddsGameCasinoXml{..} = (xml_casino_client_id, - xml_casino_name, - xml_casino_line) -- | Pickler for an 'OddsGameTeamXml'. @@ -645,13 +673,6 @@ pickle_home_team = where from_tuple = uncurryN OddsGameTeamXml - -- Use record wildcards to avoid unused field warnings. - to_tuple OddsGameTeamXml{..} = (xml_team_id, - xml_team_rotation_number, - xml_team_abbr, - xml_team_name, - xml_team_starter, - xml_team_casinos) -- | Portion of the 'OddsGameTeamStarterXml' pickler that is not @@ -663,8 +684,7 @@ pickle_starter = xpPair (xpAttr "ID" xpInt) (xpOption xpText) where from_tuple = uncurry OddsGameTeamStarterXml - to_tuple OddsGameTeamStarterXml{..} = (xml_starter_id, - xml_starter_name) + -- | Pickler for an home team 'OddsGameTeamStarterXml' -- @@ -695,14 +715,6 @@ pickle_away_team = where from_tuple = uncurryN OddsGameTeamXml - -- Use record wildcards to avoid unused field warnings. - to_tuple OddsGameTeamXml{..} = (xml_team_id, - xml_team_rotation_number, - xml_team_abbr, - xml_team_name, - xml_team_starter, - xml_team_casinos) - -- | Pickler for an 'OddsGameOverUnderXml'. @@ -732,13 +744,6 @@ pickle_game = pickle_over_under where from_tuple = uncurryN OddsGameXml - -- Use record wildcards to avoid unused field warnings. - to_tuple OddsGameXml{..} = (xml_game_id, - xml_game_date, - xml_game_time, - xml_away_team, - xml_home_team, - xml_over_under) -- | Pickler for the top-level 'Message'. @@ -757,14 +762,6 @@ pickle_message = (xpElem "time_stamp" xp_time_stamp) where from_tuple = uncurryN Message - to_tuple m = (xml_xml_file_id m, - xml_heading m, - xml_category m, - xml_sport m, - xml_title m, - xml_line_time m, - xml_games_with_notes m, - xml_time_stamp m) -- -- 2.43.2