X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FInjuries.hs;h=0b19c792b0b89abcffb120e2855a929ce714daf4;hb=988f693ce7f1abb6566e75d539ac312b627c31d5;hp=3877c12efc551a5e6c55ee3bed5d2354e5be7b6e;hpb=ee387af8b24654089f13493637efc45bd48a8e41;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/Injuries.hs b/src/TSN/Injuries.hs
index 3877c12..0b19c79 100644
--- a/src/TSN/Injuries.hs
+++ b/src/TSN/Injuries.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -14,12 +15,15 @@
 --
 module TSN.Injuries (
   Listing,
-  Message( listings ) )
+  Message( listings ),
+  injuries_tests )
 where
 
 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(..),
@@ -32,13 +36,16 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 
+import Xml ( pickle_unpickle )
+
+
 data Listing =
   Listing {
     team :: String,
     teamno :: Int,
     injuries :: String,
     updated :: Bool }
-  deriving (Show)
+  deriving (Eq, Show)
 
 data Message =
   Message {
@@ -48,7 +55,7 @@ data Message =
     sport :: String,
     listings :: [Listing],
     time_stamp :: String }
-  deriving (Show)
+  deriving (Eq, Show)
 
 
 mkPersist defaultCodegenConfig [groundhog|
@@ -94,3 +101,20 @@ pickle_message =
 
 instance XmlPickler Message where
   xpickle = pickle_message
+
+
+
+-- * Tasty Tests
+injuries_tests :: TestTree
+injuries_tests =
+  testGroup
+    "Injuries 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/injuriesxml.xml"
+    (expected :: [Message], actual) <- pickle_unpickle "message" path
+    actual @?= expected