diff --git a/COPYRIGHT b/COPYRIGHT
--- a/COPYRIGHT
+++ b/COPYRIGHT
@@ -1,5 +1,6 @@
 The HaXml library and tools were written by and are copyright to
-    (c) copyright 1998-2011    Malcolm Wallace and Colin Runciman
+    (c) copyright 1998-1999    Malcolm Wallace and Colin Runciman
+    (c) copyright 2000-2012    Malcolm Wallace
 
 The HaXml library is licensed under the terms of the GNU Lesser
 General Public Licence (LGPL), which can be found in the file called
diff --git a/HaXml.cabal b/HaXml.cabal
--- a/HaXml.cabal
+++ b/HaXml.cabal
@@ -1,5 +1,5 @@
 name:		HaXml
-version:	1.22.5
+version:	1.23
 license:	LGPL
 license-file:	COPYRIGHT
 author:		Malcolm Wallace <Malcolm.Wallace@me.com>
@@ -75,54 +75,63 @@
   else
     build-depends: base < 2 || >= 3, bytestring
   extensions: CPP, ExistentialQuantification
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   nhc98-options: -K10M
 
 Executable Canonicalise
   GHC-Options: -Wall
   Extensions:  CPP
   Hs-Source-Dirs: src/tools, src
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   Main-Is: Canonicalise.hs
 
 Executable CanonicaliseLazy
   GHC-Options: -Wall
   Extensions:  CPP
   Hs-Source-Dirs: src/tools, src
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   Main-Is: CanonicaliseLazy.hs
 
 Executable Xtract
   GHC-Options: -Wall
   Extensions:  CPP
   Hs-Source-Dirs: src/tools, src
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   Main-Is: Xtract.hs
 
 Executable Validate
   GHC-Options: -Wall
   Extensions:  CPP
   Hs-Source-Dirs: src/tools, src
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   Main-Is: Validate.hs
 
 Executable MkOneOf
   GHC-Options: -Wall
   Extensions:  CPP
   Hs-Source-Dirs: src/tools, src
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   Main-Is: MkOneOf.hs
 
 Executable DtdToHaskell
   GHC-Options: -Wall
   Extensions:  CPP
   Hs-Source-Dirs: src/tools, src
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   Main-Is: DtdToHaskell.hs
 
 Executable XsdToHaskell
   GHC-Options: -Wall
   Extensions:  CPP
   Hs-Source-Dirs: src/tools, src
-  cpp-options: -DMAJOR=1 -DMINOR=22
+  cpp-options: -DMAJOR=1 -DMINOR=23
   Main-Is: XsdToHaskell.hs
+
+Executable FpMLToHaskell
+  GHC-Options: -Wall
+  Extensions:  CPP
+  Hs-Source-Dirs: src/tools, src
+  cpp-options: -DMAJOR=1 -DMINOR=23
+  Main-Is: FpMLToHaskell.hs
+  build-depends: directory
+
diff --git a/src/Text/XML/HaXml/DtdToHaskell/Instance.hs b/src/Text/XML/HaXml/DtdToHaskell/Instance.hs
--- a/src/Text/XML/HaXml/DtdToHaskell/Instance.hs
+++ b/src/Text/XML/HaXml/DtdToHaskell/Instance.hs
@@ -23,7 +23,7 @@
     text "instance XmlContent" <+> ppHName n <+> text "where" $$
     nest 4 (
              text "toContents" <+> topatval <+> text "=" $$
-             nest 4 (text "[CElem (Elem \"" <> ppXName n <> text "\""
+             nest 4 (text "[CElem (Elem (N \"" <> ppXName n <> text "\")"
                           <+> toattr <+> text "[]) ()]")
            $$
              text "parseContents = do" $$
@@ -48,7 +48,7 @@
     text "instance XmlContent" <+> ppHName n <+> text "where" $$
     nest 4 (
              text "toContents" <+> parens (mkCpat n0 topat vs) <+> text "=" $$
-             nest 4 (text "[CElem (Elem \"" <> ppXName n <> text "\""
+             nest 4 (text "[CElem (Elem (N \"" <> ppXName n <> text "\")"
                           <+> toattr <+> parens (mkToElem sts vs)
                           <> text ") ()]")
            $$
@@ -131,7 +131,7 @@
 -- enumeration of attribute values
 mkInstance (EnumDef n es) =
     text "instance XmlAttrType" <+> ppHName n <+> text "where" $$
-    nest 4 ( text "fromAttrToTyp n (n',v)" $$
+    nest 4 ( text "fromAttrToTyp n (N n',v)" $$
              nest 4 (text "| n==n'     = translate (attr2str v)" $$
                      text "| otherwise = Nothing") $$
              nest 2 (text "where" <+> mkTranslate es)
@@ -289,7 +289,7 @@
 
 mkToAttr :: Name -> Doc
 mkToAttr n = text "toAttrFrTyp n" <+> ppHName n <+> text "=" <+>
-             text "Just (n, str2attr" <+> doubleQuotes (ppXName n) <> text ")"
+             text "Just (N n, str2attr" <+> doubleQuotes (ppXName n) <> text ")"
 
 mkFrFld :: Name -> (Name,StructType) -> Doc
 mkFrFld tag (n,st) =
@@ -392,6 +392,6 @@
     let vs = nameSupply sts
     in
     text "toContents" <+> parens (mkCpat n attrpat vs) <+> text "="
-    $$ nest 4 (text "[CElem (Elem \"" <> ppXName tag <> text "\""<+> attrexp
+    $$ nest 4 (text "[CElem (Elem (N \"" <> ppXName tag <> text "\")"<+> attrexp
               <+> parens (mkToElem sts vs) <+> text ") ()]")
 
diff --git a/src/Text/XML/HaXml/OneOfN.hs b/src/Text/XML/HaXml/OneOfN.hs
--- a/src/Text/XML/HaXml/OneOfN.hs
+++ b/src/Text/XML/HaXml/OneOfN.hs
@@ -2,6 +2,35 @@
 
 import Text.XML.HaXml.XmlContent
 
+-- | Somewhat of a nonsense - a choice of a single item.  But sometimes it
+--   occurs in auto-generated code.
+data OneOf1 a
+    = OneOf1 a
+    deriving (Eq,Show)
+
+instance (HTypeable a)
+    => HTypeable (OneOf1 a)
+  where      toHType _ = Defined "OneOf1" [] []
+  --         toHType m = Defined "OneOf1" [a] []
+  --            where a = toHType $ (\ (OneOf1 a)->a) $ m
+
+instance (XmlContent a)
+    => XmlContent (OneOf1 a)
+  where
+    parseContents =
+        (choice OneOf1
+        $ fail "OneOf1")
+    toContents (OneOf1 x) = toContents x
+
+foldOneOf1 :: (a->z) -> 
+               OneOf1 a
+               -> z
+foldOneOf1 a (OneOf1 z) = a z
+
+----
+
+-- | Equivalent to the Either type, but using the regular naming
+--   scheme of this module.
 data OneOf2 a b
     = OneOf2 a | TwoOf2 b
     deriving (Eq,Show)
@@ -13,7 +42,6 @@
   --            where a = toHType $ (\ (OneOf2 a)->a) $ m
   --                  b = toHType $ (\ (TwoOf2 b)->b) $ m
 
-
 instance (XmlContent a,XmlContent b)
     => XmlContent (OneOf2 a b)
   where
@@ -23,6 +51,12 @@
     toContents (OneOf2 x) = toContents x
     toContents (TwoOf2 x) = toContents x
 
+foldOneOf2 :: (a->z) -> (b->z) -> 
+               OneOf2 a b
+               -> z
+foldOneOf2 a b (OneOf2 z) = a z
+foldOneOf2 a b (TwoOf2 z) = b z
+
 ----
 data OneOf3 a b c
     = OneOf3 a | TwoOf3 b | ThreeOf3 c
@@ -42,6 +76,13 @@
     toContents (TwoOf3 x) = toContents x
     toContents (ThreeOf3 x) = toContents x
 
+foldOneOf3 :: (a->z) -> (b->z) -> (c->z) -> 
+               OneOf3 a b c
+               -> z
+foldOneOf3 a b c (OneOf3 z) = a z
+foldOneOf3 a b c (TwoOf3 z) = b z
+foldOneOf3 a b c (ThreeOf3 z) = c z
+
 ----
 data OneOf4 a b c d
     = OneOf4 a | TwoOf4 b | ThreeOf4 c | FourOf4 d
@@ -62,6 +103,14 @@
     toContents (ThreeOf4 x) = toContents x
     toContents (FourOf4 x) = toContents x
 
+foldOneOf4 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> 
+               OneOf4 a b c d
+               -> z
+foldOneOf4 a b c d (OneOf4 z) = a z
+foldOneOf4 a b c d (TwoOf4 z) = b z
+foldOneOf4 a b c d (ThreeOf4 z) = c z
+foldOneOf4 a b c d (FourOf4 z) = d z
+
 ----
 data OneOf5 a b c d e
     = OneOf5 a | TwoOf5 b | ThreeOf5 c | FourOf5 d | FiveOf5 e
@@ -84,18 +133,27 @@
     toContents (FourOf5 x) = toContents x
     toContents (FiveOf5 x) = toContents x
 
+foldOneOf5 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> 
+               OneOf5 a b c d e
+               -> z
+foldOneOf5 a b c d e (OneOf5 z) = a z
+foldOneOf5 a b c d e (TwoOf5 z) = b z
+foldOneOf5 a b c d e (ThreeOf5 z) = c z
+foldOneOf5 a b c d e (FourOf5 z) = d z
+foldOneOf5 a b c d e (FiveOf5 z) = e z
+
 ----
 data OneOf6 a b c d e f
     = OneOf6 a | TwoOf6 b | ThreeOf6 c | FourOf6 d | FiveOf6 e | SixOf6 f
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f)
+         ,HTypeable f)
     => HTypeable (OneOf6 a b c d e f)
   where      toHType _ = Defined "OneOf6" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f)
+         ,XmlContent f)
     => XmlContent (OneOf6 a b c d e f)
   where
     parseContents =
@@ -109,6 +167,16 @@
     toContents (FiveOf6 x) = toContents x
     toContents (SixOf6 x) = toContents x
 
+foldOneOf6 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               OneOf6 a b c d e f
+               -> z
+foldOneOf6 a b c d e f (OneOf6 z) = a z
+foldOneOf6 a b c d e f (TwoOf6 z) = b z
+foldOneOf6 a b c d e f (ThreeOf6 z) = c z
+foldOneOf6 a b c d e f (FourOf6 z) = d z
+foldOneOf6 a b c d e f (FiveOf6 z) = e z
+foldOneOf6 a b c d e f (SixOf6 z) = f z
+
 ----
 data OneOf7 a b c d e f g
     = OneOf7 a | TwoOf7 b | ThreeOf7 c | FourOf7 d | FiveOf7 e | SixOf7 f
@@ -116,12 +184,12 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g)
+         ,HTypeable f,HTypeable g)
     => HTypeable (OneOf7 a b c d e f g)
   where      toHType _ = Defined "OneOf7" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g)
+         ,XmlContent f,XmlContent g)
     => XmlContent (OneOf7 a b c d e f g)
   where
     parseContents =
@@ -136,6 +204,18 @@
     toContents (SixOf7 x) = toContents x
     toContents (SevenOf7 x) = toContents x
 
+foldOneOf7 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> 
+               OneOf7 a b c d e f g
+               -> z
+foldOneOf7 a b c d e f g (OneOf7 z) = a z
+foldOneOf7 a b c d e f g (TwoOf7 z) = b z
+foldOneOf7 a b c d e f g (ThreeOf7 z) = c z
+foldOneOf7 a b c d e f g (FourOf7 z) = d z
+foldOneOf7 a b c d e f g (FiveOf7 z) = e z
+foldOneOf7 a b c d e f g (SixOf7 z) = f z
+foldOneOf7 a b c d e f g (SevenOf7 z) = g z
+
 ----
 data OneOf8 a b c d e f g h
     = OneOf8 a | TwoOf8 b | ThreeOf8 c | FourOf8 d | FiveOf8 e | SixOf8 f
@@ -143,12 +223,12 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h)
+         ,HTypeable f,HTypeable g,HTypeable h)
     => HTypeable (OneOf8 a b c d e f g h)
   where      toHType _ = Defined "OneOf8" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h)
+         ,XmlContent f,XmlContent g,XmlContent h)
     => XmlContent (OneOf8 a b c d e f g h)
   where
     parseContents =
@@ -164,6 +244,19 @@
     toContents (SevenOf8 x) = toContents x
     toContents (EightOf8 x) = toContents x
 
+foldOneOf8 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> 
+               OneOf8 a b c d e f g h
+               -> z
+foldOneOf8 a b c d e f g h (OneOf8 z) = a z
+foldOneOf8 a b c d e f g h (TwoOf8 z) = b z
+foldOneOf8 a b c d e f g h (ThreeOf8 z) = c z
+foldOneOf8 a b c d e f g h (FourOf8 z) = d z
+foldOneOf8 a b c d e f g h (FiveOf8 z) = e z
+foldOneOf8 a b c d e f g h (SixOf8 z) = f z
+foldOneOf8 a b c d e f g h (SevenOf8 z) = g z
+foldOneOf8 a b c d e f g h (EightOf8 z) = h z
+
 ----
 data OneOf9 a b c d e f g h i
     = OneOf9 a | TwoOf9 b | ThreeOf9 c | FourOf9 d | FiveOf9 e | SixOf9 f
@@ -171,12 +264,12 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i)
     => HTypeable (OneOf9 a b c d e f g h i)
   where      toHType _ = Defined "OneOf9" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i)
     => XmlContent (OneOf9 a b c d e f g h i)
   where
     parseContents =
@@ -194,6 +287,20 @@
     toContents (EightOf9 x) = toContents x
     toContents (NineOf9 x) = toContents x
 
+foldOneOf9 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> 
+               OneOf9 a b c d e f g h i
+               -> z
+foldOneOf9 a b c d e f g h i (OneOf9 z) = a z
+foldOneOf9 a b c d e f g h i (TwoOf9 z) = b z
+foldOneOf9 a b c d e f g h i (ThreeOf9 z) = c z
+foldOneOf9 a b c d e f g h i (FourOf9 z) = d z
+foldOneOf9 a b c d e f g h i (FiveOf9 z) = e z
+foldOneOf9 a b c d e f g h i (SixOf9 z) = f z
+foldOneOf9 a b c d e f g h i (SevenOf9 z) = g z
+foldOneOf9 a b c d e f g h i (EightOf9 z) = h z
+foldOneOf9 a b c d e f g h i (NineOf9 z) = i z
+
 ----
 data OneOf10 a b c d e f g h i j
     = OneOf10 a | TwoOf10 b | ThreeOf10 c | FourOf10 d | FiveOf10 e
@@ -201,12 +308,12 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j)
     => HTypeable (OneOf10 a b c d e f g h i j)
   where      toHType _ = Defined "OneOf10" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j)
     => XmlContent (OneOf10 a b c d e f g h i j)
   where
     parseContents =
@@ -225,6 +332,21 @@
     toContents (NineOf10 x) = toContents x
     toContents (TenOf10 x) = toContents x
 
