diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,8 @@
+
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
+
diff --git a/Xml/Base.hs b/Xml/Base.hs
new file mode 100644
--- /dev/null
+++ b/Xml/Base.hs
@@ -0,0 +1,211 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances,
+             OverlappingInstances, UndecidableInstances #-}
+
+module Xml.Base where
+
+import Control.Monad.State
+import Data.Char
+import Data.List
+import Xml.DeriveAll
+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 Language.Haskell.TH
+
+$(deriveAll [d|
+    data Element = Elem String [Element]
+                 | CData String
+                 | Attr String String
+ |])
+
+-- 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 . show) es)))
+                    ++ "]"
+        where indent = map ("    " ++)
+              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
+
+-- XXX defaulting should happen here?
+fromXml :: Xml a => [Element] -> Maybe a
+fromXml xs = fmap snd $ readXml xs
+
+class Data XmlD a => Xml a where
+    toXml :: a -> [Element]
+    toXml = defaultToXml
+    readXml :: [Element] -> Maybe ([Element], a)
+    readXml = defaultFromXml
+
+instance Data XmlD t => Xml t
+
+data XmlD a = XmlD { toXmlD :: a -> [Element], readMXmlD :: ReadM a }
+
+xmlProxy :: Proxy XmlD
+xmlProxy = error "xmlProxy"
+
+instance Xml t => Sat (XmlD t) where
+    dict = XmlD { toXmlD = toXml, readMXmlD = readMXml }
+
+first :: (a -> a) -> [a] -> [a]
+first _ [] = []
+first f (x:xs) = f x : xs
+
+defaultToXml :: Xml t => t -> [Element]
+defaultToXml x = [Elem (first toLower $ constring $ toConstr xmlProxy x)
+                       (transparentToXml x)]
+
+transparentToXml :: Xml t => t -> [Element]
+transparentToXml x = concat $ gmapQ xmlProxy (toXmlD dict) x
+
+transparentReadXml :: Xml t => [Element] -> Maybe ([Element], t)
+transparentReadXml es = res
+    where resType = dataTypeOf xmlProxy (snd $ fromJust res)
+          res = aConstrFromElements (dataTypeConstrs resType) es
+
+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
+                     typ = mkXml $ foldl appT (conT n) args
+                 decs <- [d| toXml = transparentToXml
+                             readXml = transparentReadXml |]
+                 d <- instanceD ctxt typ (map return decs)
+                 return [d]
+
+defaultFromXml :: Xml t => [Element] -> Maybe ([Element], t)
+defaultFromXml = fromXmlWith fromElement
+
+fromXmlWith :: Xml t
+            => (Element -> Maybe t) -> [Element] -> Maybe ([Element], t)
+fromXmlWith f = fromXmlWith' f []
+
+fromXmlWith' :: Xml t
+             => (Element -> Maybe t) -> [Element] -> [Element]
+             -> Maybe ([Element], t)
+fromXmlWith' f acc (x:xs)
+ = case f x of
+       Nothing -> fromXmlWith' f (x:acc) xs
+       Just v ->
+           Just (reverse acc ++ xs, v)
+fromXmlWith' _ _ [] = Nothing
+
+fromElement :: Xml t => Element -> Maybe t
+fromElement (Elem n es) = res
+    where resType = dataTypeOf xmlProxy (fromJust res)
+          res = case readConstr resType $ first toUpper n of
+                Just c ->
+                    case constrFromElements c es of
+                    -- We ignore left over elements
+                    Just (_, x) -> Just x
+                    Nothing -> Nothing
+                Nothing -> Nothing
+fromElement _ = Nothing
+
+aConstrFromElements :: Xml t => [Constr] -> [Element] -> Maybe ([Element], t)
+aConstrFromElements cs es = msum [ constrFromElements c es | c <- cs ]
+
+constrFromElements :: Xml t => Constr -> [Element] -> Maybe ([Element], t)
+constrFromElements c es = case runStateT m st of
+                          -- XXX Should we flip the result order?
+                          Just (x, st) -> Just (xmls st, x)
+                          Nothing -> Nothing
+    where m = fromConstrM xmlProxy (readMXmlD dict) c
+          st = ReadState { xmls = es }
+
+type ReadM = StateT ReadState Maybe
+
+data ReadState = ReadState {
+                     xmls :: [Element]
+                 }
+
+getXmls :: ReadM [Element]
+getXmls = do st <- get
+             return $ xmls st
+
+putXmls :: [Element] -> ReadM ()
+putXmls xs = do st <- get
+                put $ st { xmls = xs }
+
+readMXml :: Xml a => ReadM a
+readMXml = do xs <- getXmls
+              case readXml xs of
+                  Nothing ->
+                      fail "Can't 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
+                   -- toXml (c x) = [Attr "c" $ BS.unpack x]
+                   toFun = funD
+                             'toXml
+                             [clause
+                                 [conP c [varP x]]
+                                 (normalB [| [Attr $(litE cstr)
+                                                   $ BS.unpack $(varE x)] |])
+                                 []]
+                   -- readXml = fromXmlWith f
+                   --     where <readHelper>
+                   readFun = funD
+                             'readXml
+                             [clause
+                                 []
+                                 (normalB [| fromXmlWith $(varE f) |])
+                                 [readHelper]]
+                   -- f (Attr "c" x) = Just $ c $ BS.pack x
+                   -- f _ = Nothing
+                   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 ds <- [d|
+                toXml x = [CData $ show x]
+                readXml = fromXmlWith f
+                    where f (CData x)
+                           | [(v, "")] <- reads x = Just v
+                          f _ = Nothing
+              |]
+      d <- instanceD (cxt [])
+                     (conT ''Xml `appT` conT newTypeName)
+                     (map return ds)
+      return [d]
+
diff --git a/Xml/DeriveAll.hs b/Xml/DeriveAll.hs
new file mode 100644
--- /dev/null
+++ b/Xml/DeriveAll.hs
@@ -0,0 +1,27 @@
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Xml.DeriveAll (deriveAll) where
+
+import Data.Generics as Old
+import Data.Generics.SYB.WithClass.Derive
+import Language.Haskell.TH
+
+deriveAll :: Q [Dec] -> Q [Dec]
+deriveAll qdecs = do decs <- qdecs
+                     derivedDecs <- deriveDec (filter isDataOrNewtype decs)
+                     let decs' = map deriveOldData decs
+                     return (decs' ++ derivedDecs)
+
+deriveOldData :: Dec -> Dec
+deriveOldData (DataD ctxt nm tvs cons derivs)
+    = DataD ctxt nm tvs cons (''Old.Data : derivs)
+deriveOldData (NewtypeD ctxt nm tvs con derivs)
+    = NewtypeD ctxt nm tvs con (''Old.Data : derivs)
+deriveOldData d = d
+
+isDataOrNewtype :: Dec -> Bool
+isDataOrNewtype (DataD {}) = True
+isDataOrNewtype (NewtypeD {}) = True
+isDataOrNewtype _ = False
+
diff --git a/Xml/HaXml.hs b/Xml/HaXml.hs
new file mode 100644
--- /dev/null
+++ b/Xml/HaXml.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances,
+             OverlappingInstances, UndecidableInstances #-}
+
+module Xml.HaXml where
+
+import Data.List
+import 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
+
+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 _ = error "fromHaXml: Not implemented"
+
+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/Xml/Instances.hs b/Xml/Instances.hs
new file mode 100644
--- /dev/null
+++ b/Xml/Instances.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances,
+             OverlappingInstances, UndecidableInstances #-}
+
+module Xml.Instances where
+
+import Data.Char
+import Data.List
+import Xml.Base
+import Data.Generics.SYB.WithClass.Basics
+import Data.Generics.SYB.WithClass.Derive
+import Data.Generics.SYB.WithClass.Instances ()
+import Data.Maybe
+import           Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+
+-- 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 = f [] []
+        where f acc_xs acc_vs [] = Just (reverse acc_xs, reverse acc_vs)
+              f acc_xs acc_vs (x:xs) = case readXml [x] of
+                                           Just ([], v) ->
+                                               f acc_xs (v:acc_vs) xs
+                                           _ ->
+                                               f (x:acc_xs) acc_vs xs
+
+instance Xml String where
+    toXml x = [CData x]
+    readXml = fromXmlWith f
+        where f (CData x) = Just x
+              f _ = Nothing
+
+-- XXX This instance should be somewhere else as otherwise we get
+-- problems when two different traversals define it
+$( deriveData [''ByteString] )
+
+instance Xml ByteString where
+    toXml x = [CData $ BS.unpack x]
+    readXml = fromXmlWith f
+        where f (CData x) = Just $ BS.pack x
+              f _ = Nothing
+
+$( xmlShowCDatas [''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 = aConstrFromElements $ map (toConstr xmlProxy) [Just (), Nothing]
+
+$( transparentXml ''Either )
+$( transparentXml ''(,) )
+$( transparentXml ''(,,) )
+$( transparentXml ''(,,,) )
+
diff --git a/Xml/PrintParse.hs b/Xml/PrintParse.hs
new file mode 100644
--- /dev/null
+++ b/Xml/PrintParse.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances,
+             OverlappingInstances, UndecidableInstances #-}
+
+module Xml.PrintParse where
+
+import Text.PrettyPrint.HughesPJ
+import Text.XML.HaXml.Parse
+import Text.XML.HaXml.Pretty
+import Text.XML.HaXml.Types (Document(Document), Content(CElem))
+import Xml.Base
+import Xml.HaXml
+import Data.Maybe
+
+toString :: Element -> String
+toString = render . content . toHaXml
+
+toStrings :: [Element] -> String
+toStrings = render . vcat . map (content . toHaXml)
+
+--fromString :: String -> Element
+
+class FromString a where
+    fromString::String->Maybe a
+
+instance FromString Element where
+    fromString s = case xmlParse "NoFile" s of
+                     Document _ _ e _ ->
+                         return $ fromHaXml $ CElem e
+                     _ -> Nothing
+
+instance (Xml a) => FromString a where
+    fromString x =  do
+                    el <- fromString x
+                    fromXml [el]
+
diff --git a/Xml/Xml.hs b/Xml/Xml.hs
new file mode 100644
--- /dev/null
+++ b/Xml/Xml.hs
@@ -0,0 +1,7 @@
+
+module Xml.Xml (module Xml.Base, module Xml.PrintParse) where
+
+import Xml.Base
+import Xml.PrintParse
+import Xml.Instances ()
+
diff --git a/generic-xml.cabal b/generic-xml.cabal
new file mode 100644
--- /dev/null
+++ b/generic-xml.cabal
@@ -0,0 +1,25 @@
+Name:               generic-xml
+Version:            0.1
+License:            BSD3
+Copyright:          2007 HAppS LLC
+Author:             HAppS LLC
+Maintainer:         AlexJacobson@HAppS.org
+Stability:          experimental
+Synopsis:           Marshalling Haskell values to/from XML
+Description:
+    Marshalling Haskell values to/from XML.
+Category:           Xml
+Tested-With:        GHC==6.6.1
+Build-Depends:      base, mtl, template-haskell, syb-with-class, HaXml
+Exposed-modules:
+    Xml.DeriveAll
+    Xml.Xml
+    Xml.HaXml
+Other-modules:
+    Xml.Base
+    Xml.Instances
+    Xml.PrintParse
+Extensions: UndecidableInstances, OverlappingInstances, Rank2Types,
+            TemplateHaskell, FlexibleInstances
+GHC-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures
+
