From c5d61081ad0d95950ca06761978d240632c44510 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 21 Jan 2014 14:19:51 -0500 Subject: [PATCH] Add a new module, TSN.Database, and use it to clean up TSN.XML.News. --- htsn-import.cabal | 1 + src/TSN/Database.hs | 18 ++++++++++++++++ src/TSN/XML/News.hs | 51 +++++++++++---------------------------------- 3 files changed, 31 insertions(+), 39 deletions(-) create mode 100644 src/TSN/Database.hs 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 \ that contains an entire news item. +-- | Parse TSN XML for the DTD \"newsxml.dtd\". Each document contains +-- a root element \ 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 (\). -- 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 -- -- 2.43.2