From 0aaa57457c219ab35f37050a09a71889e3f38469 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Mon, 20 Jan 2014 15:38:06 -0500
Subject: [PATCH] Add the FromXmlFk class which allows us to construct database
 representations from XML ones.

---
 src/Xml.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/src/Xml.hs b/src/Xml.hs
index 3242dac..2e9c18b 100644
--- a/src/Xml.hs
+++ b/src/Xml.hs
@@ -5,6 +5,7 @@
 module Xml (
   DtdName(..),
   FromXml(..),
+  FromXmlFk(..),
   parse_opts,
   pickle_unpickle,
   unpickleable )
@@ -12,6 +13,7 @@ where
 
 -- System imports.
 import Control.Exception ( SomeException(..), catch )
+import Database.Groundhog.Core ( DefaultKey )
 import Text.XML.HXT.Core (
   (>>>),
   (/>),
@@ -47,6 +49,24 @@ class FromXml a where
   from_xml :: a -> Db a
 
 
+-- | Some database types cannot be constructed from the XML type
+--   alone; they must be supplied a foreign key to a parent object
+--   first. Members of this class can be converted from an XML
+--   representation to a database representation in this manner.
+--
+class FromXmlFk a where
+  -- | Each instance @a@ must declare its associated database type @DbFk a@.
+  type DbFk a :: *
+
+  -- | The type of our parent object, i.e. to the type to whom our
+  --   foreign key will point.
+  type Parent a :: *
+
+  -- | The function that produces a @DbFk a@ out of an @a@ and a foreign
+  --   key.
+  from_xml_fk :: a -> DefaultKey (Parent a) -> DbFk a
+
+
 -- | Represents the DTD filename (\"SYSTEM\") part of the DOCTYPE
 --   definition.
 newtype DtdName = DtdName String
-- 
2.43.2