]> gitweb.michael.orlitzky.com - dead/htsn-import.git/blobdiff - src/TSN/Injuries.hs
Add a tasty test suite and two tests for the existing XML modules.
[dead/htsn-import.git] / src / TSN / Injuries.hs
index 3877c12efc551a5e6c55ee3bed5d2354e5be7b6e..0b19c792b0b89abcffb120e2855a929ce714daf4 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 --
 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