From: Michael Orlitzky Date: Mon, 13 Jan 2014 17:41:01 +0000 (-0500) Subject: Fix pickle/unpickle of non-interger team_ids and add a test case for it. X-Git-Tag: 0.0.1~77 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=2f0d419104ac1ad108ae1b29d6722ed032286665;p=dead%2Fhtsn-import.git Fix pickle/unpickle of non-interger team_ids and add a test case for it. --- diff --git a/src/TSN/Picklers.hs b/src/TSN/Picklers.hs index 1193abf..8076b29 100644 --- a/src/TSN/Picklers.hs +++ b/src/TSN/Picklers.hs @@ -33,21 +33,19 @@ xp_date = from_date = formatTime defaultTimeLocale format --- | Parse a team_id. This /should/ just be an 'Int', but TSN is doing --- something weird. First of all, player IDs do look like normal --- 'Int's. But the team IDs are all stuck in the triple digits, and --- double-digit team IDs appear to be padded to three characters --- with a leading '0'. So maybe they're treating these as text? +-- | Parse a team_id. These are (so far!) three characters long, and +-- not necessarily numeric. For simplicity, we return a 'String' +-- rather than e.g. a @(Char, Char, Char)@. But unpickling will fail +-- if the team_id is longer than three characters. -- --- In any case, we do the simplest thing that is correct for all the --- XML we've got: pad it to (only) three digits on pickling. --- -xp_team_id :: PU Int +xp_team_id :: PU String xp_team_id = (to_team_id, from_team_id) `xpWrapMaybe` xpText where - to_team_id :: String -> Maybe Int - to_team_id = readMaybe + to_team_id :: String -> Maybe String + to_team_id s + | length s <= 3 = Just s + | otherwise = Nothing - from_team_id :: Int -> String - from_team_id = printf "%03d" + from_team_id :: String -> String + from_team_id = id diff --git a/src/TSN/XML/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs index 856e800..c06768e 100644 --- a/src/TSN/XML/InjuriesDetail.hs +++ b/src/TSN/XML/InjuriesDetail.hs @@ -52,7 +52,8 @@ import Xml ( FromXml(..), pickle_unpickle, unpickleable ) data PlayerListing = PlayerListing { - team_id :: Int, + team_id :: String, -- ^ TeamIDs are (apparently) three characters long + -- and not necessarily numeric. player_id :: Int, date :: UTCTime, pos :: String, @@ -73,7 +74,9 @@ instance XmlImport PlayerListing data Listing = Listing { - listing_team_id :: Int -- ^ Avoid conflict with PlayerListing's team_id + listing_team_id :: String -- ^ Avoid conflict with PlayerListing's team_id. + -- TeamIDs are (apparently) three characters + -- long and not necessarily numeric. , full_name :: String, -- ^ Team full name player_listings :: [PlayerListing] } deriving (Eq, Show) @@ -99,6 +102,11 @@ instance DbImport Message where mkPersist defaultCodegenConfig [groundhog| - entity: PlayerListing dbName: injuries_detail_player_listings + constructors: + - name: PlayerListing + fields: + - name: team_id + type: varchar(3) |] @@ -174,17 +182,27 @@ injuries_detail_tests = -- | Warning, succeess of this 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/Injuries_Detail_XML.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/Injuries_Detail_XML.xml", + + check "pickle composed with unpickle is the identity (non-int team_id)" + "test/xml/Injuries_Detail_XML-noninteger-team-id.xml" ] + where + check desc path = testCase desc $ do + (expected, actual) <- pickle_unpickle pickle_message path + actual @?= expected test_unpickle_succeeds :: TestTree -test_unpickle_succeeds = - testCase "unpickling succeeds" $ do - let path = "test/xml/Injuries_Detail_XML.xml" - actual <- unpickleable path pickle_message - let expected = True - actual @?= expected +test_unpickle_succeeds = testGroup "unpickle tests" + [ check "unpickling succeeds" + "test/xml/Injuries_Detail_XML.xml", + + check "unpickling succeeds (non-int team_id)" + "test/xml/Injuries_Detail_XML-noninteger-team-id.xml" ] + where + check desc path = testCase desc $ do + actual <- unpickleable path pickle_message + let expected = True + actual @?= expected