diff --git a/happstack-data.cabal b/happstack-data.cabal
--- a/happstack-data.cabal
+++ b/happstack-data.cabal
@@ -1,5 +1,5 @@
 Name:               happstack-data
-Version:            0.1
+Version:            0.2.1
 License:            BSD3
 License-File:       COPYING
 Author:             Happstack team, HAppS LLC
@@ -28,7 +28,7 @@
 
 Flag tests
     Description: Build the testsuite, and include the tests in the library
-    Default: True
+    Default: False
 
 Library
   if flag(base4)
@@ -36,47 +36,49 @@
   else
     Build-Depends:    base < 4
 
-  Build-Depends:      mtl, template-haskell, syb-with-class >= 0.5, HaXml >= 1.13 && < 1.14,
-                      happstack-util, bytestring, pretty, binary, containers
+  Build-Depends:      binary,
+                      bytestring,
+                      containers,
+                      happstack-util >= 0.2.1 && < 0.3, 
+                      HaXml >= 1.13 && < 1.14,
+                      mtl,
+                      pretty,
+                      syb-with-class >= 0.5,
+                      template-haskell
+
   hs-source-dirs:     src
   if flag(tests)
     hs-source-dirs:    tests
   Exposed-modules:
-    HAppS.Data
-    HAppS.Data.Default
-    HAppS.Data.Default.Generic
-    HAppS.Data.DeriveAll
-    HAppS.Data.HList
-    HAppS.Data.Migrate
-    HAppS.Data.Normalize
-    HAppS.Data.Pairs
-    HAppS.Data.Xml
-    HAppS.Data.Xml.HaXml
-    HAppS.Data.Atom
-    HAppS.Data.GOps
-    HAppS.Data.Proxy
-    HAppS.Data.Serialize
-    HAppS.Data.SerializeTH
+    Happstack.Data
+    Happstack.Data.Default
+    Happstack.Data.Default.Generic
+    Happstack.Data.DeriveAll
+    Happstack.Data.Migrate
+    Happstack.Data.Normalize
+    Happstack.Data.Pairs
+    Happstack.Data.Xml
+    Happstack.Data.Xml.HaXml
+    Happstack.Data.GOps
+    Happstack.Data.Proxy
+    Happstack.Data.Serialize
+    Happstack.Data.SerializeTH
   if flag(tests)
     Exposed-modules:   
-      HAppS.Data.Tests
-      HAppS.Data.Tests.HasT001
-      HAppS.Data.Tests.Xml001
-      HAppS.Data.Tests.Xml002
-      HAppS.Data.Tests.Xml003
-      HAppS.Data.Tests.HList001
-      HAppS.Data.Tests.HList002
+      Happstack.Data.Tests
+      Happstack.Data.Tests.Xml001
+      Happstack.Data.Tests.Xml002
+      Happstack.Data.Tests.Xml003
 
   Other-modules:
-    HAppS.Data.HListBase
-    HAppS.Data.Xml.Base
-    HAppS.Data.Xml.Instances
-    HAppS.Data.Xml.PrintParse
+    Happstack.Data.Xml.Base
+    Happstack.Data.Xml.Instances
+    Happstack.Data.Xml.PrintParse
   Extensions: TemplateHaskell, FlexibleInstances, UndecidableInstances,
               OverlappingInstances, MultiParamTypeClasses, CPP,
               FunctionalDependencies, DeriveDataTypeable, FlexibleContexts,
               ScopedTypeVariables, GADTs, GeneralizedNewtypeDeriving,
-              PatternSignatures, TypeSynonymInstances, PatternGuards,
+              TypeSynonymInstances, PatternGuards,
               PolymorphicComponents
   -- Should also have ", DeriveDataTypeable" but Cabal complains
   GHC-Options: -Wall
