+ xml_xml_file_id :: Int,
+ xml_heading :: String,
+ xml_category :: String,
+ xml_sport :: String,
+ xml_listings :: [InjuriesListingXml],
+ xml_time_stamp :: UTCTime }
+ deriving (Eq, GHC.Generic, Show)
+
+
+-- | For 'H.HVector'.
+--
+instance H.HVector Message
+
+
+-- | Database representation of a 'Message'.
+--
+data Injuries =
+ Injuries {
+ db_xml_file_id :: Int,
+ db_sport :: String,
+ db_time_stamp :: UTCTime }
+
+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.
+ --
+ 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', but
+ -- the listings require a foreign key to the parent 'Message'.
+ --
+ dbimport msg = do
+ msg_id <- insert_xml msg
+
+ -- 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
+
+
+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
+ constructors:
+ - name: InjuriesListing
+ fields:
+ - name: _db_team
+ embeddedType:
+ - {name: team_name, dbName: team_name}
+ - {name: team_league, dbName: team_league}
+ - name: _db_injuries_id
+ reference:
+ onDelete: cascade
+
+- embedded: InjuriesTeam
+ fields:
+ - name: db_team_name
+ - name: db_team_league