-- Local imports
import TSN.Codegen ( tsn_codegen_config )
+import TSN.Database ( insert_or_select )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers (
xp_date,
xp_date_padded,
xp_datetime,
- xp_time,
+ xp_tba_time,
xp_time_dots,
xp_time_stamp )
-import TSN.Team ( Team(..) )
+import TSN.Team (
+ FromXmlFkTeams(..),
+ HTeam(..),
+ Team(..),
+ VTeam(..) )
import TSN.XmlImport (
XmlImport(..),
XmlImportFkTeams(..) )
import Xml (
Child(..),
FromXml(..),
- FromXmlFkTeams(..),
ToDb(..),
pickle_unpickle,
unpickleable,
instance XmlImport Message
--- * JFileGameAwayTeamXml / JFileGameHomeTeamXml
-
--- | The XML representation of a JFile away team. Its corresponding
--- database representation (along with that of the home team) is a
--- TSN.Team, but their XML representations are different.
-data JFileGameAwayTeamXml =
- JFileGameAwayTeamXml {
- away_team_id :: String,
- away_team_abbreviation :: Maybe String,
- away_team_name :: Maybe String }
- deriving (Eq, Show)
-
-instance ToDb JFileGameAwayTeamXml where
- -- | The database analogue of an 'JFileGameAwayTeamXml' is
- -- a 'Team'.
- --
- type Db JFileGameAwayTeamXml = Team
-
-instance FromXml JFileGameAwayTeamXml where
- -- | To convert a 'JFileGameAwayTeamXml' to a 'Team', we do just
- -- about nothing.
- --
- from_xml JFileGameAwayTeamXml{..} =
- Team {
- team_id = away_team_id,
- abbreviation = away_team_abbreviation,
- name = away_team_name }
-
--- | Allow us to import JFileGameAwayTeamXml directly.
-instance XmlImport JFileGameAwayTeamXml
-
-
--- | The XML representation of a JFile home team. Its corresponding
--- database representation (along with that of the away team) is a
--- TSN.Team, but their XML representations are different.
-data JFileGameHomeTeamXml =
- JFileGameHomeTeamXml {
- home_team_id :: String,
- home_team_abbreviation :: Maybe String,
- home_team_name :: Maybe String }
- deriving (Eq, Show)
-
-instance ToDb JFileGameHomeTeamXml where
- -- | The database analogue of an 'JFileGameHomeTeamXml' is
- -- a 'Team'.
- --
- type Db JFileGameHomeTeamXml = Team
-
-instance FromXml JFileGameHomeTeamXml where
- -- | To convert a 'JFileGameHomeTeamXml' to a 'Team', we do just
- -- about nothing.
- --
- from_xml JFileGameHomeTeamXml{..} =
- Team {
- team_id = home_team_id,
- abbreviation = home_team_abbreviation,
- name = home_team_name }
-
--- | Allow us to import JFileGameHomeTeamXml directly.
-instance XmlImport JFileGameHomeTeamXml
-
-- * JFileGame/JFileGameXml
db_schedule_id :: Int,
db_odds_info :: JFileGameOddsInfo,
db_season_type :: Maybe String,
- db_game_time :: UTCTime,
+ db_game_time :: Maybe UTCTime,
db_vleague :: Maybe String,
db_hleague :: Maybe String,
db_vscore :: Int,
xml_odds_info :: JFileGameOddsInfo,
xml_season_type :: Maybe String,
xml_game_date :: UTCTime,
- xml_game_time :: UTCTime,
- xml_vteam :: JFileGameAwayTeamXml,
+ xml_game_time :: Maybe UTCTime,
+ xml_vteam :: VTeam,
xml_vleague :: Maybe String,
- xml_hteam :: JFileGameHomeTeamXml,
+ xml_hteam :: HTeam,
xml_hleague :: Maybe String,
xml_vscore :: Int,
xml_hscore :: Int,
db_time_remaining = xml_time_remaining,
db_game_status = xml_game_status }
where
- -- | Make the database \"game time\" from the XML
- -- date/time. Simply take the day part from one and the time
- -- from the other.
- --
- make_game_time d t = UTCTime (utctDay d) (utctDayTime t)
+ -- | Construct the database game time from the XML \<Game_Date\>
+ -- and \<Game_Time\> elements. The \<Game_Time\> elements
+ -- sometimes have a value of \"TBA\"; in that case, we don't
+ -- want to pretend that we know the time by setting it to
+ -- e.g. midnight, so instead we make the entire date/time
+ -- Nothing.
+ make_game_time :: UTCTime -> Maybe UTCTime -> Maybe UTCTime
+ make_game_time _ Nothing = Nothing
+ make_game_time d (Just t) = Just $ UTCTime (utctDay d) (utctDayTime t)
-- | This allows us to insert the XML representation
-- Now loop through the message's games
forM_ (xml_games $ xml_gamelist m) $ \game -> do
-- First we insert the home and away teams.
- away_team_id <- insert_xml_or_select (xml_vteam game)
- home_team_id <- insert_xml_or_select (xml_hteam game)
+ away_team_id <- insert_or_select (vteam $ xml_vteam game)
+ home_team_id <- insert_or_select (hteam $ xml_hteam game)
-- Now insert the game keyed to the "jfile" and its teams.
insert_xml_fk_teams_ msg_id away_team_id home_team_id game
- name: db_status
dbName: status
-# Many of the JFileGameOddsInfo fields are redundant and have
-# been left out.
+ # Many of the JFileGameOddsInfo fields are redundant and have
+ # been left out.
- embedded: JFileGameOddsInfo
fields:
- name: db_list_date
pickle_odds_info
(xpElem "seasontype" (xpOption xpText))
(xpElem "Game_Date" xp_date_padded)
- (xpElem "Game_Time" xp_time)
+ (xpElem "Game_Time" xp_tba_time)
pickle_away_team
(xpOption $ xpElem "vleague" xpText)
pickle_home_team
(_:_:_:_:notes5:_) -> notes5
_ -> ""
-pickle_home_team :: PU JFileGameHomeTeamXml
+-- | (Un)pickle a home team to/from the dual XML/DB representation
+-- 'Team'.
+--
+pickle_home_team :: PU HTeam
pickle_home_team =
xpElem "hteam" $
xpWrap (from_tuple, to_tuple) $
(xpAttr "abbr" (xpOption xpText)) -- Some are blank
(xpOption xpText) -- Yup, some are nameless
where
- from_tuple = uncurryN JFileGameHomeTeamXml
- to_tuple t = (home_team_id t,
- home_team_abbreviation t,
- home_team_name t)
+ from_tuple = HTeam . (uncurryN Team)
+ to_tuple (HTeam t) = (team_id t,
+ abbreviation t,
+ name t)
-pickle_away_team :: PU JFileGameAwayTeamXml
+-- | (Un)pickle an away team to/from the dual XML/DB representation
+-- 'Team'.
+--
+pickle_away_team :: PU VTeam
pickle_away_team =
xpElem "vteam" $
xpWrap (from_tuple, to_tuple) $
(xpAttr "abbr" (xpOption xpText)) -- Some are blank
(xpOption xpText) -- Yup, some are nameless
where
- from_tuple = uncurryN JFileGameAwayTeamXml
- to_tuple t = (away_team_id t,
- away_team_abbreviation t,
- away_team_name t)
+ from_tuple = VTeam . (uncurryN Team)
+ to_tuple (VTeam t) = (team_id t,
+ abbreviation t,
+ name t)
pickle_status :: PU JFileGameStatus
[ check "pickle composed with unpickle is the identity"
"test/xml/jfilexml.xml",
check "pickle composed with unpickle is the identity (missing fields)"
- "test/xml/jfilexml-missing-fields.xml" ]
+ "test/xml/jfilexml-missing-fields.xml",
+
+ check "pickle composed with unpickle is the identity (TBA game time)"
+ "test/xml/jfilexml-tba-game-time.xml"]
where
check desc path = testCase desc $ do
(expected, actual) <- pickle_unpickle pickle_message path
test_unpickle_succeeds :: TestTree
test_unpickle_succeeds = testGroup "unpickle tests"
[ check "unpickling succeeds" "test/xml/jfilexml.xml",
+
check "unpickling succeeds (missing fields)"
- "test/xml/jfilexml-missing-fields.xml" ]
+ "test/xml/jfilexml-missing-fields.xml",
+
+ check "unpickling succeeds (TBA game time)"
+ "test/xml/jfilexml-tba-game-time.xml" ]
where
check desc path = testCase desc $ do
actual <- unpickleable path pickle_message
test_on_delete_cascade = testGroup "cascading delete tests"
[ check "deleting auto_racing_results deletes its children"
"test/xml/jfilexml.xml"
- 20,
+ 20, -- teams
+
check "deleting auto_racing_results deletes its children (missing fields)"
"test/xml/jfilexml-missing-fields.xml"
- 44 ]
+ 44,
+
+ check "deleting auto_racing_results deletes its children (TBA game time)"
+ "test/xml/jfilexml-tba-game-time.xml"
+ 8 ]
where
check desc path expected = testCase desc $ do
results <- unsafe_unpickle path pickle_message
projects / dead / htsn-import.git / blobdiff