-instance XmlPickler Message where
- xpickle = pickle_message
-
-
-
-instance DbImport News where
- dbimport _ xml = do
- runMigration defaultMigrationLogger $ do
- migrate (undefined :: News)
- migrate (undefined :: NewsTeam)
- migrate (undefined :: NewsLocation)
- migrate (undefined :: News_NewsTeam)
- migrate (undefined :: News_NewsLocation)
- let root_element = unpickleDoc xpickle xml :: Maybe Message
- case root_element of
- Nothing -> do
- let errmsg = "Could not unpickle News message in dbimport."
- return $ ImportFailed errmsg
- Just message -> do
- -- Insert the message and acquire its primary key (unique ID)
- news_id <- insert (from_xml message :: News)
-
- -- And insert each one into its own table. We use insertByAll
- -- because we know that most teams will already exist, and we
- -- want to get back a Left (id) for the existing team when
- -- there's a collision. In fact, if the insert succeeds, we'll
- -- get a Right (id) back, so we can disregard the Either
- -- constructor entirely. That's what the (either id id) does.
- either_nt_ids <- mapM insertByAll (xml_teams message)
- let nt_ids = map (either id id) either_nt_ids
-
- -- 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
- nnt_ids <- mapM insert news_news_teams
-
-
- -- Do all of that over again for the NewsLocations.
- either_loc_ids <- mapM insertByAll (xml_locations message)
- let loc_ids = map (either id id) either_loc_ids
- let news_news_locations = map (News_NewsLocation news_id) loc_ids
- nnl_ids <- mapM insertByAll news_news_locations
-
- return $ ImportSucceeded (1 + -- for the News
- (length nt_ids) +
- (length loc_ids) +
- (length nnt_ids) +
- (length nnl_ids))