diff --git a/happstack-server.cabal b/happstack-server.cabal
--- a/happstack-server.cabal
+++ b/happstack-server.cabal
@@ -1,5 +1,5 @@
 Name:                happstack-server
-Version:             0.2.1
+Version:             0.3.1
 Synopsis:            Web related tools and services.
 Description:         Web framework
 License:             BSD3
@@ -9,8 +9,13 @@
 homepage:            http://happstack.com
 Category:            Web, Distributed Computing
 Build-Type:          Simple
-Cabal-Version:       >= 1.4
+Cabal-Version:       >= 1.6
 
+source-repository head
+    type:     darcs
+    subdir:   happstack-server
+    location: http://patch-tag.com/publicrepos/happstack
+
 Flag base4
     Description: Choose the even newer, even smaller, split-up base package.
 
@@ -28,7 +33,6 @@
                        Happstack.Server.HTTP.LowLevel
                        Happstack.Server.HTTP.FileServe
                        Happstack.Server.SimpleHTTP
-                       Happstack.Server.JSON
                        Happstack.Server.MessageWrap
                        Happstack.Server.MinHaXML
                        Happstack.Server.SURI
@@ -61,8 +65,8 @@
                        extensible-exceptions,
                        HaXml >= 1.13 && < 1.14,
                        hslogger >= 1.0.2,
-                       happstack-data >= 0.2.1 && < 0.3,
-                       happstack-util >= 0.2.1 && < 0.3,
+                       happstack-data >= 0.3.1 && < 0.4,
+                       happstack-util >= 0.3.1 && < 0.4,
                        html,
                        MaybeT,
                        mtl,
@@ -73,6 +77,7 @@
                        process,
                        template-haskell,
                        time,
+                       utf8-string >= 0.3.4 && < 0.4,
                        xhtml,
                        zlib
 
diff --git a/src/Happstack/Server/HTTP/Client.hs b/src/Happstack/Server/HTTP/Client.hs
--- a/src/Happstack/Server/HTTP/Client.hs
+++ b/src/Happstack/Server/HTTP/Client.hs
@@ -10,6 +10,8 @@
 import qualified Data.ByteString.Char8 as B 
 import Network
 
+-- | Sends the serialized request to the host defined in the request
+-- and attempts to parse response upon arrival.
 getResponse :: Request -> IO (Either String Response)
 getResponse rq = withSocketsDo $ do
   let (hostName,p) = span (/=':') $ fromJust $ fmap B.unpack $ getHeader "host" rq 
diff --git a/src/Happstack/Server/HTTP/Clock.hs b/src/Happstack/Server/HTTP/Clock.hs
--- a/src/Happstack/Server/HTTP/Clock.hs
+++ b/src/Happstack/Server/HTTP/Clock.hs
@@ -22,7 +22,7 @@
   return ref
 
 updater :: IORef B.ByteString -> IO ()
-updater ref = do threadDelay (10^(6 :: Int) * 1) -- Every second
+updater ref = do threadDelay (10^(6 :: Int)) -- Every second
                  writeIORef ref =<< mkTime
                  updater ref
 
diff --git a/src/Happstack/Server/HTTP/FileServe.hs b/src/Happstack/Server/HTTP/FileServe.hs
--- a/src/Happstack/Server/HTTP/FileServe.hs
+++ b/src/Happstack/Server/HTTP/FileServe.hs
@@ -1,7 +1,15 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, Rank2Types #-}
 module Happstack.Server.HTTP.FileServe
     (
-     MimeMap,fileServe, mimeTypes,isDot, blockDotFiles,doIndex,errorwrapper
+     MimeMap,
+     blockDotFiles,
+     doIndex,
+     doIndexStrict,
+     errorwrapper,
+     fileServe,
+     fileServeStrict,
+     isDot,
+     mimeTypes
     ) where
 
 import Control.Exception.Extensible
@@ -34,37 +42,102 @@
                 do bintime <- getModificationTime binarylocation
                    logtime <- getModificationTime loglocation
                    if (logtime > bintime)
-                     then fmap Just $ readFile loglocation -- fileServe [loglocation] [] "./"
+                     then fmap Just $ readFile loglocation
                      else return Nothing
 
+
 type MimeMap = Map.Map String String
 
+type GetFileFunc = (MonadIO m) =>
+    Map.Map String String
+    -> String
+    -> m (Either String ((ClockTime, Integer), (String, L.ByteString)))
+
+
+
 doIndex :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
            [String] -> MimeMap -> String -> m Response
-doIndex [] _mime _fp = do forbidden $ toResponse "Directory index forbidden"
-doIndex (index:rest) mime fp =
+doIndex = doIndex' getFile
+
+-- | A variant of 'doIndex' that relies on 'getFileStrict'
+doIndexStrict :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
+                 [String] -> MimeMap -> String -> m Response
+doIndexStrict = doIndex' getFileStrict
+
+
+doIndex' :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
+            GetFileFunc
+         -> [String]
+         -> MimeMap
+         -> String
+         -> m Response
+doIndex' _getFileFunc []           _mime _fp = forbidden $ toResponse "Directory index forbidden"
+doIndex'  getFileFunc (index:rest)  mime  fp =
     do
     let path = fp++'/':index
     --print path
     fe <- liftIO $ doesFileExist path
     if fe then retFile path else doIndex rest mime fp
-    where retFile = returnFile mime
+    where retFile = returnFile getFileFunc mime
+
+
+
 defaultIxFiles :: [String]
 defaultIxFiles= ["index.html","index.xml","index.gif"]
 
 
-fileServe :: (ServerMonad m, FilterMonad Response m, MonadIO m) => [FilePath] -> FilePath -> m Response
-fileServe ixFiles localpath  = 
-    fileServe' localpath (doIndex (ixFiles++defaultIxFiles)) mimeTypes
+-- | Serve a file (lazy version). For efficiency reasons when serving large
+-- files, will escape the computation early if a file is successfully served,
+-- to prevent filters from being applied; if a filter were applied, we would
+-- need to compute the content-length (thereby forcing the spine of the
+-- ByteString into memory) rather than reading it from the filesystem.
+--
+-- Note that using lazy fileServe can result in some filehandles staying open
+-- until the garbage collector gets around to closing them.
+fileServe :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m) =>
+             [FilePath]         -- ^ index files if the path is a directory
+          -> FilePath           -- ^ file/directory to serve
+          -> m Response
+fileServe ixFiles localpath = do
+    resp <- fileServe' localpath
+                       (doIndex (ixFiles++defaultIxFiles))
+                       mimeTypes
+                       getFile
 