+foldOneOf10 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> 
+               OneOf10 a b c d e f g h i j
+               -> z
+foldOneOf10 a b c d e f g h i j (OneOf10 z) = a z
+foldOneOf10 a b c d e f g h i j (TwoOf10 z) = b z
+foldOneOf10 a b c d e f g h i j (ThreeOf10 z) = c z
+foldOneOf10 a b c d e f g h i j (FourOf10 z) = d z
+foldOneOf10 a b c d e f g h i j (FiveOf10 z) = e z
+foldOneOf10 a b c d e f g h i j (SixOf10 z) = f z
+foldOneOf10 a b c d e f g h i j (SevenOf10 z) = g z
+foldOneOf10 a b c d e f g h i j (EightOf10 z) = h z
+foldOneOf10 a b c d e f g h i j (NineOf10 z) = i z
+foldOneOf10 a b c d e f g h i j (TenOf10 z) = j z
+
 ----
 data OneOf11 a b c d e f g h i j k
     = OneOf11 a | TwoOf11 b | ThreeOf11 c | FourOf11 d | FiveOf11 e
@@ -233,14 +355,14 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k)
     => HTypeable (OneOf11 a b c d e f g h i j k)
   where      toHType _ = Defined "OneOf11" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k)
     => XmlContent (OneOf11 a b c d e f g h i j k)
   where
     parseContents =
@@ -261,6 +383,22 @@
     toContents (TenOf11 x) = toContents x
     toContents (ElevenOf11 x) = toContents x
 
+foldOneOf11 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> 
+               OneOf11 a b c d e f g h i j k
+               -> z
+foldOneOf11 a b c d e f g h i j k (OneOf11 z) = a z
+foldOneOf11 a b c d e f g h i j k (TwoOf11 z) = b z
+foldOneOf11 a b c d e f g h i j k (ThreeOf11 z) = c z
+foldOneOf11 a b c d e f g h i j k (FourOf11 z) = d z
+foldOneOf11 a b c d e f g h i j k (FiveOf11 z) = e z
+foldOneOf11 a b c d e f g h i j k (SixOf11 z) = f z
+foldOneOf11 a b c d e f g h i j k (SevenOf11 z) = g z
+foldOneOf11 a b c d e f g h i j k (EightOf11 z) = h z
+foldOneOf11 a b c d e f g h i j k (NineOf11 z) = i z
+foldOneOf11 a b c d e f g h i j k (TenOf11 z) = j z
+foldOneOf11 a b c d e f g h i j k (ElevenOf11 z) = k z
+
 ----
 data OneOf12 a b c d e f g h i j k l
     = OneOf12 a | TwoOf12 b | ThreeOf12 c | FourOf12 d | FiveOf12 e
@@ -269,14 +407,14 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l)
     => HTypeable (OneOf12 a b c d e f g h i j k l)
   where      toHType _ = Defined "OneOf12" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l)
     => XmlContent (OneOf12 a b c d e f g h i j k l)
   where
     parseContents =
@@ -298,6 +436,23 @@
     toContents (ElevenOf12 x) = toContents x
     toContents (TwelveOf12 x) = toContents x
 
+foldOneOf12 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               OneOf12 a b c d e f g h i j k l
+               -> z
+foldOneOf12 a b c d e f g h i j k l (OneOf12 z) = a z
+foldOneOf12 a b c d e f g h i j k l (TwoOf12 z) = b z
+foldOneOf12 a b c d e f g h i j k l (ThreeOf12 z) = c z
+foldOneOf12 a b c d e f g h i j k l (FourOf12 z) = d z
+foldOneOf12 a b c d e f g h i j k l (FiveOf12 z) = e z
+foldOneOf12 a b c d e f g h i j k l (SixOf12 z) = f z
+foldOneOf12 a b c d e f g h i j k l (SevenOf12 z) = g z
+foldOneOf12 a b c d e f g h i j k l (EightOf12 z) = h z
+foldOneOf12 a b c d e f g h i j k l (NineOf12 z) = i z
+foldOneOf12 a b c d e f g h i j k l (TenOf12 z) = j z
+foldOneOf12 a b c d e f g h i j k l (ElevenOf12 z) = k z
+foldOneOf12 a b c d e f g h i j k l (TwelveOf12 z) = l z
+
 ----
 data OneOf13 a b c d e f g h i j k l m
     = OneOf13 a | TwoOf13 b | ThreeOf13 c | FourOf13 d | FiveOf13 e
@@ -306,14 +461,14 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m)
     => HTypeable (OneOf13 a b c d e f g h i j k l m)
   where      toHType _ = Defined "OneOf13" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m)
     => XmlContent (OneOf13 a b c d e f g h i j k l m)
   where
     parseContents =
@@ -336,6 +491,25 @@
     toContents (TwelveOf13 x) = toContents x
     toContents (ThirteenOf13 x) = toContents x
 
+foldOneOf13 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> 
+               OneOf13 a b c d e f g h i j k l m
+               -> z
+foldOneOf13 a b c d e f g h i j k l m (OneOf13 z) = a z
+foldOneOf13 a b c d e f g h i j k l m (TwoOf13 z) = b z
+foldOneOf13 a b c d e f g h i j k l m (ThreeOf13 z) = c z
+foldOneOf13 a b c d e f g h i j k l m (FourOf13 z) = d z
+foldOneOf13 a b c d e f g h i j k l m (FiveOf13 z) = e z
+foldOneOf13 a b c d e f g h i j k l m (SixOf13 z) = f z
+foldOneOf13 a b c d e f g h i j k l m (SevenOf13 z) = g z
+foldOneOf13 a b c d e f g h i j k l m (EightOf13 z) = h z
+foldOneOf13 a b c d e f g h i j k l m (NineOf13 z) = i z
+foldOneOf13 a b c d e f g h i j k l m (TenOf13 z) = j z
+foldOneOf13 a b c d e f g h i j k l m (ElevenOf13 z) = k z
+foldOneOf13 a b c d e f g h i j k l m (TwelveOf13 z) = l z
+foldOneOf13 a b c d e f g h i j k l m (ThirteenOf13 z) = m z
+
 ----
 data OneOf14 a b c d e f g h i j k l m n
     = OneOf14 a | TwoOf14 b | ThreeOf14 c | FourOf14 d | FiveOf14 e
@@ -344,14 +518,14 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m,HTypeable n)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m,HTypeable n)
     => HTypeable (OneOf14 a b c d e f g h i j k l m n)
   where      toHType _ = Defined "OneOf14" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m,XmlContent n)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m,XmlContent n)
     => XmlContent (OneOf14 a b c d e f g h i j k l m n)
   where
     parseContents =
@@ -376,6 +550,26 @@
     toContents (ThirteenOf14 x) = toContents x
     toContents (FourteenOf14 x) = toContents x
 
+foldOneOf14 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> (n->z) -> 
+               OneOf14 a b c d e f g h i j k l m n
+               -> z
+foldOneOf14 a b c d e f g h i j k l m n (OneOf14 z) = a z
+foldOneOf14 a b c d e f g h i j k l m n (TwoOf14 z) = b z
+foldOneOf14 a b c d e f g h i j k l m n (ThreeOf14 z) = c z
+foldOneOf14 a b c d e f g h i j k l m n (FourOf14 z) = d z
+foldOneOf14 a b c d e f g h i j k l m n (FiveOf14 z) = e z
+foldOneOf14 a b c d e f g h i j k l m n (SixOf14 z) = f z
+foldOneOf14 a b c d e f g h i j k l m n (SevenOf14 z) = g z
+foldOneOf14 a b c d e f g h i j k l m n (EightOf14 z) = h z
+foldOneOf14 a b c d e f g h i j k l m n (NineOf14 z) = i z
+foldOneOf14 a b c d e f g h i j k l m n (TenOf14 z) = j z
+foldOneOf14 a b c d e f g h i j k l m n (ElevenOf14 z) = k z
+foldOneOf14 a b c d e f g h i j k l m n (TwelveOf14 z) = l z
+foldOneOf14 a b c d e f g h i j k l m n (ThirteenOf14 z) = m z
+foldOneOf14 a b c d e f g h i j k l m n (FourteenOf14 z) = n z
+
 ----
 data OneOf15 a b c d e f g h i j k l m n o
     = OneOf15 a | TwoOf15 b | ThreeOf15 c | FourOf15 d | FiveOf15 e
@@ -385,14 +579,14 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o)
     => HTypeable (OneOf15 a b c d e f g h i j k l m n o)
   where      toHType _ = Defined "OneOf15" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o)
     => XmlContent (OneOf15 a b c d e f g h i j k l m n o)
   where
     parseContents =
@@ -418,6 +612,27 @@
     toContents (FourteenOf15 x) = toContents x
     toContents (FifteenOf15 x) = toContents x
 
+foldOneOf15 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> (n->z) -> (o->z) -> 
+               OneOf15 a b c d e f g h i j k l m n o
+               -> z
+foldOneOf15 a b c d e f g h i j k l m n o (OneOf15 z) = a z
+foldOneOf15 a b c d e f g h i j k l m n o (TwoOf15 z) = b z
+foldOneOf15 a b c d e f g h i j k l m n o (ThreeOf15 z) = c z
+foldOneOf15 a b c d e f g h i j k l m n o (FourOf15 z) = d z
+foldOneOf15 a b c d e f g h i j k l m n o (FiveOf15 z) = e z
+foldOneOf15 a b c d e f g h i j k l m n o (SixOf15 z) = f z
+foldOneOf15 a b c d e f g h i j k l m n o (SevenOf15 z) = g z
+foldOneOf15 a b c d e f g h i j k l m n o (EightOf15 z) = h z
+foldOneOf15 a b c d e f g h i j k l m n o (NineOf15 z) = i z
+foldOneOf15 a b c d e f g h i j k l m n o (TenOf15 z) = j z
+foldOneOf15 a b c d e f g h i j k l m n o (ElevenOf15 z) = k z
+foldOneOf15 a b c d e f g h i j k l m n o (TwelveOf15 z) = l z
+foldOneOf15 a b c d e f g h i j k l m n o (ThirteenOf15 z) = m z
+foldOneOf15 a b c d e f g h i j k l m n o (FourteenOf15 z) = n z
+foldOneOf15 a b c d e f g h i j k l m n o (FifteenOf15 z) = o z
+
 ----
 data OneOf16 a b c d e f g h i j k l m n o p
     = OneOf16 a | TwoOf16 b | ThreeOf16 c | FourOf16 d | FiveOf16 e
@@ -427,16 +642,16 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
-          ,HTypeable p)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
+         ,HTypeable p)
     => HTypeable (OneOf16 a b c d e f g h i j k l m n o p)
   where      toHType _ = Defined "OneOf16" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
-          ,XmlContent p)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
+         ,XmlContent p)
     => XmlContent (OneOf16 a b c d e f g h i j k l m n o p)
   where
     parseContents =
@@ -463,6 +678,28 @@
     toContents (FifteenOf16 x) = toContents x
     toContents (SixteenOf16 x) = toContents x
 
+foldOneOf16 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> (n->z) -> (o->z) -> (p->z) -> 
+               OneOf16 a b c d e f g h i j k l m n o p
+               -> z
+foldOneOf16 a b c d e f g h i j k l m n o p (OneOf16 z) = a z
+foldOneOf16 a b c d e f g h i j k l m n o p (TwoOf16 z) = b z
+foldOneOf16 a b c d e f g h i j k l m n o p (ThreeOf16 z) = c z
+foldOneOf16 a b c d e f g h i j k l m n o p (FourOf16 z) = d z
+foldOneOf16 a b c d e f g h i j k l m n o p (FiveOf16 z) = e z
+foldOneOf16 a b c d e f g h i j k l m n o p (SixOf16 z) = f z
+foldOneOf16 a b c d e f g h i j k l m n o p (SevenOf16 z) = g z
+foldOneOf16 a b c d e f g h i j k l m n o p (EightOf16 z) = h z
+foldOneOf16 a b c d e f g h i j k l m n o p (NineOf16 z) = i z
+foldOneOf16 a b c d e f g h i j k l m n o p (TenOf16 z) = j z
+foldOneOf16 a b c d e f g h i j k l m n o p (ElevenOf16 z) = k z
+foldOneOf16 a b c d e f g h i j k l m n o p (TwelveOf16 z) = l z
+foldOneOf16 a b c d e f g h i j k l m n o p (ThirteenOf16 z) = m z
+foldOneOf16 a b c d e f g h i j k l m n o p (FourteenOf16 z) = n z
+foldOneOf16 a b c d e f g h i j k l m n o p (FifteenOf16 z) = o z
+foldOneOf16 a b c d e f g h i j k l m n o p (SixteenOf16 z) = p z
+
 ----
 data OneOf17 a b c d e f g h i j k l m n o p q
     = OneOf17 a | TwoOf17 b | ThreeOf17 c | FourOf17 d | FiveOf17 e
@@ -472,16 +709,16 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
-          ,HTypeable p,HTypeable q)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
+         ,HTypeable p,HTypeable q)
     => HTypeable (OneOf17 a b c d e f g h i j k l m n o p q)
   where      toHType _ = Defined "OneOf17" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
-          ,XmlContent p,XmlContent q)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
+         ,XmlContent p,XmlContent q)
     => XmlContent (OneOf17 a b c d e f g h i j k l m n o p q)
   where
     parseContents =
@@ -510,6 +747,29 @@
     toContents (SixteenOf17 x) = toContents x
     toContents (SeventeenOf17 x) = toContents x
 
+foldOneOf17 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> (n->z) -> (o->z) -> (p->z) -> (q->z) -> 
+               OneOf17 a b c d e f g h i j k l m n o p q
+               -> z
+foldOneOf17 a b c d e f g h i j k l m n o p q (OneOf17 z) = a z
+foldOneOf17 a b c d e f g h i j k l m n o p q (TwoOf17 z) = b z
+foldOneOf17 a b c d e f g h i j k l m n o p q (ThreeOf17 z) = c z
+foldOneOf17 a b c d e f g h i j k l m n o p q (FourOf17 z) = d z
+foldOneOf17 a b c d e f g h i j k l m n o p q (FiveOf17 z) = e z
+foldOneOf17 a b c d e f g h i j k l m n o p q (SixOf17 z) = f z
+foldOneOf17 a b c d e f g h i j k l m n o p q (SevenOf17 z) = g z
+foldOneOf17 a b c d e f g h i j k l m n o p q (EightOf17 z) = h z
+foldOneOf17 a b c d e f g h i j k l m n o p q (NineOf17 z) = i z
+foldOneOf17 a b c d e f g h i j k l m n o p q (TenOf17 z) = j z
+foldOneOf17 a b c d e f g h i j k l m n o p q (ElevenOf17 z) = k z
+foldOneOf17 a b c d e f g h i j k l m n o p q (TwelveOf17 z) = l z
+foldOneOf17 a b c d e f g h i j k l m n o p q (ThirteenOf17 z) = m z
+foldOneOf17 a b c d e f g h i j k l m n o p q (FourteenOf17 z) = n z
+foldOneOf17 a b c d e f g h i j k l m n o p q (FifteenOf17 z) = o z
+foldOneOf17 a b c d e f g h i j k l m n o p q (SixteenOf17 z) = p z
+foldOneOf17 a b c d e f g h i j k l m n o p q (SeventeenOf17 z) = q z
+
 ----
 data OneOf18 a b c d e f g h i j k l m n o p q r
     = OneOf18 a | TwoOf18 b | ThreeOf18 c | FourOf18 d | FiveOf18 e
