X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FInjuries.hs;h=03f956595606ae2c342faa9c68384141d8497e88;hb=d476419274cdf2997d768444cecc47922a902fdf;hp=7ffca2658d5baabefd5de87b95958de0de2f4259;hpb=4cdcdbe593c30f6434a25896951a1a4dfcc2b1ca;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs index 7ffca26..03f9565 100644 --- a/src/TSN/XML/Injuries.hs +++ b/src/TSN/XML/Injuries.hs @@ -14,8 +14,11 @@ -- automatically. The root message is not retained. -- module TSN.XML.Injuries ( - Message, - injuries_tests ) + pickle_message, + -- * Tests + injuries_tests, + -- * WARNING: these are private but exported to silence warnings + ListingConstructor(..) ) where import Data.Data ( Data ) @@ -31,7 +34,6 @@ import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Text.XML.HXT.Core ( PU, - XmlPickler(..), xp4Tuple, xp6Tuple, xpAttr, @@ -110,8 +112,6 @@ pickle_injuries_team = from_tuple = uncurryN InjuriesTeam to_tuple m = (team_name m, team_league m) -instance XmlPickler InjuriesTeam where - xpickle = pickle_injuries_team pickle_listing :: PU Listing pickle_listing = @@ -125,9 +125,6 @@ pickle_listing = from_tuple = uncurryN Listing to_tuple l = (team l, teamno l, injuries l, updated l) -instance XmlPickler Listing where - xpickle = pickle_listing - pickle_message :: PU Message pickle_message = @@ -148,12 +145,13 @@ pickle_message = listings m, time_stamp m) -instance XmlPickler Message where - xpickle = pickle_message - +-- +-- Tasty Tests +-- --- * Tasty Tests +-- | A list of all tests for this module. +-- injuries_tests :: TestTree injuries_tests = testGroup @@ -162,8 +160,10 @@ injuries_tests = test_unpickle_succeeds ] --- | Warning, succeess of this test does not mean that unpickling --- succeeded. +-- | If we unpickle something and then pickle it, we should wind up +-- with the same thing we started with. 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 @@ -172,6 +172,8 @@ test_pickle_of_unpickle_is_identity = actual @?= expected +-- | Make sure we can actually unpickle these things. +-- test_unpickle_succeeds :: TestTree test_unpickle_succeeds = testCase "unpickling succeeds" $ do