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/URLT.cabal b/URLT.cabal
new file mode 100644
--- /dev/null
+++ b/URLT.cabal
@@ -0,0 +1,19 @@
+Name:             URLT
+Version:          0.10
+License:          BSD3
+License-File:     debian/copyright
+Author:           jeremy@seereason.com
+Maintainer:       partners@seereason.com
+
+Synopsis:         Library for maintaining correctness of URLs within an application.
+Description:      A collection of types and functions that ensure that URLs generated by an application are valid. Need more properties here.
+
+Exposed-Modules:  URLT, URLT.Base, URLT.HandleT, URLT.Happstack, URLT.QuickCheck, URLT.TH, URLT.XMLGenT
+                  
+Build-Depends:    base >= 4 && < 5, mtl, Consumer, template-haskell, happstack-server, QuickCheck, hsx, hsp, applicative-extras
+
+Build-Type:       Simple
+Category:         Web, Language
+
+Extensions:             TemplateHaskell,
+                        FlexibleContexts
diff --git a/URLT.hs b/URLT.hs
new file mode 100644
--- /dev/null
+++ b/URLT.hs
@@ -0,0 +1,16 @@
+module URLT 
+    ( module URLT.Base
+    , module URLT.XMLGenT
+    , module URLT.Happstack
+    , module URLT.TH
+    , module URLT.QuickCheck
+    , module URLT.HandleT
+    )
+    where
+
+import URLT.XMLGenT
+import URLT.Base
+import URLT.Happstack
+import URLT.TH
+import URLT.QuickCheck
+import URLT.HandleT
diff --git a/URLT/Base.hs b/URLT/Base.hs
new file mode 100644
--- /dev/null
+++ b/URLT/Base.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, TypeFamilies #-}
+module URLT.Base where
+
+import Control.Applicative
+import Control.Monad (MonadPlus)
+import Control.Monad.Trans (MonadTrans, MonadIO)
+import Control.Monad.Fix (MonadFix)
+import Control.Monad.Reader (MonadReader(ask), ReaderT(ReaderT), mapReaderT, withReaderT)
+import HSX.XMLGenerator (XMLGenT(..))
+
+-- * URLT Monad Transformer
+
+type Link = String
+
+-- |monad transformer for generating URLs
+newtype URLT url m a = URLT { unURLT :: ReaderT  (url -> Link) m a }
+    deriving (Functor, Monad, MonadFix, MonadPlus, MonadIO, MonadTrans, MonadReader (url -> Link))
+
+-- NOTE: the Monad m requirement comes from the Functor ReaderT instance
+instance (Applicative m, Monad m) => Applicative (URLT url m) where
+    pure = return
+    (URLT (ReaderT f)) <*> (URLT (ReaderT a))
+        = URLT $ ReaderT $ \env -> (f env) <*> (a env)
+
+class ShowURL m where
+    type URL m
+    showURL :: (URL m) -> m Link -- ^ convert a URL value into a Link (aka, a String)
+
+instance (Monad m) => ShowURL (URLT url m) where
+    type URL (URLT url m) = url
+    showURL url =
+        do showF <- ask
+           return (showF url)
+
+-- |similar to withReaderT
+withURLT :: ((url' -> Link) -> (url -> Link)) -> URLT url m a -> URLT url' m a
+withURLT f (URLT r) = URLT $ withReaderT f r
+
+mapURLT :: (m a -> n b) -> URLT url m a -> URLT url n b
+mapURLT f (URLT r) = URLT $ mapReaderT f r
+
+-- |used to embed a URLT into a larger parent url
+nestURL :: (Monad m) => (url2 -> url1) -> URLT url2 m a -> URLT url1 m a
+nestURL b = withURLT (. b)
+
+crossURL :: (Monad m) => (url2 -> url1) -> URLT url1 m (url2 -> Link)
+crossURL f = 
+    do showF <- ask
+       return $ \url2 -> showF (f url2)
+
diff --git a/URLT/HandleT.hs b/URLT/HandleT.hs
new file mode 100644
--- /dev/null
+++ b/URLT/HandleT.hs
@@ -0,0 +1,27 @@
+module URLT.HandleT where
+
+import Control.Applicative.Error(Failing(Failure, Success))
+import Control.Monad.Reader (ReaderT(runReaderT))
+import URLT.Base (URLT(unURLT), Link)
+
+data Site link url m a
+    = Site { handleLink  :: link -> URLT link m a
+           , defaultPage :: link
+           , formatLink  :: link -> url
+           , parseLink   :: url -> Failing link 
+           }
+
+instance (Monad m) => Functor (Site u l m) where
+    fmap f site =
+        site { handleLink = \link -> fmap f ((handleLink site) link) }
+
+runSite :: (Monad m) => String -> Site link Link m a -> Link -> m (Failing a)
+runSite prefix site linkStr =
+    let fLink = 
+            case linkStr of
+                 "" -> Success (defaultPage site)
+                 _ -> (parseLink site) linkStr
+    in
+      case fLink of
+        (Failure errs) -> return (Failure errs)
+        (Success lnk) -> return . Success =<< runReaderT (unURLT ((handleLink site) lnk)) ((prefix ++) . (formatLink site))
diff --git a/URLT/Happstack.hs b/URLT/Happstack.hs
new file mode 100644
--- /dev/null
+++ b/URLT/Happstack.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, UndecidableInstances #-}
+module URLT.Happstack where
+
+import Control.Applicative.Error (Failing(Failure, Success))
+import Control.Monad (MonadPlus(mzero))
+import Control.Monad.Trans (lift)
+import Data.List (intersperse)
+import Happstack.Server (FilterMonad(..), ServerMonad(..), WebMonad(..), ServerPartT, Response, Request(rqPaths), ToMessage(..), dir, runServerPartT, withRequest)
+import URLT.Base (URLT(URLT), Link, mapURLT)
+import URLT.HandleT (Site, runSite)
+
+instance (ServerMonad m) => ServerMonad (URLT url m) where
+    askRq       = lift askRq
+    localRq f m = mapURLT (localRq f) m
+
+instance (FilterMonad a m)=> FilterMonad a (URLT url m) where
+    setFilter     = lift . setFilter
+    composeFilter = lift . composeFilter
+    getFilter     = mapURLT getFilter 
+
+instance (WebMonad a m) => WebMonad a (URLT url m) where
+    finishWith = lift . finishWith
+
+-- FIXME: the prefix can only be a single directory right now
+implSite :: (ToMessage a) => String -> String -> Site link Link (ServerPartT IO) a -> ServerPartT IO Response
+implSite domain prefix siteSpec =
+    dir (filter (/= '/') prefix) $ 
+        withRequest $ \rq ->
+          let link = (concat (intersperse "/" (rqPaths rq)))
+          in
+            do r <- runServerPartT (runSite (domain ++ prefix) siteSpec link) (rq { rqPaths = [] })
+               case r of 
+                 (Failure _) -> mzero
+                 (Success v) -> return (toResponse v)
+
diff --git a/URLT/QuickCheck.hs b/URLT/QuickCheck.hs
new file mode 100644
--- /dev/null
+++ b/URLT/QuickCheck.hs
@@ -0,0 +1,10 @@
+module URLT.QuickCheck where
+
+import Control.Applicative.Error (Failing(Success))
+import URLT.TH (AsURL(toURLS), fromURL)
+
+asURLInverse_prop :: (Eq url, AsURL url) => url -> Bool
+asURLInverse_prop url =
+    case (fromURL $ toURLS url "") of
+      Success url' -> url == url'
+      _ -> False
diff --git a/URLT/TH.hs b/URLT/TH.hs
new file mode 100644
--- /dev/null
+++ b/URLT/TH.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE TemplateHaskell #-}
+module URLT.TH where
+
+import Control.Applicative (Applicative((<*>)))
+import Control.Applicative.Error (Failing(Failure, Success))
+import Control.Monad (replicateM)
+import Data.List (intercalate)
+import Language.Haskell.TH
+import Control.Monad.Consumer (Consumer, next, runConsumer)
+
+class AsURL a where
+    toURLS :: a -> ShowS
+    fromURLC :: Consumer String (Failing a)
+
+toURL :: (AsURL a) => a -> String
+toURL u = '/' : toURLS u ""
+
+fromURL :: (AsURL a) => String -> Failing a
+fromURL str =
+    fst $ runConsumer (words $ map (\c -> if c == '/' then ' ' else c) str) fromURLC
+
+-- FIXME: handle unexpected end of input
+-- FIXME: handle invalid input
+-- FIXME: handle when called with a type (not data, newtype)
+deriveAsURL :: Name -> Q [Dec]
+deriveAsURL name
+    = do c <- parseInfo name
+         case c of
+           Tagged cons cx keys ->
+               do let context = [ mkType ''AsURL [varT key] | key <- keys ] ++ map return cx
+                  i <- instanceD (sequence context) (mkType ''AsURL [mkType name (map varT keys)])
+                       [ toURLFn cons 
+                       , fromURLCFn cons
+                       ]
+                  return [i]
+    where
+      toURLFn :: [(Name, Int)] -> DecQ
+      toURLFn 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) |] : [ [| toURLS $(varE arg) |] | arg <- args ])
+               funD 'toURLS [clause [varP inp] (normalB body)  []]
+      fromURLCFn :: [(Name,Int)] -> DecQ
+      fromURLCFn cons
+          = do let body = 
+                       do c <- newName "c"
+                          doE [ bindS (varP c) (varE 'next)
+                              , noBindS $ caseE (varE c)
+                                        ([ do args <- replicateM nArgs (newName "arg")
+                                              match (conP (mkName "Just") [litP $ stringL (nameBase conName) ])
+                                                       (normalB (fromURLWork conName args)) []
+                                          | (conName, nArgs) <- cons
+                                        ] ++ 
+                                        [ do str <- newName "str"
+                                             let conNames = map (nameBase . fst) cons
+                                             match (conP (mkName "Just") [varP str]) (normalB [| return (Failure ["Got '" ++ $(varE str) ++ "' expecting one of " ++ intercalate ", " conNames ]) |]) []
+                                        , match (conP (mkName "Nothing") []) (normalB  [| return (Failure ["Unexpected end of input."]) |]) []
+                                        ])
+                                
+                              ]
+                   fromURLWork :: Name -> [Name] -> ExpQ
+                   fromURLWork conName args
+                       = doE $ [ bindS (varP arg) [| fromURLC |] | arg <- args ] ++
+                               [ noBindS [| return $(foldl (\a b -> appE (appE [| (<*>) |] a) b)  (appE [| Success |] (conE conName)) (map varE args)) |] ]
+               funD 'fromURLC [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 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/URLT/XMLGenT.hs b/URLT/XMLGenT.hs
new file mode 100644
--- /dev/null
+++ b/URLT/XMLGenT.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module URLT.XMLGenT where
+
+import HSP
+import Control.Applicative ((<$>))
+import qualified HSX.XMLGenerator as HSX
+import URLT.Base (URLT, ShowURL(showURL), URL)
+
+instance (Monad m) => HSX.XMLGen (URLT url m) where
+    type HSX.XML (URLT url m) = XML
+    newtype HSX.Child (URLT url m) = UChild { unUChild :: XML }
+    newtype HSX.Attribute (URLT url m) = UAttr { unUAttr :: Attribute }
+
+    genElement n attrs children = 
+        do attribs <- map unUAttr <$> asAttr attrs
+           childer <- flattenCDATA . map unUChild <$> asChild children
+           HSX.XMLGenT $ return (Element
+                              (toName n)
+                              attribs
+                              childer
+                             )
+    xmlToChild = UChild
+
+flattenCDATA :: [XML] -> [XML]
+flattenCDATA cxml = 
+                case flP cxml [] of
+                 [] -> []
+                 [CDATA _ ""] -> []
+                 xs -> xs                       
+    where
+        flP :: [XML] -> [XML] -> [XML]
+        flP [] bs = reverse bs
+        flP [x] bs = reverse (x:bs)
+        flP (x:y:xs) bs = case (x,y) of
+                           (CDATA e1 s1, CDATA e2 s2) | e1 == e2 -> flP (CDATA e1 (s1++s2) : xs) bs
+                           _ -> flP (y:xs) (x:bs)
+
+instance (Monad m) => HSX.EmbedAsAttr (URLT url m) Attribute where
+    asAttr = return . (:[]) . UAttr 
+
+instance (Monad m) => HSX.EmbedAsAttr (URLT url m) (Attr String Char) where
+    asAttr (n := c)  = asAttr (n := [c])
+
+instance (Monad m) => HSX.EmbedAsAttr (URLT url m) (Attr String String) where
+    asAttr (n := str)  = asAttr $ MkAttr (toName n, pAttrVal str)
+
+instance (Monad m) => HSX.EmbedAsAttr (URLT url m) (Attr String Bool) where
+    asAttr (n := True)  = asAttr $ MkAttr (toName n, pAttrVal "true")
+    asAttr (n := False) = asAttr $ MkAttr (toName n, pAttrVal "false")
+
+instance (Monad m) => HSX.EmbedAsAttr (URLT url m) (Attr String Int) where
+    asAttr (n := i)  = asAttr $ MkAttr (toName n, pAttrVal (show i))
+
+instance (Monad m) => EmbedAsChild (URLT url m) Char where
+    asChild = XMLGenT . return . (:[]) . UChild . pcdata . (:[])
+
+instance (Monad m) => EmbedAsChild (URLT url m) String where
+    asChild = XMLGenT . return . (:[]) . UChild . pcdata
+
+instance (Monad m) => EmbedAsChild (URLT url m) XML where
+    asChild = XMLGenT . return . (:[]) . UChild
+
+instance Monad m => EmbedAsChild (URLT url m) () where
+  asChild () = return []
+
+instance (Monad m) => AppendChild (URLT url m) XML where
+ appAll xml children = do
+        chs <- children
+        case xml of
+         CDATA _ _       -> return xml
+         Element n as cs -> return $ Element n as (cs ++ (map unUChild chs))
+
+instance (Monad m) => SetAttr (URLT url m) XML where
+ setAll xml hats = do
+        attrs <- hats
+        case xml of
+         CDATA _ _       -> return xml
+         Element n as cs -> return $ Element n (foldr (:) as (map unUAttr attrs)) cs
+
+instance (Monad m) => XMLGenerator (URLT url m)
+
+
+instance (ShowURL m) => ShowURL (XMLGenT m) where
+    type URL (XMLGenT m) = URL m
+    showURL url = XMLGenT $ showURL url
diff --git a/debian/copyright b/debian/copyright
new file mode 100644
--- /dev/null
+++ b/debian/copyright
@@ -0,0 +1,1 @@
+BSD