diff --git a/src/HAppS/Data.hs b/src/HAppS/Data.hs
deleted file mode 100644
--- a/src/HAppS/Data.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module HAppS.Data
-   (
-    module Data.Typeable
-   ,module HAppS.Data.Default
-   ,module HAppS.Data.DeriveAll
-   ,module HAppS.Data.HList
-   ,module HAppS.Data.Migrate
-   ,module HAppS.Data.Normalize
-   ,module HAppS.Data.Pairs
-   ,module HAppS.Data.Xml
-   ,module HAppS.Data.GOps
-   ,module HAppS.Data.Serialize
-   ,module HAppS.Data.SerializeTH
-   )
-where
-
-import HAppS.Data.GOps
-import Data.Typeable
-import HAppS.Data.Default
-import HAppS.Data.DeriveAll
-import HAppS.Data.HList
-import HAppS.Data.Migrate
-import HAppS.Data.Normalize
-import HAppS.Data.Pairs
-import HAppS.Data.Xml
-import HAppS.Data.Serialize hiding (migrate, Migrate)
-import HAppS.Data.SerializeTH
diff --git a/src/HAppS/Data/Atom.hs b/src/HAppS/Data/Atom.hs
deleted file mode 100644
--- a/src/HAppS/Data/Atom.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-{-# LANGUAGE CPP, TemplateHaskell, UndecidableInstances, DeriveDataTypeable #-}
-module HAppS.Data.Atom 
-    (
-     Entry(..)
-    ,Feed(..)
-    ,Author(..)
-    ,Contributor(..)
-    ,Category(..)
-    ,Id(..)
-    ,Title(..)
-    ,Published(..)
-    ,Updated(..)
-    ,Summary(..)
-    ,Content(..)
-    ,Word(..)
-    ,Email(..)
-
-
-)
-    where
-
-import HAppS.Data
-
-
-$( deriveAll [''Ord,''Eq,''Read,''Show,''Default] 
-   [d|
-    data Feed = Feed [Entry]
-
-    data Entry = 
-        Entry
-        [Author]                                                                                                                                              
-        [Category]  
-        (Maybe Content )
-        [Contributor]
-        Id
-        
-        -- Link is a computed value
-        (Maybe Published)
-        -- ignoring stuff I don't care about
-        (Maybe Summary)
-        Title
-        Updated
-
-       {--
-
-        Entry 
-
-        --stuff not in the spec but commonly useful for management
-        --a -- sometime you want to stick other data in here
-        --(Maybe Owner) -- not in spec but useful for actual management
-        --(Maybe Refs) -- for use when Entry is actually a comment on another 
-
-        Author -- we will have only one author
-        [Contributor] -- author can credit contributors
-        [Category] -- allow user to select categories
-        Id 
-        -- Link is a computed value
-        Title
-        Updated 
-        Maybe Published
-        -- (Maybe Rights)
-        Maybe Summary -- We choose to always have a summary
-        Maybe Content -- We choose to always have content
-        --}
-
-    type PersonConstruct = (Name, Maybe Uri, Maybe Email)
-    data Author = Author PersonConstruct
-    data Contributor = Contributor PersonConstruct
-    newtype Name = Name Text 
-
-    data Category = Category Term (Maybe Scheme) (Maybe Label) 
-    newtype Term = Term String 
-    newtype Scheme = Scheme String 
-    newtype Label = Label String 
-
-    newtype Id = Id Integer 
-
-    type DateConstruct = Integer
-
-    data Title = Title TextConstruct 
-    data Subtitle = Subtitle TextConstruct 
-    newtype Summary = Summary TextConstruct 
-    newtype Content = Content TextConstruct 
-
-    newtype Uri = Uri String 
-    newtype Email = Email String 
-    newtype Updated = Updated DateConstruct
-    newtype Published = Published DateConstruct
-
-    type Text = String
-    type TextConstruct = Text
-
-    newtype Word = Word String
- |] )
-
-#define V(x) instance Version x
-V(Uri);V(Email);V(Updated);V(Published);V(Title);V(Subtitle)
-V(Summary);V(Content);V(Author);V(Contributor);V(Name);V(Category)
-V(Term);V(Scheme);V(Label);V(Id)
-$(deriveSerializeFor [''Uri, ''Email, ''Updated, ''Published
-                     ,''Title, ''Subtitle, ''Summary, ''Content
-                     ,''Author, ''Contributor, ''Name, ''Category
-                     ,''Term, ''Scheme, ''Label, ''Id])
-
diff --git a/src/HAppS/Data/Default.hs b/src/HAppS/Data/Default.hs
deleted file mode 100644
--- a/src/HAppS/Data/Default.hs
+++ /dev/null
@@ -1,124 +0,0 @@
-{-# LANGUAGE OverlappingInstances, UndecidableInstances,
-             FlexibleContexts #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  HAppS.Data.Default
--- Copyright   :  (c) 2007 HAppS LLC
--- License     :  BSD3
---
--- Maintainer  :  AlexJacobson@HAppS.org
--- Stability   :  experimental
--- Portability :  Not portable
---
--- Provides default values for Haskell datatypes.
---
------------------------------------------------------------------------------
-
-module HAppS.Data.Default
-    (
-        -- * The interface
-        Default(defaultValue),
-
-        -- * Writing your own instances
-        defaultDefaultValue,
-
-        -- * Advanced usage
-        DefaultD(..),
-        defaultProxy,
-    )
-    where
-
-import qualified Data.ByteString.Char8 as BSC
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Instances ()
-import Data.Int
-import Data.Word
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Foreign.ForeignPtr
-
--- | The 'Default' class provides a 'defaultValue' value, which
--- is the default value for that type.
---
--- There is no instance for arbitrary types by default, but if you
--- declare an instance without providing the value then one will be
--- built using the first constructor. 'defaultValue' is used to provide
--- values for any arguments of the constructor.
---
--- If you want an instance for all types then import
--- "HAppS.Data.Default.Generic".
-class (Data DefaultD a) => Default a where
-    defaultValue :: a
-    defaultValue = defaultDefaultValue
-
--- | This is the 'defaultValue' that is used in an instance if you don't
--- specify one. It may be a useful building block when writing your own
--- instances.
-defaultDefaultValue :: (Data DefaultD a,Default a) => a
-defaultDefaultValue = res
-    where res = case datarep $ dataTypeOf defaultProxy res of
-                    AlgRep (c:_) ->
-                        fromConstrB defaultProxy (defaultValueD dict) c
-                    r ->
-                        error ("defaultDefaultValue: Bad DataRep: " ++ show r)
-
--- | When writing your own generic functions for 'Default' you may
--- need to access the class method through this datatype rather than
--- directly.
-data DefaultD a = DefaultD { defaultValueD :: a }
-
--- | When writing your own generic functions for 'Default' you may
--- need this, the proxy value.
-defaultProxy :: Proxy DefaultD
-defaultProxy = error "defaultProxy"
-
-instance Default t => Sat (DefaultD t) where
-    dict = DefaultD { defaultValueD = defaultValue }
-
-instance Default a => Default [a] where
-    defaultValue = []
-
-instance Default Int     where defaultValue = 0
-instance Default Int8    where defaultValue = 0
-instance Default Int16   where defaultValue = 0
-instance Default Int32   where defaultValue = 0
-instance Default Int64   where defaultValue = 0
-instance Default Word    where defaultValue = 0
-instance Default Word8   where defaultValue = 0
-instance Default Word16  where defaultValue = 0
-instance Default Word32  where defaultValue = 0
-instance Default Word64  where defaultValue = 0
-instance Default Integer where defaultValue = 0
-instance Default Float   where defaultValue = 0
-instance Default Double  where defaultValue = 0
-
-instance (Default a, Default b) => Default (Either a b) where
-    defaultValue = Left defaultValue
-
-instance Default () where
-    defaultValue = ()
-instance (Default a, Default b) => Default (a,b) where
-    defaultValue = (defaultValue, defaultValue)
-instance (Default a, Default b, Default c) => Default (a,b,c) where
-    defaultValue = (defaultValue, defaultValue, defaultValue)
-instance (Default a, Default b, Default c, Default d) => Default (a,b,c,d) where
-    defaultValue = (defaultValue, defaultValue, defaultValue, defaultValue)
-
-
-instance Default Char where
-    defaultValue = 'A'
-
-instance Default a => Default (Maybe a) where
-    defaultValue = Nothing
-
-instance Default BSC.ByteString where
-    defaultValue = BSC.pack ""
-
--- We don't really want this instance, but we need it for the ByteString
--- instance
-instance Default a => Default (ForeignPtr a) where
-    defaultValue = error "defaultValue: ForeignPtr"
-
-instance (Data DefaultD a, Data DefaultD b, Ord a) => Default (M.Map a b) 
-instance (Data DefaultD a, Ord a) => Default (S.Set a)
diff --git a/src/HAppS/Data/Default/Generic.hs b/src/HAppS/Data/Default/Generic.hs
deleted file mode 100644
--- a/src/HAppS/Data/Default/Generic.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-
-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  HAppS.Data.Default.Generic
--- Copyright   :  (c) 2007 HAppS LLC
--- License     :  BSD3
---
--- Maintainer  :  AlexJacobson@HAppS.org
--- Stability   :  experimental
--- Portability :  Not portable
---
--- Provides a 'Default' instance for all types. 'defaultDefaultValue' is
--- used for 'defaultValue'.
---
------------------------------------------------------------------------------
-
-module HAppS.Data.Default.Generic () where
-
-import HAppS.Data.Default
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Instances ()
-
-instance Data DefaultD a => Default a
-
diff --git a/src/HAppS/Data/DeriveAll.hs b/src/HAppS/Data/DeriveAll.hs
deleted file mode 100644
--- a/src/HAppS/Data/DeriveAll.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-
-{-# LANGUAGE TemplateHaskell, CPP #-}
-{-# OPTIONS_GHC -Wall -Werror #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  HAppS.Data.DeriveAll
--- Copyright   :  (c) 2007 HAppS LLC
--- License     :  BSD3
---
--- Maintainer  :  AlexJacobson@HAppS.org
--- Stability   :  experimental
--- Portability :  Not portable
---
--- Concisely specify which classes to derive for your datatypes.
--- As well as the standard derivable classes, it can also
--- derive syb-with-class's 'New.Data' class and HAppS.Data.Default's
--- 'Default' class.
---
------------------------------------------------------------------------------
-
-module HAppS.Data.DeriveAll (deriveAll, deriveNewData, deriveNewDataNoDefault)
-    where
-
-import qualified Data.Generics as Old
-import Data.Generics.SYB.WithClass.Derive
-import Data.List
-import HAppS.Data.Default
-import Language.Haskell.TH
-
-deriveNewData :: [Name] -> Q [Dec]
-deriveNewData names
- = do nd <- deriveData names
-      defaults <- mapM mkDefaultInstance names
-      return (nd ++ concat defaults)
-
-deriveNewDataNoDefault :: [Name] -> Q [Dec]
-deriveNewDataNoDefault = deriveData
-
-mkDefaultInstance :: Name -> Q [Dec]
-mkDefaultInstance name
- = do info <- reify name
-      case info of
-          TyConI (NewtypeD _ nm tvs _ _) -> return $ deriveDefault True tvs nm
-          TyConI (DataD    _ nm tvs _ _) -> return $ deriveDefault True tvs nm
-          _ -> fail ("mkDefaultInstance: Bad info: " ++ pprint info)
-
--- | The 'deriveAll' function takes a list of classes to derive and
--- a block of declarations. It will additionally derive instances for
--- 'Typeable', 'Old.Data' and 'New.Data'.
---
--- Example:
---
--- > $( deriveAll [''Show, ''Eq, ''Default] [d|
--- >        data Foo a = Foo a
--- >        data Bar = Baz | Quux
--- >  |] )
-deriveAll :: [Name] -> Q [Dec] -> Q [Dec]
-deriveAll classes0 qdecs
- = do decs <- qdecs
-      derivedDecs <- deriveDec (filter isDataOrNewtype decs)
-      let (classDefault, classes1) = partition (''Default ==) classes0
-          classes2 = ''Old.Data : classes1
-          addDefaultInstance = not $ null classDefault
-          f = addDerivedClasses addDefaultInstance classes2
-          decs' = concatMap f decs
-      return (decs' ++ derivedDecs)
-
-addDerivedClasses :: Bool -> [Name] -> Dec -> [Dec]
-addDerivedClasses def cs (DataD ctxt nm tvs cons derivs)
-    = DataD ctxt nm tvs cons (cs ++ derivs)
-    : deriveDefault def tvs nm
-addDerivedClasses def cs (NewtypeD ctxt nm tvs con derivs)
-    = NewtypeD ctxt nm tvs con (cs ++ derivs)
-    : deriveDefault def tvs nm
-addDerivedClasses _ _ d = [d]
-
-deriveDefault :: Bool -> [Name] -> Name -> [Dec]
-deriveDefault False _ _ = []
-deriveDefault True tvs n = [InstanceD context instanceHead []]
-    where tvs' = map VarT tvs
-          mkDef x = ConT ''Default `AppT` x
-          context = map mkDef tvs'
-          instanceHead = mkDef $ foldl AppT (ConT n) tvs'
-
-isDataOrNewtype :: Dec -> Bool
-isDataOrNewtype (DataD {}) = True
-isDataOrNewtype (NewtypeD {}) = True
-isDataOrNewtype _ = False
-
diff --git a/src/HAppS/Data/GOps.hs b/src/HAppS/Data/GOps.hs
deleted file mode 100644
--- a/src/HAppS/Data/GOps.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-module HAppS.Data.GOps where
-import Data.Generics hiding (GT)
-import Control.Monad.Reader
-import Control.Monad.State
-import Data.Maybe
-
--- useful generic functions with better names
-
-gSet :: (Data b, Typeable a) => a -> b -> b
-gSet v = gReplace (const v)
-
-gReplace :: (Typeable a, Data b) => (a -> a) -> b -> b
-gReplace f x = everywhere (mkT f) x
-
-gFind :: (MonadPlus m, Data a, Typeable b) => a -> m b
-gFind x = msum $ map return $ listify (const True) x
-
-gFind' :: (Data a, Typeable b) => a -> b
-gFind' x = fromJust $ gFind x
---Monad versions
-
-gModify :: (MonadState s m,Typeable a,Data s) => (a->a) -> m ()
-gModify f = modify $ gReplace f
-
-gAsk :: (Data r, Typeable a, MonadReader r m, MonadPlus n) =>
-        (a -> n b) -> m (n b)
-gAsk f = do st <- ask
-            let y = gFind st 
-            return $ maybe mzero f y
-
-gGet :: (Data s, Typeable a, MonadState s m, MonadPlus n) =>
-        (a -> n b) -> c -> m (n b)
-gGet f _ = do st <- get
-              let y = gFind st 
-              return $ maybe mzero f y
-
diff --git a/src/HAppS/Data/HList.hs b/src/HAppS/Data/HList.hs
deleted file mode 100644
--- a/src/HAppS/Data/HList.hs
+++ /dev/null
@@ -1,98 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances,
-             UndecidableInstances, OverlappingInstances,
-             MultiParamTypeClasses, CPP, FunctionalDependencies #-}
-
-module HAppS.Data.HList (HasT, hlextract, hlupdate, (.&.),
-                         (:&:),
-                         Couple(..),Nil(..),CoupleClass,hMap,trans) where
--- HList useful with generic
-
-import HAppS.Data.Xml
-import HAppS.Data.Pairs
-import Data.Generics as G
-import HAppS.Data.HListBase
-
-infixr 6 .&.
-(.&.) :: a -> b -> Couple a b
-(.&.) = Couple
-
-type a :&: b = Couple b a
-
-
-
-class CoupleClass a where
-    toPairs' :: a -> Pairs
-    fromPairs' :: Pairs -> Maybe a
-
-instance (Eq a,Xml a, Show a, G.Data a,CoupleClass b) => CoupleClass (Couple a b) where
-    toPairs' (Couple a b) = (toPairs a) ++ (toPairs' b)
-    fromPairs' = const Nothing --doesn't make sense to unmix to make toPairs' . fromPairs' an identity
-
-instance CoupleClass Nil where
-    toPairs' _ = []
-    fromPairs' _ = return Nil
-
-instance (Xml a, Xml b) => Xml (Couple a b) where
-    toXml (Couple a b) = (toXml a) ++ (toXml b)
-    readXml r xml = do
-                  (xml', a) <- readXml r xml
-                  (xml'', b) <- readXml r xml'
-                  return (xml'', Couple a b)
-
-hlextract :: HasT a b => a -> b
-hlextract hlist = x hlist
-
-hlupdate :: HasT a b => a -> b -> a
-hlupdate hlist val = u hlist val
-
-class HasT a b where
-    x :: a -> b
-    u :: a -> b -> a
-
-instance HasT (Couple a b) a  where
-    x (Couple a _) = a
-    u (Couple _ b) a = Couple a b
-
-instance HasT (Couple a b) b where
-    x (Couple _ b) = b
-    u (Couple a _) b = Couple a b
-
--- Oleg's trick http://www.haskell.org/pipermail/haskell/2004-June/014176.html
-class HasT' a b where 
-    x' :: a -> b
-    u' :: a -> b -> a
-
-instance HasT' a b => HasT a b where
-    x a = x' a
-    u a b = u' a b
-
-instance (HasT c a) => HasT' (Couple b c) a where
-    x' (Couple _ b) = x b
-    u' (Couple a b) c = Couple a (u b c)
-
-class Trans ft a where
-    trans :: ft -> a -> a
-
-instance Trans (a->a) (Couple a b) where
-    trans f (Couple a b) = Couple (f a) b
-
-instance Trans (b->b) (Couple a b) where
-    trans f (Couple a b) = Couple a (f b) 
-
-class Trans' ft a where
-    trans' :: ft -> a ->a
-
-instance Trans' ft a => Trans ft a where
-    trans f a = trans' f a
-
-instance (Trans ft b) => Trans' ft (Couple a b) where
-    trans' f (Couple a b) = Couple a (trans f b)
-
-class HMap a b | a -> b where
-    hMap::a->b
-
-instance (HMap b d,CoupleClass b) => HMap (Couple a b) (Couple [a] d) where
-    hMap (Couple a b) = Couple [a] $ hMap b 
-
-instance HMap (Couple a Nil) (Couple [a] Nil) where
-    hMap (Couple a Nil) = Couple [a] Nil
diff --git a/src/HAppS/Data/HListBase.hs b/src/HAppS/Data/HListBase.hs
deleted file mode 100644
--- a/src/HAppS/Data/HListBase.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances,
-             UndecidableInstances, OverlappingInstances,
-             MultiParamTypeClasses, CPP, DeriveDataTypeable #-}
-module HAppS.Data.HListBase where
-import HAppS.Data.DeriveAll
-import HAppS.Data.Default
-import Data.Typeable
-
-$( deriveAll [''Show,''Default,''Eq,''Read,''Ord]
-   [d|
-        data Couple a b = Couple a b
-        data Nil = Nil
-    |]
-  )
-
-nil::Nil
-nil=Nil
diff --git a/src/HAppS/Data/Migrate.hs b/src/HAppS/Data/Migrate.hs
deleted file mode 100644
--- a/src/HAppS/Data/Migrate.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-module HAppS.Data.Migrate where
-
-class Migrate a b where
-    migrate :: a -> b
-
diff --git a/src/HAppS/Data/Normalize.hs b/src/HAppS/Data/Normalize.hs
deleted file mode 100644
--- a/src/HAppS/Data/Normalize.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# LANGUAGE OverlappingInstances, UndecidableInstances,
-             FlexibleContexts, FlexibleInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  HAppS.Data.Normalize
--- Copyright   :  (c) 2007 HAppS LLC
--- License     :  BSD3
---
--- Maintainer  :  AlexJacobson@HAppS.org
--- Stability   :  experimental
--- Portability :  Not portable
---
--- Normalizing Haskell values.
---
------------------------------------------------------------------------------
-
-module HAppS.Data.Normalize
-    (
-        -- * The interface
-        Normalize(normalize, normalizeRecursively),
-
-        -- * Writing your own instances
-        defaultNormalize,
-        defaultNormalizeRecursively,
-
-        -- * Advanced usage
-        NormalizeD(..),
-        normalizeProxy,
-    )
-    where
-
-import Data.Generics.SYB.WithClass.Basics
-
--- | The 'Normalize' class provides a 'normalize' function, which
--- is intended to normalize values only at the top-level constructor,
--- and a 'normalizeRecursively' function, which is intended to
--- normalize all the subvalues and then normalize the top-level
--- constructor.
---
--- There is a default instance that matches all types, where 'normalize'
--- is 'id' and 'normalizeRecursively' applies 'normalizeRecursively' to
--- all of its children and then 'normalize' to the result.
---
--- If you want to actually do some normalization for a certain type,
--- then just define an instance for that type; this will take precedence
--- over the default instance.
-class Data NormalizeD a => Normalize a where
-    normalize :: a -> a
-    normalize = defaultNormalize
-    normalizeRecursively :: a -> a
-    normalizeRecursively = defaultNormalizeRecursively
-
--- | This is the 'normalize' function in the default 'Normalize'
--- instance. It may be a useful building block when writing your own
--- instances.
-defaultNormalize :: Normalize a => a -> a
-defaultNormalize x = x
-
--- | This is the 'normalizeRecursively' function in the default
--- 'Normalize' instance. It may be a useful building block when writing
--- your own instances.
-defaultNormalizeRecursively :: Normalize a => a -> a
-defaultNormalizeRecursively x
- = normalize $ gmapT normalizeProxy (normalizeRecursivelyD dict) x
-
--- | When writing your own generic functions for 'Normalize' you may
--- need to access the class methods through this datatype rather than
--- directly.
-data NormalizeD a = NormalizeD { normalizeD :: a -> a,
-                                 normalizeRecursivelyD :: a -> a }
-
--- | When writing your own generic functions for 'Normalize' you may
--- need this, the proxy value.
-normalizeProxy :: Proxy NormalizeD
-normalizeProxy = error "normalizeProxy"
-
-instance Normalize t => Sat (NormalizeD t) where
-    dict = NormalizeD { normalizeD = normalize,
-                        normalizeRecursivelyD = normalizeRecursively }
-
-instance Data NormalizeD a => Normalize a
-
diff --git a/src/HAppS/Data/Pairs.hs b/src/HAppS/Data/Pairs.hs
deleted file mode 100644
--- a/src/HAppS/Data/Pairs.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, UndecidableInstances -- just for example at the bottom
-    ,CPP, DeriveDataTypeable, MultiParamTypeClasses
-  #-}
-module HAppS.Data.Pairs (pairsToXml,xmlToPairs,pairsToHTMLForm,xmlToHTMLForm
-                        ,toPairs,toPairsX,fromPairs,toHTMLForm
-                        ,Pairs,AsPairs
-                        ) where
-
-import Data.Char
-import Data.List
-import Data.Maybe
-
----stuff for examples
-import HAppS.Data.DeriveAll
-import HAppS.Util.Common
-
-import Data.Generics as G
-import HAppS.Data.Default -- for pairs
-import HAppS.Data.Xml
-import Control.Monad.Identity
-
-type Pairs = [(String,String)]
-
-pairsToXml :: Pairs -> [Element]
-pairsToXml pairs = fst $ formIntoEls "" $ map slash pairs
-
-slash :: (String,t) -> (String,t)
-slash p@('/':_,_) = p
-slash (n,v) = ('/':n,v)
-
-formIntoEls :: String -> Pairs -> ([Element], Pairs)
-formIntoEls _ [] = ([],[])
-formIntoEls ctx pairs@((name,val):rest)
-    | not $ isPrefixOf ctx name = ([],pairs)
-    | isAttr = moreCtx $ Attr elName val
-    | isLeaf = moreCtx $ Elem elName [CData val]
-    | otherwise =
-        let (es,pairs') = formIntoEls ctx' pairs
-            (es',pairs'') = formIntoEls ctx pairs'
-        in
-        (Elem elName es:es',pairs'')
-    where
-    ctx' = ctx ++ "/" ++ top
-    node =  tail $ drop (length ctx) name
-    (top,subs) = break (=='/') $  node
-    elName = takeWhile (/='[') top
-    isLeaf = null subs
-    isAttr = head top == '@'
-    moreCtx el = let (restCtx,restPairs) = formIntoEls ctx rest
-                 in (el:restCtx,restPairs)
-xmlToPairs :: [Element] -> Pairs
-xmlToPairs =
-    map (\(x,y)->(tail x,y)) .
-    xmlIntoPairs 0 ""
-
-xmlIntoPairs :: Int -> String -> [Element] -> Pairs
-xmlIntoPairs _ _ [] = []
-xmlIntoPairs x ctx (Elem _ []:xs) = xmlIntoPairs x ctx xs
-xmlIntoPairs x ctx (Attr n v:xs) = (ctx++"/"++n,v):xmlIntoPairs x ctx xs
-xmlIntoPairs _ ctx (CData v:[]) = [(ctx,v)]
-xmlIntoPairs _ _ (CData _:_) = []
-xmlIntoPairs i ctx ((Elem n xs):xs') =
-    thisElPairs ++ restPairs
-    where
-    --if we have two elements with the same name then we have to add [i]
-    nIndex = n ++ "[" ++ (show i) ++ "]"
-    (iNext,nName)
-        | i/=0 = (i+1,nIndex)
-        | null xs' = (0,n)
-        | next==n = (i+1,nIndex)
-        | otherwise = (0,n)
-    Elem next _ = head xs'
-    thisElPairs = (xmlIntoPairs 0 (ctx++"/"++nName) xs)
-    restPairs = (xmlIntoPairs iNext ctx xs')
-
-pairsToHTMLForm :: String -> String -> String -> Pairs -> [Element]
-pairsToHTMLForm iden action method pairs
- = [Elem "form" (Attr "action" action :
-                Attr "id" iden :
-                Attr "method" method :
-                map pToInput pairs ++
-                [submitButton])]
-
-submitButton :: Element
-submitButton = Elem "input" [Attr "type" "submit"]
-
-pToInput :: (String,String) -> Element
-pToInput (n,v)=
-    Elem "div" [Attr "class" "formEl",
-                Elem "span" [Attr "class" "name"
-                            ,CData $ map (\x->if x=='/' then ' ' else x) n]
-               ,Elem "input" [Attr "name" n,Attr "value" v]]
-
-xmlToHTMLForm :: (Xml a, Show a, Data a, Eq a) =>
-                 String -> String -> String -> a -> [Element]
-xmlToHTMLForm iden method action
- = pairsToHTMLForm iden method action  . toPairsX -- xmlToPairs
-
-class (Xml x,Show x, G.Data x) => AsPairs x where
-    toPairs::x->Pairs
-    fromPairs::Pairs -> Maybe x
-
-instance (Xml a,Show a,G.Data a,Eq a) => AsPairs a where
-    toPairs x = xmlToPairs $ toPublicXml x
-    fromPairs [] = Nothing
-    fromPairs pairs = if res == dv && notRigidMatch then Nothing else Just res
-        where
-        xml = pairsToXml $ mapFst clean pairs
-        res = runIdentity $ fromXml Flexible xml
-        mbRigidMatch = fromXml Rigid xml
-        _ = [mbRigidMatch,Just res]
-        isRigidMatch = isJust mbRigidMatch
-        notRigidMatch = not isRigidMatch
-        dv = defaultValue
-        (cons,_) = break (==' ') $ show dv
-        clean n = if (map toLower parent)==(map toLower cons) then n
-                  else if head n =='/' then n
-                  else (cons++('/':name))
-            where
-            name = trimSlash n
-            (parent,_) = break (=='/') name
-        trimSlash n = if head n=='/' then tail n else n
-
-toPairsX :: (Xml a, Show a, Data a, Eq a) => a -> Pairs
-toPairsX x = map (\(n,v)->let (_,child)=break (=='/') n in
-                            if null child then (n,v) else (tail child,v)) $ toPairs x
-
-toHTMLForm :: (Xml a, Show a, Data a, Eq a) =>
-              String -> String -> String -> a -> [Element]
-toHTMLForm iden method action = xmlToHTMLForm iden method action 
-
-
-
---- example usage and tests here
-$( deriveAll [''Show,''Default,''Eq]
-   [d|
-       data UserInfo = UserInfo User Pass 
-       newtype User = User String 
-       newtype Pass = Pass String 
-    |]
- )
diff --git a/src/HAppS/Data/Proxy.hs b/src/HAppS/Data/Proxy.hs
deleted file mode 100644
--- a/src/HAppS/Data/Proxy.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, DeriveDataTypeable, UndecidableInstances #-}
-module HAppS.Data.Proxy where
-
-import HAppS.Data.DeriveAll
-import HAppS.Data.Default
-
-$(deriveAll [''Read,''Show,''Default]
-  [d| data Proxy t = Proxy |]
- )
-
-proxy :: t -> Proxy t
-proxy _ = Proxy
-
-unProxy :: Proxy t -> t
-unProxy _ = undefined
-
-asProxyType :: t -> Proxy t -> t
-asProxyType t _ = t
-
-
diff --git a/src/HAppS/Data/Serialize.hs b/src/HAppS/Data/Serialize.hs
deleted file mode 100644
--- a/src/HAppS/Data/Serialize.hs
+++ /dev/null
@@ -1,276 +0,0 @@
-{-# LANGUAGE UndecidableInstances, OverlappingInstances, ScopedTypeVariables, GADTs,
-    GeneralizedNewtypeDeriving, DeriveDataTypeable, PatternSignatures #-}
-module HAppS.Data.Serialize
-    ( Serialize(..), Version(..), Migrate(..), Mode(..), Contained, contain, extension,
-      safeGet, safePut, serialize, deserialize, collectVersions,
-      Object(objectType), mkObject, deserializeObject, parseObject,
-      module HAppS.Data.Proxy
-    ) where
-
-import Control.Monad.Identity
-import Data.Int()
-import Foreign
-import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Data.ByteString.Char8 as B
-
-import HAppS.Data.Migrate
-import HAppS.Data.Proxy
-
-import Data.Typeable
-import qualified Data.Map as M
-import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
-import qualified Data.Set as Set
-
-import Data.Binary     as B
-import Data.Binary.Put as B
-import Data.Binary.Get as B
-
---------------------------------------------------------------
--- Core types
---------------------------------------------------------------
-
-data Contained a = Contained {unsafeUnPack :: a}
-
-contain :: a -> Contained a
-contain = Contained
-
-data Previous a = forall b. (Serialize b, Migrate b a) => Previous (Proxy b)
-
-mkPrevious :: forall a b. (Serialize b, Migrate b a) => Proxy b -> Previous a
-mkPrevious Proxy = Previous (Proxy :: Proxy b)
-
-extension :: forall a b. (Serialize b, Migrate b a) => VersionId a -> Proxy b -> Mode a
-extension vs prox = Versioned vs (Just (mkPrevious prox))
-
-newtype VersionId a = VersionId {unVersion :: Int} deriving (Num,Read,Show,Eq)
-instance Binary (VersionId a) where
-    get = liftM VersionId get
-    put = put . unVersion
-
-
-data Mode a = Primitive -- ^ Data layout won't change. Used for types like Int and Char.
-            | Versioned (VersionId a) (Maybe (Previous a))
-
-class Version a where
-    mode :: Mode a
-    mode = Versioned 0 Nothing
-
-class (Typeable a, Version a) => Serialize a where
-    getCopy :: Contained (Get a)
-    putCopy :: a -> Contained Put
-
---------------------------------------------------------------
--- Implementation
---------------------------------------------------------------
-
-getSafeGet :: forall a. Serialize a => Get (Get a)
-getSafeGet = case mode :: Mode a of
-               Primitive -> return (unsafeUnPack getCopy)
-               Versioned wantedVersion mbPrevious
-                         -> do storedVersion <- get
-                               return (safeGetVersioned wantedVersion mbPrevious storedVersion)
-
-getSafePut :: forall a. Serialize a => PutM (a -> Put)
-getSafePut = case mode :: Mode a of
-               Primitive -> return (unsafeUnPack . putCopy)
-               Versioned vs _
-                         -> do B.put vs
-                               return (unsafeUnPack . putCopy)
-
-
-safePut :: forall a. Serialize a => a -> Put
-safePut val = do fn <- getSafePut
-                 fn val
-
-safeGet :: forall a. Serialize a => Get a
-safeGet = join getSafeGet
-
-safeGetVersioned :: forall a b. (Serialize b) => VersionId b -> Maybe (Previous b) -> VersionId a -> B.Get b
-safeGetVersioned wantedVersion mbPrevious storedVersion
-    = case compareVersions storedVersion wantedVersion of
-        GT -> error $ "Version tag too large: " ++ show (wantedVersion,storedVersion) ++ " (" ++ tStr ++ ")"
-        EQ -> unsafeUnPack getCopy
-        LT -> case mbPrevious of
-                Nothing -> error $ "No previous version (" ++ tStr ++ ")"
-                Just (Previous (_ :: Proxy f) :: Previous b)
-                    -> case mode of
-                         Primitive -> error $ "Previous version marked as a Primitive (" ++ tStr ++ ")"
-                         Versioned wantedVersion' mbPrevious'
-                             -> do old <- safeGetVersioned wantedVersion' mbPrevious' storedVersion :: B.Get f
-                                   return $ migrate old
-    where tStr = show (typeOf (error "huh?" :: b))
-
-compareVersions :: VersionId a -> VersionId b -> Ordering
-compareVersions v1 v2 = compare (unVersion v1) (unVersion v2)
-
-
-serialize :: Serialize a => a -> L.ByteString
-serialize a = runPut (safePut a)
-
-deserialize :: Serialize a => L.ByteString -> (a, L.ByteString)
-deserialize bs = case runGetState safeGet bs 0 of
-                   (val, rest, _offset) -> (val, rest)
-
--- Version lookups
-collectVersions :: forall a . (Typeable a, Version a) => Proxy a -> [L.ByteString]
-collectVersions prox
-    = case mode :: Mode a of
-        Primitive                          -> [thisType]
-        Versioned _ Nothing                -> [thisType]
-        Versioned _ (Just (Previous prev)) -> thisType : (collectVersions prev)
-    where thisType = (L.pack . show . typeOf . unProxy) prox
-
---------------------------------------------------------------
--- Instances
---------------------------------------------------------------
-
-instance Version Int where mode = Primitive
-instance Serialize Int where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Integer where mode = Primitive
-instance Serialize Integer where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Float where mode = Primitive
-instance Serialize Float where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Double where mode = Primitive
-instance Serialize Double where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version L.ByteString where mode = Primitive
-instance Serialize L.ByteString where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version B.ByteString where mode = Primitive
-instance Serialize B.ByteString where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Char where mode = Primitive
-instance Serialize Char where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Word8 where mode = Primitive
-instance Serialize Word8 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Word16 where mode = Primitive
-instance Serialize Word16 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Word32 where mode = Primitive
-instance Serialize Word32 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Word64 where mode = Primitive
-instance Serialize Word64 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Ordering where mode = Primitive
-instance Serialize Ordering where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Int8 where mode = Primitive
-instance Serialize Int8 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Int16 where mode = Primitive
-instance Serialize Int16 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Int32 where mode = Primitive
-instance Serialize Int32 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Int64 where mode = Primitive
-instance Serialize Int64 where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version () where mode = Primitive
-instance Serialize () where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version Bool where mode = Primitive
-instance Serialize Bool where
-    getCopy = contain $ get; putCopy = contain . put
-instance Version (Either a b) where mode = Primitive
-instance (Serialize a, Serialize b) => Serialize (Either a b) where
-    getCopy = contain $ do n <- get
-                           if n then liftM Right safeGet
-                                else liftM Left safeGet
-    putCopy (Right a) = contain $ put True >> safePut a
-    putCopy (Left a) = contain $ put False >> safePut a
-instance Version (a,b) where mode = Primitive
-instance (Serialize a, Serialize b) => Serialize (a,b) where
-    getCopy = contain $ liftM2 (,) safeGet safeGet
-    putCopy (a,b) = contain $ safePut a >> safePut b
-instance Version (a,b,c) where mode = Primitive
-instance (Serialize a, Serialize b, Serialize c) => Serialize (a,b,c) where
-    getCopy = contain $ liftM3 (,,) safeGet safeGet safeGet
-    putCopy (a,b,c) = contain $ safePut a >> safePut (b,c)
-instance Version (a,b,c,d) where mode = Primitive
-instance (Serialize a, Serialize b, Serialize c, Serialize d) => Serialize (a,b,c,d) where
-    getCopy = contain $ liftM4 (,,,) safeGet safeGet safeGet safeGet
-    putCopy (a,b,c,d) = contain $ safePut a >> safePut (b,c,d)
-instance Version (a,b,c,d,e) where mode = Primitive
-instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e) => Serialize (a,b,c,d,e) where
-    getCopy = contain $ liftM5 (,,,,) safeGet safeGet safeGet safeGet safeGet
-    putCopy (a,b,c,d,e) = contain $ safePut a >> safePut (b,c,d,e)
-
-instance Version (Proxy a) where mode = Primitive
-instance Typeable a => Serialize (Proxy a) where
-    getCopy = contain $ return Proxy
-    putCopy Proxy = contain $ return ()
-
-instance Version [a] where mode = Primitive
-instance Serialize a => Serialize [a] where
-    getCopy = contain $
-              do n <- get
-                 getSafeGet >>= replicateM n
-    putCopy lst
-        = contain $
-          do put (length lst)
-             getSafePut >>= forM_ lst
-
-instance Version (Maybe a) where mode = Primitive
-instance Serialize a => Serialize (Maybe a) where
-    getCopy = contain $ do n <- get
-                           if n then liftM Just safeGet
-                                else return Nothing
-    putCopy (Just a) = contain $ put True >> safePut a
-    putCopy Nothing = contain $ put False
-
-instance Version (Set.Set a) where mode = Primitive
-instance (Serialize a, Ord a) => Serialize (Set.Set a) where
-    getCopy = contain $ fmap Set.fromAscList safeGet
-    putCopy = contain . safePut . Set.toList
-
-instance Version (Map.Map a b) where mode = Primitive
-instance (Serialize a,Serialize b, Ord a) => Serialize (Map.Map a b) where
-    getCopy = contain $ fmap Map.fromAscList safeGet
-    putCopy = contain . safePut . Map.toList
-
-instance Version (IntMap.IntMap a) where mode = Primitive
-instance (Serialize a) => Serialize (IntMap.IntMap a) where
-    getCopy = contain $ fmap IntMap.fromAscList safeGet
-    putCopy = contain . safePut . IntMap.toList
-
-
---------------------------------------------------------------
--- Object serialization
---------------------------------------------------------------
-
-
-
-deserializeObject :: L.ByteString -> (Object, L.ByteString)
-deserializeObject = deserialize
-
-
-parseObject :: Serialize a => Object -> a
-parseObject (Object objType objData)
-    = let res = runGet safeGet objData
-          resType = show (typeOf res)
-      in if objType /= resType
-         then error $ "Failed to parse object of type '" ++ objType ++ "'. Expected type '" ++ resType ++ "'"
-         else res
-
-mkObject :: Serialize a => a -> Object
-mkObject obj = Object { objectType = show (typeOf obj)
-                      , objectData = serialize obj }
-
-data Object = Object { objectType :: String
-                     , objectData :: L.ByteString
-                     }  deriving (Typeable,Show)
-
-instance Version Object
-instance Serialize Object where
-    putCopy (Object objType objData) = contain $ put (objType, objData)
-    getCopy = contain $
-              do (objType, objData) <- get
-                 return (Object objType objData)
diff --git a/src/HAppS/Data/SerializeTH.hs b/src/HAppS/Data/SerializeTH.hs
deleted file mode 100644
--- a/src/HAppS/Data/SerializeTH.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# LANGUAGE TemplateHaskell, CPP #-}
-module HAppS.Data.SerializeTH
-    ( deriveSerialize
-    , deriveSerializeFor
-    ) where
-
-import HAppS.Data.Serialize
-
-import Language.Haskell.TH
-import Control.Monad
-import Data.Binary
-
-data Class = Tagged [(Name, Int)] Cxt [Name]
-
-deriveSerialize :: Name -> Q [Dec]
-deriveSerialize name
-    = do c <- parseInfo name
-         case c of
-           Tagged cons cx keys ->
-               do let context = [ mkType ''Serialize [varT key] | key <- keys ] ++ map return cx
-                  i <- instanceD (sequence context) (mkType ''Serialize [mkType name (map varT keys)])
-                       [ putCopyFn cons
-                       , getCopyFn cons
-                       ]
-                  return [i]
-    where putCopyFn cons
-              = do inp <- newName "inp"
-                   let putCopyBody = appE (varE 'contain) $
-                                     caseE (varE inp) $
-                                       [ do args <- replicateM nArgs (newName "arg")
-                                            let matchCon = conP conName (map varP args)
-                                            match matchCon (normalB (putCopyWork args i)) []
-                                             | ((conName,nArgs), i) <- zip cons [0..]]
-                       putCopyWork args i
-                           = doE $ [noBindS [| putWord8 $(litE (integerL i)) |]] ++
-                                   [ noBindS [| safePut $(varE arg) |] | arg <- args ]
-                   funD 'putCopy [clause [varP inp] (normalB putCopyBody) []]
-          getCopyFn cons
-              = let getCopyBody = do c <- newName "c"
-                                     appE (varE 'contain) $
-                                      doE [bindS (varP c) [| getWord8 |]
-                                          , noBindS $ caseE (varE c) $
-                                                        [ do args <- replicateM nArgs (newName "arg")
-                                                             match (litP (integerL i)) (normalB $ getCopyWork conName args) []
-                                                          | ((conName, nArgs), i) <- zip cons [0..]]
-                                                        ++ [match (return WildP) (normalB [|error "Wrong serialization type"|]) []]
-                                          ]
-                    getCopyWork conName args
-                        = doE $ [ bindS (varP arg) [| safeGet |] | arg <- args ] ++
-                                [ noBindS [| return $(foldl appE (conE conName) (map varE args)) |] ]
-                in funD 'getCopy [clause [] (normalB getCopyBody) []]
-
-
-deriveSerializeFor :: [Name] -> Q [Dec]
-deriveSerializeFor names
-    = liftM concat $ mapM deriveSerialize names
-
-
-mkType :: Name -> [TypeQ] -> TypeQ
-mkType con = foldl appT (conT con)
-
-parseInfo :: Name -> Q Class
-parseInfo name
-    = do info <- reify name
-         case info of
-           TyConI (DataD cx _ keys cs _)    -> return $ Tagged (map conInfo cs) cx keys
-           TyConI (NewtypeD cx _ keys con _)-> return $ Tagged [conInfo con] cx keys
-           _                            -> error "Invalid input"
-    where conInfo (NormalC n args) = (n, length args)
-          conInfo (RecC n args) = (n, length args)
-          conInfo (InfixC _ n _) = (n, 2)
-          conInfo (ForallC _ _ con) = conInfo con
diff --git a/src/HAppS/Data/Xml.hs b/src/HAppS/Data/Xml.hs
deleted file mode 100644
--- a/src/HAppS/Data/Xml.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-
-module HAppS.Data.Xml (
-    module HAppS.Data.Xml.Base,
-    module HAppS.Data.Xml.PrintParse) where
-
-import HAppS.Data.Xml.Base
-import HAppS.Data.Xml.PrintParse
-import HAppS.Data.Xml.Instances ()
-
diff --git a/src/HAppS/Data/Xml/Base.hs b/src/HAppS/Data/Xml/Base.hs
deleted file mode 100644
--- a/src/HAppS/Data/Xml/Base.hs
+++ /dev/null
@@ -1,452 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances,
-             OverlappingInstances, UndecidableInstances, CPP,
-             ScopedTypeVariables, GADTs,
-             PolymorphicComponents, FlexibleContexts,
-             MultiParamTypeClasses, DeriveDataTypeable,
-             PatternGuards, PatternSignatures #-}
-
-module HAppS.Data.Xml.Base where
-
-import Control.Monad.Identity
-import Control.Monad.State
-import Data.Char
-import Data.List
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Instances ()
-import Data.Maybe
-import           Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as BS
-import HAppS.Data.Default
-import HAppS.Data.DeriveAll
-import HAppS.Data.Migrate
-import HAppS.Data.Normalize
-import HAppS.Util.TH
-import Language.Haskell.TH
-import qualified Data.Generics as G
-
-$(deriveAll [''Default, ''Eq,''Read,''Ord] [d|
-    data Element = Elem String [Element]
-                 | CData String
-                 | Attr String String
- |])
-
-insEl :: (Data XmlD a, Default a, Data NormalizeD a,
-          Data XmlD b, Default b, Data NormalizeD b) =>
-         a -> b -> Element
-insEl a b = case toXml b  of
-            (Elem n xs:_) -> Elem n $ toPublicXml a ++ xs
-            _ -> error "can't insert a into b"
-
-
--- This is a more readable representation than the default, but is still
--- Haskell syntax
-instance Show Element where
-    show (Elem s es) = "Elem " ++ show s ++ " ["
-                       ++ fiddle (unlines (indent (concatMap lines $ comma $ map show es)))
-                       
-                      ++ "]"
-        where indent = map ("    " ++)
-              comma::[String]->[String]
-              comma [] = []
-              comma (x:xs) = (' ':x):map (',':) xs
-              fiddle "" = ""
-              fiddle xs = '\n' : (if last xs == '\n' then init xs else xs)
-    show (CData s) = "CData " ++ show s
-    show (Attr k v) = "Attr " ++ show k ++ " " ++ show v
-
-fromXml :: forall m a . (Monad m, Xml a) => Rigidity m -> [Element] -> m a
-fromXml r xs = case readXml r xs of
-               Just (_, v) ->
-                   return v
-               Nothing ->
-                   case r of
-                   Rigid -> fail "fromXml XXX"
-                   Flexible -> return defaultValue
-
-data Other b = forall a . (Migrate a b, Xml a) => Other a
-             | NoOther
-
-toPublicXml :: Xml a => a -> [Element]
-toPublicXml x = clean $ toXml x
-    where
-    clean [] = []
-    clean ((Elem n xs):rest) = (Elem n $ clean xs): clean rest
-    clean (CData s:rest)=CData s:clean rest
-    clean (Attr n v:rest) = if n `elem` [typeAttr,versionAttr] then clean rest
-                            else Attr n v:clean rest
-
-data Rigidity m where
-    Rigid :: Rigidity Maybe
-    Flexible :: Rigidity Identity
-
-instance Show (Rigidity m) where
-    show Rigid = "Rigid"
-    show Flexible = "Flexible"
-
-class (Data XmlD a,
-       Default a, -- We'd rather have this only in the Flexible case,
-                  -- but bugs in GHC 6.6.1 and problems getting the
-                  -- instance for child types in constrFromElements
-                  -- mean it's a constraint of the Xml class for now.
-       Normalize a)
-   => Xml a where
-    toXml :: a -> [Element]
-    toXml = defaultToXml
-
-    -- readXml is like readXml' except it normalises the Elements and
-    -- the result
-    readXml :: Monad m => Rigidity m -> [Element] -> Maybe ([Element], a)
-    readXml = defaultReadXml
-
-    readXml' :: Monad m => Rigidity m -> [Element] -> Maybe ([Element], a)
-    readXml' = defaultReadXml'
-
-    normalizeXml :: a{- can't look at this value -} -> [Element] -> [Element]
-    normalizeXml _ = id
-
-    version :: a{- can't look at this value -} -> Maybe String
-    version _ = Just "0"
-
-    otherVersion :: a{- can't look at this value -} -> Other a
-    otherVersion _ = NoOther
-
-    typ :: a{- can't look at this value -} -> String
-    typ _ = dataTypeName (dataTypeOf xmlProxy (undefined :: a))
-
-instance (Data XmlD t, Default t, Normalize t) => Xml t
-
-data XmlD a = XmlD { toXmlD :: a -> [Element],
-                     readMXmlD :: forall m . Monad m
-                               => Rigidity m -> ReadM m a,
-                     readMXmlNoRootDefaultD :: forall m . Monad m
-                                            => Rigidity m -> ReadM Maybe a }
-
-xmlProxy :: Proxy XmlD
-xmlProxy = error "xmlProxy"
-
-instance Xml t => Sat (XmlD t) where
-    dict = XmlD { toXmlD = toXml,
-                  readMXmlD = readMXml,
-                  readMXmlNoRootDefaultD = readMXmlNoRootDefault }
-
-first :: (a -> a) -> [a] -> [a]
-first _ [] = []
-first f (x:xs) = f x : xs
-
-defaultToXml :: Xml t => t -> [Element]
-defaultToXml x
- = let me = first toLower $ constring $ toConstr xmlProxy x
-       rest = Attr typeAttr (dataTypeName (dataTypeOf xmlProxy x)) :
-            transparentToXml x
-       rest' = case version x of
-                   Nothing -> rest
-                   Just v -> Attr versionAttr v : rest
-   in [Elem me rest']
-
-transparentToXml :: Xml t => t -> [Element]
-transparentToXml x = concat $ gmapQ xmlProxy (toXmlD dict) x
-
-transparentReadXml :: forall m t . (Monad m, Xml t)
-                   => Rigidity m -> [Element] -> Maybe ([Element], t)
-transparentReadXml r es
- = aConstrFromElements r (dataTypeConstrs (dataTypeOf xmlProxy resType)) es
-   where resType :: t
-         resType = typeNotValue resType
-
-transparentXml :: Name -> Q [Dec]
-transparentXml n
- = do i <- reify n
-      case i of
-          TyConI (DataD _ _ vs _ _) ->
-              do argNames <- replicateM (length vs) (newName "a")
-                 let args = map varT argNames
-                     mkXml a = conT ''Xml `appT` a
-                     ctxt = cxt $ map mkXml args
-                     instanceHead = mkXml $ foldl appT (conT n) args
-                     decs = [d|
-                                toXml :: Xml a => a -> [Element]
-                                toXml = transparentToXml
-
-                                readXml :: (Monad m, Xml a)
-                                        => Rigidity m -> [Element]
-                                        -> Maybe ([Element], a)
-                                readXml = transparentReadXml
-                              |]
-                 d <- instanceD' ctxt instanceHead decs
-                 return [d]
-          _ ->
-              fail ("transparentXml: Not given a type constructor's name: " ++
-                    show n)
-
--- Don't do any defaulting here, as these functions can be implemented
--- differently by the user. We do the defaulting elsewhere instead.
--- The t' type is thus not used.
-
-defaultReadXml :: (Monad m, Xml t)
-               => Rigidity m -> [Element] -> Maybe ([Element], t)
-defaultReadXml r es = res
-    where res = case readXml' r $ normalizeXml valType es of
-                    Nothing -> Nothing
-                    Just (es', v) -> Just (es', normalize v)
-          valType = snd $ fromJust res
-
-defaultReadXml' :: (Monad m, Xml t)
-                => Rigidity m -> [Element] -> Maybe ([Element], t)
-defaultReadXml' = readXmlWith readVersionedElement
-
-readXmlWith :: Xml t
-            => (Rigidity m -> Element -> Maybe t)
-            -> Rigidity m
-            -> [Element]
-            -> Maybe ([Element], t)
-readXmlWith f r@Rigid es = case es of
-                               e : es' ->
-                                   case f r e of
-                                       Just v -> Just (es', v)
-                                       Nothing -> Nothing
-                               [] ->
-                                   Nothing
-readXmlWith f r@Flexible es = readXmlWith' [] es
-    where readXmlWith' acc (x:xs)
-           = case f r x of
-                 Nothing -> readXmlWith' (x:acc) xs
-                 Just v -> Just (reverse acc ++ xs, v)
-          readXmlWith' _ [] = Nothing
-
-readVersionedElement :: forall m t . (Monad m, Xml t)
-                     => Rigidity m -> Element -> Maybe t
-readVersionedElement r (Elem n es)
-    = case getAttr typeAttr es of
-      Nothing ->
-          readElement r (Elem n es)
-      Just (t, es')
-       | t == typ resType ->
-          case version resType of
-          Nothing ->
-              readElement r (Elem n es')
-          Just v ->
-              case getAttr versionAttr es' of
-              Nothing -> readElement r (Elem n es')
-              Just (v', es'')
-               | v == v' -> readElement r (Elem n es'')
-               | otherwise ->
-                  case otherVersion resType of
-                  NoOther ->
-                      Nothing
-                  Other (_ :: u) ->
-                      case readVersionedElement r (Elem n es'') of
-                      Just (res :: u) ->
-                          Just (migrate res)
-                      Nothing -> Nothing
-       | otherwise ->
-          Nothing
-    where resType :: t
-          resType = typeNotValue resType
-readVersionedElement _ _ = Nothing
-
-isTheAttr :: String -> Element -> Bool
-isTheAttr a (Attr k _) = a == k
-isTheAttr _ _          = False
-
-getAttr :: String -> [Element] -> Maybe (String, [Element])
-getAttr a es = case break (isTheAttr a) es of
-                (prefix, Attr _ v : suffix) -> Just (v, prefix ++ suffix)
-                _ -> Nothing
-
-versionAttr :: String
-versionAttr = "haskellTypeVersion"
-
-typeAttr :: String
-typeAttr = "haskellType"
-
-
-readElement :: forall m t . (Monad m, Xml t) => Rigidity m -> Element -> Maybe t
-readElement r (Elem n es) = res
-    where resType = dataTypeOf xmlProxy (undefined :: t)
-          res = case readConstr resType $ first toUpper n of
-                Just c -> f c
-                Nothing -> if endsWithNum n then readElement r (Elem (noNum n) es) else Nothing
-          f :: Constr -> Maybe t
-          f c =     let m :: m ([Element], t)
-                        m = constrFromElements r c es
-                    in case r of
-                       Rigid -> case m of
-                                    Just ([], x) -> Just x
-                                    _ -> Nothing
-                       Flexible -> case runIdentity m of
-                                       -- We ignore left over elements
-                                       (_, x) -> Just x
-          endsWithNum m = head (reverse m) `elem` "0123456789"
-          noNum  = reverse . dropWhile (`elem` "012344566789") . reverse 
-
-readElement _ _ = Nothing
-
--- When just trying all the constructors of a type, if defaulting is
--- allowed we would always get the first constructor as all of its
--- arguments could be defaulted. Therefore we have the choice of
---  * accepting this
---  * turning off defaulting for this level only
---  * turning off defaulting recursively
--- We choose the second option, and thus have to duplicate
--- constrFromElements and readXml(D).
-aConstrFromElements :: forall m t . (Monad m, Xml t)
-                    => Rigidity m -> [Constr] -> [Element]
-                    -> Maybe ([Element], t)
-aConstrFromElements r cs es
- = msum [ constrFromElementsNoRootDefault r c es | c <- cs ]
-
-
-constrFromElementsNoRootDefault :: forall m t . (Monad m, Xml t)
-                                => Rigidity m -> Constr -> [Element]
-                                -> Maybe ([Element], t)
-constrFromElementsNoRootDefault r c es
- = do let st = ReadState { xmls = es }
-          m :: ReadM Maybe t
-          m = fromConstrM xmlProxy (readMXmlNoRootDefaultD dict r) c
-      -- XXX Should we flip the result order?
-      (x, st') <- runStateT m st
-      return (xmls st', x)
-
-constrFromElements :: forall m t . (Monad m, Xml t)
-                   => Rigidity m -> Constr -> [Element]
-                   -> m ([Element], t)
-constrFromElements r c es
- = do let st = ReadState { xmls = es }
-          m :: ReadM m t
-          m = fromConstrM xmlProxy (readMXmlD dict r) c
-      -- XXX Should we flip the result order?
-      (x, st') <- runStateT m st
-      return (xmls st', x)
-
-type ReadM m = StateT ReadState m
-
-data ReadState = ReadState {
-                     xmls :: [Element]
-                 }
-
-getXmls :: Monad m => ReadM m [Element]
-getXmls = do st <- get
-             return $ xmls st
-
-putXmls :: Monad m => [Element] -> ReadM m ()
-putXmls xs = do st <- get
-                put $ st { xmls = xs }
-
-readMXml :: (Monad m, Xml a) => Rigidity m -> ReadM m a
-readMXml r
- = do xs <- getXmls
-      case readXml r xs of
-          Nothing ->
-              case r of
-              Rigid -> fail "Cannot read value"
-              Flexible -> return defaultValue
-          Just (xs', v) ->
-              do putXmls xs'
-                 return v
-
-readMXmlNoRootDefault :: (Monad m, Xml a) => Rigidity m -> ReadM Maybe a
-readMXmlNoRootDefault r
- = do xs <- getXmls
-      case readXml r xs of
-          Nothing -> fail "Cannot read value"
-          Just (xs', v) ->
-              do putXmls xs'
-                 return v
-
-xmlAttr :: Name -> Q [Dec]
-xmlAttr newTypeName
- = do i <- reify newTypeName
-      case i of
-          TyConI (NewtypeD _ n _ (NormalC c [(_, ConT t)]) _)
-           | t == ''ByteString -> mkDecs n c t
-          _ -> fail "xmlAttr: Didn't get what I wanted"
-
-    where mkDecs n c t =
-            do let x = mkName "x"
-                   f = mkName "f"
-                   cstr = stringL $ first toLower $ nameBase c
-                   toFun = funD
-                             'toXml
-                             [clause
-                                 [conP c [varP x]]
-                                 (normalB [| [Attr $(litE cstr)
-                                                   $ BS.unpack $(varE x)] |])
-                                 []]
-
-                   readFun = funD
-                             'readXml
-                             [clause
-                                 []
-                                 (normalB [| readXmlWith $(varE f) |])
-                                 [readHelper]]
-
-                   readHelper
-                    = funD f
-                           [
-                            clause [conP 'Attr [litP cstr, (varP x)]]
-                                   (normalB [| Just $ $(conE c)
-                                                    $ BS.pack $(varE x) |])
-                                   [],
-                            clause [wildP]
-                                   (normalB [| Nothing |])
-                                   []
-                           ]
-               inst <- instanceD (cxt [])
-                                 ( conT ''Xml `appT` conT n)
-                                 [toFun, readFun]
-               return [inst]
-
-xmlShowCDatas :: [Name] -> Q [Dec]
-xmlShowCDatas = liftM concat . mapM xmlShowCData
-
-xmlShowCData :: Name -> Q [Dec]
-xmlShowCData newTypeName
- = do d <- instanceD' (cxt [])
-                      (conT ''Xml `appT` conT newTypeName)
-                      [d|
-                          toXml :: (Show a, Xml a) => a -> [Element]
-                          toXml x = [CData $ show x]
-
-                          readXml :: (Read a, Xml a)
-                                  => Rigidity m -> [Element]
-                                  -> Maybe ([Element], a)
-                          readXml = readXmlWith f
-                              where f _ (CData x)
-                                     | [(v, "")] <- reads x = Just v
-                                    f _ _ = Nothing
-                        |]
-      return [d]
-
-xmlCDataLists :: [Name] -> Q [Dec]
-xmlCDataLists = liftM concat . mapM xmlCDataList
-
-xmlCDataList :: Name -> Q [Dec]
-xmlCDataList newTypeName
- = do d <- instanceD' (cxt [])
-                      (conT ''Xml `appT` (listT `appT` conT newTypeName))
-                      [d|
-                        toXml :: (Show a, Xml a) => [a] -> [Element]
-                        toXml xs = [CData $ concat $ intersperse ","
-                                          $ map show xs]
-
-                        readXml :: (Read a, Xml a)
-                                => Rigidity m -> [Element]
-                                -> Maybe ([Element], [a])
-                        readXml = readXmlWith f
-                            where f _ (CData x) =
-                                      let list = words $ noCommas x
-                                          is = concatMap reads list
-                                      in if length is == length list
-                                         then Just $ map fst is
-                                         else Nothing
-                                  f _ _ = Nothing
-                       |]
-      return [d]
-
-noCommas :: String -> String
-noCommas = map (\x -> if x == ',' then ' ' else x)
-
-typeNotValue :: Xml a => a -> a
-typeNotValue t = error ("Type used as value: " ++ typeName)
-    where typeName = dataTypeName (dataTypeOf xmlProxy t)
-
diff --git a/src/HAppS/Data/Xml/HaXml.hs b/src/HAppS/Data/Xml/HaXml.hs
deleted file mode 100644
--- a/src/HAppS/Data/Xml/HaXml.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances,
-             OverlappingInstances, UndecidableInstances #-}
-
-module HAppS.Data.Xml.HaXml where
-
-import Data.List
-import HAppS.Data.Xml.Base
-import qualified Text.XML.HaXml.Types as H
-
-isAttr :: Element -> Bool
-isAttr (Attr {}) = True
-isAttr _ = False
-
-toHaXmls :: [Element] -> [H.Content]
-toHaXmls = map toHaXml
-
-toHaXmlEl :: Element -> H.Element
-toHaXmlEl el = let H.CElem el' = toHaXml el in el'
-
-
-toHaXml :: Element -> H.Content
-toHaXml (Elem n es) = case partition isAttr es of
-                      (as, xs) ->
-                          H.CElem (H.Elem n (map toAttribute as) (toHaXmls xs))
-toHaXml (CData x) = H.CString True x
--- We can't do better than wrap an attribute up in a fake element.
--- This shouldn't be happening in the real world anyway.
-toHaXml a@(Attr {}) = toHaXml (Elem "JustAnAttr" [a])
-
-toAttribute :: Element -> H.Attribute
-toAttribute (Attr k v) = (k, H.AttValue [Left v])
-toAttribute _ = error "toAttribute: Can't happen"
-
-fromHaXmls :: [H.Content] -> [Element]
-fromHaXmls = map fromHaXml
-
-fromHaXml :: H.Content -> Element
-fromHaXml (H.CElem (H.Elem n as xs))
-    = Elem n (fromAttributes as ++ fromHaXmls xs)
-fromHaXml (H.CString _ x) = CData x
-fromHaXml (H.CRef (H.RefEntity "amp")) = CData "&"
-fromHaXml (H.CRef (H.RefEntity "lt")) = CData "<"
-fromHaXml (H.CRef (H.RefEntity "gt")) = CData ">"
-fromHaXml (H.CRef (H.RefEntity "apos")) = CData "'"
-fromHaXml (H.CRef (H.RefEntity "quot")) = CData "\""
-fromHaXml (H.CRef (H.RefEntity x)) = 
-    error $ "fromHaXml: Not implemented ref:" ++ x
-fromHaXml (H.CRef (H.RefChar x)) = 
-    error $ "fromHaXml: Not implemented ref:" ++ (show x)
-fromHaXml (H.CMisc (H.Comment _)) = CData ""
-fromHaXml (H.CMisc (H.PI (_,_))) = CData ""
-
-
-
-fromAttributes :: [H.Attribute] -> [Element]
-fromAttributes = map fromAttribute
-
-fromAttribute :: H.Attribute -> Element
-fromAttribute (k, H.AttValue [Left v]) = Attr k v
-fromAttribute _ = error "fromAttribute: Not implemented"
-
-
-
-
diff --git a/src/HAppS/Data/Xml/Instances.hs b/src/HAppS/Data/Xml/Instances.hs
deleted file mode 100644
--- a/src/HAppS/Data/Xml/Instances.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances,
-             OverlappingInstances, UndecidableInstances, CPP,
-             TypeSynonymInstances, PatternGuards,
-             MultiParamTypeClasses #-}
-
-module HAppS.Data.Xml.Instances where
-
-import Data.Char
-import Data.List
-import HAppS.Data.Xml.Base
-import Data.Generics.SYB.WithClass.Basics
-import Data.Generics.SYB.WithClass.Instances ()
-import Data.Maybe
-import           Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as BS
-
-import HAppS.Data.Default
-
-
-
-instance Xml Element where
-    toXml = (:[])
-
-
--- The Xml [a] context is a bit scary, but if we don't have it then
--- GHC complains about overlapping instances
-instance (Xml a, Xml [a]) => Xml [a] where
-    toXml = concatMap toXml
-    readXml r = f [] []
-        where f acc_xs acc_vs [] = Just (reverse acc_xs, reverse acc_vs)
-              f acc_xs acc_vs (x:xs) = case readXml r [x] of
-                                           Just ([], v) ->
-                                               f acc_xs (v:acc_vs) xs
-                                           _ ->
-                                               f (x:acc_xs) acc_vs xs
-
-
-instance Xml Bool where
-    toXml True = [CData "1"]
-    toXml False = [CData "0"]
-    readXml = readXmlWith f
-        where f _ (CData "1") = Just True
-              f _ (CData "0") = Just False
-              f _ (CData "True") = Just True
-              f _ (CData "False") = Just False
-              f _ (CData "T") = Just True
-              f _ (CData "F") = Just False
-              f _ _ = Nothing
-
-instance Default Bool where defaultValue= False
-
-instance Xml String where
-    toXml x = [CData x]
-    readXml = readXmlWith f
-        where f _ (CData x) = Just x
-              f _ _ = Nothing
-
-instance Xml Char where
-    toXml x = [CData (x:[])]
-    readXml = readXmlWith f
-        where f _ (CData (x:[])) = Just x
-              f _ _ = Nothing
-
-instance Xml ByteString where
-    toXml x = [CData $ BS.unpack x]
-    readXml = readXmlWith f
-        where f _ (CData x) = Just $ BS.pack x
-              f _ _ = Nothing
-
-instance Xml [String] where
-    toXml xs = [CData $ concat $ intersperse "," xs]
-    readXml = readXmlWith f
-        where f _ (CData x) = Just $ words $ noCommas x
-              f _ _ = Nothing
-
-$( xmlShowCDatas [''Int, ''Integer, ''Float, ''Double] )
-$( xmlCDataLists [''Int, ''Integer, ''Float, ''Double] )
-
-
-instance Xml a => Xml (Maybe a) where
-    toXml = transparentToXml
-    -- We can't use transparentReadXml or Nothing would always win, as
-    -- it is first in the list of constructors
-    readXml r = aConstrFromElements r
-              $ map (toConstr xmlProxy) [Just (), Nothing]
-
-$( transparentXml ''Either )
-$( transparentXml ''() )
-$( transparentXml ''(,) )
-$( transparentXml ''(,,) )
-$( transparentXml ''(,,,) )
-
-
diff --git a/src/HAppS/Data/Xml/PrintParse.hs b/src/HAppS/Data/Xml/PrintParse.hs
deleted file mode 100644
--- a/src/HAppS/Data/Xml/PrintParse.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, CPP,
-             OverlappingInstances, UndecidableInstances,
-             DeriveDataTypeable, MultiParamTypeClasses #-}
-
-module HAppS.Data.Xml.PrintParse where
-
-import Control.Monad
-import Text.PrettyPrint.HughesPJ
-import Text.XML.HaXml.Parse
-import Text.XML.HaXml.Pretty
-import Text.XML.HaXml.Types (Document(Document), Content(CElem))
-import HAppS.Data.Xml.Base
-import HAppS.Data.Xml.HaXml
-import Data.Generics as G
-import HAppS.Data.DeriveAll
-import HAppS.Data.Default
-
-$(deriveAll [''Read,''Show,''Default]
-  [d|
-      data W = W [K]
-      data K = K String
-   |]
- )
-
-
-class ToString a where toString::a->String
-instance ToString [Element] where
-    toString = render . vcat . map (content . toHaXml)
-
-instance ToString Element where
-    toString = render . content . toHaXml
-
-instance (Xml a,G.Data a) => ToString a where 
-    toString a = toString $ toXml a
-
-
-class FromString a where
-    fromString :: Monad m => Rigidity m -> String -> m a
-
-instance FromString Element where
-    fromString _ s = case xmlParse "NoFile" s of
-                       Document _ _ e _ ->
-                           return $ fromHaXml $ CElem e
-                       -- XXX Currently we assume this always succeeds,
-                       -- but we should be allowing for the possibility of
-                       -- failure
-                       -- _ -> Nothing
-
-instance FromString [Element] where
-    fromString r s = liftM (: []) $ fromString r s
-
-instance (Xml a,G.Data a) => FromString a where
-    fromString r x = do els <- fromString r x
-                        fromXml r els
-
diff --git a/src/Happstack/Data.hs b/src/Happstack/Data.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data.hs
@@ -0,0 +1,26 @@
+module Happstack.Data
+   (
+    module Data.Typeable
+   ,module Happstack.Data.Default
+   ,module Happstack.Data.DeriveAll
+   ,module Happstack.Data.Migrate
+   ,module Happstack.Data.Normalize
+   ,module Happstack.Data.Pairs
+   ,module Happstack.Data.Xml
+   ,module Happstack.Data.GOps
+   ,module Happstack.Data.Serialize
+   ,module Happstack.Data.SerializeTH
+   )
+where
+
+import Happstack.Data.GOps
+import Data.Typeable
+import Happstack.Data.Default
+import Happstack.Data.DeriveAll
+import Happstack.Data.Migrate
+import Happstack.Data.Normalize
+import Happstack.Data.Pairs
+import Happstack.Data.Xml
+import Happstack.Data.Serialize hiding (migrate, Migrate)
+import Happstack.Data.SerializeTH
+
diff --git a/src/Happstack/Data/Default.hs b/src/Happstack/Data/Default.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Default.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE OverlappingInstances, UndecidableInstances,
+             FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Happstack.Data.Default
+-- Copyright   :  (c) 2009 Happstack.com; (c) 2007 HAppS LLC
+-- License     :  BSD3
+--
+-- Maintainer  :  happs@googlegroups.com
+-- Stability   :  experimental
+-- Portability :  Not portable
+--
+-- Provides default values for Haskell datatypes.
+--
+-----------------------------------------------------------------------------
+
+module Happstack.Data.Default
+    (
+        -- * The interface
+        Default(defaultValue),
+
+        -- * Writing your own instances
+        defaultDefaultValue,
+
+        -- * Advanced usage
+        DefaultD(..),
+        defaultProxy,
+    )
+    where
+
+import qualified Data.ByteString.Char8 as BSC
+import Data.Generics.SYB.WithClass.Basics
+import Data.Generics.SYB.WithClass.Instances ()
+import Data.Int
+import Data.Word
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Foreign.ForeignPtr
+
+-- | The 'Default' class provides a 'defaultValue' value, which
+-- is the default value for that type.
+--
+-- There is no instance for arbitrary types by default, but if you
+-- declare an instance without providing the value then one will be
+-- built using the first constructor. 'defaultValue' is used to provide
+-- values for any arguments of the constructor.
+--
+-- If you want an instance for all types then import
+-- "Happstack.Data.Default.Generic".
+class (Data DefaultD a) => Default a where
+    defaultValue :: a
+    defaultValue = defaultDefaultValue
+
+-- | This is the 'defaultValue' that is used in an instance if you don't
+-- specify one. It may be a useful building block when writing your own
+-- instances.
+defaultDefaultValue :: (Data DefaultD a,Default a) => a
+defaultDefaultValue = res
+    where res = case datarep $ dataTypeOf defaultProxy res of
+                    AlgRep (c:_) ->
+                        fromConstrB defaultProxy (defaultValueD dict) c
+                    r ->
+                        error ("defaultDefaultValue: Bad DataRep: " ++ show r)
+
+-- | When writing your own generic functions for 'Default' you may
+-- need to access the class method through this datatype rather than
+-- directly.
+data DefaultD a = DefaultD { defaultValueD :: a }
+
+-- | When writing your own generic functions for 'Default' you may
+-- need this, the proxy value.
+defaultProxy :: Proxy DefaultD
+defaultProxy = error "defaultProxy"
+
+instance Default t => Sat (DefaultD t) where
+    dict = DefaultD { defaultValueD = defaultValue }
+
+instance Default a => Default [a] where
+    defaultValue = []
+
+instance Default Int     where defaultValue = 0
+instance Default Int8    where defaultValue = 0
+instance Default Int16   where defaultValue = 0
+instance Default Int32   where defaultValue = 0
+instance Default Int64   where defaultValue = 0
+instance Default Word    where defaultValue = 0
+instance Default Word8   where defaultValue = 0
+instance Default Word16  where defaultValue = 0
+instance Default Word32  where defaultValue = 0
+instance Default Word64  where defaultValue = 0
+instance Default Integer where defaultValue = 0
+instance Default Float   where defaultValue = 0
+instance Default Double  where defaultValue = 0
+
+instance (Default a, Default b) => Default (Either a b) where
+    defaultValue = Left defaultValue
+
+instance Default () where
+    defaultValue = ()
+instance (Default a, Default b) => Default (a,b) where
+    defaultValue = (defaultValue, defaultValue)
+instance (Default a, Default b, Default c) => Default (a,b,c) where
+    defaultValue = (defaultValue, defaultValue, defaultValue)
+instance (Default a, Default b, Default c, Default d) => Default (a,b,c,d) where
+    defaultValue = (defaultValue, defaultValue, defaultValue, defaultValue)
+
+
+instance Default Char where
+    defaultValue = 'A'
+
+instance Default a => Default (Maybe a) where
+    defaultValue = Nothing
+
+instance Default BSC.ByteString where
+    defaultValue = BSC.pack ""
+
+-- We don't really want this instance, but we need it for the ByteString
+-- instance
+instance Default a => Default (ForeignPtr a) where
+    defaultValue = error "defaultValue: ForeignPtr"
+
+instance (Data DefaultD a, Data DefaultD b, Ord a) => Default (M.Map a b) 
+instance (Data DefaultD a, Ord a) => Default (S.Set a)
diff --git a/src/Happstack/Data/Default/Generic.hs b/src/Happstack/Data/Default/Generic.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Default/Generic.hs
@@ -0,0 +1,30 @@
+
+{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}
+{-# OPTIONS -fno-warn-orphans #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Happstack.Data.Default.Generic
+-- Copyright   :  (c) 2009 Happstack.com; (c) 2007 HAppS LLC
+-- License     :  BSD3
+--
+-- Maintainer  :  happs@googlegroups.com
+-- Stability   :  experimental
+-- Portability :  Not portable
+--
+-- Provides a 'Default' instance for all types. 'defaultDefaultValue' is
+-- used for 'defaultValue'.
+--
+-----------------------------------------------------------------------------
+
+module Happstack.Data.Default.Generic () where
+
+import Happstack.Data.Default
+import Data.Generics.SYB.WithClass.Basics
+import Data.Generics.SYB.WithClass.Instances ()
+
+-- This is an orphaned instanced.  This means the existance of this file causes
+-- ghc to visit its .hi every time any files that depend on it are compiled,
+-- just to see if this instance is need
+instance Data DefaultD a => Default a
+
diff --git a/src/Happstack/Data/DeriveAll.hs b/src/Happstack/Data/DeriveAll.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/DeriveAll.hs
@@ -0,0 +1,97 @@
+
+{-# LANGUAGE TemplateHaskell, CPP #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Happstack.Data.DeriveAll
+-- Copyright   :  (c) 2009 Happstack.com; (c) 2007 HAppS LLC
+-- License     :  BSD3
+--
+-- Maintainer  :  happs@googlegroups.com
+-- Stability   :  experimental
+-- Portability :  Not portable
+--
+-- Concisely specify which classes to derive for your datatypes.
+-- As well as the standard derivable classes, it can also
+-- derive syb-with-class's 'New.Data' class and Happstack.Data.Default's
+-- 'Default' class.
+--
+-----------------------------------------------------------------------------
+
+module Happstack.Data.DeriveAll (deriveAll, deriveNewData, deriveNewDataNoDefault)
+    where
+
+import qualified Data.Generics as Old
+import Data.Generics.SYB.WithClass.Derive
+import Data.List
+import Happstack.Data.Default
+import Language.Haskell.TH
+
+{- | Derives instances for syb-with-class's Data class and 
+   Happstack.Data.Default's Default class.
+   The list of names should be of the form [''Foo,''Bar,..]
+-}
+deriveNewData :: [Name] -> Q [Dec]
+deriveNewData names
+ = do nd <- deriveData names
+      defaults <- mapM mkDefaultInstance names
+      return (nd ++ concat defaults)
+
+{- | Derives instances for syb-with-class's Data class only.
+   The list of names should be of the form [''Foo,''Bar,..]
+-}
+deriveNewDataNoDefault :: [Name] -> Q [Dec]
+deriveNewDataNoDefault = deriveData
+
+mkDefaultInstance :: Name -> Q [Dec]
+mkDefaultInstance name
+ = do info <- reify name
+      case info of
+          TyConI (NewtypeD _ nm tvs _ _) -> return $ deriveDefault True tvs nm
+          TyConI (DataD    _ nm tvs _ _) -> return $ deriveDefault True tvs nm
+          _ -> fail ("mkDefaultInstance: Bad info: " ++ pprint info)
+
+-- | The 'deriveAll' function takes a list of classes to derive and
+-- a block of declarations. It will additionally derive instances for
+-- 'Typeable', 'Old.Data' and 'New.Data'.
+--
+-- Example:
+--
+-- > $( deriveAll [''Show, ''Eq, ''Default] [d|
+-- >        data Foo a = Foo a
+-- >        data Bar = Baz | Quux
+-- >  |] )
+deriveAll :: [Name] -> Q [Dec] -> Q [Dec]
+deriveAll classes0 qdecs
+ = do decs <- qdecs
+      derivedDecs <- deriveDec (filter isDataOrNewtype decs)
+      let (classDefault, classes1) = partition (''Default ==) classes0
+          classes2 = ''Old.Data : classes1
+          addDefaultInstance = not $ null classDefault
+          f = addDerivedClasses addDefaultInstance classes2
+          decs' = concatMap f decs
+      return (decs' ++ derivedDecs)
+
+addDerivedClasses :: Bool -> [Name] -> Dec -> [Dec]
+addDerivedClasses def cs (DataD ctxt nm tvs cons derivs)
+    = DataD ctxt nm tvs cons (cs ++ derivs)
+    : deriveDefault def tvs nm
+addDerivedClasses def cs (NewtypeD ctxt nm tvs con derivs)
+    = NewtypeD ctxt nm tvs con (cs ++ derivs)
+    : deriveDefault def tvs nm
+addDerivedClasses _ _ d = [d]
+
+deriveDefault :: Bool -> [Name] -> Name -> [Dec]
+deriveDefault False _ _ = []
+deriveDefault True tvs n = [InstanceD context instanceHead []]
+    where tvs' = map VarT tvs
+          mkDef x = ConT ''Default `AppT` x
+          context = map mkDef tvs'
+          instanceHead = mkDef $ foldl AppT (ConT n) tvs'
+
+isDataOrNewtype :: Dec -> Bool
+isDataOrNewtype (DataD {}) = True
+isDataOrNewtype (NewtypeD {}) = True
+isDataOrNewtype _ = False
+
diff --git a/src/Happstack/Data/GOps.hs b/src/Happstack/Data/GOps.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/GOps.hs
@@ -0,0 +1,35 @@
+module Happstack.Data.GOps where
+import Data.Generics hiding (GT)
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Maybe
+
+-- useful generic functions with better names
+
+gSet :: (Data b, Typeable a) => a -> b -> b
+gSet = gReplace . const
+
+gReplace :: (Typeable a, Data b) => (a -> a) -> b -> b
+gReplace f x = everywhere (mkT f) x
+
+gFind :: (MonadPlus m, Data a, Typeable b) => a -> m b
+gFind = msum . map return . listify (const True)
+
+gFind' :: (Data a, Typeable b) => a -> b
+gFind' = fromJust . gFind
+--Monad versions
+
+gModify :: (MonadState s m,Typeable a,Data s) => (a->a) -> m ()
+gModify = modify . gReplace
+
+gAsk :: (Data r, Typeable a, MonadReader r m, MonadPlus n) =>
+        (a -> n b) -> m (n b)
+gAsk f = do st <- ask
+            let y = gFind st 
+            return $ maybe mzero f y
+
+gGet :: (Data s, Typeable a, MonadState s m, MonadPlus n) =>
+        (a -> n b) -> c -> m (n b)
+gGet f _ = do st <- get
+              let y = gFind st 
+              return $ maybe mzero f y
diff --git a/src/Happstack/Data/Migrate.hs b/src/Happstack/Data/Migrate.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Migrate.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Happstack.Data.Migrate where
+
+{- | Migrate instances are needed to allow upgrades of MACID state.  It should be declared as instance Migrate Old New where migrate = transition_function
+-}
+class Migrate a b where
+    migrate :: a -> b
+
diff --git a/src/Happstack/Data/Normalize.hs b/src/Happstack/Data/Normalize.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Normalize.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE OverlappingInstances, UndecidableInstances,
+             FlexibleContexts, FlexibleInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Happstack.Data.Normalize
+-- Copyright   :  (c) Happstack.com 2009; (c) HAppS LLC 2007
+-- License     :  BSD3
+--
+-- Maintainer  :  happs@googlegroups.com
+-- Stability   :  experimental
+-- Portability :  Not portable
+--
+-- Normalizing Haskell values.
+--
+-----------------------------------------------------------------------------
+
+module Happstack.Data.Normalize
+    (
+        -- * The interface
+        Normalize(normalize, normalizeRecursively),
+
+        -- * Writing your own instances
+        defaultNormalize,
+        defaultNormalizeRecursively,
+
+        -- * Advanced usage
+        NormalizeD(..),
+        normalizeProxy,
+    )
+    where
+
+import Data.Generics.SYB.WithClass.Basics
+
+-- | The 'Normalize' class provides a 'normalize' function, which
+-- is intended to normalize values only at the top-level constructor,
+-- and a 'normalizeRecursively' function, which is intended to
+-- normalize all the subvalues and then normalize the top-level
+-- constructor.
+--
+-- There is a default instance that matches all types, where 'normalize'
+-- is 'id' and 'normalizeRecursively' applies 'normalizeRecursively' to
+-- all of its children and then 'normalize' to the result.
+--
+-- If you want to actually do some normalization for a certain type,
+-- then just define an instance for that type; this will take precedence
+-- over the default instance.
+class Data NormalizeD a => Normalize a where
+    normalize :: a -> a
+    normalize = defaultNormalize
+    normalizeRecursively :: a -> a
+    normalizeRecursively = defaultNormalizeRecursively
+
+-- | This is the 'normalize' function in the default 'Normalize'
+-- instance. It may be a useful building block when writing your own
+-- instances.
+defaultNormalize :: Normalize a => a -> a
+defaultNormalize x = x
+
+-- | This is the 'normalizeRecursively' function in the default
+-- 'Normalize' instance. It may be a useful building block when writing
+-- your own instances.
+defaultNormalizeRecursively :: Normalize a => a -> a
+defaultNormalizeRecursively = normalize . gmapT normalizeProxy (normalizeRecursivelyD dict)
+
+-- | When writing your own generic functions for 'Normalize' you may
+-- need to access the class methods through this datatype rather than
+-- directly.
+data NormalizeD a = NormalizeD { normalizeD :: a -> a,
+                                 normalizeRecursivelyD :: a -> a }
+
+-- | When writing your own generic functions for 'Normalize' you may
+-- need this, the proxy value.
+normalizeProxy :: Proxy NormalizeD
+normalizeProxy = error "normalizeProxy"
+
+instance Normalize t => Sat (NormalizeD t) where
+    dict = NormalizeD { normalizeD = normalize,
+                        normalizeRecursivelyD = normalizeRecursively }
+
+instance Data NormalizeD a => Normalize a
+
diff --git a/src/Happstack/Data/Pairs.hs b/src/Happstack/Data/Pairs.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Pairs.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances, UndecidableInstances -- just for example at the bottom
+    ,CPP, DeriveDataTypeable, MultiParamTypeClasses
+  #-}
+module Happstack.Data.Pairs (pairsToXml,xmlToPairs,pairsToHTMLForm,xmlToHTMLForm
+                        ,toPairs,toPairsX,fromPairs,toHTMLForm
+                        ,Pairs,AsPairs
+                        ) where
+
+import Data.Char
+import Data.List
+import Data.Maybe
+
+---stuff for examples
+import Happstack.Data.DeriveAll
+import Happstack.Util.Common
+
+import Data.Generics as G
+import Happstack.Data.Default -- for pairs
+import Happstack.Data.Xml
+import Control.Monad.Identity
+
+type Pairs = [(String,String)]
+
+-- | Converts lists of string pairs into a list of Elements.
+-- The basic structure is 
+-- pairsToXml [("foo","bar")] = [Elem "foo" [CData "bar"]]
+-- pairsToXml [("foo/bar","baz")] = [Elem "foo" [Elem "bar" [CData "baz"]]] 
+pairsToXml :: Pairs -> [Element]
+pairsToXml = fst . formIntoEls "" . map slash
+
+slash :: (String,t) -> (String,t)
+slash p@('/':_,_) = p
+slash (n,v) = ('/':n,v)
+
+formIntoEls :: String -> Pairs -> ([Element], Pairs)
+formIntoEls _ [] = ([],[])
+formIntoEls ctx pairs@((name,val):rest)
+    | not $ isPrefixOf ctx name = ([],pairs)
+    | isAttr = moreCtx $ Attr elName val
+    | isLeaf = moreCtx $ Elem elName [CData val]
+    | otherwise =
+        let (es,pairs') = formIntoEls ctx' pairs
+            (es',pairs'') = formIntoEls ctx pairs'
+        in
+        (Elem elName es:es',pairs'')
+    where
+    ctx' = ctx ++ "/" ++ top
+    node =  tail $ drop (length ctx) name
+    (top,subs) = break (=='/') node
+    elName = takeWhile (/='[') top
+    isLeaf = null subs
+    isAttr = head top == '@'
+    moreCtx el = let (restCtx,restPairs) = formIntoEls ctx rest
+                 in (el:restCtx,restPairs)
+
+-- | Converts a list of Elements to a list of String pairs.
+-- xmlToPairs [CData _] = error
+-- xmlToPairs [Elem "foo" [CData "bar"]] = [("foo","bar")]
+-- xmlToPairs [Elem "foo" [Elem "bar" [CData "baz"]]] = [("foo/bar","baz")]
+-- xmlToPairs . pairsToXml = id
+xmlToPairs :: [Element] -> Pairs
+xmlToPairs =
+    map (\(x,y)->(tail x,y)) .
+    xmlIntoPairs 0 ""
+
+xmlIntoPairs :: Int -> String -> [Element] -> Pairs
+xmlIntoPairs _ _ [] = []
+xmlIntoPairs x ctx (Elem _ []:xs) = xmlIntoPairs x ctx xs
+xmlIntoPairs x ctx (Attr n v:xs) = (ctx++"/"++n,v):xmlIntoPairs x ctx xs
+xmlIntoPairs _ ctx (CData v:[]) = [(ctx,v)]
+xmlIntoPairs _ _ (CData _:_) = []
+xmlIntoPairs i ctx ((Elem n xs):xs') =
+    thisElPairs ++ restPairs
+    where
+    --if we have two elements with the same name then we have to add [i]
+    nIndex = n ++ "[" ++ (show i) ++ "]"
+    (iNext,nName)
+        | i/=0 = (i+1,nIndex)
+        | null xs' = (0,n)
+        | next==n = (i+1,nIndex)
+        | otherwise = (0,n)
+    Elem next _ = head xs'
+    thisElPairs = (xmlIntoPairs 0 (ctx++"/"++nName) xs)
+    restPairs = (xmlIntoPairs iNext ctx xs')
+
+-- | Creates the Xml structure corresponding to the specification of an HTML
+-- form.  The provided pairs should be the spec of the inputs to the form.
+pairsToHTMLForm :: String -> String -> String -> Pairs -> [Element]
+pairsToHTMLForm iden action method pairs
+ = [Elem "form" (Attr "action" action :
+                Attr "id" iden :
+                Attr "method" method :
+                map pToInput pairs ++
+                [submitButton])]
+
+submitButton :: Element
+submitButton = Elem "input" [Attr "type" "submit"]
+
+pToInput :: (String,String) -> Element
+pToInput (n,v)=
+    Elem "div" [Attr "class" "formEl",
+                Elem "span" [Attr "class" "name"
+                            ,CData $ map (\x->if x=='/' then ' ' else x) n]
+               ,Elem "input" [Attr "name" n,Attr "value" v]]
+
+-- | Equivalent to pairsToHTMLForm but first converts the Xml instance to list of pairs.
+xmlToHTMLForm :: (Xml a, Show a, Data a, Eq a) =>
+                 String -> String -> String -> a -> [Element]
+xmlToHTMLForm iden method action
+ = pairsToHTMLForm iden method action  . toPairsX -- xmlToPairs
+
+class (Xml x,Show x, G.Data x) => AsPairs x where
+    toPairs::x->Pairs
+    fromPairs::Pairs -> Maybe x
+
+instance (Xml a,Show a,G.Data a,Eq a) => AsPairs a where
+    toPairs = xmlToPairs . toPublicXml
+    fromPairs [] = Nothing
+    fromPairs pairs = if res == dv && notRigidMatch then Nothing else Just res
+        where
+        xml = pairsToXml $ mapFst clean pairs
+        res = runIdentity $ fromXml Flexible xml
+        mbRigidMatch = fromXml Rigid xml
+        _ = [mbRigidMatch,Just res]
+        isRigidMatch = isJust mbRigidMatch
+        notRigidMatch = not isRigidMatch
+        dv = defaultValue
+        (cons,_) = break (==' ') $ show dv
+        clean n = if (map toLower parent)==(map toLower cons) || (head n == '/') 
+                  then n
+                  else cons++('/':name)
+            where
+            name = trimSlash n
+            (parent,_) = break (=='/') name
+        trimSlash n = if head n=='/' then tail n else n
+
+toPairsX :: (Xml a, Show a, Data a, Eq a) => a -> Pairs
+toPairsX = map (\(n,v)->let (_,child)=break (=='/') n in
+                            if null child then (n,v) else (tail child,v)) . toPairs
+
+-- | Equivalent to pairsToHTMLForm but first converts the Xml instance to list of pairs.  An alias for xmlToHTMLForm currently.
+toHTMLForm :: (Xml a, Show a, Data a, Eq a) =>
+              String -> String -> String -> a -> [Element]
+toHTMLForm = xmlToHTMLForm
+
+--- example usage and tests here
+$( deriveAll [''Show,''Default,''Eq]
+   [d|
+       data UserInfo = UserInfo User Pass 
+       newtype User = User String 
+       newtype Pass = Pass String 
+    |]
+ )
diff --git a/src/Happstack/Data/Proxy.hs b/src/Happstack/Data/Proxy.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Proxy.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, DeriveDataTypeable, UndecidableInstances #-}
+module Happstack.Data.Proxy where
+
+import Happstack.Data.DeriveAll
+import Happstack.Data.Default
+
+-- | Proxy is empty and is used as a transport of a phantom type
+$(deriveAll [''Read,''Show,''Default]
+  [d| data Proxy t = Proxy |]
+ )
+
+-- | Creates the Proxy with a type matching the argument
+proxy :: t -> Proxy t
+proxy _ = Proxy
+
+-- | Returns bottom
+unProxy :: Proxy t -> t
+unProxy _ = undefined
+
+-- | Acts as id except for providing type restrictions
+asProxyType :: t -> Proxy t -> t
+asProxyType t _ = t
+
+
diff --git a/src/Happstack/Data/Serialize.hs b/src/Happstack/Data/Serialize.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Serialize.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE UndecidableInstances, OverlappingInstances, ScopedTypeVariables, GADTs, PatternSignatures,
+    GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+module Happstack.Data.Serialize
+    ( Serialize(..), Version(..), Migrate(..), Mode(..), Contained, contain, extension,
+      safeGet, safePut, serialize, deserialize, collectVersions,
+      Object(objectType), mkObject, deserializeObject, parseObject,
+      module Happstack.Data.Proxy
+    ) where
+
+import Control.Monad.Identity
+import Data.Int()
+import Foreign
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Char8 as B
+
+import Happstack.Data.Migrate
+import Happstack.Data.Proxy
+
+import Data.Typeable
+import qualified Data.Map as M
+import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap
+import qualified Data.Set as Set
+
+import Data.Binary     as B
+import Data.Binary.Put as B
+import Data.Binary.Get as B
+
+--------------------------------------------------------------
+-- Core types
+--------------------------------------------------------------
+
+data Contained a = Contained {unsafeUnPack :: a}
+
+-- | Lifts the provided value into Contained
+contain :: a -> Contained a
+contain = Contained
+
+data Previous a = forall b. (Serialize b, Migrate b a) => Previous (Proxy b)
+
+mkPrevious :: forall a b. (Serialize b, Migrate b a) => Proxy b -> Previous a
+mkPrevious Proxy = Previous (Proxy :: Proxy b)
+
+extension :: forall a b. (Serialize b, Migrate b a) => VersionId a -> Proxy b -> Mode a
+extension vs prox = Versioned vs (Just (mkPrevious prox))
+
+newtype VersionId a = VersionId {unVersion :: Int} deriving (Num,Read,Show,Eq)
+instance Binary (VersionId a) where
+    get = liftM VersionId get
+    put = put . unVersion
+
+
+data Mode a = Primitive -- ^ Data layout won't change. Used for types like Int and Char.
+            | Versioned (VersionId a) (Maybe (Previous a))
+
+class Version a where
+    mode :: Mode a
+    mode = Versioned 0 Nothing
+
+class (Typeable a, Version a) => Serialize a where
+    getCopy :: Contained (Get a)
+    putCopy :: a -> Contained Put
+
+--------------------------------------------------------------
+-- Implementation
+--------------------------------------------------------------
+
+getSafeGet :: forall a. Serialize a => Get (Get a)
+getSafeGet = case mode :: Mode a of
+               Primitive -> return (unsafeUnPack getCopy)
+               Versioned wantedVersion mbPrevious
+                         -> do storedVersion <- get
+                               return (safeGetVersioned wantedVersion mbPrevious storedVersion)
+
+getSafePut :: forall a. Serialize a => PutM (a -> Put)
+getSafePut = case mode :: Mode a of
+               Primitive -> return (unsafeUnPack . putCopy)
+               Versioned vs _
+                         -> do B.put vs
+                               return (unsafeUnPack . putCopy)
+
+
+-- | Equivalent of Data.Binary.put for instances of Serialize.  
+-- Takes into account versioning of types.
+safePut :: forall a. Serialize a => a -> Put
+safePut val = do fn <- getSafePut
+                 fn val
+
+-- | Equivalent of Data.Binary.get for instances of Serialize
+-- Takes into account versioning of types.
+safeGet :: forall a. Serialize a => Get a
+safeGet = join getSafeGet
+
+safeGetVersioned :: forall a b. (Serialize b) => VersionId b -> Maybe (Previous b) -> VersionId a -> B.Get b
+safeGetVersioned wantedVersion mbPrevious storedVersion
+    = case compareVersions storedVersion wantedVersion of
+        GT -> error $ "Version tag too large: " ++ show (wantedVersion,storedVersion) ++ " (" ++ tStr ++ ")"
+        EQ -> unsafeUnPack getCopy
+        LT -> case mbPrevious of
+                Nothing -> error $ "No previous version (" ++ tStr ++ ")"
+                Just (Previous (_ :: Proxy f) :: Previous b)
+                    -> case mode of
+                         Primitive -> error $ "Previous version marked as a Primitive (" ++ tStr ++ ")"
+                         Versioned wantedVersion' mbPrevious'
+                             -> do old <- safeGetVersioned wantedVersion' mbPrevious' storedVersion :: B.Get f
+                                   return $ migrate old
+    where tStr = show (typeOf (error "huh?" :: b))
+
+-- | Compares the numeric value of the versions
+compareVersions :: VersionId a -> VersionId b -> Ordering
+compareVersions v1 v2 = compare (unVersion v1) (unVersion v2)
+
+-- | Pure version of 'safePut'.  Serializes to a ByteString
+serialize :: Serialize a => a -> L.ByteString
+serialize = runPut . safePut
+
+-- | Pure version of 'safeGet'.  Parses a ByteString into the expected type
+-- and a remainder.
+deserialize :: Serialize a => L.ByteString -> (a, L.ByteString)
+deserialize bs = case runGetState safeGet bs 0 of
+                   (val, rest, _offset) -> (val, rest)
+
+-- | Version lookups
+collectVersions :: forall a . (Typeable a, Version a) => Proxy a -> [L.ByteString]
+collectVersions prox
+    = case mode :: Mode a of
+        Primitive                          -> [thisType]
+        Versioned _ Nothing                -> [thisType]
+        Versioned _ (Just (Previous prev)) -> thisType : (collectVersions prev)
+    where thisType = (L.pack . show . typeOf . unProxy) prox
+
+--------------------------------------------------------------
+-- Instances
+--------------------------------------------------------------
+
+instance Version Int where mode = Primitive
+instance Serialize Int where
+    getCopy = contain get; putCopy = contain . put
+instance Version Integer where mode = Primitive
+instance Serialize Integer where
+    getCopy = contain get; putCopy = contain . put
+instance Version Float where mode = Primitive
+instance Serialize Float where
+    getCopy = contain get; putCopy = contain . put
+instance Version Double where mode = Primitive
+instance Serialize Double where
+    getCopy = contain get; putCopy = contain . put
+instance Version L.ByteString where mode = Primitive
+instance Serialize L.ByteString where
+    getCopy = contain get; putCopy = contain . put
+instance Version B.ByteString where mode = Primitive
+instance Serialize B.ByteString where
+    getCopy = contain get; putCopy = contain . put
+instance Version Char where mode = Primitive
+instance Serialize Char where
+    getCopy = contain get; putCopy = contain . put
+instance Version Word8 where mode = Primitive
+instance Serialize Word8 where
+    getCopy = contain get; putCopy = contain . put
+instance Version Word16 where mode = Primitive
+instance Serialize Word16 where
+    getCopy = contain get; putCopy = contain . put
+instance Version Word32 where mode = Primitive
+instance Serialize Word32 where
+    getCopy = contain get; putCopy = contain . put
+instance Version Word64 where mode = Primitive
+instance Serialize Word64 where
+    getCopy = contain get; putCopy = contain . put
+instance Version Ordering where mode = Primitive
+instance Serialize Ordering where
+    getCopy = contain get; putCopy = contain . put
+instance Version Int8 where mode = Primitive
+instance Serialize Int8 where
+    getCopy = contain get; putCopy = contain . put
+instance Version Int16 where mode = Primitive
+instance Serialize Int16 where
+    getCopy = contain get; putCopy = contain . put
+instance Version Int32 where mode = Primitive
+instance Serialize Int32 where
+    getCopy = contain get; putCopy = contain . put
+instance Version Int64 where mode = Primitive
+instance Serialize Int64 where
+    getCopy = contain get; putCopy = contain . put
+instance Version () where mode = Primitive
+instance Serialize () where
+    getCopy = contain get; putCopy = contain . put
+instance Version Bool where mode = Primitive
+instance Serialize Bool where
+    getCopy = contain get; putCopy = contain . put
+instance Version (Either a b) where mode = Primitive
+instance (Serialize a, Serialize b) => Serialize (Either a b) where
+    getCopy = contain $ do n <- get
+                           if n then liftM Right safeGet
+                                else liftM Left safeGet
+    putCopy (Right a) = contain $ put True >> safePut a
+    putCopy (Left a) = contain $ put False >> safePut a
+instance Version (a,b) where mode = Primitive
+instance (Serialize a, Serialize b) => Serialize (a,b) where
+    getCopy = contain $ liftM2 (,) safeGet safeGet
+    putCopy (a,b) = contain $ safePut a >> safePut b
+instance Version (a,b,c) where mode = Primitive
+instance (Serialize a, Serialize b, Serialize c) => Serialize (a,b,c) where
+    getCopy = contain $ liftM3 (,,) safeGet safeGet safeGet
+    putCopy (a,b,c) = contain $ safePut a >> safePut (b,c)
+instance Version (a,b,c,d) where mode = Primitive
+instance (Serialize a, Serialize b, Serialize c, Serialize d) => Serialize (a,b,c,d) where
+    getCopy = contain $ liftM4 (,,,) safeGet safeGet safeGet safeGet
+    putCopy (a,b,c,d) = contain $ safePut a >> safePut (b,c,d)
+instance Version (a,b,c,d,e) where mode = Primitive
+instance (Serialize a, Serialize b, Serialize c, Serialize d, Serialize e) => Serialize (a,b,c,d,e) where
+    getCopy = contain $ liftM5 (,,,,) safeGet safeGet safeGet safeGet safeGet
+    putCopy (a,b,c,d,e) = contain $ safePut a >> safePut (b,c,d,e)
+
+instance Version (Proxy a) where mode = Primitive
+instance Typeable a => Serialize (Proxy a) where
+    getCopy = contain $ return Proxy
+    putCopy Proxy = contain $ return ()
+
+instance Version [a] where mode = Primitive
+instance Serialize a => Serialize [a] where
+    getCopy = contain $
+              do n <- get
+                 getSafeGet >>= replicateM n
+    putCopy lst
+        = contain $
+          do put (length lst)
+             getSafePut >>= forM_ lst
+
+instance Version (Maybe a) where mode = Primitive
+instance Serialize a => Serialize (Maybe a) where
+    getCopy = contain $ do n <- get
+                           if n then liftM Just safeGet
+                                else return Nothing
+    putCopy (Just a) = contain $ put True >> safePut a
+    putCopy Nothing = contain $ put False
+
+instance Version (Set.Set a) where mode = Primitive
+instance (Serialize a, Ord a) => Serialize (Set.Set a) where
+    getCopy = contain $ fmap Set.fromAscList safeGet
+    putCopy = contain . safePut . Set.toList
+
+instance Version (Map.Map a b) where mode = Primitive
+instance (Serialize a,Serialize b, Ord a) => Serialize (Map.Map a b) where
+    getCopy = contain $ fmap Map.fromAscList safeGet
+    putCopy = contain . safePut . Map.toList
+
+instance Version (IntMap.IntMap a) where mode = Primitive
+instance (Serialize a) => Serialize (IntMap.IntMap a) where
+    getCopy = contain $ fmap IntMap.fromAscList safeGet
+    putCopy = contain . safePut . IntMap.toList
+
+
+--------------------------------------------------------------
+-- Object serialization
+--------------------------------------------------------------
+
+
+-- | 'deserialize' specialized to Objects 
+deserializeObject :: L.ByteString -> (Object, L.ByteString)
+deserializeObject = deserialize
+
+-- | Attempts to convert an Object back into its base type.
+-- If the conversion fails 'error' will be called.
+parseObject :: Serialize a => Object -> a
+parseObject (Object objType objData)
+    = let res = runGet safeGet objData
+          resType = show (typeOf res)
+      in if objType /= resType
+         then error $ "Failed to parse object of type '" ++ objType ++ "'. Expected type '" ++ resType ++ "'"
+         else res
+
+-- | Serializes data and stores it along with its type name in an Object
+mkObject :: Serialize a => a -> Object
+mkObject obj = Object { objectType = show (typeOf obj)
+                      , objectData = serialize obj }
+
+data Object = Object { objectType :: String
+                     , objectData :: L.ByteString
+                     }  deriving (Typeable,Show)
+
+instance Version Object
+instance Serialize Object where
+    putCopy (Object objType objData) = contain $ put (objType, objData)
+    getCopy = contain $
+              do (objType, objData) <- get
+                 return (Object objType objData)
diff --git a/src/Happstack/Data/SerializeTH.hs b/src/Happstack/Data/SerializeTH.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/SerializeTH.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE TemplateHaskell, CPP #-}
+module Happstack.Data.SerializeTH
+    ( deriveSerialize
+    , deriveSerializeFor
+    ) where
+
+import Happstack.Data.Serialize
+
+import Language.Haskell.TH
+import Control.Monad
+import Data.Binary
+
+data Class = Tagged [(Name, Int)] Cxt [Name]
+
+deriveSerialize :: Name -> Q [Dec]
+deriveSerialize name
+    = do c <- parseInfo name
+         case c of
+           Tagged cons cx keys ->
+               do let context = [ mkType ''Serialize [varT key] | key <- keys ] ++ map return cx
+                  i <- instanceD (sequence context) (mkType ''Serialize [mkType name (map varT keys)])
+                       [ putCopyFn cons
+                       , getCopyFn cons
+                       ]
+                  return [i]
+    where putCopyFn cons
+              = do inp <- newName "inp"
+                   let putCopyBody = appE (varE 'contain) $
+                                     caseE (varE inp) $
+                                       [ do args <- replicateM nArgs (newName "arg")
+                                            let matchCon = conP conName (map varP args)
+                                            match matchCon (normalB (putCopyWork args i)) []
+                                             | ((conName,nArgs), i) <- zip cons [0..]]
+                       putCopyWork args i
+                           = doE $ [noBindS [| putWord8 $(litE (integerL i)) |]] ++
+                                   [ noBindS [| safePut $(varE arg) |] | arg <- args ]
+                   funD 'putCopy [clause [varP inp] (normalB putCopyBody) []]
+          getCopyFn cons
+              = let getCopyBody = do c <- newName "c"
+                                     appE (varE 'contain) $
+                                      doE [bindS (varP c) [| getWord8 |]
+                                          , noBindS $ caseE (varE c) $
+                                                        [ do args <- replicateM nArgs (newName "arg")
+                                                             match (litP (integerL i)) (normalB $ getCopyWork conName args) []
+                                                          | ((conName, nArgs), i) <- zip cons [0..]]
+                                                        ++ [match (return WildP) (normalB [|error "Wrong serialization type"|]) []]
+                                          ]
+                    getCopyWork conName args
+                        = doE $ [ bindS (varP arg) [| safeGet |] | arg <- args ] ++
+                                [ noBindS [| return $(foldl appE (conE conName) (map varE args)) |] ]
+                in funD 'getCopy [clause [] (normalB getCopyBody) []]
+
+
+deriveSerializeFor :: [Name] -> Q [Dec]
+deriveSerializeFor = liftM concat . mapM deriveSerialize
+
+
+mkType :: Name -> [TypeQ] -> TypeQ
+mkType con = foldl appT (conT con)
+
+parseInfo :: Name -> Q Class
+parseInfo name
+    = do info <- reify name
+         case info of
+           TyConI (DataD cx _ keys cs _)    -> return $ Tagged (map conInfo cs) cx keys
+           TyConI (NewtypeD cx _ keys con _)-> return $ Tagged [conInfo con] cx keys
+           _                            -> error "Invalid input"
+    where conInfo (NormalC n args) = (n, length args)
+          conInfo (RecC n args) = (n, length args)
+          conInfo (InfixC _ n _) = (n, 2)
+          conInfo (ForallC _ _ con) = conInfo con
diff --git a/src/Happstack/Data/Xml.hs b/src/Happstack/Data/Xml.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Xml.hs
@@ -0,0 +1,9 @@
+
+module Happstack.Data.Xml (
+    module Happstack.Data.Xml.Base,
+    module Happstack.Data.Xml.PrintParse) where
+
+import Happstack.Data.Xml.Base
+import Happstack.Data.Xml.PrintParse
+import Happstack.Data.Xml.Instances ()
+
diff --git a/src/Happstack/Data/Xml/Base.hs b/src/Happstack/Data/Xml/Base.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Xml/Base.hs
@@ -0,0 +1,504 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances,
+             OverlappingInstances, UndecidableInstances, CPP,
+             ScopedTypeVariables, GADTs,
+             PolymorphicComponents, FlexibleContexts,
+             MultiParamTypeClasses, DeriveDataTypeable,
+             PatternSignatures, PatternGuards #-}
+
+module Happstack.Data.Xml.Base where
+
+import Control.Monad.Identity
+import Control.Monad.State
+import Data.Char
+import Data.List
+import Data.Generics.SYB.WithClass.Basics
+import Data.Generics.SYB.WithClass.Instances ()
+import Data.Maybe
+import           Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import Happstack.Data.Default
+import Happstack.Data.DeriveAll
+import Happstack.Data.Migrate
+import Happstack.Data.Normalize
+import Happstack.Util.TH
+import Language.Haskell.TH
+import qualified Data.Generics as G
+
+{-| Element recursively represents XML data.  
+    Elem n elems -> XML element with name n and described by elems.  Note that elems contains sub-elements as well as the attributes or literal data of the element.
+    CData d -> Literal string data
+    Attr key val -> Key/Value pair of the element attribute.
+-}
+
+$(deriveAll [''Default, ''Eq,''Read,''Ord] [d|
+    data Element = Elem String [Element]
+                 | CData String
+                 | Attr String String
+ |])
+
+
+-- | insEl a b will convert a to xml and insert it into the
+-- xml of b if b results in an Elem constructor.
+insEl :: (Data XmlD a, Default a, Data NormalizeD a,
+          Data XmlD b, Default b, Data NormalizeD b) =>
+         a -> b -> Element
+insEl a b = case toXml b  of
+            (Elem n xs:_) -> Elem n $ toPublicXml a ++ xs
+            _ -> error "can't insert a into b"
+
+
+-- This is a more readable representation than the default, but is still
+-- Haskell syntax
+instance Show Element where
+    show (Elem s es) = "Elem " ++ show s ++ " ["
+                       ++ fiddle (unlines (indent (concatMap lines $ comma $ map show es)))
+                       
+                      ++ "]"
+        where indent = map ("    " ++)
+              comma::[String]->[String]
+              comma [] = []
+              comma (x:xs) = (' ':x):map (',':) xs
+              fiddle "" = ""
+              fiddle xs = '\n' : (if last xs == '\n' then init xs else xs)
+    show (CData s) = "CData " ++ show s
+    show (Attr k v) = "Attr " ++ show k ++ " " ++ show v
+
+-- | Wrapper around the Xml class method readXml.
+-- The Rigidity will determine the behavior in the case of a failed parsing:  Rigid will return Nothing and Flexible will return Identity (defaultValue)
+fromXml :: forall m a . (Monad m, Xml a) => Rigidity m -> [Element] -> m a
+fromXml r xs = case readXml r xs of
+               Just (_, v) ->
+                   return v
+               Nothing ->
+                   case r of
+                   Rigid -> fail "fromXml XXX"
+                   Flexible -> return defaultValue
+
+data Other b = forall a . (Migrate a b, Xml a) => Other a
+             | NoOther
+
+-- | Identical to toXml from Xml class except that it will remove attributes named haskellType or haskellTypeVersion
+toPublicXml :: Xml a => a -> [Element]
+toPublicXml x = clean $ toXml x
+    where
+    clean [] = []
+    clean ((Elem n xs):rest) = (Elem n $ clean xs): clean rest
+    clean (CData s:rest)=CData s:clean rest
+    clean (Attr n v:rest) = if n `elem` [typeAttr,versionAttr] then clean rest
+                            else Attr n v:clean rest
+-- | Rigidity is used to designate the result of a failed Xml parsing.
+data Rigidity m where
+    Rigid :: Rigidity Maybe
+    Flexible :: Rigidity Identity
+
+instance Show (Rigidity m) where
+    show Rigid = "Rigid"
+    show Flexible = "Flexible"
+
+class (Data XmlD a,
+       Default a, -- We'd rather have this only in the Flexible case,
+                  -- but bugs in GHC 6.6.1 and problems getting the
+                  -- instance for child types in constrFromElements
+                  -- mean it's a constraint of the Xml class for now.
+       Normalize a)
+   => Xml a where
+    toXml :: a -> [Element]
+    toXml = defaultToXml
+
+   -- readXml is like readXml' except it normalises the Elements and
+    -- the result
+    readXml :: Monad m => Rigidity m -> [Element] -> Maybe ([Element], a)
+    readXml = defaultReadXml
+
+    readXml' :: Monad m => Rigidity m -> [Element] -> Maybe ([Element], a)
+    readXml' = defaultReadXml'
+
+    normalizeXml :: a{- can't look at this value -} -> [Element] -> [Element]
+    normalizeXml _ = id
+
+    version :: a{- can't look at this value -} -> Maybe String
+    version _ = Just "0"
+
+    otherVersion :: a{- can't look at this value -} -> Other a
+    otherVersion _ = NoOther
+
+    typ :: a{- can't look at this value -} -> String
+    typ _ = dataTypeName (dataTypeOf xmlProxy (undefined :: a))
+
+instance (Data XmlD t, Default t, Normalize t) => Xml t
+
+data XmlD a = XmlD { toXmlD :: a -> [Element],
+                     readMXmlD :: forall m . Monad m
+                               => Rigidity m -> ReadM m a,
+                     readMXmlNoRootDefaultD :: forall m . Monad m
+                                            => Rigidity m -> ReadM Maybe a }
+
+-- | Used as a type witness for usage with syb-with-class Data class.
+xmlProxy :: Proxy XmlD
+xmlProxy = error "xmlProxy"
+
+instance Xml t => Sat (XmlD t) where
+    dict = XmlD { toXmlD = toXml,
+                  readMXmlD = readMXml,
+                  readMXmlNoRootDefaultD = readMXmlNoRootDefault }
+
+-- | Applies function to only first element of the list.  Safe on empty lists.
+first :: (a -> a) -> [a] -> [a]
+first _ [] = []
+first f (x:xs) = f x : xs
+
+
+{- | Converts the argument to an Xml element with the constructor 
+   name as the root of the Elem and the additional attributes corresponding 
+   to haskellType and haskellTypeVersion added
+-}
+defaultToXml :: Xml t => t -> [Element]
+defaultToXml x
+ = let me = first toLower $ constring $ toConstr xmlProxy x
+       rest = Attr typeAttr (dataTypeName (dataTypeOf xmlProxy x)) :
+            transparentToXml x
+       rest' = case version x of
+                   Nothing -> rest
+                   Just v -> Attr versionAttr v : rest
+   in [Elem me rest']
+
+-- | Generically traverses an instance of Xml and converts it into a list of elements 
+transparentToXml :: Xml t => t -> [Element]
+transparentToXml = concat . gmapQ xmlProxy (toXmlD dict)
+
+-- | Attempts to parse the set of elements and return the first constructor it
+-- can successfully parse of the inferred type.
+transparentReadXml :: forall m t . (Monad m, Xml t)
+                   => Rigidity m -> [Element] -> Maybe ([Element], t)
+transparentReadXml r es
+ = aConstrFromElements r (dataTypeConstrs (dataTypeOf xmlProxy resType)) es
+   where resType :: t
+         resType = typeNotValue resType
+
+-- | Create an Xml instance using transparentToXml and transparentReadXml
+transparentXml :: Name -> Q [Dec]
+transparentXml n
+ = do i <- reify n
+      case i of
+          TyConI (DataD _ _ vs _ _) ->
+              do argNames <- replicateM (length vs) (newName "a")
+                 let args = map varT argNames
+                     mkXml a = conT ''Xml `appT` a
+                     ctxt = cxt $ map mkXml args
+                     instanceHead = mkXml $ foldl appT (conT n) args
+                     decs = [d|
+                                toXml :: Xml a => a -> [Element]
+                                toXml = transparentToXml
+
+                                readXml :: (Monad m, Xml a)
+                                        => Rigidity m -> [Element]
+                                        -> Maybe ([Element], a)
+                                readXml = transparentReadXml
+                              |]
+                 d <- instanceD' ctxt instanceHead decs
+                 return [d]
+          _ ->
+              fail ("transparentXml: Not given a type constructor's name: " ++
+                    show n)
+
+-- Don't do any defaulting here, as these functions can be implemented
+-- differently by the user. We do the defaulting elsewhere instead.
+-- The t' type is thus not used.
+
+defaultReadXml :: (Monad m, Xml t)
+               => Rigidity m -> [Element] -> Maybe ([Element], t)
+defaultReadXml r es = res
+    where res = case readXml' r $ normalizeXml valType es of
+                    Nothing -> Nothing
+                    Just (es', v) -> Just (es', normalize v)
+          valType = snd $ fromJust res
+
+defaultReadXml' :: (Monad m, Xml t)
+                => Rigidity m -> [Element] -> Maybe ([Element], t)
+defaultReadXml' = readXmlWith readVersionedElement
+
+readXmlWith :: Xml t
+            => (Rigidity m -> Element -> Maybe t)
+            -> Rigidity m
+            -> [Element]
+            -> Maybe ([Element], t)
+readXmlWith f r@Rigid es = case es of
+                               e : es' ->
+                                   case f r e of
+                                       Just v -> Just (es', v)
+                                       Nothing -> Nothing
+                               [] ->
+                                   Nothing
+readXmlWith f r@Flexible es = readXmlWith' [] es
+    where readXmlWith' acc (x:xs)
+           = case f r x of
+                 Nothing -> readXmlWith' (x:acc) xs
+                 Just v -> Just (reverse acc ++ xs, v)
+          readXmlWith' _ [] = Nothing
+
+readVersionedElement :: forall m t . (Monad m, Xml t)
+                     => Rigidity m -> Element -> Maybe t
+readVersionedElement r (Elem n es)
+    = case getAttr typeAttr es of
+      Nothing ->
+          readElement r (Elem n es)
+      Just (t, es')
+       | t == typ resType ->
+          case version resType of
+          Nothing ->
+              readElement r (Elem n es')
+          Just v ->
+              case getAttr versionAttr es' of
+              Nothing -> readElement r (Elem n es')
+              Just (v', es'')
+               | v == v' -> readElement r (Elem n es'')
+               | otherwise ->
+                  case otherVersion resType of
+                  NoOther ->
+                      Nothing
+                  Other (_ :: u) ->
+                      case readVersionedElement r (Elem n es'') of
+                      Just (res :: u) ->
+                          Just (migrate res)
+                      Nothing -> Nothing
+       | otherwise ->
+          Nothing
+    where resType :: t
+          resType = typeNotValue resType
+readVersionedElement _ _ = Nothing
+
+-- | Matches the provided string to the key of an attribute.  Returns False if any other Element constructor is given.
+isTheAttr :: String -> Element -> Bool
+isTheAttr a (Attr k _) = a == k
+isTheAttr _ _          = False
+
+-- | Fetch the value of the given attribute if present, if not present will return Nothing
+getAttr :: String -> [Element] -> Maybe (String, [Element])
+getAttr a es = case break (isTheAttr a) es of
+                (prefix, Attr _ v : suffix) -> Just (v, prefix ++ suffix)
+                _ -> Nothing
+
+-- | Attribute used for Xml class version information
+versionAttr :: String
+versionAttr = "haskellTypeVersion"
+
+-- | Attribute used for recording the actual Haskell type in the xml serialization 
+typeAttr :: String
+typeAttr = "haskellType"
+
+
+readElement :: forall m t . (Monad m, Xml t) => Rigidity m -> Element -> Maybe t
+readElement r (Elem n es) = res
+    where resType = dataTypeOf xmlProxy (undefined :: t)
+          res = case readConstr resType $ first toUpper n of
+                Just c -> f c
+                Nothing -> if endsWithNum n then readElement r (Elem (noNum n) es) else Nothing
+          f :: Constr -> Maybe t
+          f c =     let m :: m ([Element], t)
+                        m = constrFromElements r c es
+                    in case r of
+                       Rigid -> case m of
+                                    Just ([], x) -> Just x
+                                    _ -> Nothing
+                       Flexible -> case runIdentity m of
+                                       -- We ignore left over elements
+                                       (_, x) -> Just x
+          endsWithNum m = (last m) `elem` "0123456789"
+          noNum  = reverse . dropWhile (`elem` "012344566789") . reverse 
+
+readElement _ _ = Nothing
+
+-- When just trying all the constructors of a type, if defaulting is
+-- allowed we would always get the first constructor as all of its
+-- arguments could be defaulted. Therefore we have the choice of
+--  * accepting this
+--  * turning off defaulting for this level only
+--  * turning off defaulting recursively
+-- We choose the second option, and thus have to duplicate
+-- constrFromElements and readXml(D).
+
+-- | aConstrFromElements will return the results of the first constructor
+-- that parses correctly.
+aConstrFromElements :: forall m t . (Monad m, Xml t)
+                    => Rigidity m -> [Constr] -> [Element]
+                    -> Maybe ([Element], t)
+aConstrFromElements r cs es
+ = msum [ constrFromElementsNoRootDefault r c es | c <- cs ]
+
+
+-- | Like constrFromElements but does not allow defaulting in case of
+-- a parse error.
+constrFromElementsNoRootDefault :: forall m t . (Monad m, Xml t)
+                                => Rigidity m -> Constr -> [Element]
+                                -> Maybe ([Element], t)
+constrFromElementsNoRootDefault r c es
+ = do let st = ReadState { xmls = es }
+          m :: ReadM Maybe t
+          m = fromConstrM xmlProxy (readMXmlNoRootDefaultD dict r) c
+      -- XXX Should we flip the result order?
+      (x, st') <- runStateT m st
+      return (xmls st', x)
+
+{- | Attempts to parse the given elements to build the particular type
+     given by the constructor argument.
+-}
+constrFromElements :: forall m t . (Monad m, Xml t)
+                   => Rigidity m -> Constr -> [Element]
+                   -> m ([Element], t)
+constrFromElements r c es
+ = do let st = ReadState { xmls = es }
+          m :: ReadM m t
+          m = fromConstrM xmlProxy (readMXmlD dict r) c
+      -- XXX Should we flip the result order?
+      (x, st') <- runStateT m st
+      return (xmls st', x)
+
+type ReadM m = StateT ReadState m
+
+data ReadState = ReadState {
+                     xmls :: [Element]
+                 }
+
+-- | Returns the elements currently in the state
+getXmls :: Monad m => ReadM m [Element]
+getXmls = do st <- get
+             return $ xmls st
+
+-- | Sets the state of the xml parsing to the given value
+putXmls :: Monad m => [Element] -> ReadM m ()
+putXmls xs = do st <- get
+                put $ st { xmls = xs }
+
+{- | Attempts to parse the current set of elements.  If it fails the behavior
+is dependent on the Rigidity.  If it is Rigid, then it will return Nothing
+but if it is Flexible it will return the defaultValue.
+If the parsing succeeds, it will return the value and store the remaining
+XML elements in the parser state.
+-}
+readMXml :: (Monad m, Xml a) => Rigidity m -> ReadM m a
+readMXml r
+ = do xs <- getXmls
+      case readXml r xs of
+          Nothing ->
+              case r of
+              Rigid -> fail "Cannot read value"
+              Flexible -> return defaultValue
+          Just (xs', v) ->
+              do putXmls xs'
+                 return v
+-- | Identical to readMXml except that in the case of a failed parsing it will not use defaultValue.
+readMXmlNoRootDefault :: (Monad m, Xml a) => Rigidity m -> ReadM Maybe a
+readMXmlNoRootDefault r
+ = do xs <- getXmls
+      case readXml r xs of
+          Nothing -> fail "Cannot read value"
+          Just (xs', v) ->
+              do putXmls xs'
+                 return v
+
+xmlAttr :: Name -> Q [Dec]
+xmlAttr newTypeName
+ = do i <- reify newTypeName
+      case i of
+          TyConI (NewtypeD _ n _ (NormalC c [(_, ConT t)]) _)
+           | t == ''ByteString -> mkDecs n c t
+          _ -> fail "xmlAttr: Didn't get what I wanted"
+
+    where mkDecs n c t =
+            do let x = mkName "x"
+                   f = mkName "f"
+                   cstr = stringL $ first toLower $ nameBase c
+                   toFun = funD
+                             'toXml
+                             [clause
+                                 [conP c [varP x]]
+                                 (normalB [| [Attr $(litE cstr)
+                                                   $ BS.unpack $(varE x)] |])
+                                 []]
+
+                   readFun = funD
+                             'readXml
+                             [clause
+                                 []
+                                 (normalB [| readXmlWith $(varE f) |])
+                                 [readHelper]]
+
+                   readHelper
+                    = funD f
+                           [
+                            clause [conP 'Attr [litP cstr, (varP x)]]
+                                   (normalB [| Just $ $(conE c)
+                                                    $ BS.pack $(varE x) |])
+                                   [],
+                            clause [wildP]
+                                   (normalB [| Nothing |])
+                                   []
+                           ]
+               inst <- instanceD (cxt [])
+                                 ( conT ''Xml `appT` conT n)
+                                 [toFun, readFun]
+               return [inst]
+
+-- | xmlShowCData lifted to act on lists
+xmlShowCDatas :: [Name] -> Q [Dec]
+xmlShowCDatas = liftM concat . mapM xmlShowCData
+
+{- | automatically creates an Xml definition for a type that is an instance
+of Show and Read.  This will result in an instance that converts the type to and from CData.
+-}
+xmlShowCData :: Name -> Q [Dec]
+xmlShowCData newTypeName
+ = do d <- instanceD' (cxt [])
+                      (conT ''Xml `appT` conT newTypeName)
+                      [d|
+                          toXml :: (Show a, Xml a) => a -> [Element]
+                          toXml x = [CData $ show x]
+
+                          readXml :: (Read a, Xml a)
+                                  => Rigidity m -> [Element]
+                                  -> Maybe ([Element], a)
+                          readXml = readXmlWith f
+                              where f _ (CData x)
+                                     | [(v, "")] <- reads x = Just v
+                                    f _ _ = Nothing
+                        |]
+      return [d]
+
+-- | xmlCDataLists lifted to act on lists
+xmlCDataLists :: [Name] -> Q [Dec]
+xmlCDataLists = liftM concat . mapM xmlCDataList
+
+{- | Creates an instance similar to xmlShowCData except for lists of the
+provided type -}
+xmlCDataList :: Name -> Q [Dec]
+xmlCDataList newTypeName
+ = do d <- instanceD' (cxt [])
+                      (conT ''Xml `appT` (listT `appT` conT newTypeName))
+                      [d|
+                        toXml :: (Show a, Xml a) => [a] -> [Element]
+                        toXml xs = [CData $ concat $ intersperse ","
+                                          $ map show xs]
+
+                        readXml :: (Read a, Xml a)
+                                => Rigidity m -> [Element]
+                                -> Maybe ([Element], [a])
+                        readXml = readXmlWith f
+                            where f _ (CData x) =
+                                      let list = words $ noCommas x
+                                          is = concatMap reads list
+                                      in if length is == length list
+                                         then Just $ map fst is
+                                         else Nothing
+                                  f _ _ = Nothing
+                       |]
+      return [d]
+
+-- | Replaces commas in the string with single spaces
+noCommas :: String -> String
+noCommas = map (\x -> if x == ',' then ' ' else x)
+
+-- | Throws an error when called
+typeNotValue :: Xml a => a -> a
+typeNotValue t = error ("Type used as value: " ++ typeName)
+    where typeName = dataTypeName (dataTypeOf xmlProxy t)
+
diff --git a/src/Happstack/Data/Xml/HaXml.hs b/src/Happstack/Data/Xml/HaXml.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Xml/HaXml.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances,
+             OverlappingInstances, UndecidableInstances #-}
+
+module Happstack.Data.Xml.HaXml where
+
+import Data.List
+import Happstack.Data.Xml.Base
+import qualified Text.XML.HaXml.Types as H
+
+-- | 
+isAttr :: Element -> Bool
+isAttr (Attr {}) = True
+isAttr _ = False
+
+-- | Lifts toHaXml to act on lists of Elements 
+toHaXmls :: [Element] -> [H.Content]
+toHaXmls = map toHaXml
+
+-- | Converts the Element to HaXml Element if the Element is of the form
+-- Elem _ _ 
+toHaXmlEl :: Element -> H.Element
+toHaXmlEl el = let H.CElem el' = toHaXml el in el'
+
+-- | Conversion function between the Happstack Element and HaXml Content types
+toHaXml :: Element -> H.Content
+toHaXml (Elem n es) = case partition isAttr es of
+                      (as, xs) ->
+                          H.CElem (H.Elem n (map toAttribute as) (toHaXmls xs))
+toHaXml (CData x) = H.CString True x
+-- We can't do better than wrap an attribute up in a fake element.
+-- This shouldn't be happening in the real world anyway.
+toHaXml a@(Attr {}) = toHaXml (Elem "JustAnAttr" [a])
+
+-- | Converts an Element that is an Attr into a HaXml Attribute.  Will throw
+-- an error if provided the wrong constructor.
+toAttribute :: Element -> H.Attribute
+toAttribute (Attr k v) = (k, H.AttValue [Left v])
+toAttribute _ = error "toAttribute: Can't happen"
+
+-- Is this function really necessary?
+-- | Lifts fromHaXml to operate on lists
+fromHaXmls :: [H.Content] -> [Element]
+fromHaXmls = map fromHaXml
+
+-- | Converts a HaXml Content to an Element
+fromHaXml :: H.Content -> Element
+fromHaXml (H.CElem (H.Elem n as xs))
+    = Elem n (fromAttributes as ++ fromHaXmls xs)
+fromHaXml (H.CString _ x) = CData x
+fromHaXml (H.CRef (H.RefEntity "amp")) = CData "&"
+fromHaXml (H.CRef (H.RefEntity "lt")) = CData "<"
+fromHaXml (H.CRef (H.RefEntity "gt")) = CData ">"
+fromHaXml (H.CRef (H.RefEntity "apos")) = CData "'"
+fromHaXml (H.CRef (H.RefEntity "quot")) = CData "\""
+fromHaXml (H.CRef (H.RefEntity x)) = 
+    error $ "fromHaXml: Not implemented ref:" ++ x
+fromHaXml (H.CRef (H.RefChar x)) = 
+    error $ "fromHaXml: Not implemented ref:" ++ (show x)
+fromHaXml (H.CMisc (H.Comment _)) = CData ""
+fromHaXml (H.CMisc (H.PI (_,_))) = CData ""
+
+-- | Lifts fromAttribute to act on lists
+fromAttributes :: [H.Attribute] -> [Element]
+fromAttributes = map fromAttribute
+
+-- | Will convert a HaXml attribute that is of the form [Left _] to a
+-- Happstack Element.  Otherwise, will throw an error.
+fromAttribute :: H.Attribute -> Element
+fromAttribute (k, H.AttValue [Left v]) = Attr k v
+fromAttribute _ = error "fromAttribute: Not implemented"
diff --git a/src/Happstack/Data/Xml/Instances.hs b/src/Happstack/Data/Xml/Instances.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Xml/Instances.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances,
+             OverlappingInstances, UndecidableInstances, CPP,
+             TypeSynonymInstances, PatternGuards,
+             MultiParamTypeClasses #-}
+{-# OPTIONS -fno-warn-orphans #-}
+-- These are orphaned instances This means the existance of this file causes
+-- ghc to visit its .hi every time any file that depends on it in any way is
+-- compiled, just to see if this instance is needed
+
+module Happstack.Data.Xml.Instances where
+
+import Data.Char
+import Data.List
+import Happstack.Data.Xml.Base
+import Data.Generics.SYB.WithClass.Basics
+import Data.Generics.SYB.WithClass.Instances ()
+import Data.Maybe
+import           Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+
+import Happstack.Data.Default
+
+
+
+instance Xml Element where
+    toXml = (:[])
+
+
+-- The Xml [a] context is a bit scary, but if we don't have it then
+-- GHC complains about overlapping instances
+instance (Xml a, Xml [a]) => Xml [a] where
+    toXml = concatMap toXml
+    readXml r = f [] []
+        where f acc_xs acc_vs [] = Just (reverse acc_xs, reverse acc_vs)
+              f acc_xs acc_vs (x:xs) = case readXml r [x] of
+                                           Just ([], v) ->
+                                               f acc_xs (v:acc_vs) xs
+                                           _ ->
+                                               f (x:acc_xs) acc_vs xs
+
+
+instance Xml Bool where
+    toXml True = [CData "1"]
+    toXml False = [CData "0"]
+    readXml = readXmlWith f
+        where f _ (CData "1") = Just True
+              f _ (CData "0") = Just False
+              f _ (CData "True") = Just True
+              f _ (CData "False") = Just False
+              f _ (CData "T") = Just True
+              f _ (CData "F") = Just False
+              f _ _ = Nothing
+
+instance Default Bool where defaultValue= False
+
+instance Xml String where
+    toXml x = [CData x]
+    readXml = readXmlWith f
+        where f _ (CData x) = Just x
+              f _ _ = Nothing
+
+instance Xml Char where
+    toXml x = [CData [x]]
+    readXml = readXmlWith f
+        where f _ (CData [x]) = Just x
+              f _ _ = Nothing
+
+instance Xml ByteString where
+    toXml x = [CData $ BS.unpack x]
+    readXml = readXmlWith f
+        where f _ (CData x) = Just $ BS.pack x
+              f _ _ = Nothing
+
+instance Xml [String] where
+    toXml xs = [CData $ concat $ intersperse "," xs]
+    readXml = readXmlWith f
+        where f _ (CData x) = Just $ words $ noCommas x
+              f _ _ = Nothing
+
+$( xmlShowCDatas [''Int, ''Integer, ''Float, ''Double] )
+$( xmlCDataLists [''Int, ''Integer, ''Float, ''Double] )
+
+
+instance Xml a => Xml (Maybe a) where
+    toXml = transparentToXml
+    -- We can't use transparentReadXml or Nothing would always win, as
+    -- it is first in the list of constructors
+    readXml r = aConstrFromElements r
+              $ map (toConstr xmlProxy) [Just (), Nothing]
+
+$( transparentXml ''Either )
+$( transparentXml ''() )
+$( transparentXml ''(,) )
+$( transparentXml ''(,,) )
+$( transparentXml ''(,,,) )
+
+
diff --git a/src/Happstack/Data/Xml/PrintParse.hs b/src/Happstack/Data/Xml/PrintParse.hs
new file mode 100644
--- /dev/null
+++ b/src/Happstack/Data/Xml/PrintParse.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances, CPP,
+             OverlappingInstances, UndecidableInstances,
+             DeriveDataTypeable, MultiParamTypeClasses #-}
+
+module Happstack.Data.Xml.PrintParse where
+
+import Control.Monad
+import Text.PrettyPrint.HughesPJ
+import Text.XML.HaXml.Parse
+import Text.XML.HaXml.Pretty
+import Text.XML.HaXml.Types (Document(Document), Content(CElem))
+import Happstack.Data.Xml.Base
+import Happstack.Data.Xml.HaXml
+import Data.Generics as G
+import Happstack.Data.DeriveAll
+import Happstack.Data.Default
+
+$(deriveAll [''Read,''Show,''Default]
+  [d|
+      data W = W [K]
+      data K = K String
+   |]
+ )
+
+
+class ToString a where toString::a->String
+instance ToString [Element] where
+    toString = render . vcat . map (content . toHaXml)
+
+instance ToString Element where
+    toString = render . content . toHaXml
+
+instance (Xml a,G.Data a) => ToString a where 
+    toString = toString . toXml
+
+
+class FromString a where
+    fromString :: Monad m => Rigidity m -> String -> m a
+
+instance FromString Element where
+    fromString _ s = case xmlParse "NoFile" s of
+                       Document _ _ e _ ->
+                           return $ fromHaXml $ CElem e
+                       -- XXX Currently we assume this always succeeds,
+                       -- but we should be allowing for the possibility of
+                       -- failure
+                       -- _ -> Nothing
+
+instance FromString [Element] where
+    fromString r s = liftM (: []) $ fromString r s
+
+instance (Xml a,G.Data a) => FromString a where
+    fromString r x = fromString r x >>= fromXml r
+
diff --git a/tests/HAppS/Data/Tests.hs b/tests/HAppS/Data/Tests.hs
deleted file mode 100644
--- a/tests/HAppS/Data/Tests.hs
+++ /dev/null
@@ -1,16 +0,0 @@
--- |HUnit tests and QuickQuick properties for HAppS.Util.*
-module HAppS.Data.Tests (allTests) where
-
-import HAppS.Data.Tests.HList001 (hlist001)
-import HAppS.Data.Tests.HList002 (hlist002)
-import HAppS.Data.Tests.Xml001   (xml001)
-import HAppS.Data.Tests.Xml002   (xml002)
-import HAppS.Data.Tests.Xml003   (xml003)
-import HAppS.Data.Tests.HasT001  (hasT001)
-
-import Test.HUnit as HU (Test(..),(~:))
-
--- |All of the tests for happstack-util should be listed here. 
-allTests :: Test
-allTests = 
-    "happstack-data tests" ~: [hlist001, hlist002, xml001, xml002, xml003, hasT001]
diff --git a/tests/HAppS/Data/Tests/HList001.hs b/tests/HAppS/Data/Tests/HList001.hs
deleted file mode 100644
--- a/tests/HAppS/Data/Tests/HList001.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable,
-             FlexibleInstances, MultiParamTypeClasses,
-             OverlappingInstances, UndecidableInstances #-}
-module HAppS.Data.Tests.HList001 (hlist001, t10, t10_2, t11) where
-
-import Language.Haskell.TH
-import HAppS.Data
-import Test.HUnit
-
-$( deriveAll [''Show,''Eq, ''Default]
-   [d|
-       data UserInfo = UserInfo User Pass 
-       newtype User = User String 
-       newtype Pass = Pass String 
-       newtype Age = Age Int
-    |]
- )
-
-t10, t10_2, t11 :: Test
-
-t10   = "t10"    ~: hlextract (User "alex" .&. "abc") @?= "abc"
-t10_2 = "t10_2"  ~: hlextract (User "alex" .&. Pass "pass" .&. "abc") @?= "abc"
-t11   = "t11"    ~:
-        let hl = User "alex" .&. Pass "pass"
-        in Pass "pass2" @?= (hlextract $ hlupdate hl (Pass "pass2"))
-
-hlist001 :: Test
-hlist001 = "hlextract" ~: [t10, t10_2, t11]
diff --git a/tests/HAppS/Data/Tests/HList002.hs b/tests/HAppS/Data/Tests/HList002.hs
deleted file mode 100644
--- a/tests/HAppS/Data/Tests/HList002.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable,
-             FlexibleInstances, MultiParamTypeClasses,
-             OverlappingInstances, UndecidableInstances #-}
-module HAppS.Data.Tests.HList002 (hlist002, t15) where
-
-import Language.Haskell.TH
-import HAppS.Data
-import Test.HUnit
-
-$( deriveAll [''Show,''Eq, ''Default]
-   [d|
-       data UserInfo = UserInfo User Pass 
-       newtype User = User String 
-       newtype Pass = Pass String 
-       newtype Age = Age Int
-    |]
- )
-t12 :: Couple User (Couple Pass Age)
-t12 = (User "ales" .&. Pass "pass" .&. Age 55 )
-
-t13 :: Pairs
-t13 = toPairs t12
-
-t14 :: Maybe (Couple User (Couple Pass Age))
-t14 = fromPairs t13 
-
-t15 :: Test
-t15 = "t15" ~: (Just t12) @?= t14
-
-hlist002 :: Test
-hlist002 = "toPairs/fromPairs" ~: [ t15 ]
diff --git a/tests/HAppS/Data/Tests/HasT001.hs b/tests/HAppS/Data/Tests/HasT001.hs
deleted file mode 100644
--- a/tests/HAppS/Data/Tests/HasT001.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable,
-             FlexibleInstances, MultiParamTypeClasses,
-             OverlappingInstances, UndecidableInstances #-}
-module HAppS.Data.Tests.HasT001 (hasT001, t8, t9) where
-
-import Language.Haskell.TH
-import HAppS.Data
-import Test.HUnit (Test,(@?=), (~:))
-
-$( deriveAll [''Show,''Eq, ''Default]
-             [d| newtype User = User String |]
- )
-
-tHasT :: HasT hlist y => hlist -> y -> (y, y)
-tHasT hlist v = (hlextract hlist, v)
-
-t8 :: Test
-t8 = "t8" ~: tHasT (User "alex" .&. "asad") (User "alex2") @?= (User "alex",User "alex2")
-
-t9 :: Test
-t9 = "t9" ~: tHasT (User "alex" .&. "asad" ) "abc" @?= ("asad","abc")
-
-hasT001 :: Test
-hasT001 = "hasT001" ~: [t8, t9]
diff --git a/tests/HAppS/Data/Tests/Xml001.hs b/tests/HAppS/Data/Tests/Xml001.hs
deleted file mode 100644
--- a/tests/HAppS/Data/Tests/Xml001.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances, DeriveDataTypeable #-}
-module HAppS.Data.Tests.Xml001 (xml001, flexibleTests, flexibleManualTests, migrationTests) where
-
-import Control.Monad.Identity
-import Data.Generics.SYB.WithClass.Basics
-import Data.Maybe
-import HAppS.Data
-import Test.HUnit (Test(..),(@?=),(~:))
-
-$( deriveAll [''Eq, ''Default, ''Show]
-    [d|
-        data Bap = Zip | Zap
-        data Fuzz a = Fo | Fig a
-      |]
- )
-$( deriveAll [''Eq, ''Show]
-    [d|
-        data Foo a = DefFoo | Foo a
-        data Bar a = DefBar | Bar a
-
-        data New = New Int
-        data Old = Old YesNo
-        data YesNo = Yes | No -- Use our own type as Bool has a
-                              -- Xml special instance
-      |]
- )
-
-newtype MyList a = MkMyList { unMyList :: [a] }
-    deriving (Show, Eq, Typeable)
-instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)
-      => Data ctx (MyList a) where
-    gfoldl _ f z x  = z MkMyList `f` unMyList x
-    toConstr _ (MkMyList _) = mkMyListConstr
-    gunfold _ k z c  = case constrIndex c of
-                           1 -> k (z MkMyList)
-                           _ -> error "gunfold MyList: Can't happen"
-    dataTypeOf _ _ = myListDataType
-mkMyListConstr :: Constr
-mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix
-myListDataType :: DataType
-myListDataType = mkDataType "MyList" [mkMyListConstr]
-instance Default a => Default (MyList a) where
-    defaultValue = MkMyList defaultValue
-
-instance Default New where
-    defaultValue = New 7
-
-instance Default Old where
-    defaultValue = Old Yes
-
-instance Xml New where
-    version _ = Just "newver"
-    otherVersion _ = Other (error "Other" :: Old)
-
-instance Xml Old where
-    typ _ = "New"
-
-instance Migrate Old New where
-    migrate (Old No)  = New 8
-    migrate (Old Yes) = New 9
-
-instance Default YesNo where
-    defaultValue = No
-
-instance Default a => Default (Foo a) where
-    defaultValue = DefFoo
-
-instance Default a => Default (Bar a) where
-    defaultValue = DefBar
-
-flexibleTests :: Test
-flexibleTests =
-    "flexibleTests" ~:
- [mkFTest [Elem "foo" [Elem "bar" [Elem "zap" []]]] (Foo $ Just $ Bar Zap)  @?= (Nothing :: Maybe Res)
- ,mkFTest [            Elem "bar" [Elem "zap" []] ] DefFoo                  @?= (Nothing :: Maybe Res)
- ,mkFTest [Elem "foo" [            Elem "zap" [] ]] (Foo Nothing)           @?= (Nothing :: Maybe Res)
- ,mkFTest [Elem "foo" [Elem "bar" [             ]]] (Foo $ Just $ Bar Zip)  @?= (Nothing :: Maybe Res)
- ,mkFTest [Elem "foo" [                          ]] (Foo Nothing)           @?= (Nothing :: Maybe Res)
- ,mkFTest [            Elem "bar" []              ] DefFoo                  @?= (Nothing :: Maybe Res)
- ,mkFTest [                        Elem "zap" []  ] DefFoo                  @?= (Nothing :: Maybe Res)
- ]
-
-flexibleManualTests :: Test
-flexibleManualTests =
-    "flexibleManualTest" ~:
- [mkFTest [] (MkMyList [])                 @?= (Nothing :: Maybe (MyList YesNo))
- ,mkFTest [Elem "yes" []] (MkMyList [Yes]) @?= (Nothing :: Maybe (MyList YesNo))
- ,mkFTest [Elem "no"  []] (MkMyList [No])  @?= (Nothing :: Maybe (MyList YesNo))
- ,mkFTest [Elem "yes" [], Elem "yes" []] (MkMyList [Yes, Yes]) @?= (Nothing :: Maybe (MyList YesNo))
- ,mkFTest [Elem "yes" [], Elem "no"  []] (MkMyList [Yes, No])  @?= (Nothing :: Maybe (MyList YesNo))
- ,mkFTest [Elem "no"  [], Elem "yes" []] (MkMyList [No,  Yes]) @?= (Nothing :: Maybe (MyList YesNo))
- ,mkFTest [Elem "no"  [], Elem "no"  []] (MkMyList [No,  No])  @?= (Nothing :: Maybe (MyList YesNo))
- ]
-
-migrationTests :: Test
-migrationTests =
- "migrationTests" ~:
- [mkFTest [Elem "new" [testtype, newver, CData "5"       ]] (New 5) @?= Nothing
- ,mkFTest [Elem "old" [testtype, oldver, Elem  "yes"   []]] (New 9) @?= Nothing
- ,mkFTest [Elem "old" [testtype, oldver, Elem  "no"    []]] (New 8) @?= Nothing
- ,mkFTest [Elem "new" [                  CData "5"       ]] (New 5) @?= Nothing
- ,mkFTest [Elem "new" [                  Elem  "yes"   []]] (New 0) @?= Nothing
- ,mkFTest [Elem "new" [                                  ]] (New 0) @?= Nothing
- ,mkFTest [Elem "old" [testtype                          ]] (New 7) @?= Nothing
- ,mkFTest [Elem "old" [testtype, oldver                  ]] (New 8) @?= Nothing
- ,mkFTest [Elem "old" [                                  ]] (New 7) @?= Nothing
- ]
-
-newver :: Element
-newver = Attr versionAttr "newver"
-
-oldver :: Element
-oldver = Attr versionAttr "oldver"
-
-testtype :: Element
-testtype = Attr typeAttr (dataTypeName (dataTypeOf xmlProxy (undefined :: New)))
-
-type Res = Foo (Maybe (Bar Bap))
-
-mkFTest :: (Eq a, Xml a) => [Element] -> a -> Maybe a
-mkFTest es v = case fromXml Flexible es of
-                   Identity v' | v == v'   -> Nothing
-                               | otherwise -> Just v'
-
-xml001 :: Test
-xml001 = "xml001" ~: [ flexibleTests, flexibleManualTests, migrationTests ]
diff --git a/tests/HAppS/Data/Tests/Xml002.hs b/tests/HAppS/Data/Tests/Xml002.hs
deleted file mode 100644
--- a/tests/HAppS/Data/Tests/Xml002.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, UndecidableInstances, OverlappingInstances #-}
-module HAppS.Data.Tests.Xml002 (xml002, rigidTests, rigidManualTests) where
-
-import Control.Monad.Identity
-import Data.Generics.SYB.WithClass.Basics
-import Data.Maybe
-import HAppS.Data
-import Test.HUnit(Test(..),(@?=),(~:))
-
-$( deriveAll [''Eq, ''Default, ''Show]
-    [d|
-        data Bap = Zip | Zap
-        data Fuzz a = Fo | Fig a
-      |]
- )
-$( deriveAll [''Eq, ''Show]
-    [d|
-        data Foo a = DefFoo | Foo a
-        data Bar a = DefBar | Bar a
-
-        data YesNo = Yes | No -- Use our own type as Bool has a
-                              -- Xml special instance
-      |]
- )
-
-newtype MyList a = MkMyList { unMyList :: [a] }
-    deriving (Show, Eq, Typeable)
-instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)
-      => Data ctx (MyList a) where
-    gfoldl _ f z x  = z MkMyList `f` unMyList x
-    toConstr _ (MkMyList _) = mkMyListConstr
-    gunfold _ k z c  = case constrIndex c of
-                           1 -> k (z MkMyList)
-    dataTypeOf _ _ = myListDataType
-mkMyListConstr :: Constr
-mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix
-myListDataType :: DataType
-myListDataType = mkDataType "MyList" [mkMyListConstr]
-instance Default a => Default (MyList a) where
-    defaultValue = MkMyList defaultValue
-
-instance Default YesNo where
-    defaultValue = No
-
-instance Default a => Default (Foo a) where
-    defaultValue = DefFoo
-
-instance Default a => Default (Bar a) where
-    defaultValue = DefBar
-
-rigidTests :: Test
-rigidTests =
-    "rigidTests" ~: 
-    [mkRTest [] (Just [])                                     @?= (Nothing :: Maybe (Maybe [YesNo]))
-    ,mkRTest [Elem "yes" []] (Just [Yes])                     @?= (Nothing :: Maybe (Maybe [YesNo]))
-    ,mkRTest [Elem "no"  []] (Just [No])                      @?= (Nothing :: Maybe (Maybe [YesNo]))
-    ,mkRTest [Elem "yes" [], Elem "yes" []] (Just [Yes, Yes]) @?= (Nothing :: Maybe (Maybe [YesNo]))
-    ,mkRTest [Elem "yes" [], Elem "no"  []] (Just [Yes, No])  @?= (Nothing :: Maybe (Maybe [YesNo]))
-    ,mkRTest [Elem "no"  [], Elem "yes" []] (Just [No,  Yes]) @?= (Nothing :: Maybe (Maybe [YesNo]))
-    ,mkRTest [Elem "no"  [], Elem "no"  []] (Just [No,  No])  @?= (Nothing :: Maybe (Maybe [YesNo]))
-    ]
-
-rigidManualTests :: Test
-rigidManualTests =
-    "rigidManualTests" ~:
-    [mkRTest [] (Just (MkMyList [])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
-    ,mkRTest [Elem "yes" []] (Just (MkMyList [Yes])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
-    ,mkRTest [Elem "no"  []] (Just (MkMyList [No]))  @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
-    ,mkRTest [Elem "yes" [], Elem "yes" []] (Just (MkMyList [Yes, Yes])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
-    ,mkRTest [Elem "yes" [], Elem "no"  []] (Just (MkMyList [Yes, No]))  @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
-    ,mkRTest [Elem "no"  [], Elem "yes" []] (Just (MkMyList [No,  Yes])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
-    ,mkRTest [Elem "no"  [], Elem "no"  []] (Just (MkMyList [No,  No]))  @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
-    ]
-
-mkRTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)
-mkRTest es v = case fromXml Rigid es of
-                   v' | v == v'   -> Nothing
-                      | otherwise -> Just v'
-
-xml002 :: Test
-xml002 = "xml002" ~: [ rigidTests, rigidManualTests ]
diff --git a/tests/HAppS/Data/Tests/Xml003.hs b/tests/HAppS/Data/Tests/Xml003.hs
deleted file mode 100644
--- a/tests/HAppS/Data/Tests/Xml003.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, UndecidableInstances, OverlappingInstances #-}
-module HAppS.Data.Tests.Xml003 (xml003, testPairs) where
-
-import Control.Monad.Identity
-import Data.Generics.SYB.WithClass.Basics
-import Data.Maybe
-import HAppS.Data
-import Test.HUnit(Test(..),(@=?),(~:), assertFailure)
-
-$( deriveAll [''Eq, ''Show]
-    [d|
-        data Foo a = DefFoo | Foo a
-        data Bar a = DefBar | Bar a
-      |]
- )
-
-instance Default a => Default (Foo a) where
-    defaultValue = DefFoo
-
-instance Default a => Default (Bar a) where
-    defaultValue = DefBar
-
--- NOTE: I am not possible the test condition is correct, I am just guessing based on what was there
-testPairs :: Test
-testPairs = let xs = [Foo $ Bar "abc",Foo $ Bar "def"]
-                xs' = runIdentity $ fromXml Flexible $ pairsToXml $ xmlToPairs $ concatMap toXml xs
-            in "testPairs" ~: xs @=? xs'
-
-xml003 :: Test
-xml003 = "xml003" ~: [ testPairs ]
diff --git a/tests/Happstack/Data/Tests.hs b/tests/Happstack/Data/Tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/Happstack/Data/Tests.hs
@@ -0,0 +1,14 @@
+-- |HUnit tests and QuickQuick properties for Happstack.Data.*
+module Happstack.Data.Tests (allTests) where
+
+import Happstack.Data.Tests.Xml001   (xml001)
+import Happstack.Data.Tests.Xml002   (xml002)
+import Happstack.Data.Tests.Xml003   (xml003)
+
+import Test.HUnit as HU (Test(..),(~:))
+
+-- |All of the tests for happstack-data should be listed here. 
+allTests :: Test
+allTests = 
+    "happstack-data tests" ~: [xml001, xml002, xml003]
+
diff --git a/tests/Happstack/Data/Tests/Xml001.hs b/tests/Happstack/Data/Tests/Xml001.hs
new file mode 100644
--- /dev/null
+++ b/tests/Happstack/Data/Tests/Xml001.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances, DeriveDataTypeable #-}
+module Happstack.Data.Tests.Xml001 (xml001, flexibleTests, flexibleManualTests, migrationTests) where
+
+import Control.Monad.Identity
+import Data.Generics.SYB.WithClass.Basics
+import Data.Maybe
+import Happstack.Data
+import Test.HUnit (Test(..),(@?=),(~:))
+
+$( deriveAll [''Eq, ''Default, ''Show]
+    [d|
+        data Bap = Zip | Zap
+        data Fuzz a = Fo | Fig a
+      |]
+ )
+$( deriveAll [''Eq, ''Show]
+    [d|
+        data Foo a = DefFoo | Foo a
+        data Bar a = DefBar | Bar a
+
+        data New = New Int
+        data Old = Old YesNo
+        data YesNo = Yes | No -- Use our own type as Bool has a
+                              -- Xml special instance
+      |]
+ )
+
+newtype MyList a = MkMyList { unMyList :: [a] }
+    deriving (Show, Eq, Typeable)
+instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)
+      => Data ctx (MyList a) where
+    gfoldl _ f z x  = z MkMyList `f` unMyList x
+    toConstr _ (MkMyList _) = mkMyListConstr
+    gunfold _ k z c  = case constrIndex c of
+                           1 -> k (z MkMyList)
+                           _ -> error "gunfold MyList: Can't happen"
+    dataTypeOf _ _ = myListDataType
+mkMyListConstr :: Constr
+mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix
+myListDataType :: DataType
+myListDataType = mkDataType "MyList" [mkMyListConstr]
+instance Default a => Default (MyList a) where
+    defaultValue = MkMyList defaultValue
+
+instance Default New where
+    defaultValue = New 7
+
+instance Default Old where
+    defaultValue = Old Yes
+
+instance Xml New where
+    version _ = Just "newver"
+    otherVersion _ = Other (error "Other" :: Old)
+
+instance Xml Old where
+    typ _ = "New"
+
+instance Migrate Old New where
+    migrate (Old No)  = New 8
+    migrate (Old Yes) = New 9
+
+instance Default YesNo where
+    defaultValue = No
+
+instance Default a => Default (Foo a) where
+    defaultValue = DefFoo
+
+instance Default a => Default (Bar a) where
+    defaultValue = DefBar
+
+flexibleTests :: Test
+flexibleTests =
+    "flexibleTests" ~:
+ [mkFTest [Elem "foo" [Elem "bar" [Elem "zap" []]]] (Foo $ Just $ Bar Zap)  @?= (Nothing :: Maybe Res)
+ ,mkFTest [            Elem "bar" [Elem "zap" []] ] DefFoo                  @?= (Nothing :: Maybe Res)
+ ,mkFTest [Elem "foo" [            Elem "zap" [] ]] (Foo Nothing)           @?= (Nothing :: Maybe Res)
+ ,mkFTest [Elem "foo" [Elem "bar" [             ]]] (Foo $ Just $ Bar Zip)  @?= (Nothing :: Maybe Res)
+ ,mkFTest [Elem "foo" [                          ]] (Foo Nothing)           @?= (Nothing :: Maybe Res)
+ ,mkFTest [            Elem "bar" []              ] DefFoo                  @?= (Nothing :: Maybe Res)
+ ,mkFTest [                        Elem "zap" []  ] DefFoo                  @?= (Nothing :: Maybe Res)
+ ]
+
+flexibleManualTests :: Test
+flexibleManualTests =
+    "flexibleManualTest" ~:
+ [mkFTest [] (MkMyList [])                 @?= (Nothing :: Maybe (MyList YesNo))
+ ,mkFTest [Elem "yes" []] (MkMyList [Yes]) @?= (Nothing :: Maybe (MyList YesNo))
+ ,mkFTest [Elem "no"  []] (MkMyList [No])  @?= (Nothing :: Maybe (MyList YesNo))
+ ,mkFTest [Elem "yes" [], Elem "yes" []] (MkMyList [Yes, Yes]) @?= (Nothing :: Maybe (MyList YesNo))
+ ,mkFTest [Elem "yes" [], Elem "no"  []] (MkMyList [Yes, No])  @?= (Nothing :: Maybe (MyList YesNo))
+ ,mkFTest [Elem "no"  [], Elem "yes" []] (MkMyList [No,  Yes]) @?= (Nothing :: Maybe (MyList YesNo))
+ ,mkFTest [Elem "no"  [], Elem "no"  []] (MkMyList [No,  No])  @?= (Nothing :: Maybe (MyList YesNo))
+ ]
+
+migrationTests :: Test
+migrationTests =
+ "migrationTests" ~:
+ [mkFTest [Elem "new" [testtype, newver, CData "5"       ]] (New 5) @?= Nothing
+ ,mkFTest [Elem "old" [testtype, oldver, Elem  "yes"   []]] (New 9) @?= Nothing
+ ,mkFTest [Elem "old" [testtype, oldver, Elem  "no"    []]] (New 8) @?= Nothing
+ ,mkFTest [Elem "new" [                  CData "5"       ]] (New 5) @?= Nothing
+ ,mkFTest [Elem "new" [                  Elem  "yes"   []]] (New 0) @?= Nothing
+ ,mkFTest [Elem "new" [                                  ]] (New 0) @?= Nothing
+ ,mkFTest [Elem "old" [testtype                          ]] (New 7) @?= Nothing
+ ,mkFTest [Elem "old" [testtype, oldver                  ]] (New 8) @?= Nothing
+ ,mkFTest [Elem "old" [                                  ]] (New 7) @?= Nothing
+ ]
+
+newver :: Element
+newver = Attr versionAttr "newver"
+
+oldver :: Element
+oldver = Attr versionAttr "oldver"
+
+testtype :: Element
+testtype = Attr typeAttr (dataTypeName (dataTypeOf xmlProxy (undefined :: New)))
+
+type Res = Foo (Maybe (Bar Bap))
+
+mkFTest :: (Eq a, Xml a) => [Element] -> a -> Maybe a
+mkFTest es v = case fromXml Flexible es of
+                   Identity v' | v == v'   -> Nothing
+                               | otherwise -> Just v'
+
+xml001 :: Test
+xml001 = "xml001" ~: [ flexibleTests, flexibleManualTests, migrationTests ]
diff --git a/tests/Happstack/Data/Tests/Xml002.hs b/tests/Happstack/Data/Tests/Xml002.hs
new file mode 100644
--- /dev/null
+++ b/tests/Happstack/Data/Tests/Xml002.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, UndecidableInstances, OverlappingInstances #-}
+module Happstack.Data.Tests.Xml002 (xml002, rigidTests, rigidManualTests) where
+
+import Control.Monad.Identity
+import Data.Generics.SYB.WithClass.Basics
+import Data.Maybe
+import Happstack.Data
+import Test.HUnit(Test(..),(@?=),(~:))
+
+$( deriveAll [''Eq, ''Default, ''Show]
+    [d|
+        data Bap = Zip | Zap
+        data Fuzz a = Fo | Fig a
+      |]
+ )
+$( deriveAll [''Eq, ''Show]
+    [d|
+        data Foo a = DefFoo | Foo a
+        data Bar a = DefBar | Bar a
+
+        data YesNo = Yes | No -- Use our own type as Bool has a
+                              -- Xml special instance
+      |]
+ )
+
+newtype MyList a = MkMyList { unMyList :: [a] }
+    deriving (Show, Eq, Typeable)
+instance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)
+      => Data ctx (MyList a) where
+    gfoldl _ f z x  = z MkMyList `f` unMyList x
+    toConstr _ (MkMyList _) = mkMyListConstr
+    gunfold _ k z c  = case constrIndex c of
+                           1 -> k (z MkMyList)
+    dataTypeOf _ _ = myListDataType
+mkMyListConstr :: Constr
+mkMyListConstr = mkConstr myListDataType "MkMyList" [] Prefix
+myListDataType :: DataType
+myListDataType = mkDataType "MyList" [mkMyListConstr]
+instance Default a => Default (MyList a) where
+    defaultValue = MkMyList defaultValue
+
+instance Default YesNo where
+    defaultValue = No
+
+instance Default a => Default (Foo a) where
+    defaultValue = DefFoo
+
+instance Default a => Default (Bar a) where
+    defaultValue = DefBar
+
+rigidTests :: Test
+rigidTests =
+    "rigidTests" ~: 
+    [mkRTest [] (Just [])                                     @?= (Nothing :: Maybe (Maybe [YesNo]))
+    ,mkRTest [Elem "yes" []] (Just [Yes])                     @?= (Nothing :: Maybe (Maybe [YesNo]))
+    ,mkRTest [Elem "no"  []] (Just [No])                      @?= (Nothing :: Maybe (Maybe [YesNo]))
+    ,mkRTest [Elem "yes" [], Elem "yes" []] (Just [Yes, Yes]) @?= (Nothing :: Maybe (Maybe [YesNo]))
+    ,mkRTest [Elem "yes" [], Elem "no"  []] (Just [Yes, No])  @?= (Nothing :: Maybe (Maybe [YesNo]))
+    ,mkRTest [Elem "no"  [], Elem "yes" []] (Just [No,  Yes]) @?= (Nothing :: Maybe (Maybe [YesNo]))
+    ,mkRTest [Elem "no"  [], Elem "no"  []] (Just [No,  No])  @?= (Nothing :: Maybe (Maybe [YesNo]))
+    ]
+
+rigidManualTests :: Test
+rigidManualTests =
+    "rigidManualTests" ~:
+    [mkRTest [] (Just (MkMyList [])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
+    ,mkRTest [Elem "yes" []] (Just (MkMyList [Yes])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
+    ,mkRTest [Elem "no"  []] (Just (MkMyList [No]))  @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
+    ,mkRTest [Elem "yes" [], Elem "yes" []] (Just (MkMyList [Yes, Yes])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
+    ,mkRTest [Elem "yes" [], Elem "no"  []] (Just (MkMyList [Yes, No]))  @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
+    ,mkRTest [Elem "no"  [], Elem "yes" []] (Just (MkMyList [No,  Yes])) @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
+    ,mkRTest [Elem "no"  [], Elem "no"  []] (Just (MkMyList [No,  No]))  @?= (Nothing :: Maybe (Maybe (MyList YesNo)))
+    ]
+
+mkRTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)
+mkRTest es v = case fromXml Rigid es of
+                   v' | v == v'   -> Nothing
+                      | otherwise -> Just v'
+
+xml002 :: Test
+xml002 = "xml002" ~: [ rigidTests, rigidManualTests ]
diff --git a/tests/Happstack/Data/Tests/Xml003.hs b/tests/Happstack/Data/Tests/Xml003.hs
new file mode 100644
--- /dev/null
+++ b/tests/Happstack/Data/Tests/Xml003.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, UndecidableInstances, OverlappingInstances #-}
+module Happstack.Data.Tests.Xml003 (xml003, testPairs) where
+
+import Control.Monad.Identity
+import Data.Generics.SYB.WithClass.Basics
+import Data.Maybe
+import Happstack.Data
+import Test.HUnit(Test(..),(@=?),(~:), assertFailure)
+
+$( deriveAll [''Eq, ''Show]
+    [d|
+        data Foo a = DefFoo | Foo a
+        data Bar a = DefBar | Bar a
+      |]
+ )
+
+instance Default a => Default (Foo a) where
+    defaultValue = DefFoo
+
+instance Default a => Default (Bar a) where
+    defaultValue = DefBar
+
+-- NOTE: I am not possible the test condition is correct, I am just guessing based on what was there
+testPairs :: Test
+testPairs = let xs = [Foo $ Bar "abc",Foo $ Bar "def"]
+                xs' = runIdentity $ fromXml Flexible $ pairsToXml $ xmlToPairs $ concatMap toXml xs
+            in "testPairs" ~: xs @=? xs'
+
+xml003 :: Test
+xml003 = "xml003" ~: [ testPairs ]
diff --git a/tests/Test.hs b/tests/Test.hs
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -1,6 +1,6 @@
 module Main where
 
-import HAppS.Data.Tests (allTests)
+import Happstack.Data.Tests (allTests)
 import Test.HUnit (errors, failures, putTextToShowS,runTestText, runTestTT)
 import System.Exit (exitFailure)
 import System.IO (hIsTerminalDevice, stdout)