+    escape' $ resp { rsFlags = RsFlags {rsfContentLength=False} }
+
+
+
+-- | Serve a file (strict version). Reads the entire file strictly into
+-- memory, and ensures that the handle is properly closed. Unlike lazy
+-- fileServe, this function doesn't shortcut the computation early, and it
+-- allows for filtering (ex: gzip compression) to be applied
+fileServeStrict :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
+                   [FilePath]   -- ^ index files if the path is a directory
+                -> FilePath     -- ^ file/directory to serve
+                -> m Response
+fileServeStrict ixFiles localpath = do
+    resp <- fileServe' localpath
+                       (doIndex (ixFiles++defaultIxFiles))
+                       mimeTypes
+                       getFileStrict
+
+    -- clear "Content-Length" because it could be modified by filters
+    -- downstream
+    let headers = rsHeaders resp
+    return $ resp {rsHeaders = Map.delete (P.pack "content-length") headers}
+
+
+
 -- | Serve files with a mime type map under a directory.
 --   Uses the function to transform URIs to FilePaths.
 fileServe' :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
               String
               -> (Map.Map String String -> String -> m Response)
               -> Map.Map String String
+              -> GetFileFunc
               -> m Response
-fileServe' localpath fdir mime = do
+fileServe' localpath fdir mime getFileFunc = do
     rq <- askRq
     let fp2 = takeWhile (/=',') fp
         fp = filepath
@@ -84,20 +157,22 @@
                | True = "NOT FOUND"
     liftIO $ logM "Happstack.Server.HTTP.FileServe" DEBUG ("fileServe: "++show fp++" \t"++status)
     if de then fdir mime fp else do
-    getFile mime fp >>= flip either (renderResponse mime) 
-                (const $ returnGroup localpath mime safepath)
+    getFileFunc mime fp >>= flip either (renderResponse mime)
+        (const $ returnGroup localpath mime safepath)
 
+
 returnFile :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-              Map.Map String String -> String -> m Response
-returnFile mime fp =  
-    getFile mime fp >>=  either fileNotFound (renderResponse mime)
+              GetFileFunc -> Map.Map String String -> String -> m Response
+returnFile getFileFunc mime fp =
+    getFileFunc mime fp >>=  either fileNotFound (renderResponse mime)
 
+
 -- if fp has , separated then return concatenation with content-type of last
 -- and last modified of latest
 tr :: (Eq a) => a -> a -> [a] -> [a]
 tr a b = map (\x->if x==a then b else x)
 ltrim :: String -> String
-ltrim = dropWhile (flip elem " \t\r")   
+ltrim = dropWhile (flip elem " \t\r")
 
 returnGroup :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
                String -> Map.Map String String -> [String] -> m Response
@@ -110,7 +185,7 @@
   mbFiles <-  mapM (getFile mime) $ fps
   let notFounds = [x | Left x <- mbFiles]
       files = [x | Right x <- mbFiles]
-  if not $ null notFounds 
+  if not $ null notFounds
     then fileNotFound $ drop (length localPath) $ head notFounds else do
   let totSize = sum $ map (snd . fst) files
       maxTime = maximum $ map (fst . fst) files :: ClockTime
@@ -121,8 +196,9 @@
 
 
 fileNotFound :: (Monad m, FilterMonad Response m) => String -> m Response
-fileNotFound fp = do setResponseCode 404 
-                     return $ toResponse $ "File not found "++ fp
+fileNotFound fp = return $ result 404 $ "File not found " ++ fp
+
+
 --fakeLen = 71* 1024
 fakeFile :: (Integral a) =>
             a -> ((ClockTime, Int64), (String, L.ByteString))
@@ -131,6 +207,9 @@
       body = L.pack $ (("//"++(show len)++" ") ++ ) $ (replicate len '0') ++ "\n"
       len = fromIntegral fakeLen
 
+-- | @getFile mimeMap path@ will lazily read the file as a ByteString
+-- with a content type provided by matching the file extension with the
+-- @mimeMap@.  getFile will return an error string or ((timeFetched,size), (contentType,fileContents))
 getFile :: (MonadIO m) =>
            Map.Map String String
            -> String
@@ -139,13 +218,31 @@
   let ct = Map.findWithDefault "text/plain" (getExt fp) mime
   fe <- liftIO $ doesFileExist fp
   if not fe then return $ Left fp else do
-  
-  time <- liftIO  $ getModificationTime fp
-  h <- liftIO $ openBinaryFile fp ReadMode
+
+  time <- liftIO $ getModificationTime fp
+  h    <- liftIO $ openBinaryFile fp ReadMode
   size <- liftIO $ hFileSize h
-  lbs <- liftIO $ L.hGetContents h
+  lbs  <- liftIO $ L.hGetContents h
   return $ Right ((time,size),(ct,lbs))
 
