xpWrap )
-- Local imports.
-import TSN.Codegen (
- tsn_codegen_config )
+import TSN.Codegen ( tsn_codegen_config )
+import TSN.Database ( insert_or_select )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp )
-import TSN.Team ( Team(..) )
+import TSN.Team ( Team(..), HTeam(..), VTeam(..) )
import TSN.XmlImport ( XmlImport(..) )
import Xml (
FromXml(..),
xml_game_date :: UTCTime,
xml_game_time :: Maybe UTCTime,
xml_location :: Maybe String,
- xml_away_team :: ScheduleChangesListingAwayTeamXml,
- xml_home_team :: ScheduleChangesListingHomeTeamXml,
+ xml_away_team :: VTeam,
+ xml_home_team :: HTeam,
xml_vscore :: Int,
xml_hscore :: Int,
xml_listing_status :: ScheduleChangesListingStatus,
--- * ScheduleChangesListingAwayTeamXml / ScheduleChangesListingHomeTeamXml
-
--- | The XML representation of a 'ScheduleChangesListing' away
--- team. Its corresponding database representation (along with that
--- of the home team) is a "TSN.Team", but their XML representations
--- are different.
---
-data ScheduleChangesListingAwayTeamXml =
- ScheduleChangesListingAwayTeamXml {
- away_team_id :: String,
- away_team_name :: Maybe String }
- deriving (Eq, Show)
-
-
-instance ToDb ScheduleChangesListingAwayTeamXml where
- -- | The database analogue of an 'ScheduleChangesListingAwayTeamXml' is
- -- a 'Team'.
- --
- type Db ScheduleChangesListingAwayTeamXml = Team
-
-
-instance FromXml ScheduleChangesListingAwayTeamXml where
- -- | To convert a 'ScheduleChangesListingAwayTeamXml' to a 'Team',
- -- we set the non-existent abbreviation to \"Nothing\".
- --
- from_xml ScheduleChangesListingAwayTeamXml{..} =
- Team {
- team_id = away_team_id,
- abbreviation = Nothing,
- name = away_team_name }
-
--- | Allow us to import ScheduleChangesListingAwayTeamXml directly.
---
-instance XmlImport ScheduleChangesListingAwayTeamXml
-
-
--- | The XML representation of a 'ScheduleChangesListing' home
--- team. Its corresponding database representation (along with that
--- of the away team) is a "TSN.Team", but their XML representations
--- are different.
---
-data ScheduleChangesListingHomeTeamXml =
- ScheduleChangesListingHomeTeamXml {
- home_team_id :: String,
- home_team_name :: Maybe String }
- deriving (Eq, Show)
-
-
-instance ToDb ScheduleChangesListingHomeTeamXml where
- -- | The database analogue of an 'ScheduleChangesListingHomeTeamXml'
- -- is a 'Team'.
- --
- type Db ScheduleChangesListingHomeTeamXml = Team
-
-
-instance FromXml ScheduleChangesListingHomeTeamXml where
- -- | To convert a 'ScheduleChangesListingHomeTeamXml' to a 'Team',
- -- we set the non-existent abbreviation to \"Nothing\".
- --
- from_xml ScheduleChangesListingHomeTeamXml{..} =
- Team {
- team_id = home_team_id,
- abbreviation = Nothing,
- name = home_team_name }
-
-
--- | Allow us to import ScheduleChangesListingHomeTeamXml directly.
---
-instance XmlImport ScheduleChangesListingHomeTeamXml
-
-
--
-- * Database stuff.
--
-- Now loop through the listings so that we can handle the teams
-- one listing at a time.
forM_ (xml_sc_listings sc) $ \listing -> do
- away_team_id <- insert_xml_or_select (xml_away_team listing)
- home_team_id <- insert_xml_or_select (xml_home_team listing)
+ away_team_id <- insert_or_select (vteam $ xml_away_team listing)
+ home_team_id <- insert_or_select (hteam $ xml_home_team listing)
-- Finish constructing the xml -> db function.
let listing_xml_to_db' = listing_xml_to_db away_team_id home_team_id
# Prevent multiple imports of the same message.
fields: [db_xml_file_id]
-# Note: we drop the "sc" prefix from the db_sc_sport field.
+ # Note: we drop the "sc" prefix from the db_sc_sport field.
- entity: ScheduleChangesListing
dbName: schedule_changes_listings
constructors:
-- | An (un)pickler for the \<Away_Team\> elements.
--
-pickle_away_team :: PU ScheduleChangesListingAwayTeamXml
+pickle_away_team :: PU VTeam
pickle_away_team =
xpElem "Away_Team" $
xpWrap (from_tuple, to_tuple) $
xpPair (xpAttr "AT_ID" xpText)
(xpOption xpText)
where
- from_tuple = uncurry ScheduleChangesListingAwayTeamXml
- to_tuple t = (away_team_id t,
- away_team_name t)
+ from_tuple (x,y) = VTeam (Team x Nothing y)
+ to_tuple (VTeam t) = (team_id t, name t)
--- | An (un)pickler for the \<Home_Team\> elements.
+-- | An (un)pickler for the \<Away_Team\> elements.
--
-pickle_home_team :: PU ScheduleChangesListingHomeTeamXml
+pickle_home_team :: PU HTeam
pickle_home_team =
xpElem "Home_Team" $
xpWrap (from_tuple, to_tuple) $
xpPair (xpAttr "HT_ID" xpText)
(xpOption xpText)
where
- from_tuple = uncurry ScheduleChangesListingHomeTeamXml
- to_tuple t = (home_team_id t,
- home_team_name t)
+ from_tuple (x,y) = HTeam (Team x Nothing y)
+ to_tuple (HTeam t) = (team_id t, name t)
-- | An (un)pickler for the \<status\> elements.