From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 21 Jan 2014 19:19:51 +0000 (-0500)
Subject: Add a new module, TSN.Database, and use it to clean up TSN.XML.News.
X-Git-Tag: 0.0.1~6
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=c5d61081ad0d95950ca06761978d240632c44510;p=dead%2Fhtsn-import.git

Add a new module, TSN.Database, and use it to clean up TSN.XML.News.
---

diff --git a/htsn-import.cabal b/htsn-import.cabal
index 635deaf..6009424 100644
--- a/htsn-import.cabal
+++ b/htsn-import.cabal
@@ -101,6 +101,7 @@ executable htsn-import
     ExitCodes
     OptionalConfiguration
     TSN.Codegen
+    TSN.Database
     TSN.DbImport
     TSN.Picklers
     TSN.XmlImport
diff --git a/src/TSN/Database.hs b/src/TSN/Database.hs
new file mode 100644
index 0000000..9350330
--- /dev/null
+++ b/src/TSN/Database.hs
@@ -0,0 +1,18 @@
+-- | Standalone database functions for dealing with Groundhog types.
+--
+module TSN.Database ( insert_or_select )
+where
+
+import Database.Groundhog ( AutoKey, insertByAll )
+import Database.Groundhog.Core ( PersistBackend, PersistEntity )
+
+
+-- | Attempt to insert the given object returning its new primary
+--   key. If any unique constraints would be violated, instead return
+--   the primary key of the existing record that caused the collision.
+insert_or_select :: (PersistBackend m, PersistEntity a)
+                 => a
+                 -> m (AutoKey a)
+insert_or_select x = do
+  tmp <- insertByAll x
+  return $ (either id id) tmp
diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs
index 78dc935..2031634 100644
--- a/src/TSN/XML/News.hs
+++ b/src/TSN/XML/News.hs
@@ -7,8 +7,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
--- | Parse TSN XML for the DTD "newsxml.dtd". Each document contains a
---   root element \<message\> that contains an entire news item.
+-- | Parse TSN XML for the DTD \"newsxml.dtd\". Each document contains
+--   a root element \<message\> that contains an entire news item.
 --
 module TSN.XML.News (
   pickle_message,
@@ -55,6 +55,7 @@ import Text.XML.HXT.Core (
 import TSN.Codegen (
   tsn_codegen_config,
   tsn_db_field_namer ) -- Used in a test
+import TSN.Database ( insert_or_select )
 import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
 import TSN.Picklers ( xp_time_stamp )
 import TSN.XmlImport ( XmlImport(..) )
@@ -71,6 +72,7 @@ import Xml ( FromXml(..), ToDb(..), pickle_unpickle, unpickleable )
 --   embed it into the 'News' type. We (pointlessly) use the "db_"
 --   prefix here so that the two names don't collide on "id" when
 --   Groundhog is creating its fields using our field namer.
+--
 data MsgId =
   MsgId {
     db_msg_id       :: Int,
@@ -78,7 +80,7 @@ data MsgId =
   deriving (Data, Eq, Show, Typeable)
 
 
--- | The XML representation of a news item (message).
+-- | The XML representation of a news item (\<message\>).
 --
 data Message =
   Message {
@@ -118,6 +120,7 @@ data News =
 
 
 instance ToDb Message where
+  -- | The database representation of 'Message' is 'News'.
   type Db Message = News
 
 -- | Convert the XML representation 'Message' to the database
@@ -137,7 +140,7 @@ instance FromXml Message where
                                 db_continue = xml_continue,
                                 db_time_stamp = xml_time_stamp }
 
--- | This lets us call 'insert_xml' on a 'Message'.
+-- | This lets us insert the XML representation 'Message' directly.
 --
 instance XmlImport Message
 
@@ -151,22 +154,6 @@ data NewsTeam =
   deriving (Eq, Show)
 
 
-instance ToDb NewsTeam where
-  -- | The database representaion of a 'NewsTeam' is itself.
-  type Db NewsTeam = NewsTeam
-
--- | This is needed to define the XmlImport instance for NewsTeam.
---
-instance FromXml NewsTeam where
-  -- | How to we get a 'NewsTeam' from itself?
-  from_xml = id
-
--- | Allow us to call 'insert_xml' on the XML representation of
---   NewsTeams.
---
-instance XmlImport NewsTeam
-
-
 
 -- * News_NewsTeam
 
@@ -191,21 +178,6 @@ data NewsLocation =
     country :: String }
   deriving (Eq, Show)
 
-instance ToDb NewsLocation where
-  -- | The database representation of a 'NewsLocation' is itself.
-  type Db NewsLocation = NewsLocation
-
--- | This is needed to define the XmlImport instance for NewsLocation.
---
-instance FromXml NewsLocation where
-  -- | How to we get a 'NewsLocation' from itself?
-  from_xml = id
-
--- | Allow us to call 'insert_xml' on the XML representation of
---   NewsLocations.
---
-instance XmlImport NewsLocation
-
 
 -- * News_NewsLocation
 
@@ -231,10 +203,10 @@ data News_NewsLocation = News_NewsLocation
 instance DbImport Message where
   dbmigrate _ =
     run_dbmigrate $ do
-      migrate (undefined :: NewsTeam)
-      migrate (undefined :: NewsLocation)
       migrate (undefined :: News)
+      migrate (undefined :: NewsTeam)
       migrate (undefined :: News_NewsTeam)
+      migrate (undefined :: NewsLocation)
       migrate (undefined :: News_NewsLocation)
 
   dbimport message = do
@@ -245,7 +217,7 @@ instance DbImport Message where
     -- 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)
+    nt_ids <- mapM insert_or_select (xml_teams message)
 
     -- Now that the teams have been inserted, create
     -- news__news_team records mapping beween the two.
@@ -253,7 +225,7 @@ instance DbImport Message where
     mapM_ insert_ news_news_teams
 
     -- Do all of that over again for the NewsLocations.
-    loc_ids <- mapM insert_xml_or_select (xml_locations message)
+    loc_ids <- mapM insert_or_select (xml_locations message)
     let news_news_locations = map (News_NewsLocation news_id) loc_ids
     mapM_ insert_ news_news_locations
 
@@ -339,6 +311,7 @@ mkPersist tsn_codegen_config [groundhog|
             onDelete: cascade
 |]
 
+
 --
 -- XML Picklers
 --