@@ -519,16 +779,16 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
-          ,HTypeable p,HTypeable q,HTypeable r)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
+         ,HTypeable p,HTypeable q,HTypeable r)
     => HTypeable (OneOf18 a b c d e f g h i j k l m n o p q r)
   where      toHType _ = Defined "OneOf18" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
-          ,XmlContent p,XmlContent q,XmlContent r)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
+         ,XmlContent p,XmlContent q,XmlContent r)
     => XmlContent (OneOf18 a b c d e f g h i j k l m n o p q r)
   where
     parseContents =
@@ -558,6 +818,30 @@
     toContents (SeventeenOf18 x) = toContents x
     toContents (EighteenOf18 x) = toContents x
 
+foldOneOf18 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> (n->z) -> (o->z) -> (p->z) -> (q->z) -> (r->z) -> 
+               OneOf18 a b c d e f g h i j k l m n o p q r
+               -> z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (OneOf18 z) = a z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (TwoOf18 z) = b z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (ThreeOf18 z) = c z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (FourOf18 z) = d z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (FiveOf18 z) = e z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (SixOf18 z) = f z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (SevenOf18 z) = g z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (EightOf18 z) = h z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (NineOf18 z) = i z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (TenOf18 z) = j z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (ElevenOf18 z) = k z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (TwelveOf18 z) = l z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (ThirteenOf18 z) = m z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (FourteenOf18 z) = n z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (FifteenOf18 z) = o z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (SixteenOf18 z) = p z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (SeventeenOf18 z) = q z
+foldOneOf18 a b c d e f g h i j k l m n o p q r (EighteenOf18 z) = r z
+
 ----
 data OneOf19 a b c d e f g h i j k l m n o p q r s
     = OneOf19 a | TwoOf19 b | ThreeOf19 c | FourOf19 d | FiveOf19 e
@@ -568,16 +852,16 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
-          ,HTypeable p,HTypeable q,HTypeable r,HTypeable s)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
+         ,HTypeable p,HTypeable q,HTypeable r,HTypeable s)
     => HTypeable (OneOf19 a b c d e f g h i j k l m n o p q r s)
   where      toHType _ = Defined "OneOf19" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
-          ,XmlContent p,XmlContent q,XmlContent r,XmlContent s)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
+         ,XmlContent p,XmlContent q,XmlContent r,XmlContent s)
     => XmlContent (OneOf19 a b c d e f g h i j k l m n o p q r s)
   where
     parseContents =
@@ -608,6 +892,32 @@
     toContents (EighteenOf19 x) = toContents x
     toContents (NineteenOf19 x) = toContents x
 
+foldOneOf19 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> (n->z) -> (o->z) -> (p->z) -> (q->z) -> (r->z) -> 
+               (s->z) -> 
+               OneOf19 a b c d e f g h i j k l m n o p q r s
+               -> z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (OneOf19 z) = a z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (TwoOf19 z) = b z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (ThreeOf19 z) = c z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (FourOf19 z) = d z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (FiveOf19 z) = e z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (SixOf19 z) = f z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (SevenOf19 z) = g z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (EightOf19 z) = h z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (NineOf19 z) = i z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (TenOf19 z) = j z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (ElevenOf19 z) = k z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (TwelveOf19 z) = l z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (ThirteenOf19 z) = m z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (FourteenOf19 z) = n z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (FifteenOf19 z) = o z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (SixteenOf19 z) = p z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (SeventeenOf19 z) = q z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (EighteenOf19 z) = r z
+foldOneOf19 a b c d e f g h i j k l m n o p q r s (NineteenOf19 z) = s z
+
 ----
 data OneOf20 a b c d e f g h i j k l m n o p q r s t
     = OneOf20 a | TwoOf20 b | ThreeOf20 c | FourOf20 d | FiveOf20 e
@@ -618,16 +928,16 @@
     deriving (Eq,Show)
 
 instance (HTypeable a,HTypeable b,HTypeable c,HTypeable d,HTypeable e
-          ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
-          ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
-          ,HTypeable p,HTypeable q,HTypeable r,HTypeable s,HTypeable t)
+         ,HTypeable f,HTypeable g,HTypeable h,HTypeable i,HTypeable j
+         ,HTypeable k,HTypeable l,HTypeable m,HTypeable n,HTypeable o
+         ,HTypeable p,HTypeable q,HTypeable r,HTypeable s,HTypeable t)
     => HTypeable (OneOf20 a b c d e f g h i j k l m n o p q r s t)
   where      toHType _ = Defined "OneOf20" [] []
 
 instance (XmlContent a,XmlContent b,XmlContent c,XmlContent d,XmlContent e
-          ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
-          ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
-          ,XmlContent p,XmlContent q,XmlContent r,XmlContent s,XmlContent t)
+         ,XmlContent f,XmlContent g,XmlContent h,XmlContent i,XmlContent j
+         ,XmlContent k,XmlContent l,XmlContent m,XmlContent n,XmlContent o
+         ,XmlContent p,XmlContent q,XmlContent r,XmlContent s,XmlContent t)
     => XmlContent (OneOf20 a b c d e f g h i j k l m n o p q r s t)
   where
     parseContents =
@@ -659,5 +969,52 @@
     toContents (EighteenOf20 x) = toContents x
     toContents (NineteenOf20 x) = toContents x
     toContents (TwentyOf20 x) = toContents x
+
+foldOneOf20 :: (a->z) -> (b->z) -> (c->z) -> (d->z) -> (e->z) -> (f->z) -> 
+               (g->z) -> (h->z) -> (i->z) -> (j->z) -> (k->z) -> (l->z) -> 
+               (m->z) -> (n->z) -> (o->z) -> (p->z) -> (q->z) -> (r->z) -> 
+               (s->z) -> (t->z) -> 
+               OneOf20 a b c d e f g h i j k l m n o p q r s t
+               -> z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (OneOf20 z) = a z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (TwoOf20 z) = b z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (ThreeOf20 z) = c z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (FourOf20 z) = d z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (FiveOf20 z) = e z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (SixOf20 z) = f z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (SevenOf20 z) = g z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (EightOf20 z) = h z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (NineOf20 z) = i z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (TenOf20 z) = j z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (ElevenOf20 z) = k z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (TwelveOf20 z) = l z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (ThirteenOf20 z) = m z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (FourteenOf20 z) = n z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (FifteenOf20 z) = o z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (SixteenOf20 z) = p z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (SeventeenOf20 z) = q z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (EighteenOf20 z) = r z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (NineteenOf20 z) = s z
+foldOneOf20 a b c d e f g h i j k l m n o p q r s
+            t (TwentyOf20 z) = t z
 
 ----
diff --git a/src/Text/XML/HaXml/Schema/Environment.hs b/src/Text/XML/HaXml/Schema/Environment.hs
--- a/src/Text/XML/HaXml/Schema/Environment.hs
+++ b/src/Text/XML/HaXml/Schema/Environment.hs
@@ -33,8 +33,20 @@
 -- types, we need to be able to lift them out to the top-level, then
 -- refer to them by name only at the nested position(?)
 
+-- When dealing with sub/supertype relationships, we often need to know all
+-- of the subtypes of a supertype before some of the subtypes are actually
+-- available in scope.  The environment must therefore first be closed
+-- over all modules: the resulting type mapping (env_type) should be _copied_
+-- across to (env_allTypes) in a fresh initial environment, which latter is
+-- then used to rebuild the local scope from scratch.
+-- Likewise, the mappings from supertype->subtype (env_extendty) and for
+-- substitution groups (env_substGrp) also need to be global.
+
 data Environment =  Environment
     { env_type      :: Map QName (Either SimpleType ComplexType)
+                                 -- ^ type definitions in scope
+    , env_allTypes  :: Map QName (Either SimpleType ComplexType)
+                                 -- ^ all type definitions, regardless of scope
     , env_element   :: Map QName ElementDecl
     , env_attribute :: Map QName AttributeDecl
     , env_group     :: Map QName Group
@@ -48,12 +60,13 @@
 -- | An empty environment of XSD type mappings.
 emptyEnv :: Environment
 emptyEnv = Environment Map.empty Map.empty Map.empty Map.empty Map.empty
-                       Map.empty Map.empty Map.empty Map.empty
+                       Map.empty Map.empty Map.empty Map.empty Map.empty
 
 -- | Combine two environments (e.g. read from different interface files)
 combineEnv :: Environment -> Environment -> Environment
 combineEnv e1 e0 = Environment
     { env_type      = Map.union (env_type e1)      (env_type e0)
+    , env_allTypes  = Map.union (env_allTypes e1)  (env_allTypes e0)
     , env_element   = Map.union (env_element e1)   (env_element e0)
     , env_attribute = Map.union (env_attribute e1) (env_attribute e0)
     , env_group     = Map.union (env_group e1)     (env_group e0)
@@ -107,6 +120,13 @@
                                                [(mkN n, fp)]
                                                (env_extendty env)})
                      (isExtn (complex_content c))
+              $ (if complex_abstract c then \env->
+              -- because an abstract type might have no concrete instantiations!
+                        env{env_extendty = Map.insertWith (++)
+                                               (mkN n)
+                                               []
+                                               (env_extendty env)}
+                 else id)
               $ env{env_type=Map.insert (mkN n) (Right c) (env_type env)
                    ,env_typeloc=Map.insert (mkN n) fp (env_typeloc env)}
           where isExtn x@SimpleContent{}  = ci_stuff x
diff --git a/src/Text/XML/HaXml/Schema/HaskellTypeModel.hs b/src/Text/XML/HaXml/Schema/HaskellTypeModel.hs
--- a/src/Text/XML/HaXml/Schema/HaskellTypeModel.hs
+++ b/src/Text/XML/HaXml/Schema/HaskellTypeModel.hs
@@ -11,7 +11,7 @@
 import Data.List (partition)
 
 -- | Comments can be attached to most things, but not all of them will exist.
-type Comment = Maybe String
+type Comment   = Maybe String
 
 -- | The whole Haskell module.
 data Module    = Module
@@ -22,26 +22,6 @@
                  , module_decls       :: [Decl]  -- the body of the module
                  }
 
-mkModule :: String -> Schema -> [Decl] -> Module
-mkModule name schema decls =
-                      Module { module_name        = XName $ N name
-                             , module_xsd_ns      = xsdQualification
-                                                      (schema_namespaces schema)
-                             , module_re_exports  = reexports
-                             , module_import_only = imports
-                             , module_decls       = theRest
-                             }
-    where (reexports,other)   = partition xsdinclude decls
-          (imports,  theRest) = partition xsdimport  other
-          xsdinclude (XSDInclude _ _)  = True
-          xsdinclude _                 = False
-          xsdimport  (XSDImport _ _ _) = True
-          xsdimport  _                 = False
-          xsdQualification nss = fmap (XName . N . nsPrefix) $
-                                      lookupBy ((==xsd).nsURI) nss
-              where xsd = "http://www.w3.org/2001/XMLSchema"
-
-
 -- | There are essentially simple types, and complex types, each of which
 --   can be either restricted or extended.  There are four kinds of complex
 --   type: choices, sequences, named groups, or a simple element with content.
@@ -78,6 +58,16 @@
                  --         data FwdC = FwdC -- because C is not yet in scope
                  --         instance FwdDecl FwdC C  -- later, at defn of C
                  --
+                 -- In fact, it is better to move the declaration of type C
+                 -- here, rather than use a FwdDecl proxy.  This will require
+                 -- some patching later where C was originally declared.
+                 --         data T = T_A  A
+                 --                | T_B  B
+                 --                | T_C  C -- but C not yet declared
+                 --                | ...
+                 --         data C = ... -- because C is not yet in scope
+                 --         -- later, at true defn site of C, omit its decl.
+                 --
                  -- An earlier solution was
                  --         class T a where parseT :: String -> XMLParser a
                  --         instance T A
@@ -85,7 +75,10 @@
                  --         instance T C
                  -- but this is incorrect because the choice between A|B|C
                  -- rests with the input doc, not with the caller of the parser.
-               | ElementsAttrsAbstract XName [(XName,Maybe XName)] Comment
+               | ElementsAttrsAbstract {-typename-}XName
+                                       {-subtypes-}[(XName,Maybe XName)]
+                                 -- ^ [(type name, module where declared later)]
+                                       Comment
 
                  -- becomes function
                  --    elementE :: Parser T
@@ -128,10 +121,11 @@
                  -- or when T is itself abstract, extending an abstract type S
                  --        class T a where parseT :: String -> XMLParser a
                  --        instance (T a) => S a where parseS = parseT
