From 073446135216972a0af41df69e8d551860f1e770 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Mon, 20 Jan 2014 23:25:50 -0500
Subject: [PATCH] Add XmlImportFk, a total copy of XmlImport for instances of
 FromXmlFk. This could probably use a redesign.

---
 src/TSN/XmlImport.hs | 43 +++++++++++++++++++++++++++++++++++++++----
 1 file changed, 39 insertions(+), 4 deletions(-)

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
-- 
2.43.2