+-- | As 'getFile' but strictly fetches the file, instead of lazily.
+getFileStrict :: (MonadIO m) =>
+                 Map.Map String String
+              -> String
+              -> m (Either String ((ClockTime, Integer), (String, L.ByteString)))
+getFileStrict mime fp = do
+  let ct = Map.findWithDefault "text/plain" (getExt fp) mime
+  fe     <- liftIO $ doesFileExist fp
+
+  if not fe then return $ Left fp else do
+
+  time     <- liftIO $ getModificationTime fp
+  s        <- liftIO $ P.readFile fp
+  let lbs  = L.fromChunks [s]
+  let size = toInteger . P.length $ s
+  return $ Right ((time,size),(ct,lbs))
+
+
 renderResponse :: (Monad m,
                    ServerMonad m,
                    FilterMonad Response m,
@@ -156,21 +253,21 @@
 renderResponse _ ((modtime,size),(ct,body)) = do
   rq <- askRq
   let notmodified = getHeader "if-modified-since" rq == Just (P.pack $ repr)
-      repr = formatCalendarTime defaultTimeLocale 
+      repr = formatCalendarTime defaultTimeLocale
              "%a, %d %b %Y %X GMT" (toUTCTime modtime)
   -- "Mon, 07 Jan 2008 19:51:02 GMT"
   -- when (isJust $ getHeader "if-modified-since"  rq) $ error $ show $ getHeader "if-modified-since" rq
-  if notmodified then do setResponseCode 304 ; return $ toResponse "" else do
-  --  modifyResponse (setHeader "HUH" $ show $ (fmap P.unpack mod == Just repr,mod,Just repr))
-  setHeaderM "Last-modified" repr
-  -- if %Z or UTC are in place of GMT below, wget complains that the last-modified header is invalid
-  setHeaderM "Content-Length" (show size)
-  setHeaderM "Content-Type" ct
-  return $ resultBS 200 body
+  if notmodified then
+      return $ result 304 ""
+    else do
+      return $ ((setHeader "Last-modified" repr) .
+                (setHeader "Content-Length" (show size)) .
+                (setHeader "Content-Type" ct)) $
+               resultBS 200 body
 
-              
 
 
+
 getExt :: String -> String
 getExt = reverse . takeWhile (/='.') . reverse
 
@@ -181,6 +278,7 @@
 	    ,("xsl","application/xml")
 	    ,("js","text/javascript")
 	    ,("html","text/html")
+	    ,("htm","text/html")
 	    ,("css","text/css")
 	    ,("gif","image/gif")
 	    ,("jpg","image/jpeg")
diff --git a/src/Happstack/Server/HTTP/Handler.hs b/src/Happstack/Server/HTTP/Handler.hs
--- a/src/Happstack/Server/HTTP/Handler.hs
+++ b/src/Happstack/Server/HTTP/Handler.hs
@@ -35,8 +35,6 @@
 import Data.Time.Clock (getCurrentTime)
 import System.Log.Logger (Priority(..), logM)
 
-log' = logM "Happstack.Server"
-
 request :: Conf -> Handle -> Host -> (Request -> IO Response) -> IO ()
 request conf h host handler = rloop conf h host handler =<< L.hGetContents h
 
@@ -84,16 +82,29 @@
                      time <- getCurrentTime
                      let host' = fst host
                          user = "-"
-                         requestLine = unwords [show $ rqMethod req, rqUri req, show $ rqVersion req]
+                         requestLn = unwords [show $ rqMethod req, rqUri req, show $ rqVersion req]
                          responseCode = rsCode res
-                         size = toInteger $ L.length $ rsBody res
+                         sendContentLength = rsfContentLength (rsFlags res)
+
+                         -- don't force the bytestring if "sendContentLength"
+                         -- is false, at least not if a content-length header
+                         -- has been set
+                         size = if not sendContentLength then
+                                    maybe (toInteger $ L.length $ rsBody res)
+                                          ((read . P.unpack) :: P.ByteString -> Integer)
+                                          (getHeaderBS contentLengthC req)
+                                  else
+                                    toInteger $ L.length $ rsBody res
+
                          referer = B.unpack $ fromMaybe (B.pack "") $ getHeader "Referer" req
                          userAgent = B.unpack $ fromMaybe (B.pack "") $ getHeader "User-Agent" req
-                     log' NOTICE $ formatRequestCombined host' user time requestLine responseCode size referer userAgent
-                     
+                     logM "Happstack.Server.AccessLog.Combined" INFO $ formatRequestCombined host' user time requestLn responseCode size referer userAgent
+
                      putAugmentedResult h req res
                      when (continueHTTP req res) $ rloop conf h host handler rest
 
+-- | Unserializes the bytestring into a response.  If there is an
+-- error it will return @Left msg@.
 parseResponse :: L.ByteString -> Either String Response
 parseResponse inputStr =
     do (topStr,restStr) <- required "failed to separate response" $ 
@@ -205,7 +216,7 @@
   when (rqMethod req /= HEAD) $ L.hPut h $ rsBody res
   hFlush h
 
-
+-- | Serializes the request to the given handle
 putRequest :: Handle -> Request -> IO ()
 putRequest h rq = do 
     let put = B.hPut h
diff --git a/src/Happstack/Server/HTTP/Socket.hs b/src/Happstack/Server/HTTP/Socket.hs
--- a/src/Happstack/Server/HTTP/Socket.hs
+++ b/src/Happstack/Server/HTTP/Socket.hs
@@ -18,7 +18,7 @@
   )
 import System.IO
 