-               | ExtendComplexTypeAbstract XName XName [(XName,Maybe XName)]
-                                           {-FwdDecl instnc req'd-}(Maybe XName)
-                                           {-grandsupertypes-}[XName]
-                                           Comment
+               | ExtendComplexTypeAbstract XName XName
+                                       {-subtypes-}[(XName,Maybe XName)]
+                                       {-FwdDecl instnc req'd-}(Maybe XName)
+                                       {-grandsupertypes-}[XName]
+                                       Comment
 
                  -- becomes an import and re-export
                | XSDInclude XName Comment
@@ -161,6 +155,7 @@
                  deriving (Eq,Show)
 data Attribute = Attribute { attr_name    :: XName
                            , attr_type    :: XName
+                           , attr_required:: Bool
                            , attr_comment :: Comment
                            }
                  deriving (Eq,Show)
@@ -176,4 +171,25 @@
                | Enumeration [(String,Comment)]
                | StrLength Occurs Comment
                  deriving (Eq,Show)
+
+
+-- | A helper for building the formal Module structure.
+mkModule :: String -> Schema -> [Decl] -> Module
+mkModule name schema decls =
+                      Module { module_name        = XName $ N name
+                             , module_xsd_ns      = xsdQualification
+                                                      (schema_namespaces schema)
+                             , module_re_exports  = reexports
+                             , module_import_only = imports
+                             , module_decls       = theRest
+                             }
+    where (reexports,other)   = partition xsdinclude decls
+          (imports,  theRest) = partition xsdimport  other
+          xsdinclude (XSDInclude _ _)  = True
+          xsdinclude _                 = False
+          xsdimport  (XSDImport _ _ _) = True
+          xsdimport  _                 = False
+          xsdQualification nss = fmap (XName . N . nsPrefix) $
+                                      lookupBy ((==xsd).nsURI) nss
+              where xsd = "http://www.w3.org/2001/XMLSchema"
 
diff --git a/src/Text/XML/HaXml/Schema/Parse.hs b/src/Text/XML/HaXml/Schema/Parse.hs
--- a/src/Text/XML/HaXml/Schema/Parse.hs
+++ b/src/Text/XML/HaXml/Schema/Parse.hs
@@ -633,7 +633,7 @@
 qname :: (String->String->QName) -> TextParser QName
 qname q = do a <- word
              ( do ":" <- word
-                  b   <- word
+                  b   <- many (satisfy (/=':'))
                   return (q a b)
                `onFail`
                do cs <- many next
diff --git a/src/Text/XML/HaXml/Schema/PrettyHaskell.hs b/src/Text/XML/HaXml/Schema/PrettyHaskell.hs
--- a/src/Text/XML/HaXml/Schema/PrettyHaskell.hs
+++ b/src/Text/XML/HaXml/Schema/PrettyHaskell.hs
@@ -7,8 +7,6 @@
   , ppModule
   , ppHighLevelDecl
   , ppHighLevelDecls
-  , ppModuleWithInstances
-  , ppHighLevelInstances
   , ppvList
   ) where
 
@@ -19,7 +17,8 @@
 import Text.PrettyPrint.HughesPJ as PP
 
 import Data.List (intersperse,notElem,inits)
-import Data.Maybe (isJust,fromJust,catMaybes)
+import Data.Maybe (isJust,fromJust,fromMaybe,catMaybes)
+import Data.Char (toLower)
 
 -- | Vertically pretty-print a list of things, with open and close brackets,
 --   and separators.
@@ -42,6 +41,35 @@
   where
     (c:cs) = lines (paragraph 60 s)
 
+-- | Generate aligned haddock-style docs for choices (where each choice
+--   has its own documentation, but haddock cannot place it directly next
+--   to the appropriate component.
+ppCommentForChoice :: CommentPosition -> Comment -> [[Element]] -> Doc
+ppCommentForChoice pos outer nested =
+    text "--" <+> text (case pos of Before -> "|"; After -> "^") <+> text c
+    $$ vcat (map (\x-> text "--  " <+> text x) cs)
+    $$ vcat (map (\x-> text "--  " <+> text x) bullets)
+  where
+    (c:cs)  = lines intro
+    intro   = maybe "Choice between:"
+                    (\s-> paragraph 60 s++"\n\nChoice between:")
+                    outer
+    bullets = concatMap lines
+              $ zipWith (\n seq-> case seq of
+                              [x]-> "\n("++show n++") "++paragraph 56 x
+                              _  -> "\n("++show n++") Sequence of:"
+                                    ++ concatMap (\s->"\n\n  * "
+                                                      ++paragraph 52 s)
+                                                 seq)
+                        [1..]
+              $ map (map safeComment)
+              $ nested
+    safeComment Text = "mixed text"
+    safeComment e@Element{} = fromMaybe (xname $ elem_name e) (elem_comment e)
+    safeComment e@_         = fromMaybe ("unknown") (elem_comment e)
+    xname (XName (N x))     = x
+    xname (XName (QN ns x)) = nsPrefix ns++":"++x
+
 -- | Pretty-print a Haskell-style name.
 ppHName :: HName -> Doc
 ppHName (HName x) = text x
@@ -68,8 +96,7 @@
 -- | Convert a whole document from HaskellTypeModel to Haskell source text.
 ppModule :: NameConverter -> Module -> Doc
 ppModule nx m =
-    text "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,"
-    $$ text "             ExistentialQuantification, FlexibleContexts #-}"
+    text "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}"
     $$ text "{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}"
     $$ text "module" <+> ppModId nx (module_name m)
     $$ nest 2 (text "( module" <+> ppModId nx (module_name m)
@@ -81,61 +108,54 @@
     $$ text " "
     $$ text "import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..))"
     $$ text "import Text.XML.HaXml.Schema.Schema as Schema"
-    $$ (case module_xsd_ns m of
-         Nothing -> text "import Text.XML.HaXml.Schema.PrimitiveTypes as Xsd"
-         Just ns -> text "import qualified Text.XML.HaXml.Schema.PrimitiveTypes as"<+>ppConId nx ns)
-    $$ vcat (map (ppHighLevelDecl nx)
-                 (module_re_exports m ++ module_import_only m))
-    $$ text " "
-    $$ ppHighLevelDecls nx (module_decls m)
-
--- | Generate a supplementary module to contain instances, especially for
---   types that needed to be forward-declared.
-ppModuleWithInstances :: NameConverter -> Module -> Doc
-ppModuleWithInstances nx m =
-    text "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,"
-    $$ text "             ExistentialQuantification, FlexibleContexts #-}"
-    $$ text "{-# OPTIONS_GHC -fno-warn-orphan-instances #-}"
-    $$ text "module" <+> ppModId nx (module_name m) <> text "Instances"
-    $$ nest 2 (text "( module" <+> ppModId nx (module_name m)
-                                                    <> text "Instances"
-              $$ text ") where")
-    $$ text " "
-    $$ text "import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..))"
-    $$ text "import Text.XML.HaXml.Schema.Schema as Schema"
+    $$ text "import Text.XML.HaXml.OneOfN"
     $$ (case module_xsd_ns m of
          Nothing -> text "import Text.XML.HaXml.Schema.PrimitiveTypes as Xsd"
          Just ns -> text "import qualified Text.XML.HaXml.Schema.PrimitiveTypes as"<+>ppConId nx ns)
     $$ vcat (map (ppHighLevelDecl nx)
                  (module_re_exports m ++ module_import_only m))
     $$ text " "
-    $$ text "import" <+> ppModId nx (module_name m)
-    $$ text "-- More imports are required, extracted from FwdDecls"
+    $$ text "-- Some hs-boot imports are required, for fwd-declaring types."
     $$ vcat (map ppFwdDecl $ concatMap imports $ module_decls m)
+    $$ vcat (map ppFwdElem $ concatMap importElems $ module_decls m)
     $$ text " "
-    $$ vcat (intersperse (text " ")
-                         (map (ppHighLevelInstances nx)
-                              (filter hasInstances (module_decls m))))
-  where
-    hasInstances ElementsAttrsAbstract{}     = True
-    hasInstances ElementAbstractOfType{}     = True
-    hasInstances ExtendComplexType{}         = True
-    hasInstances ExtendComplexTypeAbstract{} = True
-    hasInstances _                           = False
+    $$ ppHighLevelDecls nx (module_decls m)
 
-    imports (ElementsAttrsAbstract _ insts _) = insts
-    imports (ExtendComplexTypeAbstract _ _ insts _ _ _) = insts
+  where
+    imports (ElementsAttrsAbstract _ deps _) = deps
+    imports (ExtendComplexTypeAbstract _ _ deps _ _ _) = deps
     imports _ = []
 
+    importElems (ElementAbstractOfType _ _ deps _) = deps
+    importElems _ = []
+
     ppFwdDecl (_,   Nothing)  = empty
-    ppFwdDecl (name,Just mod) = text "import" <+> ppModId nx mod
-                                <+> text "-- for" <+> ppConId nx name
+    ppFwdDecl (name,Just mod) = text "import {-# SOURCE #-}" <+> ppModId nx mod
+                                <+> text "(" <+> ppConId nx name <+> text ")"
 
+    ppFwdElem (_,   Nothing)  = empty
+    ppFwdElem (name,Just mod) = text "import {-# SOURCE #-}" <+> ppModId nx mod
+                                <+> text "("
+                                    <+> (text "element" <> ppUnqConId nx name)
+                                    <> (text ", elementToXML" <> ppUnqConId nx name)
+                                <+> text ")"
+
+
 -- | Generate a fragmentary parser for an attribute.
 ppAttr :: Attribute -> Int -> Doc
-ppAttr a n = (text "a"<>text (show n)) <+> text "<- getAttribute \""
+ppAttr a n = (text "a"<>text (show n)) <+> text "<-"
+                                       <+> (if attr_required a then empty
+                                                 else text "optional $")
+                                       <+> text "getAttribute \""
                                        <> ppXName (attr_name a)
                                        <> text "\" e pos"
+
+-- | Generate a fragmentary toXML for an attribute.
+toXmlAttr :: Attribute -> Doc
+toXmlAttr a = (if attr_required a then id
+                                  else (\d-> text "maybe []" <+> parens d))
+              (text "toXMLAttribute \"" <> ppXName (attr_name a) <> text "\"")
+
 -- | Generate a fragmentary parser for an element.
 ppElem :: NameConverter -> Element -> Doc
 ppElem nx e@Element{}
@@ -149,14 +169,18 @@
 ppElem nx e@AnyElem{} = ppElemModifier (elem_modifier e)
                           (text "parseAnyElement")
 ppElem nx e@Text{}    = text "parseText"
-ppElem nx e@OneOf{}   = ppElemModifier (elem_modifier e)
-                          (text "oneOf" <+> ppvList "[" "," "]"
+ppElem nx e@OneOf{}   = ppElemModifier (liftedElemModifier e)
+                          (text "oneOf'" <+> ppvList "[" "," "]"
                                                     (ppOneOf n)
                                                     (zip (elem_oneOf e) [1..n]))
   where
     n = length (elem_oneOf e)
-    ppOneOf n (e,i) = text "fmap" <+> text (ordinal i ++"Of"++show n)
-                      <+> parens (ppSeqElem e)
+    ppOneOf n (e,i) = text "(\"" <> hsep (map (ppElemTypeName nx id)
+                                         . cleanChoices $ e)
+                      <> text "\","
+                      <+> text "fmap" <+> text (ordinal i ++"Of"++show n)
+                          <+> parens (ppSeqElem . cleanChoices $ e)
+                      <> text ")"
     ordinal i | i <= 20   = ordinals!!i
               | otherwise = "Choice" ++ show i
     ordinals = ["Zero","One","Two","Three","Four","Five","Six","Seven","Eight"
@@ -167,6 +191,34 @@
     ppSeqElem es  = text ("return ("++replicate (length es-1) ','++")")
                     <+> vcat (map (\e-> text "`apply`" <+> ppElem nx e) es)
 
+-- | Generate a fragmentary toXML for an element.  Fragment must still be
+--   applied to an actual element value.
+toXmlElem :: NameConverter -> Element -> Doc
+toXmlElem nx e@Element{}
+    | elem_byRef e    = xmlElemModifier (elem_modifier e)
+                                        (text "elementToXML"
+                                        <> ppUnqConId nx (elem_name e))
+    | otherwise       = xmlElemModifier (elem_modifier e)
+                                        (text "schemaTypeToXML \""
+                                        <> ppXName (elem_name e)
+                                        <> text "\"")
+toXmlElem nx e@AnyElem{} = xmlElemModifier (elem_modifier e)
+                                           (text "toXMLAnyElement")
+toXmlElem nx e@Text{}    = text "toXMLText"
+toXmlElem nx e@OneOf{}   = xmlElemModifier (liftedElemModifier e)
+                           (text "foldOneOf" <> text (show n)
+                           <+> ppvList "" "" "" xmlOneOf (elem_oneOf e))
+  where
+    n = length (elem_oneOf e)
+    xmlOneOf e = parens (xmlSeqElem . cleanChoices $ e)
+    xmlSeqElem []  = PP.empty
+    xmlSeqElem [e] = toXmlElem nx e
+    xmlSeqElem es  = text "\\ (" <> hcat (intersperse (text ",") vars)
+                     <> text ") -> concat"
+                     <+> ppvList "[" "," "]" (\(e,v)-> toXmlElem nx e <+> v)
+                                             (zip es vars)
+        where vars = map (text.(:[])) . take (length es) $ ['a'..'z']
+
 -- | Convert multiple HaskellTypeModel Decls to Haskell source text.
 ppHighLevelDecls :: NameConverter -> [Decl] -> Doc
 ppHighLevelDecls nx hs = vcat (intersperse (text " ")
@@ -193,6 +245,9 @@
                   $$ nest 4 (text "e <- element [s]"
                            $$ text "commit $ interior e $ parseSimpleType")
                   )
+        $$ nest 4 (text "schemaTypeToXML s ("<> ppUnqConId nx t <+> text "x) = " 
+                  $$ nest 4 (text "toXMLElement s [] [toXMLText (simpleTypeText x)]")
+                  )
     $$ text "instance SimpleType" <+> ppUnqConId nx t <+> text "where"
         $$ nest 4 (text "acceptingParser = fmap" <+> ppUnqConId nx t
                                                  <+> text "acceptingParser"
@@ -200,6 +255,8 @@
                    $$ text "-- XXX should enforce the restrictions somehow?"
                    $$ text "-- The restrictions are:"
                    $$ vcat (map ((text "--     " <+>) . ppRestrict) r))
+        $$ nest 4 (text "simpleTypeText (" <> ppUnqConId nx t
+                                          <+> text "x) = simpleTypeText x")
   where
     ppRestrict (RangeR occ comm)     = text "(RangeR"
                                          <+> ppOccurs occ <>  text ")"
@@ -216,8 +273,10 @@
     $$ text "data" <+> ppUnqConId nx t <+> text "="
                                     <+> ppUnqConId nx t <+> ppConId nx s
                                     <+> ppConId nx t_attrs
+                                    <+> text "deriving (Eq,Show)"
     $$ text "data" <+> ppConId nx t_attrs <+> text "=" <+> ppConId nx t_attrs
-        $$ nest 4 (ppFields nx t_attrs [] as)
+        $$ nest 4 (ppFields nx t_attrs [] as
+                  $$ text "deriving (Eq,Show)")
     $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"
         $$ nest 4 (text "parseSchemaType s = do" 
                   $$ nest 4 (text "(pos,e) <- posnElement [s]"
@@ -231,6 +290,16 @@
                                                      <+> attrsValue as)
                             )
                   )
+        $$ nest 4 (text "schemaTypeToXML s ("<> ppUnqConId nx t
+                                             <+> text "bt at) ="
+                  $$ nest 4 (text "addXMLAttributes"
+                             <+> ppvList "[" "," "]"
+                                     (\a-> toXmlAttr a <+> text "$"
+                                         <+> ppFieldId nx t_attrs (attr_name a)
+                                         <+> text "at")
+                                     as
+                             $$ nest 4 (text "$ schemaTypeToXML s bt"))
+                  )
     $$ text "instance Extension" <+> ppUnqConId nx t <+> ppConId nx s
                                  <+> text "where"
         $$ nest 4 (text "supertype (" <> ppUnqConId nx t <> text " s _) = s")
@@ -264,73 +333,121 @@
                   $$ nest 4 (text "e <- element [s]"
                            $$ text "commit $ interior e $ parseSimpleType")
                   )
+        $$ nest 4 (text "schemaTypeToXML s x = " 
+                  $$ nest 4 (text "toXMLElement s [] [toXMLText (simpleTypeText x)]")
+                  )
     $$ text "instance SimpleType" <+> ppUnqConId nx t <+> text "where"
         $$ nest 4 (text "acceptingParser ="
-                        <+> ppvList "" "`onFail`" "" parseItem is)
+                        <+> ppvList "" "`onFail`" "" parseItem is
+                   $$ vcat (map enumText is))
   where
     item (i,c) = (ppUnqConId nx t <> text "_" <> ppConId nx i)
                  $$ ppComment After c
     parseItem (i,_) = text "do isWord \"" <> ppXName i <> text "\"; return"
                            <+> (ppUnqConId nx t <> text "_" <> ppConId nx i)
+    enumText  (i,_) = text "simpleTypeText"
+                           <+> (ppUnqConId nx t <> text "_" <> ppConId nx i)
+                           <+> text "= \"" <> ppXName i <> text "\""
 
 ppHighLevelDecl nx (ElementsAttrs t es as comm) =
     ppComment Before comm
     $$ text "data" <+> ppUnqConId nx t <+> text "=" <+> ppUnqConId nx t
-        $$ nest 8 (ppFields nx t (uniqueify es) as)
+        $$ nest 8 (ppFields nx t (uniqueify es) as
+                  $$ text "deriving (Eq,Show)")
     $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"
         $$ nest 4 (text "parseSchemaType s = do" 
                   $$ nest 4 (text "(pos,e) <- posnElement [s]"
-                            $$ text "commit $ do"
-                            $$ nest 2
-                                  (vcat (zipWith ppAttr as [0..])
-                                  $$ text "interior e $ return"
+                       --   $$ text "commit $ do"
+                       --   $$ nest 2
+                            $$    (vcat (zipWith ppAttr as [0..])
+                                  $$ text "commit $ interior e $ return"
                                       <+> returnValue as
                                       $$ nest 4 (vcat (map ppApplyElem es))
                                   )
                             )
                   )
+        $$ nest 4 (text "schemaTypeToXML s x@"<> ppUnqConId nx t <> text "{} ="
+                  $$ nest 4 (text "toXMLElement s"
+                             <+> ppvList "[" "," "]"
+                                         (\a-> toXmlAttr a <+> text "$"
+                                               <+> ppFieldId nx t (attr_name a)
+                                               <+> text "x")
+                                         as
+                             $$ nest 4 (ppvList "[" "," "]"
+                                           (\ (e,i)-> toXmlElem nx e
+                                                      <+> text "$"
+                                                      <+> ppFieldName nx t e i
+                                                      <+> text "x")
+                                           (zip es [0..]))
+                            )
+                  )
   where
     returnValue [] = ppUnqConId nx t
     returnValue as = parens (ppUnqConId nx t <+>
                              hsep [text ("a"++show n) | n <- [0..length as-1]])
     ppApplyElem e = text "`apply`" <+> ppElem nx e
 
+ppHighLevelDecl nx (ElementsAttrsAbstract t [] comm) =
+    ppComment Before comm
+    $$ text "--  (There are no subtypes defined for this abstract type.)"
+    $$ text "data" <+> ppUnqConId nx t <+> text "=" <+> ppUnqConId nx t
+                   <+> text "deriving (Eq,Show)"
+    $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"
+        $$ nest 4 (text "parseSchemaType s = fail" <+> errmsg)
+        $$ nest 4 (text "schemaTypeToXML s _ = toXMLElement s [] []")
+  where
+    errmsg = text "\"Parse failed when expecting an extension type of"
+             <+> ppXName t <> text ":\\n  No extension types are known.\""
 ppHighLevelDecl nx (ElementsAttrsAbstract t insts comm) =
     ppComment Before comm
     $$ text "data" <+> ppUnqConId nx t
-        $$ nest 8 (ppvList "=" "|" "" ppAbstrCons insts)
-    $$ text "-- instance SchemaType" <+> ppUnqConId nx t
-        <+> text "(declared in Instance module)"
---  $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"
---      $$ nest 4 (text "parseSchemaType s = do" 
---                $$ nest 4 (vcat (intersperse (text "`onFail`")
---                                             (map ppParse insts)
---                                 ++ [text "`onFail` fail" <+> errmsg])))
-    $$ text ""
-    $$ vcat (map ppFwdDecl $ filter (isJust . snd) insts)
+        $$ nest 8 (ppvList "=" "|" "" ppAbstrCons insts
+                  $$ text "deriving (Eq,Show)")
+--  $$ text "-- instance SchemaType" <+> ppUnqConId nx t
+--      <+> text "(declared in Instance module)"
+-- *** Declare instance here
+    $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"
+        $$ nest 4 (text "parseSchemaType s = do" 
+                  $$ nest 4 (vcat (intersperse (text "`onFail`")
+                                               (map ppParse insts)
+                                   ++ [text "`onFail` fail" <+> errmsg])))
+        $$ nest 4 (vcat (map toXML insts))
+--  $$ text ""
+--  $$ vcat (map ppFwdDecl $ filter (isJust . snd) insts)
   where
     ppAbstrCons (name,Nothing)  = con name <+> ppConId nx name
-    ppAbstrCons (name,Just mod) = text "forall q . (FwdDecl" <+>
-                                  fwd name <+> text "q," <+>
-                                  text "SchemaType q) =>" <+>
-                                  con name <+>
-                                  text "("<>fwd name<>text"->q)" <+> fwd name
---  ppParse (name,Nothing) = text "(fmap" <+> con name <+>
---                           text "$ parseSchemaType s)"
+    ppAbstrCons (name,Just mod) = con name <+> ppConId nx name
+-- *** Declare FwdDecl type here (proxy for type declared in later module)
+--  ppAbstrCons (name,Just mod) = text "forall q . (FwdDecl" <+>
+--                                fwd name <+> text "q," <+>
+--                                text "SchemaType q) =>" <+>
+--                                con name <+>
+--                                text "("<>fwd name<>text"->q)" <+> fwd name
+    ppParse (name,Nothing) = text "(fmap" <+> con name <+>
+                             text "$ parseSchemaType s)"
+    ppParse (name,Just _)  = ppParse (name,Nothing)
 --  ppParse (name,Just _)  = text "(return" <+> con name <+>
 --                           text "`apply` (fmap const $ parseSchemaType s)" <+>
 --                           text "`apply` return" <+> fwd name <> text ")"
-    ppFwdDecl (name,Just mod)
-           = text "-- | Proxy:" <+> ppConId nx name
-                 <+> text "declared later in" <+> ppModId nx mod
-             $$ text "data" <+> fwd name <+> text "=" <+> fwd name
---  errmsg = text "\"Parse failed when expecting an extension type of"
---           <+> ppXName t <> text ",\\n\\\n\\  namely one of:\\n\\\n\\"
---           <> hcat (intersperse (text ",")
---                                (map (ppXName . fst) insts))
---           <> text "\""
-    fwd name = ppFwdConId nx name
+--  ppFwdDecl (name,Just mod)
+--         = text "-- | Proxy:" <+> ppConId nx name
+--               <+> text "declared later in" <+> ppModId nx mod
+--           $$ text "data" <+> fwd name <+> text "=" <+> fwd name
+    errmsg = text "\"Parse failed when expecting an extension type of"
+             <+> ppXName t <> text ",\\n\\\n\\  namely one of:\\n\\\n\\"
+             <> hcat (intersperse (text ",")
+                                  (map (ppXName . fst) insts))
+             <> text "\""
+--  fwd name = ppFwdConId nx name
     con name = ppJoinConId nx t name
+    -- This is probably an unportable hack, but because an abstract type never
+    -- has an element in its own name, we need to guess at the name of the
+    -- possible subtype elements that could substitute for it.
+    toXML (name,_) = text "schemaTypeToXML _s ("
+                     <> con name <+> text "x) = schemaTypeToXML \""
+                     <> ppXName (initLower name) <> text "\" x"
+    initLower (XName (N (c:cs))) = XName $ N (toLower c:cs)
+    initLower (XName (QN ns (c:cs))) = XName $ QN ns (toLower c:cs)
 
 ppHighLevelDecl nx (ElementOfType e@Element{}) =
     ppComment Before (elem_comment e)
@@ -338,21 +455,66 @@
         <+> text "XMLParser" <+> ppConId nx (elem_type e)
     $$ (text "element" <> ppUnqConId nx (elem_name e)) <+> text "="
         <+> (text "parseSchemaType \"" <> ppXName (elem_name e)  <> text "\"")
+    $$ (text "elementToXML" <> ppUnqConId nx (elem_name e)) <+> text "::"
+        <+> ppConId nx (elem_type e) <+> text "-> [Content ()]"
+    $$ (text "elementToXML" <> ppUnqConId nx (elem_name e)) <+> text "="
+        <+> (text "schemaTypeToXML \"" <> ppXName (elem_name e)  <> text "\"")
 
+ppHighLevelDecl nx e@(ElementAbstractOfType n t [] comm) =
+    ppComment Before comm
+    $$ text "--  (There are no elements in any substitution group for this element.)"
+    $$ (text "element" <> ppUnqConId nx n) <+> text "::"
+        <+> text "XMLParser" <+> ppConId nx t
+    $$ (text "element" <> ppUnqConId nx n) <+> text "="
+        <+> text "fail" <+> errmsg
+    $$ (text "elementToXML" <> ppUnqConId nx n) <+> text "::"
+        <+> ppConId nx t <+> text "-> [Content ()]"
+    $$ (text "elementToXML" <> ppUnqConId nx n) <+> text "="
+        <+> (text "schemaTypeToXML \"" <> ppXName n <> text "\"")
+  where
+    errmsg = text "\"Parse failed when expecting an element in the substitution group for\\n\\\n\\    <"
+             <> ppXName n <> text ">,\\n\\\n\\  There are no substitutable elements.\""
 ppHighLevelDecl nx e@(ElementAbstractOfType n t substgrp comm)
-    | any notInScope substgrp
-                = (text "-- element" <> ppUnqConId nx n) <+> text "::"
-                      <+> text "XMLParser" <+> ppConId nx t
-                $$ text "--     declared in Instances module"
-    | otherwise = ppElementAbstractOfType nx e
+--  | any notInScope substgrp
+--              = (text "-- element" <> ppUnqConId nx n) <+> text "::"
+--                    <+> text "XMLParser" <+> ppConId nx t
+--              $$ text "--     declared in Instances module"
+    | otherwise = ppComment Before comm
+                $$ (text "element" <> ppUnqConId nx n) <+> text "::"
+                    <+> text "XMLParser" <+> ppConId nx t
+                $$ (text "element" <> ppUnqConId nx n) <+> text "="
+                   <+> vcat (intersperse (text "`onFail`") (map ppOne substgrp)
+                             ++ [text "`onFail` fail" <+> errmsg])
+                $$ (text "elementToXML" <> ppUnqConId nx n) <+> text "::"
+                    <+> ppConId nx t <+> text "-> [Content ()]"
+                $$ (text "elementToXML" <> ppUnqConId nx n) <+> text "="
+                    <+> (text "schemaTypeToXML \"" <> ppXName n <> text "\"")
+            --  $$ vcat (map elementToXML substgrp)
+--  | otherwise = ppElementAbstractOfType nx e
   where
     notInScope (_,Just _)  = True
     notInScope (_,Nothing) = False
+    ppOne (c,Nothing) = text "fmap" <+> text "supertype" -- ppJoinConId nx t c
+                        <+> (text "element" <> ppConId nx c)
+    ppOne (c,Just _)  = text "fmap" <+> text "supertype" -- ppJoinConId nx t c
+                        <+> (text "element" <> ppConId nx c)
+                        <+> text "-- FIXME: element is forward-declared"
+    errmsg = text "\"Parse failed when expecting an element in the substitution group for\\n\\\n\\    <"
+             <> ppXName n <> text ">,\\n\\\n\\  namely one of:\\n\\\n\\<"
+             <> hcat (intersperse (text ">, <")
+                                  (map (ppXName . fst) substgrp))
+             <> text ">\""
+--  elementToXML (c,_) = (text "elementToXML" <> ppUnqConId nx n)
+--                       <+> text "(" <> ppJoinConId nx t c
+--                       <+> text " x) = elementToXML" <> ppUnqConId nx c
+--                       <+> text "x"
 
+
 ppHighLevelDecl nx (Choice t es comm) =
     ppComment Before comm
     $$ text "data" <+> ppUnqConId nx t
-        <+> nest 4 ( ppvList "=" "|" "" choices (zip es [1..]) )
+        <+> nest 4 ( ppvList "=" "|" "" choices (zip es [1..])
+                   $$ text "deriving (Eq,Show)" )
   where
     choices (e,n) = (ppUnqConId nx t <> text (show n))
                     <+> ppConId nx (elem_type e)
@@ -373,7 +535,9 @@
     ppComment Before comm
     $$ text "newtype" <+> ppUnqConId nx t <+> text "="
                                        <+> ppUnqConId nx t <+> ppConId nx s
+                                       <+> text "deriving (Eq,Show)"
     $$ text "-- plus different (more restrictive) parser"
+    $$ text "-- (parsing restrictions currently unimplemented)"
     $$ text "instance Restricts" <+> ppUnqConId nx t <+> ppConId nx s
                                  <+> text "where"
         $$ nest 4 (text "restricts (" <> ppUnqConId nx t <+> text "x) = x")
@@ -381,6 +545,8 @@
         $$ nest 4 (text "parseSchemaType = fmap " <+> ppUnqConId nx t <+>
                    text ". parseSchemaType")
 		-- XXX should enforce the restriction.
+        $$ nest 4 (text "schemaTypeToXML s (" <> ppUnqConId nx t <+> text "x)")
+                   <+> text "= schemaTypeToXML s x"
 
 {-
 ppHighLevelDecl nx (ExtendComplexType t s es as _ comm)
@@ -389,6 +555,7 @@
     $$ text "data" <+> ppConId nx t <+> text "="
                                     <+> ppConId nx t <+> ppConId nx s
                                     <+> ppFields nx t es as
+                                    <+> text "deriving (Eq,Show)"
     $$ text "instance Extension" <+> ppConId nx t <+> ppConId nx s
                                  <+> ppAuxConId nx t <+> text "where"
         $$ nest 4 (text "supertype (" <> ppConId nx t <> text " s e) = s"
@@ -399,7 +566,7 @@
                                       fwdReqd absSup grandsuper comm) =
     ppHighLevelDecl nx (ElementsAttrs t (oes++es) (oas++as) comm)
     $$ ppExtension nx t s fwdReqd absSup oes oas es as
-    $$ (if not (null grandsuper) -- && isJust fwdReqd
+    $$ (if not (null grandsuper) -- && not (isJust fwdReqd) -- && isJust fwdReqd
         then ppSuperExtension nx s grandsuper (t,Nothing)
         else empty)
 
@@ -407,10 +574,10 @@
                                               fwdReqd grandsuper comm) =
     ppHighLevelDecl nx (ElementsAttrsAbstract t insts comm)
     $$ ppExtension nx t s fwdReqd True [] [] [] []
-    $$ if not (null grandsuper)
-       then vcat (map (ppSuperExtension nx t grandsuper) insts)
-                       -- FIXME some instances are missing!
-       else empty
+--  $$ if not (null grandsuper)
+--     then vcat (map (ppSuperExtension nx t grandsuper) insts)
+--                     -- FIXME some instances are missing!
+--     else empty
 
 ppHighLevelDecl nx (XSDInclude m comm) =
     ppComment After comm
@@ -424,7 +591,7 @@
 ppHighLevelDecl nx (XSDComment comm) =
     ppComment Before comm
 
---------------------------------------------------------------------------------
+{-------------------------------------------------------------------------------
 
 -- | Instances that depend on FwdDecl'd types, need to be declared in a
 --   different module.  So they have been separated out from ppHighLevelDecl.
@@ -473,6 +640,7 @@
 --                     -- FIXME some instances are missing!
 --     else empty
 
+
 ppElementAbstractOfType nx (ElementAbstractOfType n t substgrp comm) =
     ppComment Before comm
     $$ (text "element" <> ppUnqConId nx n) <+> text "::"
@@ -492,6 +660,8 @@
                                   (map (ppXName . fst) substgrp))
              <> text ">\""
 
+----------------------------------------------------------------------------- -}
+
 --------------------------------------------------------------------------------
 
 -- | Generate an instance of the Extension class for a subtype/supertype pair.
@@ -503,20 +673,21 @@
        $$ (if abstractSuper then
            nest 4 (text "supertype v" <+> text "="
                                       <+> ppJoinConId nx s t <+>
-                                      (if isJust fwdReqd
-                                       then text "(\\_-> v)" <+> ppFwdConId nx t
-                                       else text "v"))
+                                 --   (if isJust fwdReqd
+                                 --    then text "(\\_-> v)" <+> ppFwdConId nx t
+                                 --    else text "v")
+                                      text "v")
            else
            nest 4 (text "supertype (" <> ppType t (oes++es) (oas++as)
                                       <> text ") ="
                                       $$ nest 11 (ppType s oes oas) ))
-    $$ (if isJust fwdReqd then
-       -- text "data" <+> fwd t <+> text "=" <+> fwd t $$  -- already defined
-          text ""
-          $$ text "-- | Proxy" <+> fwd t <+> text "was declared earlier in"
-                     <+> ppModId nx (fromJust fwdReqd)
-          $$ text "instance FwdDecl" <+> fwd t <+> ppConId nx t
-        else empty)
+--  $$ (if isJust fwdReqd then
+--     -- text "data" <+> fwd t <+> text "=" <+> fwd t $$  -- already defined
+--        text ""
+--        $$ text "-- | Proxy" <+> fwd t <+> text "was declared earlier in"
+--                   <+> ppModId nx (fromJust fwdReqd)
+--        $$ text "instance FwdDecl" <+> fwd t <+> ppConId nx t
+--      else empty)
   where
     fwd name = ppFwdConId nx name
     ppType t es as = ppUnqConId nx t
@@ -540,10 +711,10 @@
                                            <+> text "->"
                                            <+> ppConId nx super <> text ")"))
 -}
