From: Michael Orlitzky Date: Tue, 21 Jan 2014 04:25:50 +0000 (-0500) Subject: Add XmlImportFk, a total copy of XmlImport for instances of FromXmlFk. This could... X-Git-Tag: 0.0.1~22 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=073446135216972a0af41df69e8d551860f1e770;p=dead%2Fhtsn-import.git Add XmlImportFk, a total copy of XmlImport for instances of FromXmlFk. This could probably use a redesign. --- diff --git a/src/TSN/XmlImport.hs b/src/TSN/XmlImport.hs index 022ddad..5693bd4 100644 --- a/src/TSN/XmlImport.hs +++ b/src/TSN/XmlImport.hs @@ -4,16 +4,19 @@ -- | Definition of the XmlImport class. -- module TSN.XmlImport ( - XmlImport(..) ) + XmlImport(..), + XmlImportFk(..) ) where import Database.Groundhog ( AutoKey, + DefaultKey, insert, + insert_, insertByAll ) import Database.Groundhog.Core ( PersistBackend, PersistEntity ) -import Xml ( FromXml(..) ) +import Xml ( FromXml(..), FromXmlFk(..), ToDb(..) ) -- | In Groundhog, there is a typeclass of things you can insert into @@ -35,13 +38,17 @@ class (FromXml a, PersistEntity (Db a)) => XmlImport a where -- function, except the 'AutoKey' we return is for our 'Db' -- counterpart. insert_xml :: (PersistBackend m) => a -> m (AutoKey (Db a)) - insert_xml x = insert (from_xml x) + insert_xml = insert . from_xml + + -- | Identical to 'insert_xml', except it doesn't return anything. + insert_xml_ :: (PersistBackend m) => a -> m () + insert_xml_ = insert_ . from_xml -- | Same rationale as 'insert_xml', except it uses 'insertByAll'. insertByAll_xml :: (PersistBackend m) => a -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) ) - insertByAll_xml x = insertByAll (from_xml x) + insertByAll_xml = insertByAll . from_xml -- | Try to insert the given object and get its primary key @@ -57,3 +64,31 @@ class (FromXml a, PersistEntity (Db a)) => XmlImport a where insert_xml_or_select x = do tmp <- insertByAll_xml x return $ (either id id) tmp + + + +-- | A total copy of 'XmlImport' for instances of 'FromXmlFk'. +-- +class (FromXmlFk a, PersistEntity (Db a)) => XmlImportFk a where + insert_xml_fk :: (PersistBackend m) + => DefaultKey (Parent a) + -> a + -> m (AutoKey (Db a)) + insert_xml_fk fk x = insert $ from_xml_fk fk x + + insert_xml_fk_ :: (PersistBackend m) => DefaultKey (Parent a) -> a -> m () + insert_xml_fk_ fk x = insert_ $ from_xml_fk fk x + + insertByAll_xml_fk :: (PersistBackend m) + => DefaultKey (Parent a) + -> a + -> m ( Either (AutoKey (Db a)) (AutoKey (Db a)) ) + insertByAll_xml_fk fk x = insertByAll $ from_xml_fk fk x + + insert_xml_or_select_fk :: (PersistBackend m) + => DefaultKey (Parent a) + -> a + -> m (AutoKey (Db a)) + insert_xml_or_select_fk fk x = do + tmp <- insertByAll_xml_fk fk x + return $ (either id id) tmp