]> gitweb.michael.orlitzky.com - dead/htsn-import.git/commitdiff
Add the FromXmlFk class which allows us to construct database representations from...
authorMichael Orlitzky <michael@orlitzky.com>
Mon, 20 Jan 2014 20:38:06 +0000 (15:38 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Mon, 20 Jan 2014 20:38:06 +0000 (15:38 -0500)
src/Xml.hs

index 3242dacd8b2a7a69c997acb527846dfaaeb0ff75..2e9c18bfad5fec0cd9599667c07ae7ed060aae0e 100644 (file)
@@ -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