Update TSN.XML.Injuries for the new typeclass hierarchy.

diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs
index d2b4e10f938519f849b4fa2cd6d6c87d1df906a2..4ef0154cbf8867d7da97eba31e778c6db1da633a 100644 (file)
--- a/src/TSN/XML/Injuries.hs
+++ b/src/TSN/XML/Injuries.hs
@@ -26,11 +26,10 @@ module TSN.XML.Injuries (
 where
 
 -- System imports.
-import Control.Monad ( forM_ )
 import Data.Data ( Data )
 import Data.Time ( UTCTime )
 import Data.Typeable ( Typeable )
-import Database.Groundhog ( insert_, migrate )
+import Database.Groundhog ( migrate )
 import Database.Groundhog.Core ( DefaultKey )
 import Database.Groundhog.TH (
   groundhog,
@@ -56,8 +55,13 @@ import Text.XML.HXT.Core (
 import TSN.Codegen ( tsn_codegen_config )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers ( xp_time_stamp )
-import TSN.XmlImport ( XmlImport(..) )
-import Xml ( FromXml(..), FromXmlFk(..), pickle_unpickle, unpickleable )
+import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) )
+import Xml (
+  FromXml(..),
+  FromXmlFk(..),
+  ToDb(..),
+  pickle_unpickle,
+  unpickleable )
 
 -- | XML/Database representation of a team as they appear in the
 --   injuries documents.
@@ -80,8 +84,8 @@ data InjuriesListingXml =
   deriving (Eq, Show)
 
 -- | Database representation of a 'InjuriesListing'. It possesses a
--- foreign key to an 'Injuries' object so that we can easily delete
--- 'InjuriesListing's based on the parent message's time_stamp.
+--   foreign key to an 'Injuries' object so that we can easily delete
+--   'InjuriesListing's based on the parent message's time_stamp.
 --
 data InjuriesListing =
   InjuriesListing {
@@ -91,17 +95,17 @@ data InjuriesListing =
     db_injuries :: String,
     db_updated :: Maybe Bool }
 
-
-instance FromXmlFk InjuriesListingXml where
+instance ToDb InjuriesListingXml where
   -- | The DB analogue of a 'InjuriesListingXml' is a 'InjuriesListing'
-  type DbFk InjuriesListingXml = InjuriesListing
+  type Db InjuriesListingXml = InjuriesListing
 
+instance FromXmlFk InjuriesListingXml where
   -- | Our foreign key points to an 'Injuries'.
   type Parent InjuriesListingXml = Injuries
 
   -- | To convert between a 'InjuriesListingXml' and a
   --   'InjuriesListing', we simply append the foreign key.
-  from_xml_fk InjuriesListingXml{..} fk =
+  from_xml_fk fk InjuriesListingXml{..} =
     InjuriesListing {
       db_injuries_id = fk,
       db_team = xml_team,
@@ -109,6 +113,7 @@ instance FromXmlFk InjuriesListingXml where
       db_injuries = xml_injuries,
       db_updated = xml_updated }
 
+instance XmlImportFk InjuriesListingXml
 
 -- | XML representation of an injuriesxml \<message\>.
 --
@@ -130,10 +135,11 @@ data Injuries =
     db_sport :: String,
     db_time_stamp :: UTCTime }
 
-instance FromXml Message where
+instance ToDb Message where
   -- | The database analogue of a 'Message' is an 'Injuries'.
   type Db Message = Injuries
 
+instance FromXml Message where
   -- | To convert from XML to DB, we simply drop the fields we don't
   --   care about.
   --
@@ -156,10 +162,9 @@ instance DbImport Message where
   dbimport msg = do
     msg_id <- insert_xml msg
 
-    forM_ (xml_listings msg) $ \listing ->
-      -- Convert the XML listing to a DB one using the message id and
-      -- insert it (disregarding the result).
-      insert_ $ from_xml_fk listing msg_id
+    -- Convert each XML listing to a DB one using the message id and
+    -- insert it (disregarding the result).
+    mapM_ (insert_xml_fk_ msg_id) (xml_listings msg)
 
     return ImportSucceeded