Add SportInfo support for NFLTopPuntReturnXML.dtd.

[dead/htsn-import.git] / src / TSN / XML / Injuries.hs

diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs
index 81243e44f20f8edd0dbd0f77a46c992379b2132f..3f0fea55e364b066dfe4e95a2979893f4f0e75c0 100644 (file)
--- a/src/TSN/XML/Injuries.hs
+++ b/src/TSN/XML/Injuries.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -17,6 +16,7 @@
 --   time_stamp.
 --
 module TSN.XML.Injuries (
+  dtd,
   pickle_message,
   -- * Tests
   injuries_tests,
@@ -31,7 +31,7 @@ import Data.Time ( UTCTime )
 import Data.Typeable ( Typeable )
 import Database.Groundhog (
   countAll,
-  executeRaw,
+  deleteAll,
   migrate,
   runMigration,
   silentMigrationLogger )
@@ -64,6 +64,7 @@ import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers ( xp_time_stamp )
 import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
 import Xml (
+  Child(..),
   FromXml(..),
   FromXmlFk(..),
   ToDb(..),
@@ -72,6 +73,12 @@ import Xml (
   unsafe_unpickle )
 
 
+
+-- | The DTD to which this module corresponds. Used to invoke dbimport.
+--
+dtd :: String
+dtd = "injuriesxml.dtd"
+
 --
 -- DB/XML Data types
 --
@@ -95,7 +102,7 @@ data InjuriesTeam =
 data InjuriesListingXml =
   InjuriesListingXml {
     xml_team :: InjuriesTeam,
-    xml_teamno :: Maybe Int,
+    xml_teamno :: Maybe String, -- ^ Can contain non-numerics, e.g. \"ZR2\"
     xml_injuries :: String,
     xml_updated :: Maybe Bool }
   deriving (Eq, Show)
@@ -108,7 +115,7 @@ data InjuriesListing =
   InjuriesListing {
     db_injuries_id :: DefaultKey Injuries,
     db_team :: InjuriesTeam,
-    db_teamno :: Maybe Int,
+    db_teamno :: Maybe String, -- ^ Can contain non-numerics, e.g. \"ZR2\"
     db_injuries :: String,
     db_updated :: Maybe Bool }
 
@@ -116,10 +123,11 @@ instance ToDb InjuriesListingXml where
   -- | The DB analogue of a 'InjuriesListingXml' is a 'InjuriesListing'
   type Db InjuriesListingXml = InjuriesListing
 
-instance FromXmlFk InjuriesListingXml where
+instance Child InjuriesListingXml where
   -- | Our foreign key points to an 'Injuries'.
   type Parent InjuriesListingXml = Injuries
 
+instance FromXmlFk InjuriesListingXml where
   -- | To convert between a 'InjuriesListingXml' and a
   --   'InjuriesListing', we simply append the foreign key.
   from_xml_fk fk InjuriesListingXml{..} =
@@ -256,7 +264,7 @@ pickle_listing =
   xpElem "listing" $
     xpWrap (from_tuple, to_tuple) $
     xp4Tuple pickle_injuries_team
-             (xpOption $ xpElem "teamno" xpInt)
+             (xpOption $ xpElem "teamno" xpText)
              (xpElem "injuries" xpText)
              (xpOption $ xpElem "updated" xpPrim)
   where
@@ -339,8 +347,7 @@ test_on_delete_cascade =
                   migrate a
                   migrate b
                 _ <- dbimport inj
-                -- No idea how 'delete' works, so do this instead.
-                executeRaw False "DELETE FROM injuries;" []
+                deleteAll a
                 count_a <- countAll a
                 count_b <- countAll b
                 return $ count_a + count_b