-- are not retained.
--
module TSN.XML.InjuriesDetail (
- Listing ( player_listings ),
- Message ( listings ),
- PlayerListing,
+ Message,
injuries_detail_tests )
where
import Data.Time ( UTCTime )
import Data.Tuple.Curry ( uncurryN )
-import Database.Groundhog()
+import Database.Groundhog (
+ migrate )
import Database.Groundhog.TH (
defaultCodegenConfig,
groundhog,
xp6Tuple,
xp10Tuple,
xpElem,
+ xpInt,
xpList,
xpPrim,
xpText,
xpText0,
xpWrap )
-import TSN.DbImport ( DbImport(..), import_generic )
import TSN.Picklers( xp_date, xp_team_id )
-import Xml ( pickle_unpickle )
+import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
+import TSN.XmlImport ( XmlImport(..) )
+import Xml ( FromXml(..), pickle_unpickle, unpickleable )
data PlayerListing =
}
deriving (Eq, Show)
+instance FromXml PlayerListing where
+ type Db PlayerListing = PlayerListing
+ from_xml = id
+
+instance XmlImport PlayerListing
+
data Listing =
Listing {
listing_team_id :: Int -- ^ Avoid conflict with PlayerListing's team_id
player_listings :: [PlayerListing] }
deriving (Eq, Show)
+
data Message =
Message {
xml_file_id :: Int,
time_stamp :: String }
deriving (Eq, Show)
+instance DbImport Message where
+ dbimport msg = do
+ mapM_ insert_xml (concatMap player_listings $ listings msg)
+ return ImportSucceeded
+
+ dbmigrate _ = run_dbmigrate $ migrate (undefined :: PlayerListing)
mkPersist defaultCodegenConfig [groundhog|
- entity: PlayerListing
xpElem "PlayerListing" $
xpWrap (from_tuple, to_tuple) $
xp10Tuple (xpElem "TeamID" xp_team_id)
- (xpElem "PlayerID" xpPrim)
+ (xpElem "PlayerID" xpInt)
(xpElem "Date" xp_date)
(xpElem "Pos" xpText)
(xpElem "Name" xpText)
(xpElem "Injury" xpText)
(xpElem "Status" xpText)
(xpElem "Fantasy" xpText0)
- (xpElem "Injured" xpickle)
+ (xpElem "Injured" xpPrim)
(xpElem "Type" xpText)
where
from_tuple = uncurryN PlayerListing
pickle_message =
xpElem "message" $
xpWrap (from_tuple, to_tuple) $
- xp6Tuple (xpElem "XML_File_ID" xpPrim)
+ xp6Tuple (xpElem "XML_File_ID" xpInt)
(xpElem "heading" xpText)
(xpElem "category" xpText)
(xpElem "sport" xpText)
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,
+ test_unpickle_succeeds ]
+-- | Warning, succeess of this test does not mean that unpickling
+-- succeeded.
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
+
+
+test_unpickle_succeeds :: TestTree
+test_unpickle_succeeds =
+ testCase "unpickling succeeds" $ do
+ let path = "test/xml/Injuries_Detail_XML.xml"
+ actual <- unpickleable path pickle_message
+ let expected = True
+ actual @?= expected