diff --git a/Web/Routes/TH.hs b/Web/Routes/TH.hs
--- a/Web/Routes/TH.hs
+++ b/Web/Routes/TH.hs
@@ -1,23 +1,58 @@
 {-# LANGUAGE CPP, TemplateHaskell #-}
 {- OPTIONS_GHC -optP-include -optPdist/build/autogen/cabal_macros.h -}
-module Web.Routes.TH where
+module Web.Routes.TH
+     ( derivePathInfo
+     , derivePathInfo'
+     , standard
+     , mkRoute
+     ) where
 
-import Control.Monad (ap, replicateM)
-import Data.List (intercalate)
-import Data.Text (pack, unpack)
+import Control.Applicative           ((<$>))
+import Control.Monad                 (ap, replicateM)
+import Data.Char                     (isUpper, toLower, toUpper)
+import Data.List                     (intercalate, foldl')
+import Data.List.Split               (split, dropInitBlank, keepDelimsL, whenElt)
+import Data.Text                     (pack, unpack)
 import Language.Haskell.TH
+import Language.Haskell.TH.Syntax    (nameBase)
 import Text.ParserCombinators.Parsec ((<|>),many1)
 import Web.Routes.PathInfo
 
+#include "/home/stepcut/n-heptane/projects/haskell/web-routes/web-routes-th/dist/build/autogen/cabal_macros.h"
+
+-- | use Template Haskell to create 'PathInfo' instances for a type.
+--
+-- > $(derivePathInfo ''SiteURL)
+--
+-- Uses the 'standard' formatter by default.
+derivePathInfo :: Name
+               -> Q [Dec]
+derivePathInfo = derivePathInfo' standard
+
 -- FIXME: handle when called with a type (not data, newtype)
-derivePathInfo :: Name -> Q [Dec]
-derivePathInfo name
+
+-- | use Template Haskell to create 'PathInfo' instances for a type.
+--
+-- This variant allows the user to supply a function that transforms
+-- the constructor name to a prettier rendering. It is important that
+-- the transformation function generates a unique output for each
+-- input. For example, simply converting the string to all lower case
+-- is not acceptable, because then 'FooBar' and 'Foobar' would be
+-- indistinguishable.
+--
+-- > $(derivePathInfo' standard ''SiteURL)
+--
+-- see also: 'standard'
+derivePathInfo' :: (String -> String)
+                -> Name
+                -> Q [Dec]
+derivePathInfo' formatter 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 
+                       [ toPathSegmentsFn cons
                        , fromPathSegmentsFn cons
                        ]
                   return [i]
@@ -27,14 +62,13 @@
 #else
       mkCtx = mkType
 #endif
-
       toPathSegmentsFn :: [(Name, Int)] -> DecQ
-      toPathSegmentsFn cons 
+      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)
+                                     conStr = formatter (nameBase conName)
                                  match matchCon (normalB (toURLWork conStr args)) []
                                   |  (conName, nArgs) <- cons ]
                    toURLWork :: String -> [Name] -> ExpQ
@@ -44,11 +78,11 @@
       fromPathSegmentsFn :: [(Name,Int)] -> DecQ
       fromPathSegmentsFn cons
           = do let body = (foldl1 (\a b -> appE (appE [| (<|>) |] a) b)
-                            [ parseCon conName nArgs 
+                            [ parseCon conName nArgs
                             | (conName, nArgs) <- cons])
                    parseCon :: Name -> Int -> ExpQ
-                   parseCon conName nArgs = foldl1 (\a b -> appE (appE [| ap |] a) b) 
-                                                   ([| segment (pack $(stringE (nameBase conName))) >> return $(conE conName) |]
+                   parseCon conName nArgs = foldl1 (\a b -> appE (appE [| ap |] a) b)
+                                                   ([| segment (pack $(stringE (formatter $ nameBase conName))) >> return $(conE conName) |]
                                                    : (replicate nArgs [| fromPathSegments |]))
                funD 'fromPathSegments [clause [] (normalB body) []]
 
@@ -74,3 +108,69 @@
 #else
           conv = id
 #endif
+
+-- | the standard formatter
+--
+-- Converts @CamelCase@ to @camel-case@.
+--
+-- see also: 'derivePathInfo' and 'derivePathInfo''
+standard :: String -> String
+standard =
+    intercalate "-" . map (map toLower) . split splitter
+  where
+    splitter = dropInitBlank . keepDelimsL . whenElt $ isUpper
+
+mkRoute :: Name -> Q [Dec]
+mkRoute url =
+    do (Tagged cons _ _) <- parseInfo url
+       fn <- funD (mkName "route") $
+               map (\(con, numArgs) ->
+                        do -- methods <- parseMethods con
+                           -- runIO $ print methods
+                           args <- replicateM numArgs (newName "arg")
+                           clause [conP con $ map varP args] (normalB $ foldl' appE (varE (mkName (headLower (nameBase con)))) (map varE args)) []
+                   ) cons
+       return [fn]
+    where
+      headLower :: String -> String
+      headLower (c:cs) = toLower c : cs
+
+-- work in progress
+
+parseMethods :: Name -> Q [Name]
+parseMethods con =
+    do info <- reify con
+       case info of
+         (DataConI _ ty _ _) ->
+             do runIO $ print ty
+                runIO $ print $ lastTerm ty
+                return $ extractMethods (lastTerm ty)
+
+extractMethods :: Type -> [Name]
+extractMethods ty =
+    case ty of
+      (AppT (ConT con) (ConT method)) ->
+          [method]
+      (AppT (ConT con) methods) ->
+          extractMethods' methods
+        where
+          extractMethods' :: Type -> [Name]
+          extractMethods' t = map (\(ConT n) -> n) (leafs t)
+
+-- | return the 'Type' after the right-most @->@. Or the original 'Type' if there are no @->@.
+lastTerm :: Type -> Type
+lastTerm t@(AppT l r)
+    | hasArrowT l = lastTerm r
+    | otherwise   = t
+lastTerm t = t
+
+-- | tests if a 'Type' contains an 'ArrowT' somewhere
+hasArrowT :: Type -> Bool
+hasArrowT ArrowT     = True
+hasArrowT (AppT l r) = hasArrowT l || hasArrowT r
+hasArrowT _          = False
+
+leafs :: Type -> [Type]
+leafs (AppT l@(AppT _ _) r) = leafs l ++ leafs r
+leafs (AppT _ r) = leafs r
+leafs t          = [t]
diff --git a/web-routes-th.cabal b/web-routes-th.cabal
--- a/web-routes-th.cabal
+++ b/web-routes-th.cabal
@@ -1,5 +1,5 @@
 Name:             web-routes-th
-Version:          0.21.1
+Version:          0.22.0
 License:          BSD3
 License-File:     LICENSE
 Author:           jeremy@seereason.com
@@ -15,6 +15,7 @@
                           parsec >= 2 && < 4,
                           template-haskell,
                           text,
+                          split,
                           web-routes >= 0.26
         Exposed-Modules:  Web.Routes.TH