X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FXml.hs;fp=src%2FXml.hs;h=dfb6d055ac0e297b94d42d92eff810e1464d42ec;hb=fee0cee55b87fd717b04d065b6f68162b6138a4a;hp=21a806847ca1761845260f1a2d4f92344d07916d;hpb=3ae2e92dc38fed748e135a32db6821467353efd8;p=dead%2Fhtsn-import.git

diff --git a/src/Xml.hs b/src/Xml.hs
index 21a8068..dfb6d05 100644
--- a/src/Xml.hs
+++ b/src/Xml.hs
@@ -3,11 +3,12 @@
 -- | General XML stuff.
 --
 module Xml (
-  FromXml(..),
+  ToFromXml(..),
   parse_opts,
   pickle_unpickle )
 where
 
+import Database.Groundhog ( AutoKey )
 import Text.XML.HXT.Core (
   (>>>),
   (/>),
@@ -39,13 +40,24 @@ import Text.XML.HXT.Core (
 --   Groundhog type from the XML one. But Groundhog won't use type family
 --   instances, so here we are.
 --
-class FromXml a where
+class ToFromXml a where
   -- | Each instance a must declare its associated XML type (Xml a)
   type Xml a :: *
+  type Container a :: *
 
   -- | And provide a function for getting an (Xml a) out of an "a."
   to_xml :: a -> Xml a
 
+  -- | And provide a function for getting an "a" out of an (Xml a).
+  from_xml :: Xml a -> a
+
+  -- | Often we need to provide a key to use as a foreign key into
+  --   some container. If the instance "belongs" to some other object,
+  --   then it might need to be passed a key before it can un-XML
+  --   itself. For example, the XML version of 'NewsTeam' doesn't
+  --   contain a message ID which is part of its database type.
+  from_xml_fk :: AutoKey (Container a) -> Xml a -> a
+  from_xml_fk _ = from_xml
 
 -- | A list of options passed to 'readDocument' when we parse an XML
 --   document. We don't validate because the DTDs from TSN are