X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FInjuries.hs;h=8c2de14b04006e0a954fd156505ec8dc5fa8ae2c;hb=f8a623928407ceaaa8c28b60316e9123a4f3821b;hp=4809786b2906523ff06850e2e20b45a55c9fffb5;hpb=dd4d3adf452823702f3376d1869b07e39f03bff2;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/Injuries.hs b/src/TSN/Injuries.hs
index 4809786..8c2de14 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 #-}
@@ -13,12 +14,19 @@
 --   automatically. The root message is not retained.
 --
 module TSN.Injuries (
-  Message )
+  Listing,
+  Message( listings ),
+  injuries_tests )
 where
 
 import Data.Tuple.Curry ( uncurryN )
 import Database.Groundhog()
-import Database.Groundhog.TH
+import Database.Groundhog.TH (
+  defaultCodegenConfig,
+  groundhog,
+  mkPersist )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
   PU,
   XmlPickler(..),
@@ -31,6 +39,9 @@ import Text.XML.HXT.Core (
   xpWrap )
 
 
+import TSN.DbImport ( DbImport(..), import_generic )
+import Xml ( pickle_unpickle )
+
 
 data Listing =
   Listing {
@@ -38,7 +49,7 @@ data Listing =
     teamno :: Int,
     injuries :: String,
     updated :: Bool }
-  deriving (Show)
+  deriving (Eq, Show)
 
 data Message =
   Message {
@@ -48,7 +59,7 @@ data Message =
     sport :: String,
     listings :: [Listing],
     time_stamp :: String }
-  deriving (Show)
+  deriving (Eq, Show)
 
 
 mkPersist defaultCodegenConfig [groundhog|
@@ -94,3 +105,23 @@ pickle_message =
 
 instance XmlPickler Message where
   xpickle = pickle_message
+
+
+
+instance DbImport Listing where
+  dbimport = import_generic listings
+
+-- * 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