-ppSuperExtension nx super (grandSuper:_) (t,Just mod) =  -- fwddecl
-    -- FIXME: generate comment for all of the grandSupers.
-    text "-- instance Extension" <+> ppUnqConId nx t <+> ppConId nx grandSuper
-    $$ text "--   will be declared in module" <+> ppModId nx mod
+ppSuperExtension nx super grandSupers (t,Just mod) =  -- fwddecl
+    text "-- Note that" <+> ppUnqConId nx t
+    <+> text "will be declared later in module" <+> ppModId nx mod
+    $$ ppSuperExtension nx super grandSupers (t,Nothing)
 ppSuperExtension nx super grandSupers (t,Nothing) =
     vcat (map (ppSuper t) (map reverse . drop 2 . inits $ super: grandSupers))
   where
@@ -565,28 +736,36 @@
     fields = map (ppFieldAttribute nx t) as ++
              zipWith (ppFieldElement nx t) es [0..]
 
--- | Generate a single named field from an element.
+-- | Generate a single named field (including type sig) from an element.
 ppFieldElement :: NameConverter -> XName -> Element -> Int -> Doc
-ppFieldElement nx t e@Element{} _ = ppFieldId nx t (elem_name e)
-                                        <+> text "::" <+> ppElemTypeName nx id e
-                                    $$ ppComment After (elem_comment e)
-ppFieldElement nx t e@OneOf{}   i = ppFieldId nx t (XName $ N $"choice"++show i)
-                                        <+> text "::" <+> ppElemTypeName nx id e
+ppFieldElement nx t e@Element{} i = ppFieldName nx t e i
+                                    <+> text "::" <+> ppElemTypeName nx id e
                                     $$ ppComment After (elem_comment e)
