From: Michael Orlitzky Date: Sat, 11 Jan 2014 23:34:26 +0000 (-0500) Subject: Add the insert_xml_or_select function to TSN.XmlImport and use it in TSN.XML.News. X-Git-Tag: 0.0.1~96 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=59d56f0ae0da1d4b1898b3c7536ae38473306319;p=dead%2Fhtsn-import.git Add the insert_xml_or_select function to TSN.XmlImport and use it in TSN.XML.News. --- diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs index 8da4329..f962c9c 100644 --- a/src/TSN/XML/News.hs +++ b/src/TSN/XML/News.hs @@ -161,14 +161,11 @@ instance DbImport Message where -- 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 insertByAll_xml + -- 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 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 (xml_teams message) - let nt_ids = map (either id id) either_nt_ids + -- 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. @@ -176,8 +173,7 @@ instance DbImport Message where mapM_ insert_ news_news_teams -- Do all of that over again for the NewsLocations. - either_loc_ids <- mapM insertByAll_xml (xml_locations message) - let loc_ids = map (either id id) either_loc_ids + 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 diff --git a/src/TSN/XmlImport.hs b/src/TSN/XmlImport.hs index 3791ab5..4300e87 100644 --- a/src/TSN/XmlImport.hs +++ b/src/TSN/XmlImport.hs @@ -26,3 +26,18 @@ class (FromXml a, PersistEntity (Db a)) => XmlImport a where => a -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) ) insertByAll_xml x = insertByAll (from_xml x) + + + -- | Try to insert the given object and get its primary key + -- back. Or, if there's a unique constraint violation, get the + -- primary key of the unique thing already present. + -- + -- Note: we can switch to using fmap here as soon as Functor is a + -- superclass of Monad (PersistBackend is a Monad). + -- + insert_xml_or_select :: (PersistBackend m) + => a + -> m (AutoKey (Db a)) + insert_xml_or_select x = do + tmp <- insertByAll_xml x + return $ (either id id) tmp