--- alternative implementation of accept to work around EAI_AGAIN errors
+-- | alternative implementation of accept to work around EAI_AGAIN errors
 acceptLite :: S.Socket -> IO (Handle, S.HostName, S.PortNumber)
 acceptLite sock = do
   (sock', addr) <- S.accept sock
diff --git a/src/Happstack/Server/JSON.hs b/src/Happstack/Server/JSON.hs
deleted file mode 100644
--- a/src/Happstack/Server/JSON.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-module Happstack.Server.JSON where
-import Data.Char
-import Data.List
-
-data JSON = JBool Bool | JString String | JInt Int | JFloat Float | 
-            JObj [(String,JSON)] | JList [JSON] | JNull
-
-
-jInt :: Integral a => a -> JSON
-jInt = JInt . fromIntegral
-
-class ToJSON a where
-    toJSON::a->JSON
-instance ToJSON JSON where toJSON=id
-
-jsonToString :: JSON -> String
-jsonToString (JBool bool) = map toLower $ show bool
-jsonToString (JString string) = show string
-jsonToString (JInt int) = show int
-jsonToString (JFloat float) = show float
-jsonToString (JObj pairs) = '{' : (concat $ (intersperse "," $ map impl pairs) )++"}"
-    where
-    impl (name,val) = concat [show name,":",jsonToString val]
-jsonToString (JList list) = 
-    '[':(concat $ (intersperse "," $ map jsonToString list)) ++"]"
-jsonToString JNull = "null"
-type CallBack=String
-
-data JSONCall x = JCall CallBack x
diff --git a/src/Happstack/Server/MessageWrap.hs b/src/Happstack/Server/MessageWrap.hs
--- a/src/Happstack/Server/MessageWrap.hs
+++ b/src/Happstack/Server/MessageWrap.hs
@@ -13,7 +13,7 @@
 import Happstack.Util.Common
 
 queryInput :: SURI -> [(String, Input)]
-queryInput uri = formDecode (case SURI.query $ uri of
+queryInput uri = formDecode (case SURI.query uri of
                                '?':r -> r
                                xs    -> xs)
 
@@ -25,7 +25,7 @@
     in decodeBody ctype (getBS $ rqBody req)
 
 
--- Decodes application\/x-www-form-urlencoded inputs.      
+-- | Decodes application\/x-www-form-urlencoded inputs.      
 formDecode :: String -> [(String, Input)]
 formDecode [] = []
 formDecode qString = 
@@ -71,7 +71,7 @@
               _ -> ("ERROR",simpleInput "ERROR") -- FIXME: report error
     where ctype = fromMaybe defaultInputType (getContentType hs)
 
-
+-- | Packs a string into an Input of type "text/plain"
 simpleInput :: String -> Input
 simpleInput v
     = Input { inputValue = L.pack v
diff --git a/src/Happstack/Server/Parts.hs b/src/Happstack/Server/Parts.hs
--- a/src/Happstack/Server/Parts.hs
+++ b/src/Happstack/Server/Parts.hs
@@ -8,6 +8,7 @@
 import Happstack.Server.SimpleHTTP
 import Text.ParserCombinators.Parsec
 import Control.Monad
+import Data.Char
 import Data.Maybe
 import Data.List
 import qualified Data.ByteString.Char8 as BS
@@ -22,19 +23,27 @@
     (FilterMonad Response m, MonadPlus m, WebMonad Response m, ServerMonad m)
     => m String
 compressedResponseFilter = do
-    mbAccept<-getHeaderM "Accept-Encoding"
-    accept<- maybe mzero return mbAccept
-    let eEncoding = bestEncoding $ BS.unpack accept
-    (coding,action) <- case eEncoding of
-        Left _ -> do
+    getHeaderM "Accept-Encoding" >>=
+        (maybe (return "identity") installHandler)
+
+  where
+    badEncoding = "Encoding returned not in the list of known encodings"
+
+    installHandler accept = do
+      let eEncoding = bestEncoding $ BS.unpack accept
+      (coding,action) <- case eEncoding of
+          Left _ -> do
             setResponseCode 406
             finishWith $ toResponse ""
-        Right a -> return (a, maybe (fail "Encoding returned not in the list of known encodings")
-            id (lookup a allEncodingHandlers))
-    setHeaderM "Content-Encoding" coding
-    action
-    return coding
 
+          Right a -> return (a, fromMaybe (fail badEncoding)
+                                          (lookup a allEncodingHandlers))
+
+      setHeaderM "Content-Encoding" coding
+      action
+      return coding
+
+
 -- | compresses the body of the response with gzip.
 -- does not set any headers.
 gzipFilter::(FilterMonad Response m) => m()
@@ -113,7 +122,7 @@
 --    ,compressFilter
     ,deflateFilter
     ,return ()
-    ,fail $ "chose * as content encoding"
+    ,fail "chose * as content encoding"
     ]
 
 -- | unsupported:  a parser for the Accept-Encoding header
@@ -125,16 +134,17 @@
             ws
             char ','
             ws
+        
         encoding1 :: GenParser Char st ([Char], Maybe Double)
         encoding1 = do
-            encoding <- many1 letter <|> string "*"
+            encoding <- many1 alphaNum <|> string "*"
             ws
             quality<-optionMaybe qual
             return (encoding, fmap read quality)
         qual = do
             char ';' >> ws >> char 'q' >> ws >> char '=' >> ws
             q<-float
-            return $ q
+            return q
         int = many1 digit
         float = do
                 wholePart<-many1 digit
@@ -143,7 +153,7 @@
             <|>
                 do
                 fractionalPart<-fraction
-                return $ fractionalPart
+                return fractionalPart
         fraction :: GenParser Char st String
         fraction = do
             char '.'
diff --git a/src/Happstack/Server/SURI.hs b/src/Happstack/Server/SURI.hs
--- a/src/Happstack/Server/SURI.hs
+++ b/src/Happstack/Server/SURI.hs
@@ -38,9 +38,9 @@
 unEscape = URI.unEscapeString . map (\x->if x=='+' then ' ' else x)
 escape = URI.escapeURIString URI.isAllowedInURI
 
+-- | Returns true if the URI is absolute
 isAbs :: SURI -> Bool
 isAbs = not . null . URI.uriScheme . suri
---isAbs = maybe True ( mbParsed
 
 newtype SURI = SURI {suri::URI.URI} deriving (Eq,Data,Typeable)
 instance Show SURI where
diff --git a/src/Happstack/Server/SimpleHTTP.hs b/src/Happstack/Server/SimpleHTTP.hs
--- a/src/Happstack/Server/SimpleHTTP.hs
+++ b/src/Happstack/Server/SimpleHTTP.hs
@@ -1,6 +1,16 @@
-{-# LANGUAGE UndecidableInstances, OverlappingInstances, ScopedTypeVariables, FlexibleInstances, TypeSynonymInstances,
-    MultiParamTypeClasses, PatternGuards, FlexibleContexts, FunctionalDependencies, GeneralizedNewtypeDeriving, PatternSignatures
-    #-}
+
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PatternSignatures #-}
+
 {-# OPTIONS -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -16,7 +26,7 @@
 --
 -- By default, the built-in HTTP server will be used. However, other back-ends
 -- like CGI\/FastCGI can used if so desired.
--- 
+--
 -- So the general nature of 'simpleHTTP' is no different than what you'd expect
 -- from a web application container.  First you figure out when function is
 -- going to process your request, process the request to generate a response,
@@ -39,12 +49,12 @@
 -- suitable for sending back to the server.  Most of the time though you don't
 -- even need to worry about that as ServerPartT hides almost all the machinery
 -- for building your response by exposing a few type classes.
--- 
+--
 -- 'ServerPartT' is a pretty rich monad.  You can interact with your request,
 -- your response, do IO, etc.  Here is a do block that validates basic
 -- authentication It takes a realm name as a string, a Map of username to
 -- password and a server part to run if authentication fails.
--- 
+--
 -- @basicAuth'@ acts like a guard, and only produces a response when
 -- authentication fails.  So put it before any ServerPartT you want to demand
 -- authentication for in any collection of ServerPartTs.
@@ -63,7 +73,7 @@
 --        authHeader <- getHeaderM \"authorization\"
 --        case authHeader of
 --            Nothing -> err
---            Just x  -> case parseHeader x of 
+--            Just x  -> case parseHeader x of
 --                (name, \':\':pass) | validLogin name pass -> mzero
 --                                   | otherwise -> err
 --                _                                       -> err
@@ -87,7 +97,7 @@
 --     when (take 2 line \/= \"ok\") $ (notfound () >> return \"refused\")
 --     return \"Hello World!\"
 -- @
--- 
+--
 -- This example will ask in the console \"return? \" if you type \"ok\" it will
 -- show \"Hello World!\" and if you type anything else it will return a 404.
 --
@@ -109,6 +119,7 @@
     , anyRequest
     -- * WebT
     , WebT(..)
+    , UnWebT
     , FilterFun
     , Web
     , mkWebT
@@ -140,7 +151,7 @@
     , badGateway
     , internalServerError
     , badRequest
-    , unauthorized 
+    , unauthorized
     , forbidden
     , notFound
     , seeOther
@@ -203,46 +214,75 @@
     , noopValidator
     , lazyProcValidator
     ) where
-import qualified Paths_happstack_server as Cabal
-import qualified Data.Version as DV
-import Happstack.Server.HTTP.Client
-import Happstack.Data.Xml.HaXml
-import qualified Happstack.Server.MinHaXML as H
 
 import Happstack.Server.HTTP.Types hiding (Version(..))
-import qualified Happstack.Server.HTTP.Types as Types
-import Happstack.Server.HTTP.Listen as Listen
-import Happstack.Server.XSLT
-import Happstack.Server.SURI (ToSURI)
-import Happstack.Util.Common
 import Happstack.Server.Cookie
-import Happstack.Data -- used by default implementation of fromData
-import Control.Applicative
-import Control.Concurrent (forkIO)
-import Control.Exception (evaluate)
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Error
-import Control.Monad.Trans()
-import Control.Monad.Maybe
-import Control.Monad.Writer as Writer
-import Data.Maybe
-import Data.Monoid
-import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Data.Generics as G
-import qualified Data.Map as M
-import Text.Html (Html,renderHtml)
-import qualified Text.XHtml as XHtml (Html,renderHtml)
-import qualified Happstack.Crypto.Base64 as Base64
-import Data.Char
-import Data.List
-import System.IO
-import System.Console.GetOpt
-import System.Process (runInteractiveProcess, waitForProcess)
-import System.Exit
-import Text.Show.Functions ()
 
+import qualified Paths_happstack_server          as Cabal
+
+import qualified Data.Version                    as DV
+import Happstack.Server.HTTP.Client              (getResponse, unproxify, unrproxify)
+import Happstack.Data.Xml.HaXml                  (toHaXmlEl)
+import qualified Happstack.Server.MinHaXML       as H
+import qualified Happstack.Server.HTTP.Listen    as Listen (listen) -- So that we can disambiguate 'Writer.listen'
+import Happstack.Server.XSLT                     (XSLTCmd, XSLPath, procLBSIO)
+import Happstack.Server.SURI                     (ToSURI)
+import Happstack.Util.Common                     (Seconds, readM)
+import Happstack.Data                            (Xml, normalize, fromPairs, Element, toXml, toPublicXml) -- used by default implementation of fromData
+import Control.Applicative                       (Applicative, pure, (<*>))
+import Control.Concurrent                        (forkIO)
+import Control.Exception                         (evaluate)
+import Control.Monad                             ( MonadPlus, mzero, mplus
+                                                 , msum, ap, unless
+                                                 , liftM, liftM2, liftM3, liftM4
+                                                 )
+import Control.Monad.Trans                       ( MonadTrans, lift
+                                                 , MonadIO, liftIO
+                                                 )
+import Control.Monad.Reader                      ( ReaderT(ReaderT), runReaderT
+                                                 , MonadReader, ask, local
+                                                 , asks
+                                                 )
+import Control.Monad.Writer                      ( WriterT(WriterT), runWriterT
+                                                 , MonadWriter, tell, pass
+                                                 , listens
+                                                 )
+import qualified Control.Monad.Writer            as Writer (listen) -- So that we can disambiguate 'Listen.listen'
+import Control.Monad.State                       (MonadState, get, put)
+import Control.Monad.Error                       ( ErrorT(ErrorT), runErrorT
+                                                 , Error, strMsg
+                                                 , MonadError, throwError, catchError
+                                                 )
+import Control.Monad.Maybe                       (MaybeT(MaybeT), runMaybeT)
+import Data.Char                                 (ord)
+import Data.Maybe                                (fromMaybe)
+import Data.Monoid                               ( Monoid, mempty, mappend
+                                                 , Dual(Dual), getDual
+                                                 , Endo(Endo), appEndo
+                                                 )
+
+import qualified Data.ByteString.Char8           as B
+import qualified Data.ByteString.Lazy.Char8      as L
+import qualified Data.ByteString.Lazy.UTF8       as LU (toString)
+
+import qualified Data.Generics                   as G
+import qualified Data.Map                        as M
+
+import Text.Html                                 (Html, renderHtml)
+import qualified Text.XHtml                      as XHtml (Html, renderHtml)
+
+import qualified Happstack.Crypto.Base64         as Base64
+import Data.Char                                 (toLower)
+import Data.List                                 (isPrefixOf)
+import System.IO                                 (hGetContents, hClose)
+import System.Console.GetOpt                     ( OptDescr(Option)
+                                                 , ArgDescr(ReqArg)
+                                                 , ArgOrder(Permute)
+                                                 , getOpt
+                                                 )
+import System.Process                            (runInteractiveProcess, waitForProcess)
+import System.Exit                               (ExitCode(ExitSuccess, ExitFailure))
+
 -- | An alias for WebT when using IO
 type Web a = WebT IO a
 -- | An alias for using ServerPartT when using the IO
@@ -279,44 +319,45 @@
 -- can provide the function:
 --
 -- @
---   unpackErrorT:: (Monad m, Show e) =>
---       -> (ErrorT e m) (Maybe ((Either Response a), FilterFun Response))
---       -> m (Maybe ((Either Response a), FilterFun Response))
+--   unpackErrorT:: (Monad m, Show e) => UnWebT (ErrorT e m) a -> UnWebT m a
 --   unpackErrorT handler et = do
 --      eitherV <- runErrorT et
 --      case eitherV of
 --          Left err -> return $ Just (Left "Catastrophic failure " ++ show e, Set $ Endo \r -> r{rsCode = 500})
 --          Right x -> return x
 -- @
--- 
+--
 -- With @unpackErrorT@ you can now call simpleHTTP.  Just wrap your @ServerPartT@ list.
 --
 -- @
 --   simpleHTTP nullConf $ mapServerPartT unpackErrorT (myPart \`catchError\` myHandler)
 -- @
--- 
+--
 -- Or alternatively:
 --
 -- @
 --   simpleHTTP' unpackErrorT nullConf (myPart \`catchError\` myHandler)
 -- @
--- 
+--
 -- Also see 'spUnwrapErrorT' for a more sophisticated version of this function
 --
-mapServerPartT :: (m (Maybe (Either Response a, FilterFun Response)) -> n (Maybe (Either Response b, FilterFun Response))) -> ServerPartT m a -> ServerPartT n b
+mapServerPartT :: (     UnWebT m a ->      UnWebT n b)
+               -> (ServerPartT m a -> ServerPartT n b)
 mapServerPartT f ma = withRequest $ \rq -> mapWebT f (runServerPartT ma rq)
 
 -- | A varient of mapServerPartT where the first argument, also takes a request.
 -- useful if you want to runServerPartT on a different ServerPartT inside your
 -- monad (see spUnwrapErrorT)
-mapServerPartT' :: (Request -> m (Maybe (Either Response a, FilterFun Response)) -> n (Maybe (Either Response b, FilterFun Response))) -> ServerPartT m a -> ServerPartT n b
+mapServerPartT' :: (Request -> UnWebT m a ->      UnWebT n b)
+                -> (      ServerPartT m a -> ServerPartT n b)
 mapServerPartT' f ma = withRequest $ \rq -> mapWebT (f rq) (runServerPartT ma rq)
+
 instance MonadTrans (ServerPartT) where
     lift m = withRequest (\_ -> lift m)
 
-instance (Monad m) => Monoid (ServerPartT m a)
- where mempty = mzero
-       mappend = mplus
+instance (Monad m) => Monoid (ServerPartT m a) where
+    mempty  = mzero
+    mappend = mplus
 
 instance (Monad m, Functor m) => Applicative (ServerPartT m) where
     pure = return
@@ -351,48 +392,58 @@
 -- you can add a ReaderT to your monad stack without
 -- any trouble.
 class Monad m => ServerMonad m where
-    askRq :: m Request
-    localRq :: (Request->Request)->m a->m a
+    askRq   :: m Request
+    localRq :: (Request -> Request) -> m a -> m a
 
 instance (Monad m) => ServerMonad (ServerPartT m) where
     askRq = ServerPartT $ ask
     localRq f m = ServerPartT $ local f (unServerPartT m)
+
 -------------------------------
 -- HERE BEGINS WebT definitions
 
 -- | A monoid operation container.
 -- If a is a monoid, then SetAppend is a monoid with the following behaviors:
--- 
+--
 -- @
---   Set x `mappend` Append y = Set (x `mappend` y)
+--   Set    x `mappend` Append y = Set    (x `mappend` y)
 --   Append x `mappend` Append y = Append (x `mappend` y)
---   \_     `mappend` Set y = Set y
+--   \_       `mappend` Set y    = Set y
 -- @
 --
--- A simple way of sumerizing this is, if the left side is Append, then the
--- right is appended to the left.  If the left side is Set, then the right side
+-- A simple way of sumerizing this is, if the right side is Append, then the
+-- right is appended to the left.  If the right side is Set, then the right side
 -- is ignored.
+
 data SetAppend a = Set a | Append a
     deriving (Eq, Show)
+
 instance Monoid a => Monoid (SetAppend a) where
    mempty = Append mempty
-   Set x    `mappend` Append y = Set (x `mappend` y)
+
+   Set    x `mappend` Append y = Set    (x `mappend` y)
    Append x `mappend` Append y = Append (x `mappend` y)
    _        `mappend` Set y    = Set y
 
-value :: SetAppend t -> t
-value (Set x) = x
-value (Append x) = x
+-- | Extract the value from a SetAppend
+-- Note that a SetAppend is actually a CoPointed from:
+-- <http://hackage.haskell.org/packages/archive/category-extras/latest/doc/html/Control-Functor-Pointed.html>
+-- But lets not drag in that dependency. yet...
+extract :: SetAppend t -> t
+extract (Set    x) = x
+extract (Append x) = x
 
 instance Functor (SetAppend) where
-    fmap f (Set x) = Set $ f x
+    fmap f (Set    x) = Set    $ f x
     fmap f (Append x) = Append $ f x
 
 -- | @FilterFun@ is a lot more fun to type than @SetAppend (Dual (Endo a))@
 type FilterFun a = SetAppend (Dual (Endo a))
 
-newtype FilterT a m b =
-   FilterT { unFilterT :: WriterT (FilterFun a) m b }
+unFilterFun :: FilterFun a -> (a -> a)
+unFilterFun = appEndo . getDual . extract
+
+newtype FilterT a m b = FilterT { unFilterT :: WriterT (FilterFun a) m b }
    deriving (Monad, MonadTrans, Functor, MonadIO)
 
 -- | A set of functions for manipulating filters.  A ServerPartT implements
@@ -420,23 +471,27 @@
     -- existing filter function.
     composeFilter :: (a->a) -> m ()
     -- | retrives the filter from the environment
-    getFilter :: m b -> m (b,a->a)
+    getFilter :: m b -> m (b, a->a)
 
 instance (Monad m) => FilterMonad a (FilterT a m) where
-    setFilter f = FilterT $ Writer.tell $ Set $ Dual $ Endo f
-    composeFilter f = FilterT $ Writer.tell $ Append $ Dual $ Endo f
-    getFilter m = FilterT $ Writer.listens (appEndo . getDual . value)  (unFilterT m) 
+    setFilter     = FilterT . tell                . Set    . Dual . Endo
+    composeFilter = FilterT . tell                . Append . Dual . Endo
+    getFilter     = FilterT . listens unFilterFun . unFilterT
 
 -- | The basic response building object.
+newtype WebT m a = WebT { unWebT :: ErrorT Response (FilterT (Response) (MaybeT m)) a }
+    deriving (MonadIO, Functor)
+
+-- |
 --  It is worth discussing the unpacked structure of WebT a bit as it's exposed
 --  in 'mapServerPartT' and 'mapWebT'.
 --
 --  A fully unpacked WebT has a structure that looks like:
---  
+--
 --  @
 --    ununWebT $ WebT m a :: m (Maybe (Either Response a, FilterFun Response))
 --  @
---   
+--
 --  So, ignoring m, as it is just the containing Monad, the outermost layer is
 --  a Maybe.  This is 'Nothing' if 'mzero' was called or @Just (Either Response
 --  a, SetAppend (Endo Response))@ if 'mzero' wasn't called.  Inside the Maybe,
@@ -475,9 +530,8 @@
 --          Just (Right a, f) -> Just (Right a, f) -- a is our normal monadic value
 --                                                 -- f is still our filter function
 --  @
---  
-newtype WebT m a = WebT { unWebT :: ErrorT Response (FilterT (Response) (MaybeT m)) a }
-    deriving (MonadIO, Functor)
+--
+type UnWebT m a = m (Maybe (Either Response a, FilterFun Response))
 
 instance Monad m => Monad (WebT m) where
     m >>= f = WebT $ unWebT m >>= unWebT . f
@@ -525,39 +579,36 @@
 instance (Monad m) => FilterMonad Response (WebT m) where
     setFilter f = WebT $ lift $ setFilter $ f
     composeFilter f = WebT . lift . composeFilter $ f
-    getFilter m = WebT $ ErrorT $ getFilter (runErrorT $ unWebT m) >>= liftWebT
-        where liftWebT (Left r, _) = return $ Left r
-              liftWebT (Right a, f) = return $ Right (a, f)
+    getFilter     m = WebT $ ErrorT $ fmap lft $ getFilter (runErrorT $ unWebT m)
+        where
+          lft (Left  r, _) = Left r
+          lft (Right a, f) = Right (a, f)
 
 instance (Monad m) => Monoid (WebT m a) where
     mempty = mzero
     mappend = mplus
 
--- | takes your WebT, converts the monadic value to a Response,
--- applys your filter, and returns it wrapped in a Maybe.
-runWebT :: (ToMessage b, Monad m) => WebT m b -> m (Maybe Response)
-runWebT m = runMaybeT $ do
-                (r,ed) <- runWriterT $ unFilterT $ runErrorT $ unWebT $ m
-                let f = appEndo $ getDual $ value ed
-                return $ either (f) (f . toResponse) r
+-- | takes your WebT, if it is 'mempty' it returns Nothing else it
+-- converts the value to a Response and applies your filter to it.
+runWebT :: forall m b. (Functor m, ToMessage b) => WebT m b -> m (Maybe Response)
+runWebT = (fmap . fmap) appFilterToResp . ununWebT
+    where
+      appFilterToResp :: (Either Response b, FilterFun Response) -> Response
+      appFilterToResp (e, ff) = unFilterFun ff $ either id toResponse e
+
 -- | for when you really need to unpack a WebT entirely (and not
 -- just unwrap the first layer with unWebT)
-ununWebT :: WebT m a
-    -> m (Maybe
-            (Either Response a,
-             FilterFun Response))
+ununWebT :: WebT m a -> UnWebT m a
 ununWebT = runMaybeT . runWriterT . unFilterT . runErrorT . unWebT
 
 -- | for wrapping a WebT back up.  @mkWebT . ununWebT = id@
-mkWebT :: m (Maybe
-       (Either Response a,
-        FilterFun Response)) -> WebT m a
+mkWebT :: UnWebT m a -> WebT m a
 mkWebT = WebT . ErrorT . FilterT . WriterT . MaybeT
 
 -- | see 'mapServerPartT' for a discussion of this function
-mapWebT :: (m (Maybe (Either Response a, FilterFun Response)) -> n (Maybe (Either Response b, FilterFun Response))) -> WebT m a -> WebT n b
-mapWebT f ma = mkWebT $  f (ununWebT ma)
-
+mapWebT :: (UnWebT m a -> UnWebT n b)
+        -> (  WebT m a ->   WebT n b)
+mapWebT f ma = mkWebT $ f (ununWebT ma)
 
 instance (Monad m, Functor m) => Applicative (WebT m) where
     pure = return
@@ -576,7 +627,7 @@
  	catchError action handler = mkWebT $ catchError (ununWebT action) (ununWebT . handler)
 
 instance MonadWriter w m => MonadWriter w (WebT m) where
-    tell = lift . Writer.tell
+    tell = lift . tell
     listen m = mkWebT $ Writer.listen (ununWebT m) >>= (return . liftWebT)
         where liftWebT (Nothing, _) = Nothing
               liftWebT (Just (Left x,f), _) = Just (Left x,f)
@@ -627,36 +678,39 @@
 
 -- | a combination of simpleHTTP and 'mapServerPartT'.  See 'mapServerPartT' for a discussion
 -- of the first argument of this function.
-simpleHTTP' :: (Monad m, ToMessage b) =>
-   (m (Maybe (Either Response a, FilterFun Response))
-   -> IO (Maybe (Either Response b, FilterFun Response)))
-   -> Conf
-   -> ServerPartT m a
-   -> IO ()
-simpleHTTP' toIO conf hs = do
+simpleHTTP' :: (ToMessage b, Monad m, Functor m) => (UnWebT m a -> UnWebT IO b)
+            -> Conf -> ServerPartT m a -> IO ()
+simpleHTTP' toIO conf hs =
     Listen.listen conf (\req -> runValidator (fromMaybe return (validator conf)) =<< (simpleHTTP'' (mapServerPartT toIO hs) req))
-    
 
+
 -- | Generate a result from a 'ServerPart' and a 'Request'. This is mainly used
 -- by CGI (and fast-cgi) wrappers.
-simpleHTTP'' :: (ToMessage b, Monad m) => ServerPartT m b -> Request -> m Response
+simpleHTTP'' :: (ToMessage b, Monad m, Functor m) => ServerPartT m b -> Request -> m Response
 simpleHTTP'' hs req =  (runWebT $ runServerPartT hs req) >>= (return . (maybe standardNotFound id))
     where
         standardNotFound = setHeader "Content-Type" "text/html" $ toResponse notFoundHtml
 
 
--- | a wrapper for Read apparently.  Pretty much only used for 'path' and probably
--- unnecessarily, as it is exactly "readM"
+-- | This class is used by 'path' to parse a path component into a value.
+-- At present, the instances for number types (Int, Float, etc) just
+-- call 'readM'. The instance for 'String' however, just passes the
+-- path component straight through. This is so that you can read a
+-- path component which looks like this as a String:
+--
+--  \/somestring\/
+--
+-- instead of requiring the path component to look like:
+--
+-- \/"somestring"\/
 class FromReqURI a where
     fromReqURI :: String -> Maybe a
 
-
-
-instance FromReqURI String where fromReqURI = Just
-instance FromReqURI Int where    fromReqURI = readM
-instance FromReqURI Integer where    fromReqURI = readM
-instance FromReqURI Float where  fromReqURI = readM
-instance FromReqURI Double where fromReqURI = readM
+instance FromReqURI String  where fromReqURI = Just
+instance FromReqURI Int     where fromReqURI = readM
+instance FromReqURI Integer where fromReqURI = readM
+instance FromReqURI Float   where fromReqURI = readM
+instance FromReqURI Double  where fromReqURI = readM
 
 type RqData a = ReaderT ([(String,Input)], [(String,Cookie)]) Maybe a
 
@@ -739,9 +793,9 @@
 
 
 class MatchMethod m where matchMethod :: m -> Method -> Bool
-instance MatchMethod Method where matchMethod m = (== m) 
+instance MatchMethod Method where matchMethod m = (== m)
 instance MatchMethod [Method] where matchMethod methods = (`elem` methods)
-instance MatchMethod (Method -> Bool) where matchMethod f = f 
+instance MatchMethod (Method -> Bool) where matchMethod f = f
 instance MatchMethod () where matchMethod () _ = True
 
 -- | flatten turns your arbitrary @m a@ and converts it too
@@ -768,7 +822,7 @@
 addHeaderM a v = composeFilter $ \res-> addHeader a v res
 
 -- | sets a header into the response.  This will replace
--- an existing header of the same name.  Use addHeaderM, if you 
+-- an existing header of the same name.  Use addHeaderM, if you
 -- want to add more than one header of the same name.
 setHeaderM :: (FilterMonad Response m) => String -> String -> m ()
 setHeaderM a v = composeFilter $ \res -> setHeader a v res
@@ -779,7 +833,7 @@
 guardRq :: (ServerMonad m, MonadPlus m) => (Request -> Bool) -> m ()
 guardRq f = do
     rq <- askRq
-    when ( f rq /= True ) mzero 
+    unless (f rq) mzero
 
 -- | Guard against the method.  This function also guards against
 -- any remaining path segments.  See methodOnly for the version
@@ -814,19 +868,15 @@
         rq <- askRq
         case rqPaths rq of
             (p:xs) | p == staticPath -> localRq (\newRq -> newRq{rqPaths = xs}) handle
-                   | otherwise -> mzero
             _ -> mzero
 
--- | Pop a path element and parse it.  Annoyingly enough, rather than just using Read
--- (or providing a parser argument), this method uses 'FromReqURI' which is just a wrapper
--- for Read.
+-- | Pop a path element and parse it using the 'fromReqURI' in the 'FromReqURI' class.
 path :: (FromReqURI a, MonadPlus m, ServerMonad m) => (a -> m b) -> m b
 path handle = do
     rq <- askRq
     case rqPaths rq of
         (p:xs) | Just a <- fromReqURI p
                             -> localRq (\newRq -> newRq{rqPaths = xs}) (handle a)
-               | otherwise -> mzero
         _ -> mzero
 
 -- | grabs the rest of the URL (dirs + query) and passes it to your handler
@@ -892,11 +942,7 @@
 -- | withDataFn is like with data, but you pass in a RqData monad
 -- for reading.
 withDataFn :: (MonadPlus m, ServerMonad m) => RqData a -> (a -> m r) -> m r
-withDataFn fn handle = do
-    d <- getDataFn fn
-    case d of
-        Nothing -> mzero
-        Just a -> handle a
+withDataFn fn handle = getDataFn fn >>= maybe mzero handle
 
 -- | proxyServe is for creating ServerPartT's that proxy.
 -- The sole argument [String] is a list of allowed domains for
@@ -923,7 +969,7 @@
      | superdomain `elem` wildcards =True
      | otherwise = False
      where
-     domain = head (rqPaths rq) 
+     domain = head (rqPaths rq)
      superdomain = tail $ snd $ break (=='.') domain
      wildcards = (map (drop 2) $ filter ("*." `isPrefixOf`) allowed)
 
@@ -980,9 +1026,9 @@
 
 doXslt :: (MonadIO m) =>
           XSLTCmd -> XSLPath -> Response -> m Response
-doXslt cmd xslPath res = 
+doXslt cmd xslPath res =
     do new <- liftIO $ procLBSIO cmd xslPath $ rsBody res
-       return $ setHeader "Content-Type" "text/html" $ 
+       return $ setHeader "Content-Type" "text/html" $
               setHeader "Content-Length" (show $ L.length new) $
               res { rsBody = new }
 
@@ -1012,9 +1058,11 @@
 ok :: (FilterMonad Response m) => a -> m a
 ok = resp 200
 
+-- | Respond with @500 Interal Server Error@
 internalServerError :: (FilterMonad Response m) => a -> m a
 internalServerError = resp 500
 
+-- | Responds with @502 Bad Gateway@
 badGateway :: (FilterMonad Response m) => a -> m a
 badGateway = resp 502
 
@@ -1072,7 +1120,7 @@
 anyRequest x = withRequest $ \_ -> x
 
 -- | again, why is this useful?
-applyRequest :: (ToMessage a, Monad m) =>
+applyRequest :: (ToMessage a, Monad m, Functor m) =>
                 ServerPartT m a -> Request -> Either (m Response) b
 applyRequest hs = simpleHTTP'' hs >>= return . Left
 
@@ -1120,7 +1168,7 @@
 
 -- | Gets the named input as a String
 look :: String -> RqData String
-look = fmap L.unpack . lookBS
+look = fmap LU.toString . lookBS
 
 -- | Gets the named cookie
 -- the cookie name is case insensitive
@@ -1145,7 +1193,7 @@
 
 -- | gets all the input parameters, and converts them to a string
 lookPairs :: RqData [(String,String)]
-lookPairs = asks fst >>= return . map (\(n,vbs)->(n,L.unpack $ inputValue vbs))
+lookPairs = asks fst >>= return . map (\(n,vbs)->(n,LU.toString $ inputValue vbs))
 
 
 --------------------------------------------------------------
@@ -1157,7 +1205,7 @@
 --
 --   You can wrap the complete second argument to 'simpleHTTP' in this function.
 --
-errorHandlerSP :: (Monad m, Error e) => (Request -> e -> WebT m a) -> ServerPartT (ErrorT e m) a -> ServerPartT m a 
+errorHandlerSP :: (Monad m, Error e) => (Request -> e -> WebT m a) -> ServerPartT (ErrorT e m) a -> ServerPartT m a
 errorHandlerSP handler sps = withRequest $ \req -> mkWebT $ do
 			eer <- runErrorT $ ununWebT $ runServerPartT sps req
 			case eer of
@@ -1179,18 +1227,17 @@
 -- that monad into a ServerPartT m a.  Used with
 -- mapServerPartT\' to allow throwError and catchError inside your
 -- monad.  Eg.
--- 
+--
 -- @
 --   simpleHTTP conf $ mapServerPartT\' (spUnWrapErrorT failurePart)  $ myPart \`catchError\` errorPart
 -- @
--- 
+--
 -- Note that @failurePart@ will only be run if errorPart threw an error
 -- so it doesn\'t have to be very complex.
-spUnwrapErrorT:: Monad m =>
-        (e -> ServerPartT m a)
-        -> Request
-        -> ErrorT e m (Maybe (Either Response a, FilterFun Response))
-        -> m (Maybe (Either Response a, FilterFun Response))
+spUnwrapErrorT:: Monad m => (e -> ServerPartT m a)
+              -> Request
+              -> UnWebT (ErrorT e m) a
+              -> UnWebT m a
 spUnwrapErrorT handler rq = \x -> do
     err <- runErrorT x
     case err of
@@ -1245,9 +1292,9 @@
 validateConf = nullConf { validator = Just wdgHTMLValidator }
 
 -- |Actually perform the validation on a 'Response'
--- 
+--
 -- Run the validator specified in the 'Response'. If none is provide
--- use the supplied default instead. 
+-- use the supplied default instead.
 --
 -- Note: This function will run validation unconditionally. You
 -- probably want 'setValidator' or 'validateConf'.
@@ -1278,7 +1325,7 @@
 noopValidator = return
 
 -- |Validate the 'Response' using an external application.
--- 
+--
 -- If the external application returns 0, the original response is
 -- returned unmodified. If the external application returns non-zero, a 'Response'
 -- containing the error messages and original response body is
@@ -1290,7 +1337,7 @@
 --
 -- NOTE: This function requirse the use of -threaded to avoid blocking.
 -- However, you probably need that for Happstack anyway.
--- 
+--
 -- See also: 'wdgHTMLValidator'
 lazyProcValidator :: FilePath -- ^ name of executable
                -> [String] -- ^ arguements to pass to the executable
@@ -1311,14 +1358,14 @@
            ec <- waitForProcess ph
            case ec of
              ExitSuccess     -> return response
-             (ExitFailure _) -> 
+             (ExitFailure _) ->
                  return $ toResponse (unlines ([ "ExitCode: " ++ show ec
                                                , "stdout:"
                                                , out
                                                , "stderr:"
                                                , err
                                                , "input:"
-                                               ] ++ 
+                                               ] ++
                                                showLines (rsBody response)))
     | otherwise = return response
     where
@@ -1335,21 +1382,37 @@
     finishWith $ res
 
 failHtml:: String->String
-failHtml errString = "<html><head><title>Happstack "
-    ++ ver ++ " Internal Server Error</title>"
+failHtml errString = 
+   "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"
+    ++ "<html><head><title>Happstack "
+    ++ ver ++ " Internal Server Error</title></head>"
     ++ "<body><h1>Happstack " ++ ver ++ "</h1>"
-    ++ "<p>Something went wrong here<br />"
-    ++ "Internal server error<br />"
+    ++ "<p>Something went wrong here<br>"
+    ++ "Internal server error<br>"
     ++ "Everything has stopped</p>"
-    ++ "<p>The error was \"" ++ errString ++ "\"</p></body></html>"
+    ++ "<p>The error was \"" ++ (escapeString errString) ++ "\"</p></body></html>"
     where ver = DV.showVersion Cabal.version
 
+escapeString :: String -> String
+escapeString str = concatMap encodeEntity str
+    where
+      encodeEntity :: Char -> String
+      encodeEntity '<' = "&lt;"
+      encodeEntity '>' = "&gt;"
+      encodeEntity '&' = "&amp;"
+      encodeEntity '"' = "&quot;"
+      encodeEntity c
+          | ord c > 127 = "&#" ++ show (ord c) ++ ";"
+          | otherwise = [c]
+
 notFoundHtml :: String
-notFoundHtml = "<html><head><title>Happstack "
-    ++ ver ++ " File not found</title>"
+notFoundHtml = 
+    "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"
+    ++ "<html><head><title>Happstack "
+    ++ ver ++ " File not found</title></head>"
     ++ "<body><h1>Happstack " ++ ver ++ "</h1>"
-    ++ "<p>Your file is not found<br />"
-    ++ "To try again is useless<br />"
+    ++ "<p>Your file is not found<br>"
+    ++ "To try again is useless<br>"
     ++ "It is just not here</p>"
     ++ "</body></html>"
     where ver = DV.showVersion Cabal.version