-ppFieldElement nx t e@AnyElem{} i = ppFieldId nx t (XName $ N $"any"++show i)
-                                        <+> text "::" <+> ppElemTypeName nx id e
+ppFieldElement nx t e@OneOf{}   i = ppFieldName nx t e i
+                                    <+> text "::" <+> ppElemTypeName nx id e
+                                    $$ ppCommentForChoice After (elem_comment e)
+                                                                (elem_oneOf e)
+ppFieldElement nx t e@AnyElem{} i = ppFieldName nx t e i
+                                    <+> text "::" <+> ppElemTypeName nx id e
                                     $$ ppComment After (elem_comment e)
-ppFieldElement nx t e@Text{}    i = ppFieldId nx t (XName $ N $"text"++show i)
-                                        <+> text "::" <+> ppElemTypeName nx id e
+ppFieldElement nx t e@Text{}    i = ppFieldName nx t e i
+                                    <+> text "::" <+> ppElemTypeName nx id e
 
+-- | Generate a single named field (no type sig) from an element.
+ppFieldName :: NameConverter -> XName -> Element -> Int -> Doc
+ppFieldName nx t e@Element{} _ = ppFieldId nx t (elem_name e)
+ppFieldName nx t e@OneOf{}   i = ppFieldId nx t (XName $ N $"choice"++show i)
+ppFieldName nx t e@AnyElem{} i = ppFieldId nx t (XName $ N $"any"++show i)
+ppFieldName nx t e@Text{}    i = ppFieldId nx t (XName $ N $"text"++show i)
+
 -- | What is the name of the type for an Element (or choice of Elements)?
 ppElemTypeName :: NameConverter -> (Doc->Doc) -> Element -> Doc
 ppElemTypeName nx brack e@Element{} =
     ppTypeModifier (elem_modifier e) brack $ ppConId nx (elem_type e)
 ppElemTypeName nx brack e@OneOf{}   = 
-    brack $ ppTypeModifier (elem_modifier e) parens $
+    brack $ ppTypeModifier (liftedElemModifier e) parens $
     text "OneOf" <> text (show (length (elem_oneOf e)))
-     <+> hsep (map ppSeq (elem_oneOf e))
+     <+> hsep (map (ppSeq . cleanChoices) (elem_oneOf e))
   where
     ppSeq []  = text "()"
     ppSeq [e] = ppElemTypeName nx parens e
@@ -602,6 +781,8 @@
 -- | Generate a single named field from an attribute.
 ppFieldAttribute :: NameConverter -> XName -> Attribute -> Doc
 ppFieldAttribute nx t a = ppFieldId nx t (attr_name a) <+> text "::"
+                                   <+> (if attr_required a then empty
+                                           else text "Maybe")
                                    <+> ppConId nx (attr_type a)
                           $$ ppComment After (attr_comment a)
 
@@ -614,18 +795,69 @@
 ppTypeModifier (Range (Occurs _ _))              _ d = text "[" <> d <> text "]"
 
 -- | Generate a parser for a list or Maybe value.
+ppElemModifier :: Modifier -> Doc -> Doc
 ppElemModifier Single    doc = doc
 ppElemModifier Optional  doc = text "optional" <+> parens doc
 ppElemModifier (Range (Occurs Nothing Nothing))  doc = doc
 ppElemModifier (Range (Occurs (Just 0) Nothing)) doc = text "optional"
                                                        <+> parens doc
+ppElemModifier (Range (Occurs (Just 0) (Just n))) doc
+               | n==maxBound = text "many" <+> parens doc
+ppElemModifier (Range (Occurs Nothing  (Just n))) doc
+               | n==maxBound = text "many1" <+> parens doc
+ppElemModifier (Range (Occurs (Just 1) (Just n))) doc
+               | n==maxBound = text "many1" <+> parens doc
 ppElemModifier (Range o) doc = text "between" <+> (parens (text (show o))
                                                   $$ parens doc)
 
+-- | Generate a toXML for a list or Maybe value.
+xmlElemModifier :: Modifier -> Doc -> Doc
+xmlElemModifier Single    doc = doc
+xmlElemModifier Optional  doc = text "maybe []" <+> parens doc
+xmlElemModifier (Range (Occurs Nothing Nothing))  doc = doc
+xmlElemModifier (Range (Occurs (Just 0) Nothing)) doc = text "maybe []"
+                                                        <+> parens doc
+xmlElemModifier (Range (Occurs _ _)) doc = text "concatMap" <+> parens doc
+
+-- | Eliminate a Maybe type modifier, when it occurs directly inside a
+--   choice construct (since a parsed Nothing would always be preferred over
+--   a real value later in the choice).  Likewise, empty lists must
+--   be disallowed inside choice.
+cleanChoices :: [Element] -> [Element]
+cleanChoices [e@Element{}] = (:[]) $
+    case elem_modifier e of
+      Range (Occurs (Just 0) Nothing) -> e{elem_modifier=Single}
+      Range (Occurs (Just 0) max)-> e{elem_modifier=Range (Occurs (Just 1) max)}
+      _ -> e
+cleanChoices es = es
+
+-- | Sometimes, a choice without a type modifier contains element sequences,
+--   all of which have the same modifier. In that case, it makes sense to lift
+--   the modifier (typically Maybe) to the outer layer.
+liftedElemModifier :: Element -> Modifier
+liftedElemModifier e@OneOf{} =
+    case elem_modifier e of
+      Range (Occurs Nothing Nothing) -> newModifier
+      Single -> newModifier
+      m -> m
+  where
+    newModifier = if all (\x-> case x of
+                                 Text -> True
+                                 _ -> case elem_modifier x of
+                                        Range (Occurs (Just 0) _) -> True
+                                        Optional                  -> True
+                                        _                         -> False)
+                         (concat (elem_oneOf e))
+                  then Optional
+                  else Single
+
 -- | Split long lines of comment text into a paragraph with a maximum width.
 paragraph :: Int -> String -> String
 paragraph n s = go n (words s)
     where go i []     = []
+          go i [x]    | len<i     =       x
+                      | otherwise = "\n"++x
+              where len = length x
           go i (x:xs) | len<i     =       x++" "++go (i-len-1) xs
                       | otherwise = "\n"++x++" "++go (n-len-1) xs
               where len = length x
diff --git a/src/Text/XML/HaXml/Schema/PrimitiveTypes.hs b/src/Text/XML/HaXml/Schema/PrimitiveTypes.hs
--- a/src/Text/XML/HaXml/Schema/PrimitiveTypes.hs
+++ b/src/Text/XML/HaXml/Schema/PrimitiveTypes.hs
@@ -66,6 +66,7 @@
 --   as layered parsers.
 class SimpleType a where
   acceptingParser :: TextParser a
+  simpleTypeText  :: a -> String
 
 -- * Primitive types
 
@@ -81,15 +82,20 @@
 --data Float
 --data Double
 data Duration     = Duration Bool Int Int Int Int Int Float  deriving (Eq,Show)
-data DateTime     = DateTime               deriving (Eq,Show) -- LocalTime ?
-data Time         = Time                   deriving (Eq,Show) -- TimeOfDay ?
-data Date         = Date                   deriving (Eq,Show) -- Day ?
-data GYearMonth   = GYearMonth             deriving (Eq,Show)
-data GYear        = GYear                  deriving (Eq,Show)
-data GMonthDay    = GMonthDay              deriving (Eq,Show)
-data GDay         = GDay                   deriving (Eq,Show)
-data GMonth       = GMonth                 deriving (Eq,Show)
 
+-- * All of the following temporal types are incompletely specified for now.
+--   They should probably be mapped to something appropriate from the time
+--   package?
+
+data DateTime     = DateTime String        deriving (Eq,Show) -- LocalTime ?
+data Time         = Time String            deriving (Eq,Show) -- TimeOfDay ?
+data Date         = Date String            deriving (Eq,Show) -- Day ?
+data GYearMonth   = GYearMonth String      deriving (Eq,Show) -- ??
+data GYear        = GYear String           deriving (Eq,Show) -- ??
+data GMonthDay    = GMonthDay String       deriving (Eq,Show) -- ??
+data GDay         = GDay String            deriving (Eq,Show) -- ??
+data GMonth       = GMonth String          deriving (Eq,Show) -- ??
+
 isNext :: Char -> TextParser Char
 isNext c = do d <- next
               if c==d then return c else fail ("expected "++c:", got "++d:".")
@@ -101,25 +107,35 @@
                                    "0"     -> return False;
                                    "1"     -> return True
                                    _       -> fail ("Not a bool: "++w)
+    simpleTypeText False = "false"
+    simpleTypeText True  = "true"
 instance SimpleType XsdString where
-    acceptingParser = fmap XsdString word
+    acceptingParser = fmap XsdString (many next)
+    simpleTypeText (XsdString s) = s
 instance SimpleType Base64Binary where
     acceptingParser = fmap Base64Binary (many (satisfy isAlphaNum `onFail`
                                                satisfy isSpace `onFail`
                                                satisfy (`elem`"+/=")))
+    simpleTypeText (Base64Binary s) = s
 instance SimpleType HexBinary where
     acceptingParser = fmap HexBinary (many (satisfy Char.isHexDigit))
+    simpleTypeText (HexBinary s) = s
 instance SimpleType AnyURI where
     acceptingParser = fmap AnyURI (many next) -- not very satisfactory
+    simpleTypeText (AnyURI s) = s
 instance SimpleType NOTATION where
     acceptingParser = fmap NOTATION (many next) -- not very satisfactory
+    simpleTypeText (NOTATION s) = s
 
 instance SimpleType Decimal where
     acceptingParser = fmap Decimal parse
+    simpleTypeText (Decimal s) = show s	-- XXX FIXME: showGFloat?
 instance SimpleType Float where
-    acceptingParser = parse
+    acceptingParser  = parse
+    simpleTypeText x = show x		-- XXX FIXME: showGFloat?
 instance SimpleType Double where
-    acceptingParser = parse
+    acceptingParser  = parse
+    simpleTypeText x = show x		-- XXX FIXME: showGFloat?
 
 instance SimpleType Duration where
     acceptingParser = return Duration `apply` (do isNext '-'; return False
@@ -139,22 +155,42 @@
                                                `onFail` return 0)
                                       `apply` ((parseFloat `discard` isNext 'S')
                                                `onFail` return 0)
+    simpleTypeText (Duration pos y m d h n s) =
+        (if pos then "" else "-")++show y++"Y"++show m++"M"++show d++"D"
+        ++"T"++show h++"H"++show n++"M"++show s++"S"
+
 instance SimpleType DateTime where
