X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FInjuries.hs;h=eb369e03eb8d1ecae646a383a4d0a95e9e2b8659;hb=c5d61081ad0d95950ca06761978d240632c44510;hp=4ef0154cbf8867d7da97eba31e778c6db1da633a;hpb=83902c16cf946f81ea733f707d432632aa124084;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs
index 4ef0154..eb369e0 100644
--- a/src/TSN/XML/Injuries.hs
+++ b/src/TSN/XML/Injuries.hs
@@ -63,6 +63,13 @@ import Xml (
   pickle_unpickle,
   unpickleable )
 
+
+--
+-- DB/XML Data types
+--
+
+-- * InjuriesTeam
+
 -- | XML/Database representation of a team as they appear in the
 --   injuries documents.
 --
@@ -73,7 +80,9 @@ data InjuriesTeam =
   deriving (Data, Eq, Show, Typeable)
 
 
--- | XML/Database representation of the injury listings.
+-- * InjuriesListing/InjuriesListingXml
+
+-- | XML representation of the injury listings.
 --
 data InjuriesListingXml =
   InjuriesListingXml {
@@ -113,8 +122,14 @@ instance FromXmlFk InjuriesListingXml where
       db_injuries = xml_injuries,
       db_updated = xml_updated }
 
+-- | This allows us to insert the XML representation
+--   'InjuriesListingXml' directly.
+--
 instance XmlImportFk InjuriesListingXml
 
+
+-- * Injuries/Message
+
 -- | XML representation of an injuriesxml \<message\>.
 --
 data Message =
@@ -127,11 +142,11 @@ data Message =
     xml_time_stamp :: UTCTime }
   deriving (Eq, Show)
 
--- | Database representation of a 'Message'. We really only care about
---   the time stamp.
+-- | Database representation of a 'Message'.
 --
 data Injuries =
   Injuries {
+    db_xml_file_id :: Int,
     db_sport :: String,
     db_time_stamp :: UTCTime }
 
@@ -145,19 +160,28 @@ instance FromXml Message where
   --
   from_xml Message{..} =
     Injuries {
+      db_xml_file_id = xml_xml_file_id,
       db_sport = xml_sport,
       db_time_stamp = xml_time_stamp }
 
+-- | This allows us to insert the XML representation 'Message'
+--   directly.
+--
 instance XmlImport Message
 
 
+--
+-- Database code
+--
+
 instance DbImport Message where
   dbmigrate _ =
     run_dbmigrate $ do
       migrate (undefined :: Injuries)
       migrate (undefined :: InjuriesListing)
 
-  -- | We import a 'Message' by inserting all of its 'listings'.
+  -- | We import a 'Message' by inserting all of its 'listings', but
+  --   the listings require a foreign key to the parent 'Message'.
   --
   dbimport msg = do
     msg_id <- insert_xml msg
@@ -171,6 +195,13 @@ instance DbImport Message where
 
 mkPersist tsn_codegen_config [groundhog|
 - entity: Injuries
+  constructors:
+    - name: Injuries
+      uniques:
+        - name: unique_injuries
+          type: constraint
+          # Prevent multiple imports of the same message.
+          fields: [db_xml_file_id]
 
 - entity: InjuriesListing
   dbName: injuries_listings
@@ -192,6 +223,11 @@ mkPersist tsn_codegen_config [groundhog|
 |]
 
 
+--
+-- XML Picklers
+--
+
+
 -- | A pickler for 'InjuriesTeam's that can convert them to/from XML.
 --
 pickle_injuries_team :: PU InjuriesTeam
@@ -204,7 +240,8 @@ pickle_injuries_team =
     to_tuple m = (db_team_name m, db_team_league m)
 
 
--- | A pickler for 'InjuriesListingXml's that can convert them to/from XML.
+-- | A pickler for 'InjuriesListingXml's that can convert them to/from
+--   XML.
 --
 pickle_listing :: PU InjuriesListingXml
 pickle_listing =