Add a tasty test suite and two tests for the existing XML modules.

[dead/htsn-import.git] / src / TSN / InjuriesDetail.hs

diff --git a/src/TSN/InjuriesDetail.hs b/src/TSN/InjuriesDetail.hs
index aa4d7c01beab823c0344a1e72d1014d76ae47040..fda6cc849e06544d6ceef441556f4cd81809dcc2 100644 (file)
--- a/src/TSN/InjuriesDetail.hs
+++ b/src/TSN/InjuriesDetail.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -19,13 +20,16 @@
 module TSN.InjuriesDetail (
   Listing ( player_listings ),
   Message ( listings ),
-  PlayerListing )
+  PlayerListing,
+  injuries_detail_tests )
 where
 
 import Data.Time ( UTCTime )
 import Data.Tuple.Curry ( uncurryN )
 import Database.Groundhog()
 import Database.Groundhog.TH
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
   PU,
   XmlPickler(..),
@@ -39,7 +43,9 @@ import Text.XML.HXT.Core (
   xpText0,
   xpWrap )
 
-import TSN.Picklers( xp_date )
+import TSN.Picklers( xp_date, xp_team_id )
+import Xml ( pickle_unpickle )
+
 
 data PlayerListing =
   PlayerListing {
@@ -54,14 +60,14 @@ data PlayerListing =
     injured     :: Bool,
     injury_type :: String -- ^ "type" is a reserved keyword so we can't use it
     }
-  deriving (Show)
+  deriving (Eq, Show)
 
 data Listing =
   Listing {
     listing_team_id :: Int -- ^ Avoid conflict with PlayerListing's team_id
     , full_name :: String, -- ^ Team full name
     player_listings :: [PlayerListing] }
-  deriving (Show)
+  deriving (Eq, Show)
 
 data Message =
   Message {
@@ -71,7 +77,7 @@ data Message =
     sport :: String,
     listings :: [Listing],
     time_stamp :: String }
-  deriving (Show)
+  deriving (Eq, Show)
 
 
 mkPersist defaultCodegenConfig [groundhog|
@@ -84,7 +90,7 @@ pickle_player_listing :: PU PlayerListing
 pickle_player_listing =
   xpElem "PlayerListing" $
     xpWrap (from_tuple, to_tuple) $
-    xp10Tuple (xpElem "TeamID" xpPrim)
+    xp10Tuple (xpElem "TeamID" xp_team_id)
               (xpElem "PlayerID" xpPrim)
               (xpElem "Date" xp_date)
               (xpElem "Pos" xpText)
@@ -114,7 +120,7 @@ pickle_listing :: PU Listing
 pickle_listing =
   xpElem "Listing" $
     xpWrap (from_tuple, to_tuple) $
-    xpTriple (xpElem "TeamID" xpPrim)
+    xpTriple (xpElem "TeamID" xp_team_id)
              (xpElem "FullName" xpText)
              (xpList pickle_player_listing)
   where
@@ -146,3 +152,19 @@ pickle_message =
 
 instance XmlPickler Message where
   xpickle = pickle_message
+
+
+-- * Tasty Tests
+injuries_detail_tests :: TestTree
+injuries_detail_tests =
+  testGroup
+    "InjuriesDetail tests"
+    [ test_pickle_of_unpickle_is_identity ]
+
+
+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 :: [Message], actual) <- pickle_unpickle "message" path
+    actual @?= expected