diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Web/Routes/TH.hs b/Web/Routes/TH.hs
new file mode 100644
--- /dev/null
+++ b/Web/Routes/TH.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE CPP, TemplateHaskell #-}
+{- OPTIONS_GHC -optP-include -optPdist/build/autogen/cabal_macros.h -}
+module Web.Routes.TH where
+
+import Control.Monad (ap, replicateM)
+import Data.List (intercalate)
+import Language.Haskell.TH
+import Text.ParserCombinators.Parsec ((<|>),many1)
+import Web.Routes.PathInfo
+
+-- FIXME: handle when called with a type (not data, newtype)
+derivePathInfo :: Name -> Q [Dec]
+derivePathInfo name
+    = do c <- parseInfo name
+         case c of
+           Tagged cons cx keys ->
+               do let context = [ mkCtx ''PathInfo [varT key] | key <- keys ] ++ map return cx
+                  i <- instanceD (sequence context) (mkType ''PathInfo [mkType name (map varT keys)])
+                       [ toPathSegmentsFn cons 
+                       , fromPathSegmentsFn cons
+                       ]
+                  return [i]
+    where
+#if MIN_VERSION_template_haskell(2,4,0)
+      mkCtx = classP
+#else
+      mkCtx = mkType
+#endif
+
+      toPathSegmentsFn :: [(Name, Int)] -> DecQ
+      toPathSegmentsFn cons 
+          = do inp <- newName "inp"
+               let body = caseE (varE inp) $
+                            [ do args <- replicateM nArgs (newName "arg")
+                                 let matchCon = conP conName (map varP args)
+                                     conStr = (nameBase conName)
+                                 match matchCon (normalB (toURLWork conStr args)) []
+                                  |  (conName, nArgs) <- cons ]
+                   toURLWork :: String -> [Name] -> ExpQ
+                   toURLWork conStr args
+                       = foldr1 (\a b -> appE (appE [| (++) |] a) b) ([| [conStr] |] : [ [| toPathSegments $(varE arg) |] | arg <- args ])
+               funD 'toPathSegments [clause [varP inp] (normalB body)  []]
+      fromPathSegmentsFn :: [(Name,Int)] -> DecQ
+      fromPathSegmentsFn cons
+          = do let body = (foldl1 (\a b -> appE (appE [| (<|>) |] a) b)
+                            [ parseCon conName nArgs 
+                            | (conName, nArgs) <- cons])
+                   parseCon :: Name -> Int -> ExpQ
+                   parseCon conName nArgs = foldl1 (\a b -> appE (appE [| ap |] a) b) 
+                                                   ([| segment $(stringE (nameBase conName)) >> return $(conE conName) |]
+                                                   : (replicate nArgs [| fromPathSegments |]))
+               funD 'fromPathSegments [clause [] (normalB body) []]
+
+mkType :: Name -> [TypeQ] -> TypeQ
+mkType con = foldl appT (conT con)
+
+data Class = Tagged [(Name, Int)] Cxt [Name]
+
+parseInfo :: Name -> Q Class
+parseInfo name
+    = do info <- reify name
+         case info of
+           TyConI (DataD cx _ keys cs _)    -> return $ Tagged (map conInfo cs) cx $ map conv keys
+           TyConI (NewtypeD cx _ keys con _)-> return $ Tagged [conInfo con] cx $ map conv 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
+#if MIN_VERSION_template_haskell(2,4,0)
+          conv (PlainTV nm) = nm
+          conv (KindedTV nm _) = nm
+#else
+          conv = id
+#endif
diff --git a/web-routes-th.cabal b/web-routes-th.cabal
new file mode 100644
--- /dev/null
+++ b/web-routes-th.cabal
@@ -0,0 +1,18 @@
+Name:             web-routes-th
+Version:          0.20
+License:          BSD3
+Author:           jeremy@seereason.com
+Maintainer:       partners@seereason.com
+Bug-Reports:      http://bugzilla.seereason.com/
+Category:         Web, Language
+Synopsis:         Support for deriving PathInfo using Template Haskell
+Cabal-Version:    >= 1.6
+Build-type:       Simple
+
+Library
+        Build-Depends:    base >= 4 && < 5, parsec >= 2 && <3, template-haskell, web-routes >= 0.19
+        Exposed-Modules:  Web.Routes.TH
+
+source-repository head
+    type:     darcs
+    location: http://src.seereason.com/web-routes/