X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FInjuriesDetail.hs;h=995101de618d875cd0828554c947061b24ab98b9;hb=c5d61081ad0d95950ca06761978d240632c44510;hp=fee6ce2beb46d09da012a5ae60f9f5f37afd927a;hpb=e207228e7b7b47f4cbe16b578ce16cea009b15f9;p=dead%2Fhtsn-import.git

diff --git a/src/TSN/XML/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs
index fee6ce2..995101d 100644
--- a/src/TSN/XML/InjuriesDetail.hs
+++ b/src/TSN/XML/InjuriesDetail.hs
@@ -85,6 +85,7 @@ data Message =
 --
 data InjuriesDetail =
   InjuriesDetail {
+    db_xml_file_id :: Int,
     db_sport :: String,
     db_time_stamp :: UTCTime }
   deriving (Eq, Show)
@@ -92,6 +93,7 @@ data InjuriesDetail =
 instance ToDb Message where
   -- | The database representation of a 'Message' is an
   --   'InjuriesDetail'.
+  --
   type Db Message = InjuriesDetail
 
 instance FromXml Message where
@@ -100,18 +102,25 @@ instance FromXml Message where
   --
   from_xml Message{..} =
     InjuriesDetail {
+      db_xml_file_id = xml_xml_file_id,
       db_sport = xml_sport,
       db_time_stamp = xml_time_stamp }
 
 
--- | This allows us to call 'insert_xml' directly on the XML
---   representation.
+-- | This allows us to insert the XML representation 'Message'
+--   directly.
+--
 instance XmlImport Message
 
 
 
 -- * InjuriesDetailListing/InjuriesDetailListingXml
 
+-- | Database representation of a \<Listing\> element. It has a
+--   foreign key pointing to its parent 'InjuriesDetail', and does not
+--   contain the list of 'xml_player_listings' (which get their own
+--   table).
+--
 data InjuriesDetailListing =
   InjuriesDetailListing {
     db_injuries_detail_id :: DefaultKey InjuriesDetail,
@@ -133,17 +142,28 @@ data InjuriesDetailListingXml =
   deriving (Eq, Show)
 
 instance ToDb InjuriesDetailListingXml where
+  -- | The database analogue of an 'InjuriesDetailListingXml' is a
+  --   'InjuriesDetailListing'.
   type Db InjuriesDetailListingXml = InjuriesDetailListing
 
 instance FromXmlFk InjuriesDetailListingXml where
+  -- | Each 'InjuriesDetailListingXml' is contained in an
+  --   'InjuriesDetail'.
   type Parent InjuriesDetailListingXml = InjuriesDetail
 
+  -- | Construct a 'InjuriesDetailListing' from a
+  --   'InjuriesDetailListingXml' and a foreign key to a
+  --   'InjuriesDetail'.
+  --
   from_xml_fk fk InjuriesDetailListingXml{..} =
     InjuriesDetailListing {
       db_injuries_detail_id = fk,
       db_team_id = xml_team_id,
       db_full_name = xml_full_name }
 
+-- | This allows us to insert the XML representation
+--   'InjuriesDetailListingXml' directly.
+--
 instance XmlImportFk InjuriesDetailListingXml
 
 
@@ -201,10 +221,15 @@ instance ToDb InjuriesDetailListingPlayerListingXml where
     InjuriesDetailListingPlayerListing
 
 instance FromXmlFk InjuriesDetailListingPlayerListingXml where
+  -- | Each 'InjuriesDetailListingPlayerListingXml' is contained in an
+  --   'InjuriesDetailListing'.
+  --
   type Parent InjuriesDetailListingPlayerListingXml = InjuriesDetailListing
 
-  -- | To convert between a 'InjuriesDetailListingPlayerListingXml'
-  --   and a 'InjuriesDetailListingPlayerListingXml', we do nothing.
+  -- | To construct a 'InjuriesDetailListingPlayerListing' from a
+  --   'InjuriesDetailListingPlayerListingXml' we need to supply a
+  --   foreign key to an 'InjuriesDetailListing'.
+  --
   from_xml_fk fk InjuriesDetailListingPlayerListingXml{..} =
     InjuriesDetailListingPlayerListing {
       db_injuries_detail_listings_id = fk,
@@ -218,9 +243,8 @@ instance FromXmlFk InjuriesDetailListingPlayerListingXml where
       db_injured = xml_injured,
       db_type = xml_type }
 
--- | This lets us call 'insert_xml' on a
---   'InjuriesDetailListingPlayerListingXml' without having to
---   explicitly convert it to its database analogue first.
+-- | This lets us insert the XML representation
+--   'InjuriesDetailListingPlayerListingXml' directly.
 --
 instance XmlImportFk InjuriesDetailListingPlayerListingXml
 
@@ -230,9 +254,16 @@ instance XmlImportFk InjuriesDetailListingPlayerListingXml
 --
 
 instance DbImport Message where
+  dbmigrate _ =
+    run_dbmigrate $ do
+      migrate (undefined :: InjuriesDetail)
+      migrate (undefined :: InjuriesDetailListing)
+      migrate (undefined :: InjuriesDetailListingPlayerListing)
+
   -- | To import a 'Message', we import all of its
-  --   'InjuriesDetailListingPlayerListingXml's, which we have to dig out of its
-  --   'Listing's.
+  --   'InjuriesDetailListingPlayerListingXml's, which we have to dig
+  --   out of its 'Listing's.
+  --
   dbimport msg = do
     msg_id <- insert_xml msg
 
@@ -242,16 +273,17 @@ instance DbImport Message where
 
     return ImportSucceeded
 
-  dbmigrate _ =
-    run_dbmigrate $ do
-      migrate (undefined :: InjuriesDetail)
-      migrate (undefined :: InjuriesDetailListing)
-      migrate (undefined :: InjuriesDetailListingPlayerListing)
-
 
 mkPersist tsn_codegen_config [groundhog|
 - entity: InjuriesDetail
   dbName: injuries_detail
+  constructors:
+    - name: InjuriesDetail
+      uniques:
+        - name: unique_injuries_detail
+          type: constraint
+          # Prevent multiple imports of the same message.
+          fields: [db_xml_file_id]
 
 - entity: InjuriesDetailListing
   dbName: injuries_detail_listings