{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
+-- | Parse TSN XML for the DTD \"earlylineXML.dtd\". Each \<message\>
+-- element contains a bunch of \<date\>s, and those \<date\>s
+-- contain a single \<game\>. In the database, we merge the date
+-- info into the games, and key the games to the messages.
+--
module TSN.XML.EarlyLine (
dtd,
pickle_message,
xml_category :: String,
xml_sport :: String,
xml_title :: String,
- xml_dates :: [EarlyLineDateXml],
+ xml_dates :: [EarlyLineDate],
xml_time_stamp :: UTCTime }
deriving (Eq, Show)
--- * EarlyLineDateXml
+-- * EarlyLineDate
-- | XML representation of a \<date\>. It has a \"value\" attribute
-- containing the actual date string. As children it contains a
-- (non-optional) note, and a game. The note and date value are
-- properties of the game as far as I can tell.
--
-data EarlyLineDateXml =
- EarlyLineDateXml {
- xml_date_value :: UTCTime,
- xml_note :: String,
- xml_game :: EarlyLineGameXml }
+data EarlyLineDate =
+ EarlyLineDate {
+ date_value :: UTCTime,
+ date_note :: String,
+ date_game :: EarlyLineGameXml }
deriving (Eq, Show)
deriving (Eq, Show)
-date_to_game :: (DefaultKey EarlyLine) -> EarlyLineDateXml -> EarlyLineGame
+-- | Convert an 'EarlyLineDate' into an 'EarlyLineGame'. Each date has
+-- exactly one game, and the fields that belong to the date should
+-- really be in the game anyway. So the database representation of a
+-- game has the combined fields of the XML date/game.
+--
+-- This function gets the game out of a date, and then sticks the
+-- date value and note inside the game. It also adds the foreign key
+-- reference to the game's parent message, and returns the result.
+--
+date_to_game :: (DefaultKey EarlyLine) -> EarlyLineDate -> EarlyLineGame
date_to_game fk date =
EarlyLineGame {
db_early_lines_id = fk,
db_game_time = combined_date_time,
- db_note = (xml_note date),
- db_away_team = xml_away_team (xml_game date),
- db_home_team = xml_home_team (xml_game date),
- db_over_under = xml_over_under (xml_game date) }
+ db_note = (date_note date),
+ db_away_team = xml_away_team (date_game date),
+ db_home_team = xml_home_team (date_game date),
+ db_over_under = xml_over_under (date_game date) }
where
- date_part = xml_date_value date
- time_part = xml_game_time (xml_game date)
+ date_part = date_value date
+ time_part = xml_game_time (date_game date)
combined_date_time = UTCTime (utctDay date_part) (utctDayTime time_part)
--
--
-- * Pickling
--
+
+
+-- | Pickler for the top-level 'Message'.
+--
pickle_message :: PU Message
pickle_message =
xpElem "message" $
xml_dates m,
xml_time_stamp m)
-pickle_date :: PU EarlyLineDateXml
+
+-- | Pickler for the \<date\> elements within each \<message\>.
+--
+pickle_date :: PU EarlyLineDate
pickle_date =
xpElem "date" $
xpWrap (from_tuple, to_tuple) $
(xpElem "note" xpText)
pickle_game
where
- from_tuple = uncurryN EarlyLineDateXml
- to_tuple m = (xml_date_value m, xml_note m, xml_game m)
+ from_tuple = uncurryN EarlyLineDate
+ to_tuple m = (date_value m, date_note m, date_game m)
+
+-- | Pickler for the \<game\> element within each \<date\>.
+--
pickle_game :: PU EarlyLineGameXml
pickle_game =
xpElem "game" $
+-- | Pickle an away team (\<teamA\>) element within a \<game\>. Most
+-- of the work (common with the home team pickler) is done by
+-- 'pickle_team'.
+--
pickle_away_team :: PU EarlyLineGameTeam
pickle_away_team = xpElem "teamA" pickle_team
+
+-- | Pickle a home team (\<teamH\>) element within a \<game\>. Most
+-- of the work (common with theaway team pickler) is done by
+-- 'pickle_team'.
+--
pickle_home_team :: PU EarlyLineGameTeam
pickle_home_team = xpElem "teamH" pickle_team
+
+-- | Team pickling common to both 'pickle_away_team' and
+-- 'pickle_home_team'. Handles everything inside the \<teamA\> and
+-- \<teamH\> elements.
+--
pickle_team :: PU EarlyLineGameTeam
pickle_team =
xpWrap (from_tuple, to_tuple) $