]> gitweb.michael.orlitzky.com - dead/htsn-import.git/commitdiff
Replace the FromXml class with ToFromXml and add a method to it.
authorMichael Orlitzky <michael@orlitzky.com>
Tue, 31 Dec 2013 19:41:03 +0000 (14:41 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Tue, 31 Dec 2013 19:41:03 +0000 (14:41 -0500)
src/Xml.hs

index 21a806847ca1761845260f1a2d4f92344d07916d..dfb6d055ac0e297b94d42d92eff810e1464d42ec 100644 (file)
@@ -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