--
data EarlyLineGameXml =
EarlyLineGameXml {
- xml_game_time :: UTCTime, -- ^ Only an ambiguous time string, e.g. \"8:30\"
+ xml_game_time :: Maybe UTCTime, -- ^ Only an ambiguous time string,
+ -- e.g. \"8:30\". Can be empty.
xml_away_team :: EarlyLineGameTeamXml,
xml_home_team :: EarlyLineGameTeamXml,
xml_over_under :: Maybe String }
--
data EarlyLineGameTeam =
EarlyLineGameTeam {
- db_rotation_number :: Int,
+ db_rotation_number :: Maybe Int, -- ^ Usually there but sometimes empty.
db_line :: Maybe String, -- ^ Can be blank, a Double, or \"off\".
db_team_name :: Maybe String, -- ^ NOT optional, see the data type docs.
db_pitcher :: Maybe String -- ^ Optional in MLB_earlylineXML.dtd,
--
data EarlyLineGameTeamXml =
EarlyLineGameTeamXml {
- xml_rotation_number :: Int,
+ xml_rotation_number :: Maybe Int,
xml_line_attr :: Maybe String,
xml_team_name_attr :: Maybe String,
xml_team_name_text :: Maybe String,
games_only :: [EarlyLineGameXml]
games_only = (map date_game (date_games_with_notes date))
- -- | Stick the date value into the given game.
+ -- | Stick the date value into the given game. If our
+ -- 'EarlyLineGameXml' has an 'xml_game_time', then we combine it
+ -- with the day portion of the supplied @date@. If not, then we
+ -- just use @date as-is.
--
combine_date_time :: EarlyLineGameXml -> UTCTime
- combine_date_time elgx =
- UTCTime (utctDay $ date_value date) (utctDayTime $ xml_game_time elgx)
+ combine_date_time (EarlyLineGameXml (Just t) _ _ _) =
+ UTCTime (utctDay $ date_value date) (utctDayTime t)
+ combine_date_time (EarlyLineGameXml Nothing _ _ _ ) = date_value date
-- | Convert an XML game to a database one.
--
pickle_game =
xpElem "game" $
xpWrap (from_tuple, to_tuple) $
- xp4Tuple (xpElem "time" xp_ambiguous_time)
+ xp4Tuple (xpElem "time" (xpOption xp_ambiguous_time))
pickle_away_team
pickle_home_team
(xpElem "over_under" (xpOption xpText))
pickle_team :: PU EarlyLineGameTeamXml
pickle_team =
xpWrap (from_tuple, to_tuple) $
- xp6Tuple (xpAttr "rotation" xpInt)
+ xp6Tuple (xpAttr "rotation" (xpOption xpInt))
(xpOption $ xpAttr "line" (xpOption xpText))
(xpOption $ xpAttr "name" xpText)
(xpOption xpText)
-- test does not mean that unpickling succeeded.
--
test_pickle_of_unpickle_is_identity :: TestTree
-test_pickle_of_unpickle_is_identity =
- testCase "pickle composed with unpickle is the identity" $ do
- let path = "test/xml/earlylineXML.xml"
- (expected, actual) <- pickle_unpickle pickle_message path
- actual @?= expected
+test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $
+ [ check "pickle composed with unpickle is the identity"
+ "test/xml/earlylineXML.xml",
+
+ check "pickle composed with unpickle is the identity (empty game time)"
+ "test/xml/earlylineXML-empty-game-time.xml" ]
+ where
+ check desc path = testCase desc $ do
+ (expected, actual) <- pickle_unpickle pickle_message path
+ actual @?= expected
-- | Make sure we can actually unpickle these things.
--
test_unpickle_succeeds :: TestTree
-test_unpickle_succeeds =
- testCase "unpickling succeeds" $ do
- let path = "test/xml/earlylineXML.xml"
- actual <- unpickleable path pickle_message
+test_unpickle_succeeds = testGroup "unpickle tests" $
+ [ check "unpickling succeeds"
+ "test/xml/earlylineXML.xml",
- let expected = True
- actual @?= expected
+ check "unpickling succeeds (empty game time)"
+ "test/xml/earlylineXML-empty-game-time.xml" ]
+ where
+ check desc path = testCase desc $ do
+ actual <- unpickleable path pickle_message
+ let expected = True
+ actual @?= expected
-- record.
--
test_on_delete_cascade :: TestTree
-test_on_delete_cascade =
- testCase "deleting early_lines deletes its children" $ do
- let path = "test/xml/earlylineXML.xml"
- results <- unsafe_unpickle path pickle_message
- let a = undefined :: EarlyLine
- let b = undefined :: EarlyLineGame
-
- actual <- withSqliteConn ":memory:" $ runDbConn $ do
- runMigration silentMigrationLogger $ do
- migrate a
- migrate b
- _ <- dbimport results
- deleteAll a
- count_a <- countAll a
- count_b <- countAll b
- return $ sum [count_a, count_b]
- let expected = 0
- actual @?= expected
+test_on_delete_cascade = testGroup "cascading delete tests" $
+ [ check "deleting early_lines deletes its children"
+ "test/xml/earlylineXML.xml",
+
+ check "deleting early_lines deletes its children (empty game time)"
+ "test/xml/earlylineXML-empty-game-time.xml" ]
+ where
+ check desc path = testCase desc $ do
+ results <- unsafe_unpickle path pickle_message
+ let a = undefined :: EarlyLine
+ let b = undefined :: EarlyLineGame
+
+ actual <- withSqliteConn ":memory:" $ runDbConn $ do
+ runMigration silentMigrationLogger $ do
+ migrate a
+ migrate b
+ _ <- dbimport results
+ deleteAll a
+ count_a <- countAll a
+ count_b <- countAll b
+ return $ sum [count_a, count_b]
+ let expected = 0
+ actual @?= expected