-instance ToFromXml News where
- type Xml News = Message
- type Container News = ()
-
- -- Use a record wildcard here so GHC doesn't complain that we never
- -- used our named fields.
- to_xml (News {..}) =
- Message
- def
- def
- db_mid
- def
- db_sport
- db_url
- def
- def
- db_sms
- db_editor
- db_text
- db_continue
- def
-
- -- We don't need the key argument (from_xml_fk) since the XML type
- -- contains more information in this case.
- from_xml (Message _ _ c _ e f _ _ i j k l _) =
- News c e f i j k l
+
+
+instance ToDb Message where
+ type Db Message = News
+
+-- | Convert the XML representation 'Message' to the database
+-- representation 'News'.
+--
+instance FromXml Message where
+ -- | We use a record wildcard so GHC doesn't complain that we never
+ -- used the field names.
+ --
+ from_xml Message{..} = News { db_mid = xml_mid,
+ db_sport = xml_sport,
+ db_url = xml_url,
+ db_sms = xml_sms,
+ db_editor = xml_editor,
+ db_text = xml_text,
+ db_continue = xml_continue,
+ db_time_stamp = xml_time_stamp }
+
+-- | This lets us call 'insert_xml' on a 'Message'.
+--
+instance XmlImport Message
+
+-- | Define 'dbmigrate' and 'dbimport' for 'Message's. The import is
+-- slightly non-generic because of our 'News_NewsTeam' and
+-- 'News_NewsLocation' join tables.
+--
+instance DbImport Message where
+ dbmigrate _ =
+ run_dbmigrate $ do
+ migrate (undefined :: NewsTeam)
+ migrate (undefined :: NewsLocation)
+ migrate (undefined :: News)
+ migrate (undefined :: News_NewsTeam)
+ migrate (undefined :: News_NewsLocation)
+
+ dbimport message = do
+ -- Insert the message and acquire its primary key (unique ID)
+ news_id <- insert_xml message
+
+ -- And insert each one into its own table. We use insert_xml_or_select
+ -- because we know that most teams will already exist, and we
+ -- want to get back the id for the existing team when
+ -- there's a collision.
+ nt_ids <- mapM insert_xml_or_select (xml_teams message)
+
+ -- Now that the teams have been inserted, create
+ -- news__news_team records mapping beween the two.
+ let news_news_teams = map (News_NewsTeam news_id) nt_ids
+ mapM_ insert_ news_news_teams
+
+ -- Do all of that over again for the NewsLocations.
+ loc_ids <- mapM insert_xml_or_select (xml_locations message)
+ let news_news_locations = map (News_NewsLocation news_id) loc_ids
+ mapM_ insert_ news_news_locations
+
+ return ImportSucceeded