diff --git a/Network/XmlRpc/THDeriveXmlRpcType.hs b/Network/XmlRpc/THDeriveXmlRpcType.hs
new file mode 100644
--- /dev/null
+++ b/Network/XmlRpc/THDeriveXmlRpcType.hs
@@ -0,0 +1,100 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Network.XmlRpc.THDeriveXmlRpcType
+-- Copyright   :  (c) Bjorn Bringert 2003-2005
+-- License     :  BSD-style
+-- 
+-- Maintainer  :  bjorn@bringert.net
+-- Stability   :  experimental
+-- Portability :  non-portable (requires extensions and non-portable libraries)
+--
+-- Uses Template Haskell to automagically derive instances of 'XmlRpcType'
+--
+------------------------------------------------------------------------------
+
+{-# LANGUAGE TemplateHaskell #-}
+module Network.XmlRpc.THDeriveXmlRpcType (asXmlRpcStruct) where
+
+import Control.Monad (replicateM, liftM)
+import Data.List (genericLength)
+import Data.Maybe (maybeToList)
+import Language.Haskell.TH
+import Network.XmlRpc.Internals hiding (Type)
+
+-- | Creates an 'XmlRpcType' instance which handles a Haskell record
+--   as an XmlRpc struct. Example:
+-- @
+-- data Person = Person { name :: String, age :: Int }
+-- $(asXmlRpcStruct \'\'Person)
+-- @
+asXmlRpcStruct :: Name -> Q [Dec]
+asXmlRpcStruct name = 
+    do
+    info <- reify name
+    dec <- case info of
+		     TyConI d -> return d
+		     _ -> fail $ show name ++ " is not a type constructor"
+    mkInstance dec
+
+mkInstance :: Dec -> Q [Dec]
+mkInstance  (DataD _ n _ [RecC c fs] _) = 
+    do
+    let ns = (map (\ (f,_,t) -> (unqual f, isMaybe t)) fs)
+    tv <- mkToValue ns 
+    fv <- mkFromValue c ns
+    gt <- mkGetType
+    liftM (:[]) $ instanceD (cxt []) (appT (conT ''XmlRpcType)
+				    (conT n)) 
+	      (map return $ concat [tv, fv, gt])
+
+mkInstance _ = error "Can only derive XML-RPC type for simple record types"
+
+
+isMaybe :: Type -> Bool
+isMaybe (AppT (ConT n) _) | n == ''Maybe = True
+isMaybe _ = False
+
+
+unqual :: Name -> Name
+unqual = mkName . reverse . takeWhile (`notElem` [':','.']) . reverse . show
+
+mkToValue :: [(Name,Bool)] -> Q [Dec]
+mkToValue fs = 
+    do
+    p <- newName "p"
+    simpleFun 'toValue [varP p] 
+		(appE (varE 'toValue)
+			  (appE [| concat |] $ listE $ map (fieldToTuple p) fs))
+
+
+simpleFun :: Name -> [PatQ] -> ExpQ -> Q [Dec]
+simpleFun n ps b = sequence [funD n [clause ps (normalB b) []]]
+
+fieldToTuple :: Name -> (Name,Bool) -> ExpQ
+fieldToTuple p (n,False) = listE [tupE [stringE (show n), 
+					 appE (varE 'toValue)
+					 (appE (varE n) (varE p))
+					]
+				 ]
+fieldToTuple p (n,True) = 
+    [| map (\v -> ($(stringE (show n)), toValue v)) $ maybeToList $(appE (varE n) (varE p)) |]
+
+mkFromValue :: Name -> [(Name,Bool)] -> Q [Dec]
+mkFromValue c fs = 
+    do
+    names <- replicateM (length fs) (newName "x")
+    v <- newName "v"
+    t <- newName "t"
+    simpleFun 'fromValue [varP v] $ 
+	       doE $ [bindS (varP t) (appE (varE 'fromValue) (varE v))] ++
+		      zipWith (mkGetField t) (map varP names) fs ++ 
+		      [noBindS $ appE [| return |] $ appsE (conE c:map varE names)]
+
+mkGetField t p (f,False) = bindS p (appsE [varE 'getField, 
+					   stringE (show f), varE t])
+mkGetField t p (f,True) = bindS p (appsE [varE 'getFieldMaybe, 
+					  stringE (show f), varE t])
+
+mkGetType :: Q [Dec]
+mkGetType = simpleFun 'getType [wildP] 
+	     (conE 'TStruct)
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,8 @@
+#!/usr/bin/env runghc
+
+> module Main where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
diff --git a/haxr-th.cabal b/haxr-th.cabal
new file mode 100644
--- /dev/null
+++ b/haxr-th.cabal
@@ -0,0 +1,20 @@
+Name: haxr-th
+Version: 3000.0.0
+Copyright: Bjorn Bringert, 2003-2006
+Build-depends: base, haxr >= 3000.0.0, template-haskell
+License: BSD4
+License-file: ../LICENSE
+Author: Bjorn Bringert <bjorn@bringert.net>
+Maintainer: Bjorn Bringert <bjorn@bringert.net>
+Homepage: http://www.haskell.org/haxr/
+Synopsis: Automatic deriving of XML-RPC structs for Haskell records.
+Description:
+        HaXR is a library for writing XML-RPC 
+        client and server applications in Haskell.
+        This package adds automatic deriving of
+        XML-RPC structs for Haskell records,
+        using Template Haskell.
+Exposed-Modules:
+        Network.XmlRpc.THDeriveXmlRpcType
+Extensions: OverlappingInstances, TypeSynonymInstances, TemplateHaskell
+GHC-options: -O2