X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FInjuriesDetail.hs;h=a787ad5251b0d553e99804d2f1c1b98593b0883c;hb=e46de7e95112d4e35219b74c0b3efffe99c69c6a;hp=aa4d7c01beab823c0344a1e72d1014d76ae47040;hpb=767dc8dbacaf6dcdefd268c7c8c08cd0c23c3391;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/InjuriesDetail.hs b/src/TSN/InjuriesDetail.hs
index aa4d7c0..a787ad5 100644
--- 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,19 @@
 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 Database.Groundhog.TH (
+  defaultCodegenConfig,
+  groundhog,
+  mkPersist )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.XML.HXT.Core (
   PU,
   XmlPickler(..),
@@ -39,7 +46,10 @@ import Text.XML.HXT.Core (
   xpText0,
   xpWrap )
 
-import TSN.Picklers( xp_date )
+import TSN.DbImport ( DbImport(..), import_generic )
+import TSN.Picklers( xp_date, xp_team_id )
+import Xml ( pickle_unpickle )
+
 
 data PlayerListing =
   PlayerListing {
@@ -54,14 +64,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 +81,7 @@ data Message =
     sport :: String,
     listings :: [Listing],
     time_stamp :: String }
-  deriving (Show)
+  deriving (Eq, Show)
 
 
 mkPersist defaultCodegenConfig [groundhog|
@@ -84,7 +94,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 +124,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 +156,22 @@ pickle_message =
 
 instance XmlPickler Message where
   xpickle = pickle_message
+
+instance DbImport PlayerListing where
+  dbimport = import_generic ( (concatMap player_listings) . listings)
+
+
+-- * 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