+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
dtd,
pickle_message,
-- * Tests
--- auto_racing_results_tests,
+ -- auto_racing_results_tests,
-- * WARNING: these are private but exported to silence warnings
- MLBBoxScoreConstructor(..) )
+ MLBBoxScoreConstructor(..),
+ MLBBoxScoreGameBreakdown(..),
+ MLBBoxScoreHomerunStats(..),
+ MLBBoxScoreMiscellaneousGameInfo(..),
+ MLBBoxScoreMiscPitchingStats(..),
+ MLBBoxScoreTeamSummary(..)
+ )
-- AutoRacingResultsListingConstructor(..),
-- AutoRacingResultsRaceInformationConstructor(..) )
where
-- System imports.
-import Control.Monad ( forM_ )
import Data.Time ( UTCTime(..) )
import Data.Tuple.Curry ( uncurryN )
import Database.Groundhog (
- countAll,
- deleteAll,
insert,
- migrate,
- runMigration,
- silentMigrationLogger )
+ migrate )
import Database.Groundhog.Core ( DefaultKey )
-import Database.Groundhog.Generic ( runDbConn )
-import Database.Groundhog.Sqlite ( withSqliteConn )
import Database.Groundhog.TH (
groundhog,
mkPersist )
-import Test.Tasty ( TestTree, testGroup )
-import Test.Tasty.HUnit ( (@?=), testCase )
+import qualified GHC.Generics as GHC ( Generic )
import Text.XML.HXT.Core (
PU,
xp4Tuple,
- xp11Tuple,
xp23Tuple,
xpAttr,
- xpDefault,
xpElem,
xpInt,
xpList,
xpOption,
xpPair,
- xpPrim,
xpText,
xpTriple,
xpUnit,
xpWrap )
-- Local imports.
+import Generics ( Generic(..), to_tuple )
import TSN.Codegen ( tsn_codegen_config )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers (
xp_time,
xp_time_stamp )
import TSN.Team ( Team(..), FromXmlFkTeams(..) )
-import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
import Xml (
Child(..),
- FromXml(..),
- FromXmlFk(..),
- ToDb(..),
- pickle_unpickle,
- unpickleable,
- unsafe_unpickle )
+ ToDb(..) )
-- | The DTD to which this module corresponds. Used to invoke dbimport.
xml_homerun_stats :: Maybe MLBBoxScoreHomerunStatsXml,
xml_miscellaneous_game_info :: MLBBoxScoreMiscellaneousGameInfoXml,
xml_time_stamp :: UTCTime }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic Message
instance ToDb Message where
MLBBoxScoreGameBreakdownXml {
xml_away_team :: MLBBoxScoreGameBreakdownTeamXml,
xml_home_team :: MLBBoxScoreGameBreakdownTeamXml }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+-- | For 'Generics.to_tuple'
+--
+instance Generic MLBBoxScoreGameBreakdownXml
+
data MLBBoxScoreHomerunStats = MLBBoxScoreHomerunStats
data MLBBoxScoreHomerunStatsXml = MLBBoxScoreHomerunStatsXml
xml_runs :: Int,
xml_hits :: Int,
xml_errors :: Int }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+instance Generic MLBBoxScoreGameBreakdownTeamXml
+
data MLBBoxScoreRunsByInningsXml =
MLBBoxScoreRunsByInningsXml {
xml_runs_by_innings_inning_number :: Int,
xml_runs_by_innings_runs :: Int }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic MLBBoxScoreRunsByInningsXml
data MLBBoxScoreMiscPitchingStats = MLBBoxScoreMiscPitchingStats
xml_wild_pitches :: Maybe Int,
xml_intentional_walks :: [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml],
xml_hits_by_pitch :: [MLBBoxScoreMiscPitchingStatsHitByPitchXml] }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+instance Generic MLBBoxScoreMiscPitchingStatsXml
+
data MLBBoxScoreMiscPitchingStatsIntentionalWalkXml =
MLBBoxScoreMiscPitchingStatsIntentionalWalkXml {
xml_iw_batter_id :: Int,
xml_iw_pitcher_id :: Int,
xml_iw_number_of_times_walked :: Int }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+instance Generic MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
+
data MLBBoxScoreMiscPitchingStatsHitByPitchXml =
MLBBoxScoreMiscPitchingStatsHitByPitchXml {
xml_hbp_batter_id :: Int,
xml_hbp_pitcher_id :: Int,
xml_hbp_number_of_times_hit :: Int }
- deriving (Eq, Show)
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'Generics.to_tuple'.
+--
+instance Generic MLBBoxScoreMiscPitchingStatsHitByPitchXml
+
--
-- * Database
-- Now we can key the message to the teams we just inserted.
-- The message has no parent, so we pass in undefined.
let db_msg = from_xml_fk_teams undefined vteam_fk hteam_fk m
- msg_id <- insert db_msg
+ _ <- insert db_msg
-- Now get the hteam
return ImportSucceeded
(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_game_id m,
- xml_schedule_id m,
- xml_vteam m,
- xml_hteam m,
- xml_vteam_id m,
- xml_hteam_id m,
- xml_season m,
- xml_season_type m,
- xml_title m,
- xml_game_date m,
- xml_game_time m,
- xml_game_number m,
- xml_capacity m,
- xml_game_breakdown m,
- xml_team_summaries m,
- xml_misc_pitching_stats m,
- xml_homerun_stats m,
- xml_miscellaneous_game_info m,
- xml_time_stamp m)
pickle_team_summary :: PU MLBBoxScoreTeamSummaryXml
pickle_team_summary =
- xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple) $ xpUnit
+ xpElem "Team_Summary" $ xpWrap (from_tuple, to_tuple') $ xpUnit
where
from_tuple _ = MLBBoxScoreTeamSummaryXml
- to_tuple _ = ()
+ to_tuple' _ = ()
pickle_game_breakdown :: PU MLBBoxScoreGameBreakdownXml
pickle_game_breakdown =
pickle_home_team
where
from_tuple = uncurry MLBBoxScoreGameBreakdownXml
- to_tuple MLBBoxScoreGameBreakdownXml{..} = (xml_away_team, xml_home_team)
pickle_runs_by_innings :: PU MLBBoxScoreRunsByInningsXml
xpInt
where
from_tuple = uncurry MLBBoxScoreRunsByInningsXml
- to_tuple MLBBoxScoreRunsByInningsXml{..} =
- (xml_runs_by_innings_inning_number, xml_runs_by_innings_runs)
+
+pickle_team :: PU MLBBoxScoreGameBreakdownTeamXml
pickle_team =
xpWrap (from_tuple, to_tuple) $
xp4Tuple (xpList pickle_runs_by_innings)
(xpElem "Errors" xpInt)
where
from_tuple = uncurryN MLBBoxScoreGameBreakdownTeamXml
- to_tuple MLBBoxScoreGameBreakdownTeamXml{..} =
- (xml_runs_by_innings, xml_runs, xml_hits, xml_errors)
+
pickle_away_team :: PU MLBBoxScoreGameBreakdownTeamXml
pickle_away_team =
pickle_homerun_stats :: PU (Maybe MLBBoxScoreHomerunStatsXml)
pickle_homerun_stats =
- xpOption $ xpElem "Homerun_Stats" $ xpWrap (from_tuple, to_tuple) $ xpUnit
+ xpOption $ xpElem "Homerun_Stats" $ xpWrap (from_tuple, to_tuple') $ xpUnit
where
from_tuple _ = MLBBoxScoreHomerunStatsXml
- to_tuple _ = ()
+ to_tuple' _ = ()
pickle_misc_pitching_stats :: PU MLBBoxScoreMiscPitchingStatsXml
pickle_hits_by_pitch
where
from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsXml
- to_tuple MLBBoxScoreMiscPitchingStatsXml{..} =
- (xml_wild_pitches, xml_intentional_walks, xml_hits_by_pitch)
+
pickle_intentional_walks :: PU [MLBBoxScoreMiscPitchingStatsIntentionalWalkXml]
(xpElem "IW_Number_Of_Times_Walked" xpInt)
where
from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsIntentionalWalkXml
- to_tuple MLBBoxScoreMiscPitchingStatsIntentionalWalkXml{..} =
- (xml_iw_batter_id, xml_iw_pitcher_id, xml_iw_number_of_times_walked)
+
pickle_hits_by_pitch :: PU [MLBBoxScoreMiscPitchingStatsHitByPitchXml]
(xpElem "HBP_Number_Of_Times_Hit" xpInt)
where
from_tuple = uncurryN MLBBoxScoreMiscPitchingStatsHitByPitchXml
- to_tuple MLBBoxScoreMiscPitchingStatsHitByPitchXml{..} =
- (xml_hbp_batter_id, xml_hbp_pitcher_id, xml_hbp_number_of_times_hit)
pickle_miscellaneous_game_info :: PU MLBBoxScoreMiscellaneousGameInfoXml
pickle_miscellaneous_game_info =
- xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple) $ xpUnit
+ xpElem "Miscelaneous_Game_Info" $ xpWrap (from_tuple, to_tuple') $ xpUnit
where
from_tuple _ = MLBBoxScoreMiscellaneousGameInfoXml
- to_tuple _ = ()
+ to_tuple' _ = ()