X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;ds=inline;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 \
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