-    acceptingParser = fail "not implemented: simpletype parser for DateTime"
+    acceptingParser = fmap DateTime (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for DateTime"
+    simpleTypeText (DateTime x) = x
 instance SimpleType Time where
-    acceptingParser = fail "not implemented: simpletype parser for Time"
+    acceptingParser = fmap Time (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for Time"
+    simpleTypeText (Time x) = x
 instance SimpleType Date where
-    acceptingParser = fail "not implemented: simpletype parser for Date"
+    acceptingParser = fmap Date (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for Date"
+    simpleTypeText (Date x) = x
 instance SimpleType GYearMonth where
-    acceptingParser = fail "not implemented: simpletype parser for GYearMonth"
+    acceptingParser = fmap GYearMonth (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for GYearMonth"
+    simpleTypeText (GYearMonth x) = x
 instance SimpleType GYear where
-    acceptingParser = fail "not implemented: simpletype parser for GYear"
+    acceptingParser = fmap GYear (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for GYear"
+    simpleTypeText (GYear x) = x
 instance SimpleType GMonthDay where
-    acceptingParser = fail "not implemented: simpletype parser for GMonthDay"
+    acceptingParser = fmap GMonthDay (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for GMonthDay"
+    simpleTypeText (GMonthDay x) = x
 instance SimpleType GDay where
-    acceptingParser = fail "not implemented: simpletype parser for GDay"
+    acceptingParser = fmap GDay (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for GDay"
+    simpleTypeText (GDay x) = x
 instance SimpleType GMonth where
-    acceptingParser = fail "not implemented: simpletype parser for GMonth"
+    acceptingParser = fmap GMonth (many next)
+ -- acceptingParser = fail "not implemented: simpletype parser for GMonth"
+    simpleTypeText (GMonth x) = x
 
 -- * Derived builtin types
 
@@ -173,28 +209,40 @@
 
 instance SimpleType NormalizedString where
     acceptingParser = fmap Normalized (many next)
+    simpleTypeText (Normalized x) = x
 instance SimpleType Token where
     acceptingParser = fmap Token (many next)
+    simpleTypeText (Token x) = x
 instance SimpleType Language where
     acceptingParser = fmap Language (many next)
+    simpleTypeText (Language x) = x
 instance SimpleType Name where
     acceptingParser = fmap Name (many next)
+    simpleTypeText (Name x) = x
 instance SimpleType NCName where
     acceptingParser = fmap NCName (many next)
+    simpleTypeText (NCName x) = x
 instance SimpleType ID where
     acceptingParser = fmap ID (many next)
+    simpleTypeText (ID x) = x
 instance SimpleType IDREF where
     acceptingParser = fmap IDREF (many next)
+    simpleTypeText (IDREF x) = x
 instance SimpleType IDREFS where
     acceptingParser = fmap IDREFS (many next)
+    simpleTypeText (IDREFS x) = x
 instance SimpleType ENTITY where
     acceptingParser = fmap ENTITY (many next)
+    simpleTypeText (ENTITY x) = x
 instance SimpleType ENTITIES where
     acceptingParser = fmap ENTITIES (many next)
+    simpleTypeText (ENTITIES x) = x
 instance SimpleType NMTOKEN where
     acceptingParser = fmap NMTOKEN (many next)
+    simpleTypeText (NMTOKEN x) = x
 instance SimpleType NMTOKENS where
     acceptingParser = fmap NMTOKENS (many next)
+    simpleTypeText (NMTOKENS x) = x
 
 --data Integer
 newtype NonPositiveInteger = NonPos   Integer   deriving (Eq,Show)
@@ -212,28 +260,41 @@
 
 instance SimpleType Integer where
     acceptingParser = parse
+    simpleTypeText  = show
 instance SimpleType NonPositiveInteger where
     acceptingParser = fmap NonPos parse
+    simpleTypeText (NonPos x) = show x
 instance SimpleType NegativeInteger where
     acceptingParser = fmap Negative parse
+    simpleTypeText (Negative x) = show x
 instance SimpleType Long where
     acceptingParser = fmap (Long . fromInteger) parse
+    simpleTypeText (Long x) = show x
 instance SimpleType Int where
     acceptingParser = parse
+    simpleTypeText  = show
 instance SimpleType Short where
     acceptingParser = fmap (Short . fromInteger) parse
+    simpleTypeText (Short x) = show x
 instance SimpleType Byte where
     acceptingParser = fmap (Byte . fromInteger) parse
+    simpleTypeText (Byte x) = show x
 instance SimpleType NonNegativeInteger where
     acceptingParser = fmap NonNeg parse
+    simpleTypeText (NonNeg x) = show x
 instance SimpleType UnsignedLong where
     acceptingParser = fmap (ULong . fromInteger) parse
+    simpleTypeText (ULong x) = show x
 instance SimpleType UnsignedInt where
     acceptingParser = fmap (UInt . fromInteger) parse
+    simpleTypeText (UInt x) = show x
 instance SimpleType UnsignedShort where
     acceptingParser = fmap (UShort . fromInteger) parse
+    simpleTypeText (UShort x) = show x
 instance SimpleType UnsignedByte where
     acceptingParser = fmap (UByte . fromInteger) parse
+    simpleTypeText (UByte x) = show x
 instance SimpleType PositiveInteger where
     acceptingParser = fmap Positive parse
+    simpleTypeText (Positive x) = show x
 
diff --git a/src/Text/XML/HaXml/Schema/Schema.hs b/src/Text/XML/HaXml/Schema/Schema.hs
--- a/src/Text/XML/HaXml/Schema/Schema.hs
+++ b/src/Text/XML/HaXml/Schema/Schema.hs
@@ -25,6 +25,11 @@
   , module Text.Parse
 --  , module Text.XML.HaXml.Schema.PrimitiveTypes
   , module Text.XML.HaXml.OneOfN
+  , toXMLElement
+  , toXMLText
+  , toXMLAnyElement
+  , toXMLAttribute
+  , addXMLAttributes
   ) where
 
 import Text.ParserCombinators.Poly
@@ -40,10 +45,11 @@
 import Text.XML.HaXml.OneOfN
 import Text.XML.HaXml.Verbatim
 
--- | A SchemaType is for element types, and has a parser from generic XML
---   content tree to a Haskell value.
+-- | A SchemaType promises to interconvert between a generic XML
+--   content tree and a Haskell value, according to the rules of XSD.
 class SchemaType a where
     parseSchemaType :: String -> XMLParser a
+    schemaTypeToXML :: String -> a -> [Content ()]
 
 -- | A type t can extend another type s by the addition of extra elements
 --   and/or attributes.  s is therefore the supertype of t.
@@ -70,6 +76,8 @@
                        (Right v, "") -> return v
                        (Right v, _)  -> return v -- ignore trailing text
 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
 -- | Between is a list parser that tries to ensure that any range
 --   specification (min and max elements) is obeyed when parsing.
 between :: PolyParse p => Occurs -> p a -> p [a]
@@ -118,6 +126,7 @@
     a == b  =  show a == show b
 instance SchemaType AnyElement where
     parseSchemaType _ = parseAnyElement
+    schemaTypeToXML _ = toXMLAnyElement
 
 parseAnyElement :: XMLParser AnyElement
 parseAnyElement = fmap UnconvertedANY next
@@ -127,7 +136,34 @@
 parseText = text  -- from XmlContent.Parser
             `onFail` return ""
 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 
+toXMLElement :: String -> [[Attribute]] -> [[Content ()]] -> [Content ()]
+toXMLElement name attrs content =
+    [CElem (Elem (N name) (concat attrs) (concat content)) ()]
+
+toXMLText :: String -> [Content ()]
+toXMLText text =
+    [CString False text ()]
+
+toXMLAnyElement :: AnyElement -> [Content ()]
+toXMLAnyElement (UnconvertedANY c) = [fmap (const ()) c]
+--toXMLAnyElement (ANYSchemaType x)  = [c]
+
+toXMLAttribute :: (SimpleType a) => String -> a -> [Attribute]
+toXMLAttribute name val = [ (N name, AttValue [Left (simpleTypeText val)]) ]
+
+-- | For a ComplexType that is an extension of a SimpleType, it is necessary to
+--   convert the value to XML first, then add in the extra attributes that
+--   constitute the extension.
+addXMLAttributes :: [[Attribute]] -> [Content ()] -> [Content ()]
+addXMLAttributes extra [CElem (Elem n attrs content) ()] =
+                       [CElem (Elem n (attrs++concat extra) content) ()]
+addXMLAttributes _ x = x
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+
 {- examples
    --------
 
@@ -142,13 +178,33 @@
                              c2 <- optional $ parseSchemaType "doodad"
                              c3 <- between (Occurs (Just 3) (Just 5))
                                             $ parseSchemaType "rinta"
-                             return $ FpMLSomething a0 a1 c0 c1 c2 c3
+                             c4 <- fmap OneOf2 (parseSchemaType "left")
+                                   `onFail`
+                                   fmap TwoOf2 (parseSchemaType "right")
+                             return $ FpMLSomething a0 a1 c0 c1 c2 c3 c4
+  schemaTypeToXML s x@FPMLSomething{} =
+      toXMLElement s [ mkAttribute "flirble" (something_flirble x)
+                     , mkAttribute "binky"   (something_binky x)
+                     ]
+          [             schemaTypeToXML "foobar"  (something_foobar x)
+          , concatMap  (schemaTypeToXML "quux")   (something_quux x)
+          , maybe []   (schemaTypeToXML "doodad") (something_doodad x)
+          , concatMap  (schemaTypeToXML "rinta")  (something_rinta x)
+          , foldOneOf2 (schemaTypeToXML "left")
+                       (schemaTypeToXML "right")  (something_choice4 x)
+          ]
 
 instance SimpleType FpMLNumber where
     acceptingParser = ...
+    simpleTypeText  = ...
 -}
 
-#define SchemaInstance(TYPE)  instance SchemaType TYPE where parseSchemaType s = do { e <- element [s]; interior e $ parseSimpleType; }
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+-- Ensure that all primitive/simple types can also be used as elements.
+
+#define SchemaInstance(TYPE)  instance SchemaType TYPE where { parseSchemaType s = do { e <- element [s]; interior e $ parseSimpleType; }; schemaTypeToXML s x = toXMLElement s [] [toXMLText (simpleTypeText x)] }
 
 SchemaInstance(XsdString)
 SchemaInstance(Prim.Boolean)
diff --git a/src/Text/XML/HaXml/Schema/TypeConversion.hs b/src/Text/XML/HaXml/Schema/TypeConversion.hs
--- a/src/Text/XML/HaXml/Schema/TypeConversion.hs
+++ b/src/Text/XML/HaXml/Schema/TypeConversion.hs
@@ -14,7 +14,7 @@
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Data.List (foldl')
-import Data.Maybe (fromMaybe,fromJust,isNothing)
+import Data.Maybe (fromMaybe,fromJust,isNothing,isJust)
 import Data.Monoid
 
 -- | Given an environment of schema type mappings, and a schema module,
@@ -116,7 +116,7 @@
                         ExtendComplexTypeAbstract n
                              ({-supertype-}XName $ extension_base e)
                              ({-subtypes-}
-                              maybe (error "ECTA")
+                              maybe (error ("ExtendComplexTypeAbstract "++show nx))
                                     (map (\(t,l)->(XName t,if l/=myLoc
                                                            then Just (xname l)
                                                            else Nothing)))
@@ -235,9 +235,11 @@
     elementDecl :: XSD.ElementDecl -> Haskell.Element
     elementDecl ed = case elem_nameOrRef ed of
         Left  n   -> Element ({-name-}xname $ theName n)
-                             ({-type-}maybe (xname $ theName n{-"unknownElement"-}) XName $ theType n)
+                             ({-type-}maybe (localTypeExp ed)
+                                            XName
+                                            (theType n))
                              ({-modifier-}Haskell.Range $ elem_occurs ed)
-                             (isNothing $ theType n) -- by reference
+                             False   -- by reference
                              []      -- internal Decl
                              Nothing -- substitution group
                              (comment (elem_annotation ed))
@@ -259,6 +261,25 @@
                                               (Haskell.Range (elem_occurs ed))
                                               True [] Nothing Nothing
 
+    localTypeExp :: XSD.ElementDecl -> XName
+    localTypeExp ed | isJust (elem_content ed) =
+                          case fromJust (elem_content ed) of
+                            Left st@Primitive{}   -> xname "SomethingPrimitive"
+                            Left st@Restricted{}  -> (\x-> maybe x xname
+                                                          (simple_name st)) $
+                                                     (maybe (xname "GiveUp")
+                                                            XName $
+                                                      restrict_base $
+                                                      simple_restriction st)
+                            Left st@ListOf{}      -> xname "SomethingListy"
+                            Left st@UnionOf{}     -> xname "SomethingUnionLike"
+                            Right c@ComplexType{} -> xname $ fromMaybe "unknown"
+                                                     $ complex_name c
+                    | otherwise =
+                          case elem_nameOrRef ed of
+                            Left n  -> xname $ theName n
+                            Right _ -> xname $ "unknownElement"
+
     attributeDecl :: XSD.AttributeDecl -> [Haskell.Attribute]
     attributeDecl ad = case attr_nameOrRef ad of
         Left  n   -> singleton $
@@ -268,6 +289,7 @@
                                              (attr_simpleType ad))
                                       XName
                                       (theType n))
+                               (attr_use ad == Required)
                                (comment  (attr_annotation ad))
         Right ref -> case Map.lookup ref (env_attribute env) of
                        Nothing -> error $ "<attributeDecl> unknown attribute reference "
diff --git a/src/Text/XML/HaXml/Schema/XSDTypeModel.hs b/src/Text/XML/HaXml/Schema/XSDTypeModel.hs
--- a/src/Text/XML/HaXml/Schema/XSDTypeModel.hs
+++ b/src/Text/XML/HaXml/Schema/XSDTypeModel.hs
@@ -296,3 +296,12 @@
   (Documentation d) `mappend` (Documentation e) = Documentation (d++"\n"++e)
   _                 `mappend` (Documentation e) = Documentation e
   ann               `mappend` _                 = ann          
+
+-- This instance is pretty unsatisfactory, and is useful only for
+-- building environments involving recursive modules.  The /mappend/
+-- method is left-biased, and the /mempty/ value contains lots of
+-- undefined values.
+instance Monoid Schema where
+  mempty        = Schema{ schema_items=[] }
+  s `mappend` t = s{ schema_items = schema_items s ++ schema_items t }
+
diff --git a/src/Text/XML/HaXml/Types.hs b/src/Text/XML/HaXml/Types.hs
--- a/src/Text/XML/HaXml/Types.hs
+++ b/src/Text/XML/HaXml/Types.hs
@@ -171,7 +171,13 @@
                         -- ^ bool is whether whitespace is significant
                | CRef Reference i
                | CMisc Misc i
-               deriving Eq
+
+-- custom instance of Eq, ignoring the informational elements.
+instance Eq (Content i) where
+    (CElem e _)     == (CElem e' _)       =  e==e'
+    (CString b c _) == (CString b' c' _)  =  b==b' && c==c'
+    (CRef r _)      == (CRef r' _)        =  r==r'
+    (CMisc m _)     == (CMisc m' _)       =  m==m'
 
 info :: Content t -> t
 info (CElem _ i) = i
diff --git a/src/Text/XML/HaXml/Validate.hs b/src/Text/XML/HaXml/Validate.hs
--- a/src/Text/XML/HaXml/Validate.hs
+++ b/src/Text/XML/HaXml/Validate.hs
@@ -51,9 +51,17 @@
       , attributes = listToFM [ ((elem,attr),typ)
                               | AttList (AttListDecl elem attdefs) <- decls
                               , AttDef attr typ _ <- attdefs ]
-      , required   = listToFM [ (elem, [ attr
-                                       | AttDef attr _ REQUIRED <- attdefs ])
-                              | AttList (AttListDecl elem attdefs) <- decls ]
+      -- Be sure to look at all attribute declarations for each
+      -- element, since we must merge them.  This implements the
+      -- specification in that regard only; the specification's rules
+      -- about how to merge multiple declarations for the same
+      -- attribute are not considered by this implementation.
+      -- See: http://www.w3.org/TR/REC-xml/#NT-AttlistDecl
+      , required   = listToFM [ (elem, concat [ [ attr | AttDef attr _ REQUIRED <- attdefs ]
+                                              | AttList (AttListDecl elem' attdefs) <- decls
+                                              , elem' == elem ]
+                                )
+                              | Element (ElementDecl elem _) <- decls ]
       , ids        = [ (elem,attr)
                      | Element (ElementDecl elem _) <- decls
                      , AttList (AttListDecl name attdefs) <- decls
diff --git a/src/Text/XML/HaXml/Verbatim.hs b/src/Text/XML/HaXml/Verbatim.hs
--- a/src/Text/XML/HaXml/Verbatim.hs
+++ b/src/Text/XML/HaXml/Verbatim.hs
@@ -71,7 +71,9 @@
     verbatim (CElem c _)     = verbatim c
     verbatim (CString _ c _) = c
     verbatim (CRef c _)      = verbatim c
-    verbatim (CMisc _ _)     = error "NYI: verbatim not defined for CMisc"
+    verbatim (CMisc (Comment c) _) = "<!--"++c++"-->"
+    verbatim (CMisc _ _)     = "<? ?>"
+ -- verbatim (CMisc _ _)     = error "NYI: verbatim not defined for CMisc"
 
 instance Verbatim (Element i) where
     verbatim (Elem nam att [])   = "<" ++ qname nam
diff --git a/src/Text/XML/HaXml/XmlContent/Parser.hs b/src/Text/XML/HaXml/XmlContent/Parser.hs
--- a/src/Text/XML/HaXml/XmlContent/Parser.hs
+++ b/src/Text/XML/HaXml/XmlContent/Parser.hs
@@ -192,7 +192,9 @@
             | otherwise       -> fail ("Too many elements inside <"
                                       ++printableName e++"> at\n"
                                       ++show (info d)++"\n"
-                                      ++"Found excess: "++verbatim d)
+                                      ++"Found excess: "
+                                      ++verbatim (take 7 ds)
+                                      ++"\n[...]")
   where onlyMisc (CMisc _ _) = True
         onlyMisc (CString False s _) | all isSpace s = True
         onlyMisc _ = False
diff --git a/src/tools/DtdToHaskell.hs b/src/tools/DtdToHaskell.hs
--- a/src/tools/DtdToHaskell.hs
+++ b/src/tools/DtdToHaskell.hs
@@ -56,6 +56,7 @@
   in
   do hPutStrLn o ("module "++realname
                   ++" where\n\nimport Text.XML.HaXml.XmlContent"
+                  ++"\nimport Text.XML.HaXml.Types"
                   ++"\nimport Text.XML.HaXml.OneOfN")
     --            ++"\nimport Char (isSpace)"
     --            ++"\nimport List (isPrefixOf)"
diff --git a/src/tools/FpMLToHaskell.hs b/src/tools/FpMLToHaskell.hs
new file mode 100644
--- /dev/null
+++ b/src/tools/FpMLToHaskell.hs
@@ -0,0 +1,216 @@
+-- FpMLToHaskell
+module Main where
+
+-- This program is designed to convert a bunch of XML files containing XSD
+-- module decls into a bunch of Haskell modules containing data/newtype
+-- definitions which mirror the XSD.  Once you have used this program
+-- to generate your type definitions, you should import Text.XML.HaXml.Schema
+-- (as well as the generated modules) wherever you intend to read and write
+-- XML files with your Haskell programs.
+
+import System.Exit
+import System.Environment
+import System.IO
+import Control.Monad
+import System.Directory
+import Data.List
+import Data.Maybe (fromMaybe,catMaybes)
+import Data.Function (on)
+import Data.Monoid (mconcat)
+--import Either
+
+import Text.XML.HaXml            (version)
+import Text.XML.HaXml.Types
+import Text.XML.HaXml.Namespaces (resolveAllNames,qualify
+                                 ,nullNamespace)
+import Text.XML.HaXml.Parse      (xmlParse')
+import Text.XML.HaXml.Util       (docContent)
+import Text.XML.HaXml.Posn       (posInNewCxt)
+
+import Text.XML.HaXml.Schema.Parse
+import Text.XML.HaXml.Schema.XSDTypeModel (Schema)
+import Text.XML.HaXml.Schema.NameConversion
+import Text.XML.HaXml.Schema.Environment    as Env
+import Text.XML.HaXml.Schema.TypeConversion as XsdToH
+import Text.XML.HaXml.Schema.PrettyHaskell
+import qualified Text.XML.HaXml.Schema.PrettyHsBoot     as HsBoot
+import qualified Text.XML.HaXml.Schema.HaskellTypeModel as Haskell
+import Text.ParserCombinators.Poly
+import Text.PrettyPrint.HughesPJ (render,vcat)
+
+fst3 :: (a,b,c) -> a
+fst3 (a,_,_) = a
+
+-- sucked in from Text.XML.HaXml.Wrappers to avoid dependency on T.X.H.Html
+argDirsToFiles :: IO (FilePath,[(FilePath,FilePath)])
+argDirsToFiles = do
+  args <- getArgs
+  when ("--version" `elem` args) $ do
+      putStrLn $ "part of HaXml-"++version
+      exitWith ExitSuccess
+  when ("--help" `elem` args) $ do
+      putStrLn $ "Usage: FpMLToHaskell xsdDir haskellDir"
+      putStrLn $ "    -- The results go into haskelldir/Data/FpML/file0.hs etc"
+      putStrLn $ "See http://haskell.org/HaXml"
+      exitWith ExitSuccess
+  case args of
+    [xsddir,hdir]-> do
+            files <- fmap (filter (".xsd" `isSuffixOf`))
+                          (getDirectoryContents xsddir)
+            let newdirs = map (\file->hdir++"/"++dirOf (fpml file)) files
+            mapM_ (\newdir -> do createDirectoryIfMissing True newdir) newdirs
+            return (xsddir
+                   ,map (\f-> (f, hdir++"/"++(reslash (fpml f))++".hs")) files)
+    _ -> do prog <- getProgName
+            putStrLn ("Usage: "++prog++" xsdDir haskellDir")
+            exitFailure
+ where
+  reslash = map (\c-> case c of '.'->'/'; _->c)
+  dirOf   = concat . intersperse "/" . init . wordsBy '.'
+  wordsBy c s = let (a,b) = span (/=c) s in
+                if null b then [a] else a: wordsBy c (tail b)
+
+main ::IO ()
+main = do
+    (dir,files) <- argDirsToFiles
+    deps <- flip mapM files (\ (inf,outf)-> do
+        hPutStrLn stdout $ "Reading "++inf
+        thiscontent <- readFile (dir++"/"++inf)
+        let d@Document{} = resolveAllNames qualify
+                           . either (error . ("not XML:\n"++)) id
+                           . xmlParse' inf
+                           $ thiscontent
+        case runParser schema [docContent (posInNewCxt inf Nothing) d] of
+            (Left msg,_) -> do hPutStrLn stderr msg
+                               return ([], undefined)
+            (Right v,[]) ->    return (Env.gatherImports v, v)
+            (Right v,_)  -> do hPutStrLn stdout $ "Parse incomplete!"
+                               hPutStrLn stdout $ inf
+                               hPutStrLn stdout $ "\n-----------------\n"
+                               hPutStrLn stdout $ show v
+                               hPutStrLn stdout $ "\n-----------------\n"
+                               return ([],v)
+        )
+    let filedeps :: [[((FilePath,FilePath),([(FilePath,Maybe String)],Schema))]]
+        filedeps  = ordered (\ ((inf,_),_)-> inf)
+                            (\ (_,(ds,_))-> map fst ds)
+                            (\x-> lookupWith (fst.fst) x (zip files deps))
+                            (zip files deps)
+        -- a single supertype environment, closed over all modules
+        supertypeEnv :: Environment
+        supertypeEnv = foldr (\fs e->
+                              foldr (\((inf,_),(_,v))-> mkEnvironment inf v)
+                                    e fs)
+                             emptyEnv filedeps
+        adjust :: Environment -> Environment
+        adjust env = env{ env_extendty = env_extendty supertypeEnv
+                        , env_substGrp = env_substGrp supertypeEnv
+                        , env_allTypes = env_allTypes supertypeEnv }
+        -- each module's env includes only dependencies, apart from supertypes
+        environs :: [(FilePath,(Environment,FilePath,Schema))]
+        environs  = flip concatMap filedeps $ \scc->
+                      case scc of
+                        [((inf,outf),(ds,v))]->
+                          [(inf, ( adjust $ mkEnvironment inf v
+                                     (foldr combineEnv emptyEnv
+                                         (flip map ds
+                                               (\d-> fst3 $
+                                                     fromMaybe (error "FME") $
+                                                     lookup (fst d) environs)
+                                         )
+                                     )
+                                 , outf
+                                 , v
+                                 )
+                          )]
+                        cyclic ->
+                            let jointSchema :: Schema
+                                jointSchema = mconcat (map (snd.snd) cyclic)
+                                jointDeps :: [FilePath]
+                                jointDeps = concatMap (map fst.fst.snd) cyclic
+                                jointEnv :: Environment
+                                jointEnv = mkEnvironment "" jointSchema $
+                                           foldr combineEnv emptyEnv $
+                                           flip map (nub jointDeps
+                                                    \\ map (fst.fst) cyclic)
+                                               (\d-> fst3 $
+                                                     fromMaybe (error "FME") $
+                                                     lookup d environs)
+                            in flip map cyclic
+                                    (\((inf,outf),(_,v))->
+                                      (inf,(adjust $ mkEnvironment inf v
+                                                   $ jointEnv
+                                           ,outf
+                                           ,v)
+                                      )
+                                    )
+    flip mapM_ environs (\ (inf,(env,outf,v))-> do
+        o  <- openFile outf WriteMode
+        hb <- openFile (bootf outf) WriteMode
+        let decls   = XsdToH.convert env v
+            haskell = Haskell.mkModule inf v decls
+            doc     = ppModule fpmlNameConverter haskell
+            docboot = HsBoot.ppModule fpmlNameConverter haskell
+        hPutStrLn stdout $ "Writing "++outf
+        hPutStrLn o $ render doc
+        hPutStrLn stdout $ "Writing "++(bootf outf)
+        hPutStrLn hb $ render docboot
+        hFlush o
+        hFlush hb
+        )
+
+-- | Munge filename for hs-boot.
+bootf :: FilePath -> FilePath
+bootf x = case reverse x of
+            's':'h':'.':f -> reverse f++".hs-boot"
+            _ -> error "bad stuff made my cheese boots melt"
+
+-- | Calculate dependency ordering of modules, least dependent first.
+--   Cyclic groups may occur, suitably placed in the ordering.
+ordered :: (Eq a, Eq b) => (b->a) -> (b->[a]) -> (a->Maybe b) -> [b] -> [[b]]
+ordered name deps env list =
+    let cycles    = cyclicDeps name deps env list
+        noncyclic = map (:[]) $ list \\ concat cycles
+        workqueue = noncyclic++cycles
+    in traverse [] workqueue
+  where
+    traverse acc []     = acc
+    traverse acc (w:wq) = if all (`elem` concatMap (map name) acc)
+                                 (concatMap deps w \\ map name w)
+                          then traverse (acc++[w]) wq
+                          else traverse     acc   (wq++[w])
+
+-- | Find cyclic dependencies between modules.
+cyclicDeps :: Eq a => (b->a) -> (b->[a]) -> (a->Maybe b) -> [b] -> [[b]]
+cyclicDeps name deps env = nubBy (setEq`on`map name)
+                           . (\cs-> foldl minimal cs cs)
+                           . concatMap (walk [])
+  where
+--  walk :: [b] -> b -> [[b]]
+    walk acc t = if name t `elem` map name acc then [acc]
+                 else concatMap (walk (t:acc)) (catMaybes . map env $ deps t)
+    minimal acc c = concatMap (prune c) acc
+    prune c c' = if map name c `isProperSubsetOf` map name c' then [] else [c']
+    isSubsetOf a b = all (`elem`b) a
+    setEq a b            = a`isSubsetOf`b &&      b`isSubsetOf`a
+    isProperSubsetOf a b = a`isSubsetOf`b && not (b`isSubsetOf`a)
+
+-- | A variation on the standard lookup function.
+lookupWith :: Eq a => (b->a) -> a -> [b] -> Maybe b
+lookupWith proj x [] = Nothing
+lookupWith proj x (y:ys) | proj y == x = Just y
+                         | otherwise   = lookupWith proj x ys
+
+-- | What is the targetNamespace of the unique top-level element?
+targetNamespace :: Element i -> String
+targetNamespace (Elem qn attrs _) =
+    if qn /= xsdSchema then "ERROR! top element not an xsd:schema tag"
+    else case lookup (N "targetNamespace") attrs of
+           Nothing -> "ERROR! no targetNamespace specified"
+           Just atv -> show atv
+
+-- | The XSD Namespace.
+xsdSchema :: QName
+xsdSchema = QN (nullNamespace{nsURI="http://www.w3.org/2001/XMLSchema"})
+               "schema"
+
diff --git a/src/tools/MkOneOf.hs b/src/tools/MkOneOf.hs
--- a/src/tools/MkOneOf.hs
+++ b/src/tools/MkOneOf.hs
@@ -39,11 +39,11 @@
                                  [1..n]
                                  (take n variables))
     ++ "\n    deriving (Eq,Show)"
-    ++ "\n\ninstance "++ format 10 78 10 "(" ","
+    ++ "\n\ninstance "++ format 9 78 9 "(" ","
                                 (map ("HTypeable "++) (take n variables))
     ++ ")\n    => HTypeable ("++ typename n 26 ++")\n  where"
-    ++ "      toHType m = Defined \""++constructor 1 n++"\" [] []"
-    ++ "\n\ninstance "++ format 10 78 10 "(" ","
+    ++ "      toHType _ = Defined \""++constructor 1 n++"\" [] []"
+    ++ "\n\ninstance "++ format 9 78 9 "(" ","
                                 (map ("XmlContent "++) (take n variables))
     ++ ")\n    => XmlContent ("++ typename n 26 ++")\n  where"
     ++ "\n    parseContents ="
@@ -53,6 +53,17 @@
     ++ concatMap (\v->"\n    toContents ("++constructor v n
                                           ++" x) = toContents x")
                  [1..n]
+    ++ "\n\nfold"++constructor 1 n++" :: "
+                 ++format 15 78 15 "" ""
+                          (map (\v->"("++v++"->z) -> ") (take n variables))
+                 ++"\n               "
+                 ++constructor 1 n++format 22 78 22 " " " " (take n variables)
+                 ++"\n               -> z"
+    ++ concat (zipWith (\i v-> "\n"++"fold"++constructor 1 n
+                               ++format 11 50 11 " " " " (take n variables)
+                               ++" ("++constructor i n ++" z) = "++v++" z")
+                       [1..n]
+                       (take n variables))
     ++ "\n\n----"
 
 ---- constructor names ----
@@ -73,7 +84,7 @@
 
 ---- variable names ----
 variables :: [String]
-variables = [ v:[] | v <- ['a'..'z']]
+variables = [ v:[] | v <- ['a'..'y']]
             ++ [ v:w:[] | v <- ['a'..'z'], w <- ['a'..'z']]
 
 ---- simple pretty-printing ----