From 16d86e7a3c1eda08b91752f92510a1de0b952a17 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Wed, 23 Jul 2014 15:12:06 -0400 Subject: [PATCH] Add more comments to TSN.XML.EarlyLine. Remove earlylineXML.dtd from the TODO. Add earlylineXML.dtd to the man page as a supported type. Bump version in the cabal file. --- doc/TODO | 1 - doc/man1/htsn-import.1 | 2 ++ htsn-import.cabal | 2 +- src/TSN/XML/EarlyLine.hs | 72 ++++++++++++++++++++++++++++++---------- 4 files changed, 58 insertions(+), 19 deletions(-) diff --git a/doc/TODO b/doc/TODO index b399605..01caafd 100644 --- a/doc/TODO +++ b/doc/TODO @@ -36,7 +36,6 @@ * CBATeamScheduleXML * CFLTeamScheduleXML * CFLTotalTeamScheduleXML - * earlylineXML * Minor_Baseball_TeamScheduleXML * MinorLeagueHockeyTeamScheduleXML * MLB_Boxscore_XML diff --git a/doc/man1/htsn-import.1 b/doc/man1/htsn-import.1 index 9c76165..66f7ae5 100644 --- a/doc/man1/htsn-import.1 +++ b/doc/man1/htsn-import.1 @@ -579,6 +579,8 @@ AutoRacingResultsXML.dtd .IP \[bu] Auto_Racing_Schedule_XML.dtd .IP \[bu] +earlylineXML.dtd +.IP \[bu] Heartbeat.dtd .IP \[bu] Injuries_Detail_XML.dtd diff --git a/htsn-import.cabal b/htsn-import.cabal index d1e184c..e7d2940 100644 --- a/htsn-import.cabal +++ b/htsn-import.cabal @@ -1,5 +1,5 @@ name: htsn-import -version: 0.0.8 +version: 0.0.9 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs index 3870eb8..4ad9ae2 100644 --- a/src/TSN/XML/EarlyLine.hs +++ b/src/TSN/XML/EarlyLine.hs @@ -5,6 +5,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +-- | Parse TSN XML for the DTD \"earlylineXML.dtd\". Each \ +-- element contains a bunch of \s, and those \s +-- contain a single \. 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, @@ -100,7 +105,7 @@ data Message = xml_category :: String, xml_sport :: String, xml_title :: String, - xml_dates :: [EarlyLineDateXml], + xml_dates :: [EarlyLineDate], xml_time_stamp :: UTCTime } deriving (Eq, Show) @@ -135,18 +140,18 @@ instance XmlImport Message --- * EarlyLineDateXml +-- * EarlyLineDate -- | XML representation of a \. 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) @@ -182,18 +187,27 @@ data EarlyLineGameTeam = 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) -- @@ -268,6 +282,10 @@ mkPersist tsn_codegen_config [groundhog| -- -- * Pickling -- + + +-- | Pickler for the top-level 'Message'. +-- pickle_message :: PU Message pickle_message = xpElem "message" $ @@ -289,7 +307,10 @@ pickle_message = xml_dates m, xml_time_stamp m) -pickle_date :: PU EarlyLineDateXml + +-- | Pickler for the \ elements within each \. +-- +pickle_date :: PU EarlyLineDate pickle_date = xpElem "date" $ xpWrap (from_tuple, to_tuple) $ @@ -297,10 +318,13 @@ pickle_date = (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 \ element within each \. +-- pickle_game :: PU EarlyLineGameXml pickle_game = xpElem "game" $ @@ -318,12 +342,26 @@ pickle_game = +-- | Pickle an away team (\) element within a \. 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 (\) element within a \. 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 \ and +-- \ elements. +-- pickle_team :: PU EarlyLineGameTeam pickle_team = xpWrap (from_tuple, to_tuple) $ -- 2.43.2