+-- | Database representation of a 'Message'.
+--
+data InjuriesDetail =
+ InjuriesDetail {
+ db_xml_file_id :: Int,
+ db_sport :: String,
+ db_time_stamp :: UTCTime }
+ deriving (Eq, Show)
+
+instance ToDb Message where
+ -- | The database representation of a 'Message' is an
+ -- 'InjuriesDetail'.
+ type Db Message = InjuriesDetail
+
+instance FromXml Message where
+ -- | To convert a 'Message' into an 'InjuriesDetail', we simply drop
+ -- a few fields.
+ --
+ 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.
+instance XmlImport Message
+
+
+
+-- * InjuriesDetailListing/InjuriesDetailListingXml
+
+-- | Database representation of an InjuriesDetailListing. 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,
+ db_team_id :: String,
+ db_full_name :: String }
+
+
+-- | XML incarnation of a \<Listing\> element. We don't store these;
+-- the data type is used only for parsing.
+--
+data InjuriesDetailListingXml =
+ InjuriesDetailListingXml {
+ xml_team_id :: String, -- ^ TeamIDs are (apparently) three
+ -- characters long and not necessarily
+ -- numeric.
+
+ xml_full_name :: String, -- ^ Team full name
+ xml_player_listings :: [InjuriesDetailListingPlayerListingXml] }
+ deriving (Eq, Show)
+
+instance ToDb InjuriesDetailListingXml where
+ -- | The database analogue of an 'InjuriesDetailListingXml' is a
+ -- 'InjuriesDetailListing'.
+ type Db InjuriesDetailListingXml = InjuriesDetailListing
+
+instance FromXmlFk InjuriesDetailListingXml where
+ 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 }
+
+instance XmlImportFk InjuriesDetailListingXml
+
+
+-- * InjuriesDetailListingPlayerListing
+
+-- | XML representation of a \<PlayerListing\>, the main type of
+-- element contains in Injuries_Detail_XML messages.
+--
+data InjuriesDetailListingPlayerListingXml =
+ InjuriesDetailListingPlayerListingXml {
+ xml_player_team_id :: String, -- ^ TeamIDs are (apparently) three
+ -- characters long and not
+ -- necessarily numeric. Postgres
+ -- imposes no performance penalty
+ -- on a lengthless text field, so
+ -- we ignore the likely upper
+ -- bound of three characters.
+ -- We add the \"player\" to avoid conflict
+ -- with 'InjuriesDetailListingXml'.
+ xml_player_id :: Int,
+ xml_date :: UTCTime,
+ xml_pos :: String,
+ xml_name :: String,
+ xml_injury :: String,
+ xml_status :: String,
+ xml_fantasy :: Maybe String, -- ^ Nobody knows what this is.
+ xml_injured :: Bool,
+ xml_type :: String }
+ deriving (Eq, Show)
+
+
+
+-- | Database representation of a
+-- 'InjuriesDetailListingPlayerListingXml'. We drop the team_id
+-- because it's redundant.
+--
+data InjuriesDetailListingPlayerListing =
+ InjuriesDetailListingPlayerListing {
+ db_injuries_detail_listings_id :: DefaultKey InjuriesDetailListing,
+ db_player_id :: Int,
+ db_date :: UTCTime,
+ db_pos :: String,
+ db_name :: String,
+ db_injury :: String,
+ db_status :: String,
+ db_fantasy :: Maybe String, -- ^ Nobody knows what this is.
+ db_injured :: Bool,
+ db_type :: String }
+
+
+instance ToDb InjuriesDetailListingPlayerListingXml where
+ -- | The DB analogue of a 'InjuriesDetailListingPlayerListingXml' is
+ -- 'InjuriesDetailListingPlayerListing'.
+ type Db InjuriesDetailListingPlayerListingXml =
+ InjuriesDetailListingPlayerListing
+
+instance FromXmlFk InjuriesDetailListingPlayerListingXml where
+ type Parent InjuriesDetailListingPlayerListingXml = InjuriesDetailListing
+
+ -- | To convert between a 'InjuriesDetailListingPlayerListingXml'
+ -- and a 'InjuriesDetailListingPlayerListingXml', we do nothing.
+ from_xml_fk fk InjuriesDetailListingPlayerListingXml{..} =
+ InjuriesDetailListingPlayerListing {
+ db_injuries_detail_listings_id = fk,
+ db_player_id = xml_player_id,
+ db_date = xml_date,
+ db_pos = xml_pos,
+ db_name = xml_name,
+ db_injury = xml_injury,
+ db_status = xml_status,
+ db_fantasy = xml_fantasy,
+ 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.
+--
+instance XmlImportFk InjuriesDetailListingPlayerListingXml
+
+
+--
+-- Database stuff
+--
+
+instance DbImport Message where
+ -- | To import a 'Message', we import all of its
+ -- 'InjuriesDetailListingPlayerListingXml's, which we have to dig out of its
+ -- 'Listing's.
+ dbimport msg = do
+ msg_id <- insert_xml msg
+
+ forM_ (xml_listings msg) $ \listing -> do
+ l_id <- insert_xml_fk msg_id listing
+ mapM_ (insert_xml_fk_ l_id) (xml_player_listings listing)
+
+ return ImportSucceeded
+
+ dbmigrate _ =
+ run_dbmigrate $ do
+ migrate (undefined :: InjuriesDetail)
+ migrate (undefined :: InjuriesDetailListing)
+ migrate (undefined :: InjuriesDetailListingPlayerListing)
+