X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FJFile.hs;h=84e6b66ebd642e148241a7d5acc042bb66dfa880;hb=532d663c1aca4add29bc9e1430130d72938b58a5;hp=51db0abfa32af3b0be591e1099803a5289b4b853;hpb=d88388235ec3df702f80e70d50898850befef6ed;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index 51db0ab..84e6b66 100644 --- a/src/TSN/XML/JFile.hs +++ b/src/TSN/XML/JFile.hs @@ -67,17 +67,20 @@ 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, @@ -211,7 +214,7 @@ data JFileGame = 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, @@ -233,10 +236,10 @@ data JFileGameXml = xml_odds_info :: JFileGameOddsInfo, xml_season_type :: Maybe String, xml_game_date :: UTCTime, - xml_game_time :: UTCTime, - xml_vteam :: Team, + xml_game_time :: Maybe UTCTime, + xml_vteam :: VTeam, xml_vleague :: Maybe String, - xml_hteam :: Team, + xml_hteam :: HTeam, xml_hleague :: Maybe String, xml_vscore :: Int, xml_hscore :: Int, @@ -294,11 +297,15 @@ instance FromXmlFkTeams JFileGameXml where 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 \ + -- and \ elements. The \ 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 @@ -325,8 +332,8 @@ instance DbImport Message where -- 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_or_select (xml_vteam game) - home_team_id <- insert_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 @@ -353,8 +360,8 @@ mkPersist tsn_codegen_config [groundhog| - 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 @@ -450,7 +457,7 @@ pickle_game = 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 @@ -541,7 +548,7 @@ pickle_odds_info = -- | (Un)pickle a home team to/from the dual XML/DB representation -- 'Team'. -- -pickle_home_team :: PU Team +pickle_home_team :: PU HTeam pickle_home_team = xpElem "hteam" $ xpWrap (from_tuple, to_tuple) $ @@ -549,16 +556,16 @@ pickle_home_team = (xpAttr "abbr" (xpOption xpText)) -- Some are blank (xpOption xpText) -- Yup, some are nameless where - from_tuple = uncurryN Team - to_tuple t = (team_id t, - abbreviation t, - name t) + from_tuple = HTeam . (uncurryN Team) + to_tuple (HTeam t) = (team_id t, + abbreviation t, + name t) -- | (Un)pickle an away team to/from the dual XML/DB representation -- 'Team'. -- -pickle_away_team :: PU Team +pickle_away_team :: PU VTeam pickle_away_team = xpElem "vteam" $ xpWrap (from_tuple, to_tuple) $ @@ -566,10 +573,10 @@ pickle_away_team = (xpAttr "abbr" (xpOption xpText)) -- Some are blank (xpOption xpText) -- Yup, some are nameless where - from_tuple = uncurryN Team - to_tuple t = (team_id t, - abbreviation t, - name t) + from_tuple = VTeam . (uncurryN Team) + to_tuple (VTeam t) = (team_id t, + abbreviation t, + name t) pickle_status :: PU JFileGameStatus @@ -609,7 +616,10 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" [ 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 @@ -622,8 +632,12 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" 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 @@ -640,10 +654,15 @@ test_on_delete_cascade :: TestTree 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