diff --git a/ImplantFile.hs b/ImplantFile.hs
--- a/ImplantFile.hs
+++ b/ImplantFile.hs
@@ -78,11 +78,11 @@
 main = withOpenSSL $
        do (opts, sources, errors) <- return . getOpt Permute options =<< getArgs
 
-          when (not $ null errors)
+          unless (null errors)
                    $ do mapM_ putStr errors
                         exitWith $ ExitFailure 1
 
-          when (any (\ x -> x == OptHelp) opts)
+          when (any (== OptHelp) opts)
                    $ do printUsage
                         exitWith ExitSuccess
 
@@ -106,7 +106,7 @@
          output   <- openOutput opts
          eTag     <- getETag opts input
 
-         let compParams  = defaultCompressParams { compressLevel = BestCompression }
+         let compParams  = defaultCompressParams { compressLevel = bestCompression }
              gzippedData = compressWith compParams input
              originalLen = L.length input
              gzippedLen  = L.length gzippedData
@@ -371,12 +371,12 @@
                                             _            -> False) opts
           -- モジュール名をピリオドで分割した時の最後の項目の先頭文字を
           -- 小文字にしたものを使ふ。
-          defaultSymName = mkDefault modName
-          mkDefault      = headToLower . getLastComp
-          headToLower    = \ str -> case str of
-                                      []     -> error "module name must not be empty"
-                                      (x:xs) -> toLower x : xs
-          getLastComp    = reverse . fst . break (== '.') . reverse
+          defaultSymName  = mkDefault modName
+          mkDefault       = headToLower . getLastComp
+          headToLower str = case str of
+                              []     -> error "module name must not be empty"
+                              (x:xs) -> toLower x : xs
+          getLastComp     = reverse . fst . break (== '.') . reverse
       in
         case symNameOpts of
           []                      -> return defaultSymName
@@ -400,8 +400,8 @@
 
 getLastModified :: FilePath -> IO UTCTime
 getLastModified "-"   = getCurrentTime
-getLastModified fpath = getFileStatus fpath
-                        >>= return . posixSecondsToUTCTime . fromRational . toRational . modificationTime
+getLastModified fpath = fmap (posixSecondsToUTCTime . fromRational . toRational . modificationTime)
+                        $ getFileStatus fpath
 
 
 getETag :: [CmdOpt] -> Lazy.ByteString -> IO String
@@ -411,25 +411,26 @@
                                       _         -> False) opts
       in
         case eTagOpts of
-          []               -> getDigestByName "SHA1" >>= return . mkETagFromInput . fromJust
+          []               -> fmap (mkETagFromInput . fromJust) (getDigestByName "SHA1")
           (OptETag str):[] -> return str
           _                -> error "too many --etag options."
     where
       mkETagFromInput :: Digest -> String
-      mkETagFromInput sha1 = "SHA-1:" ++ (toHex $ digestLBS sha1 input)
+      mkETagFromInput sha1 = "SHA-1:" ++ toHex (digestLBS sha1 input)
 
-      toHex :: [Char] -> String
-      toHex []     = ""
-      toHex (x:xs) = hexByte (fromEnum x) ++ toHex xs
+      toHex :: String -> String
+      toHex = foldr ((++) . hexByte . fromEnum) ""
 
       hexByte :: Int -> String
       hexByte n
-          = hex4bit ((n `shiftR` 4) .&. 0x0F) : hex4bit (n .&. 0x0F) : []
+          = [ hex4bit ((n `shiftR` 4) .&. 0x0F)
+            , hex4bit ( n             .&. 0x0F)
+            ]
 
       hex4bit :: Int -> Char
       hex4bit n
-          | n < 10    = (chr $ ord '0' + n     )
-          | n < 16    = (chr $ ord 'a' + n - 10)
+          | n < 10    = chr $ ord '0' + n
+          | n < 16    = chr $ ord 'a' + n - 10
           | otherwise = undefined
 
 
diff --git a/Lucu.cabal b/Lucu.cabal
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -8,7 +8,7 @@
         messing around FastCGI. It is also intended to be run behind a
         reverse-proxy so it doesn't have some facilities like logging,
         client filtering or such like.
-Version: 0.4
+Version: 0.4.1
 License: PublicDomain
 License-File: COPYING
 Author: PHO <pho at cielonegro dot org>
@@ -44,8 +44,9 @@
 Library
     Build-Depends:
         HsOpenSSL, base >= 4 && < 5, bytestring, containers, dataenc,
-        directory, haskell-src, hxt, mtl, network, stm, time, unix,
-        zlib
+        filepath, directory, haskell-src, hxt, mtl, network, stm,
+        time, unix, zlib
+
     Exposed-Modules:
         Network.HTTP.Lucu
         Network.HTTP.Lucu.Abortion
@@ -66,6 +67,7 @@
         Network.HTTP.Lucu.Response
         Network.HTTP.Lucu.StaticFile
         Network.HTTP.Lucu.Utils
+
     Other-Modules:
         Network.HTTP.Lucu.Chunk
         Network.HTTP.Lucu.ContentCoding
@@ -79,8 +81,10 @@
         Network.HTTP.Lucu.Preprocess
         Network.HTTP.Lucu.RequestReader
         Network.HTTP.Lucu.ResponseWriter
+
     Extensions:
         BangPatterns, DeriveDataTypeable, ScopedTypeVariables, UnboxedTuples
+
     ghc-options:
         -Wall
         -funbox-strict-fields
@@ -90,9 +94,12 @@
         Buildable: True
     else
         Buildable: False
+
     Main-Is: ImplantFile.hs
+
     Extensions:
         BangPatterns, ScopedTypeVariables, UnboxedTuples
+
     ghc-options:
         -Wall
         -funbox-strict-fields
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,24 @@
+Changes from 0.4 to 0.4.1
+-------------------------
+* Network.HTTP.Lucu.Resource: (Thanks: Voker57)
+
+    - getPathInfo now un-escapes the resulting path info. This may
+      break backward compatibility in very confusing way, if your code
+      relies on the previous implementation. Sorry for any
+      inconvenience.
+
+* Network.HTTP.Lucu.Resource.Tree: (Thanks: Voker57)
+
+    - Fix: mkResTree wasn't working correctly for a resource path
+           [""], which should be treated as same as [] the root.
+
+    - Fix: Greedy resources on the root of resource tree wasn't really
+           greedy.
+
+* Network.HTTP.Lucu.Resource.Tree:
+
+    - New constant: emptyResource
+
 Changes from 0.3.3 to 0.4
 -------------------------
 * Network.HTTP.Lucu.Resource: (Thanks: Voker57)
diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs
--- a/Network/HTTP/Lucu.hs
+++ b/Network/HTTP/Lucu.hs
@@ -43,6 +43,7 @@
 
       -- * Resource Tree
     , ResourceDef(..)
+    , emptyResource
     , ResTree
     , mkResTree
 
diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -109,7 +109,6 @@
         Nothing
             -> let res'  = res { resStatus = aboStatus abo }
                    res'' = foldl (.) id [setHeader name value
-                                             | (name, value) <- fromHeaders $ aboHeaders abo]
-                           $ res'
+                                             | (name, value) <- fromHeaders $ aboHeaders abo] res'
                in
                  getDefaultPage conf reqM res''
diff --git a/Network/HTTP/Lucu/ContentCoding.hs b/Network/HTTP/Lucu/ContentCoding.hs
--- a/Network/HTTP/Lucu/ContentCoding.hs
+++ b/Network/HTTP/Lucu/ContentCoding.hs
@@ -7,6 +7,7 @@
     where
 
 import           Data.Char
+import           Data.Ord
 import           Data.Maybe
 import           Network.HTTP.Lucu.Parser
 import           Network.HTTP.Lucu.Parser.Http
@@ -43,4 +44,5 @@
 
 orderAcceptEncodings :: (String, Maybe Double) -> (String, Maybe Double) -> Ordering
 orderAcceptEncodings (_, q1) (_, q2)
-    = fromMaybe 0 q1 `compare` fromMaybe 0 q2
+    = comparing (fromMaybe 0) q1 q2
+
diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -29,9 +29,8 @@
 
 
 getDefaultPage :: Config -> Maybe Request -> Response -> String
-getDefaultPage conf req res
-    = conf `seq` req `seq` res `seq`
-      let msgA = getMsg req res
+getDefaultPage !conf !req !res
+    = let msgA = getMsg req res
       in
         unsafePerformIO $
         do [xmlStr] <- runX ( mkDefaultPage conf (resStatus res) msgA
@@ -42,10 +41,9 @@
 
 
 writeDefaultPage :: Interaction -> STM ()
-writeDefaultPage itr
-    = itr `seq`
-      -- Content-Type が正しくなければ補完できない。
-      do res <- readItr itr itrResponse id
+writeDefaultPage !itr
+    -- Content-Type が正しくなければ補完できない。
+    = do res <- readItr itr itrResponse id
          when (getHeader (C8.pack "Content-Type") res == Just defaultPageContentType)
                   $ do reqM <- readItr itr itrRequest id
 
@@ -57,9 +55,8 @@
 
 
 mkDefaultPage :: (ArrowXml a) => Config -> StatusCode -> a b XmlTree -> a b XmlTree
-mkDefaultPage conf status msgA
-    = conf `seq` status `seq` msgA `seq`
-      let (# sCode, sMsg #) = statusCode status
+mkDefaultPage !conf !status !msgA
+    = let (# sCode, sMsg #) = statusCode status
           sig               = C8.unpack (cnfServerSoftware conf)
                               ++ " at "
                               ++ C8.unpack (cnfServerHost conf)
@@ -85,9 +82,8 @@
 {-# SPECIALIZE mkDefaultPage :: Config -> StatusCode -> IOSArrow b XmlTree -> IOSArrow b XmlTree #-}
 
 getMsg :: (ArrowXml a) => Maybe Request -> Response -> a b XmlTree
-getMsg req res
-    = req `seq` res `seq`
-      case resStatus res of
+getMsg !req !res
+    = case resStatus res of
         -- 1xx は body を持たない
         -- 2xx の body は補完しない
 
diff --git a/Network/HTTP/Lucu/Format.hs b/Network/HTTP/Lucu/Format.hs
--- a/Network/HTTP/Lucu/Format.hs
+++ b/Network/HTTP/Lucu/Format.hs
@@ -24,7 +24,7 @@
     where
       fmt' :: Int -> String
       fmt' m
-          | m < base  = (intToChar upperCase m) : []
+          | m < base  = [intToChar upperCase m]
           | otherwise = (intToChar upperCase $! m `mod` base) : fmt' (m `div` base)
 
 
@@ -40,50 +40,54 @@
 fmtDec2 :: Int -> String
 fmtDec2 n
     | n < 0 || n >= 100 = fmtInt 10 undefined 2 '0' False n -- fallback
-    | n < 10            =   '0'
-                          : intToChar undefined n
-                          : []
-    | otherwise         =   intToChar undefined (n `div` 10)
-                          : intToChar undefined (n `mod` 10)
-                          : []
+    | n < 10            = [ '0'
+                          , intToChar undefined n
+                          ]
+    | otherwise         = [ intToChar undefined (n `div` 10)
+                          , intToChar undefined (n `mod` 10)
+                          ]
 
 
 fmtDec3 :: Int -> String
 fmtDec3 n
     | n < 0 || n >= 1000 = fmtInt 10 undefined 3 '0' False n -- fallback
-    | n < 10             = '0' : '0'
-                           : intToChar undefined n
-                           : []
-    | n < 100            = '0'
-                           : intToChar undefined ((n `div` 10) `mod` 10)
-                           : intToChar undefined ( n           `mod` 10)
-                           : []
-    | otherwise          =   intToChar undefined ((n `div` 100) `mod` 10)
-                           : intToChar undefined ((n `div`  10) `mod` 10)
-                           : intToChar undefined ( n            `mod` 10)
-                           : []
+    | n < 10             = [ '0'
+                           , '0'
+                           , intToChar undefined n
+                           ]
+    | n < 100            = [ '0'
+                           , intToChar undefined ((n `div` 10) `mod` 10)
+                           , intToChar undefined ( n           `mod` 10)
+                           ]
+    | otherwise          = [ intToChar undefined ((n `div` 100) `mod` 10)
+                           , intToChar undefined ((n `div`  10) `mod` 10)
+                           , intToChar undefined ( n            `mod` 10)
+                           ]
 
 
 fmtDec4 :: Int -> String
 fmtDec4 n
     | n < 0 || n >= 10000 = fmtInt 10 undefined 4 '0' False n -- fallback
-    | n < 10              =   '0' : '0' : '0'
-                            : intToChar undefined n
-                            : []
-    | n < 100             =   '0' : '0'
-                            : intToChar undefined ((n `div` 10) `mod` 10)
-                            : intToChar undefined ( n           `mod` 10)
-                            : []
-    | n < 1000            =   '0'
-                            : intToChar undefined ((n `div` 100) `mod` 10)
-                            : intToChar undefined ((n `div`  10) `mod` 10)
-                            : intToChar undefined ( n            `mod` 10)
-                            : []
-    | otherwise           =   intToChar undefined ((n `div` 1000) `mod` 10)
-                            : intToChar undefined ((n `div`  100) `mod` 10)
-                            : intToChar undefined ((n `div`   10) `mod` 10)
-                            : intToChar undefined ( n             `mod` 10)
-                            : []
+    | n < 10              = [ '0'
+                            , '0'
+                            , '0'
+                            , intToChar undefined n
+                            ]
+    | n < 100             = [ '0'
+                            , '0'
+                            , intToChar undefined ((n `div` 10) `mod` 10)
+                            , intToChar undefined ( n           `mod` 10)
+                            ]
+    | n < 1000            = [ '0'
+                            , intToChar undefined ((n `div` 100) `mod` 10)
+                            , intToChar undefined ((n `div`  10) `mod` 10)
+                            , intToChar undefined ( n            `mod` 10)
+                            ]
+    | otherwise           = [ intToChar undefined ((n `div` 1000) `mod` 10)
+                            , intToChar undefined ((n `div`  100) `mod` 10)
+                            , intToChar undefined ((n `div`   10) `mod` 10)
+                            , intToChar undefined ( n             `mod` 10)
+                            ]
 
 
 fmtHex :: Bool -> Int -> Int -> String
diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -21,6 +21,7 @@
 import           Data.List
 import           Data.Map (Map)
 import qualified Data.Map as M
+import           Data.Ord
 import           Data.Word
 import           Foreign.ForeignPtr
 import           Foreign.Ptr
@@ -76,7 +77,7 @@
     | otherwise
         = do c1 <- peek p1
              c2 <- peek p2
-             case toLower (w2c c1) `compare` toLower (w2c c2) of
+             case comparing (toLower . w2c) c1 c2 of
                EQ -> noCaseCmp' (p1 `plusPtr` 1) (l1 - 1) (p2 `plusPtr` 1) (l2 - 1)
                x  -> return x
 
@@ -194,7 +195,7 @@
       normalize :: String -> String
       normalize = trimBody . trim isWhiteSpace
 
-      trimBody = foldr (++) []
+      trimBody = concat
                  . map (\ s -> if head s == ' ' then
                                    " "
                                else
diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -84,8 +84,8 @@
 
 newInteraction :: Config -> SockAddr -> Maybe X509 -> Maybe Request -> IO Interaction
 newInteraction !conf !addr !cert !req
-    = do request  <- newTVarIO $ req
-         responce <- newTVarIO $ Response {
+    = do request  <- newTVarIO req
+         responce <- newTVarIO Response {
                        resVersion = HttpVersion 1 1
                      , resStatus  = Ok
                      , resHeaders = toHeaders [(C8.pack "Content-Type", defaultPageContentType)]
@@ -115,7 +115,7 @@
          wroteContinue <- newTVarIO False
          wroteHeader   <- newTVarIO False
 
-         return $ Interaction {
+         return Interaction {
                       itrConfig       = conf
                     , itrRemoteAddr   = addr
                     , itrRemoteCert   = cert
@@ -150,33 +150,28 @@
 
 
 writeItr :: Interaction -> (Interaction -> TVar a) -> a -> STM ()
-writeItr itr accessor value
-    = itr `seq` accessor `seq` value `seq`
-      writeTVar (accessor itr) value
+writeItr !itr !accessor !value
+    = writeTVar (accessor itr) value
 
 
 readItr :: Interaction -> (Interaction -> TVar a) -> (a -> b) -> STM b
-readItr itr accessor reader
-    = itr `seq` accessor `seq` reader `seq`
-      readTVar (accessor itr) >>= return . reader
+readItr !itr !accessor !reader
+    = fmap reader $ readTVar (accessor itr)
 
 
 readItrF :: Functor f => Interaction -> (Interaction -> TVar (f a)) -> (a -> b) -> STM (f b)
-readItrF itr accessor reader
-    = itr `seq` accessor `seq` reader `seq`
-      readItr itr accessor (fmap reader)
+readItrF !itr !accessor !reader
+    = readItr itr accessor (fmap reader)
 {-# SPECIALIZE readItrF :: Interaction -> (Interaction -> TVar (Maybe a)) -> (a -> b) -> STM (Maybe b) #-}
 
 
 updateItr :: Interaction -> (Interaction -> TVar a) -> (a -> a) -> STM ()
-updateItr itr accessor updator
-    = itr `seq` accessor `seq` updator `seq`
-      do old <- readItr itr accessor id
+updateItr !itr !accessor !updator
+    = do old <- readItr itr accessor id
          writeItr itr accessor (updator old)
 
 
 updateItrF :: Functor f => Interaction -> (Interaction -> TVar (f a)) -> (a -> a) -> STM ()
-updateItrF itr accessor updator
-    = itr `seq` accessor `seq` updator `seq`
-      updateItr itr accessor (fmap updator)
+updateItrF !itr !accessor !updator
+    = updateItr itr accessor (fmap updator)
 {-# SPECIALIZE updateItrF :: Interaction -> (Interaction -> TVar (Maybe a)) -> (a -> a) -> STM () #-}
diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs
--- a/Network/HTTP/Lucu/Parser.hs
+++ b/Network/HTTP/Lucu/Parser.hs
@@ -93,6 +93,9 @@
     return !x = Parser $! return $! Success x
     fail _    = Parser $! return $! IllegalInput
 
+instance Functor Parser where
+    fmap f p = p >>= return . f
+
 -- |@'failP'@ is just a synonym for @'Prelude.fail'
 -- 'Prelude.undefined'@.
 failP :: Parser a
diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs
--- a/Network/HTTP/Lucu/Parser/Http.hs
+++ b/Network/HTTP/Lucu/Parser/Http.hs
@@ -87,7 +87,7 @@
 
 -- |'text' accepts one character which doesn't satisfy 'isCtl'.
 text :: Parser Char
-text = satisfy (\ c -> not (isCtl c))
+text = satisfy (not . isCtl)
 
 -- |'separator' accepts one character which satisfies 'isSeparator'.
 separator :: Parser Char
diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs
--- a/Network/HTTP/Lucu/Postprocess.hs
+++ b/Network/HTTP/Lucu/Postprocess.hs
@@ -56,13 +56,12 @@
 -}
 
 postprocess :: Interaction -> STM ()
-postprocess itr
-    = itr `seq`
-      do reqM <- readItr itr itrRequest id
+postprocess !itr
+    = do reqM <- readItr itr itrRequest id
          res  <- readItr itr itrResponse id
          let sc = resStatus res
 
-         when (not $ any (\ p -> p sc) [isSuccessful, isRedirection, isError])
+         unless (any (\ p -> p sc) [isSuccessful, isRedirection, isError])
                   $ abortSTM InternalServerError []
                         $ Just ("The status code is not good for a final status: "
                                 ++ show sc)
@@ -119,10 +118,8 @@
                conn <- readHeader (C8.pack "Connection")
                case conn of
                  Nothing    -> return ()
-                 Just value -> if value `noCaseEq` C8.pack "close" then
-                                   writeItr itr itrWillClose True
-                               else
-                                   return ()
+                 Just value -> when (value `noCaseEq` C8.pack "close")
+                                   $ writeItr itr itrWillClose True
 
                willClose <- readItr itr itrWillClose id
                when willClose
@@ -132,20 +129,17 @@
                         $ writeTVar (itrWillDiscardBody itr) True
 
       readHeader :: Strict.ByteString -> STM (Maybe Strict.ByteString)
-      readHeader name
-          = name `seq`
-            readItr itr itrResponse $ getHeader name
+      readHeader !name
+          = readItr itr itrResponse $ getHeader name
 
       updateRes :: (Response -> Response) -> STM ()
-      updateRes updator 
-          = updator `seq`
-            updateItr itr itrResponse updator
+      updateRes !updator 
+          = updateItr itr itrResponse updator
 
 
 completeUnconditionalHeaders :: Config -> Response -> IO Response
-completeUnconditionalHeaders conf res
-    = conf `seq` res `seq`
-      return res >>= compServer >>= compDate >>= return
+completeUnconditionalHeaders !conf !res
+    = compServer res >>= compDate
       where
         compServer res'
             = case getHeader (C8.pack "Server") res' of
@@ -177,7 +171,6 @@
     where
       mostlyEq :: UTCTime -> UTCTime -> Bool
       mostlyEq a b
-          = if utctDay a == utctDay b then
-                fromEnum (utctDayTime a) == fromEnum (utctDayTime b)
-            else
-                False
+          = (utctDay a == utctDay b)
+            &&
+            (fromEnum (utctDayTime a) == fromEnum (utctDayTime b))
diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -100,7 +100,7 @@
                          portStr
                               = case port of
                                   Just 80 -> Just ""
-                                  Just n  -> Just $ ":" ++ show n
+                                  Just n  -> Just $ ':' : show n
                                   Nothing -> Nothing
                      case portStr of
                        Just str -> updateAuthority host (C8.pack str)
@@ -110,10 +110,10 @@
                        -- いと思ふ。stderr？
                        Nothing  -> setStatus InternalServerError
               else
-                  do case getHeader (C8.pack "Host") req of
-                       Just str -> let (host, portStr) = parseHost str
-                                   in updateAuthority host portStr
-                       Nothing  -> setStatus BadRequest
+                  case getHeader (C8.pack "Host") req of
+                    Just str -> let (host, portStr) = parseHost str
+                                in updateAuthority host portStr
+                    Nothing  -> setStatus BadRequest
 
 
       parseHost :: Strict.ByteString -> (Strict.ByteString, Strict.ByteString)
@@ -148,13 +148,11 @@
 
                case getHeader (C8.pack "Transfer-Encoding") req of
                  Nothing    -> return ()
-                 Just value -> if value `noCaseEq` C8.pack "identity" then
-                                   return ()
-                               else
-                                   if value `noCaseEq` C8.pack "chunked" then
-                                       writeItr itr itrRequestIsChunked True
-                                   else
-                                       setStatus NotImplemented
+                 Just value -> unless (value `noCaseEq` C8.pack "identity")
+                                   $ if value `noCaseEq` C8.pack "chunked" then
+                                         writeItr itr itrRequestIsChunked True
+                                     else
+                                         setStatus NotImplemented
 
                case getHeader (C8.pack "Content-Length") req of
                  Nothing    -> return ()
@@ -167,7 +165,5 @@
 
                case getHeader (C8.pack "Connection") req of
                  Nothing    -> return ()
-                 Just value -> if value `noCaseEq` C8.pack "close" then
-                                   writeItr itr itrWillClose True
-                               else
-                                   return ()
+                 Just value -> when (value `noCaseEq` C8.pack "close")
+                                   $ writeItr itr itrWillClose True
diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs
--- a/Network/HTTP/Lucu/Request.hs
+++ b/Network/HTTP/Lucu/Request.hs
@@ -67,19 +67,19 @@
 
 
 methodP :: Parser Method
-methodP = (let methods = [ ("OPTIONS", OPTIONS)
-                         , ("GET"    , GET    )
-                         , ("HEAD"   , HEAD   )
-                         , ("POST"   , POST   )
-                         , ("PUT"    , PUT    )
-                         , ("DELETE" , DELETE )
-                         , ("TRACE"  , TRACE  )
-                         , ("CONNECT", CONNECT)
-                         ]
-           in foldl (<|>) failP $ map (\ (str, mth)
-                                           -> string str >> return mth) methods)
+methodP = ( let methods = [ ("OPTIONS", OPTIONS)
+                          , ("GET"    , GET    )
+                          , ("HEAD"   , HEAD   )
+                          , ("POST"   , POST   )
+                          , ("PUT"    , PUT    )
+                          , ("DELETE" , DELETE )
+                          , ("TRACE"  , TRACE  )
+                          , ("CONNECT", CONNECT)
+                          ]
+            in choice $ map (\ (str, mth)
+                                 -> string str >> return mth) methods )
           <|>
-          token >>= return . ExtensionMethod
+          fmap ExtensionMethod token
 
 
 uriP :: Parser URI
diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -60,7 +60,7 @@
 
 module Network.HTTP.Lucu.Resource
     (
-    -- * Monad
+    -- * Types
       Resource
     , FormData(..)
     , runRes -- private
@@ -285,14 +285,15 @@
                      return $! fromJust $! itrResourcePath itr
 
 
--- |This is an analogy of CGI PATH_INFO. Its result is always @[]@ if
--- the 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is not
--- greedy. See 'getResourcePath'.
+-- |This is an analogy of CGI PATH_INFO. The result is
+-- URI-unescaped. It is always @[]@ if the
+-- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is not greedy. See
+-- 'getResourcePath'.
 getPathInfo :: Resource [String]
 getPathInfo = do rsrcPath <- getResourcePath
                  uri      <- getRequestURI
                  let reqPathStr = uriPath uri
-                     reqPath    = [x | x <- splitBy (== '/') reqPathStr, x /= ""]
+                     reqPath    = [unEscapeString x | x <- splitBy (== '/') reqPathStr, x /= ""]
                  -- rsrcPath と reqPath の共通する先頭部分を reqPath か
                  -- ら全部取り除くと、それは PATH_INFO のやうなものにな
                  -- る。rsrcPath は全部一致してゐるに決まってゐる（でな
diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
--- a/Network/HTTP/Lucu/Resource/Tree.hs
+++ b/Network/HTTP/Lucu/Resource/Tree.hs
@@ -3,6 +3,8 @@
 -- | Repository of the resources in httpd.
 module Network.HTTP.Lucu.Resource.Tree
     ( ResourceDef(..)
+    , emptyResource
+
     , ResTree
     , FallbackHandler
 
@@ -13,6 +15,7 @@
     )
     where
 
+import           Control.Arrow
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
@@ -98,11 +101,37 @@
     , resDelete           :: !(Maybe (Resource ()))
     }
 
+-- |'emptyResource' is a resource definition with no actual
+-- handlers. You can construct a 'ResourceDef' by selectively
+-- overriding 'emptyResource'. It is defined as follows:
+--
+-- @
+--   emptyResource = ResourceDef {
+--                     resUsesNativeThread = False
+--                   , resIsGreedy         = False
+--                   , resGet              = Nothing
+--                   , resHead             = Nothing
+--                   , resPost             = Nothing
+--                   , resPut              = Nothing
+--                   , resDelete           = Nothing
+--                   }
+-- @
+emptyResource :: ResourceDef
+emptyResource = ResourceDef {
+                  resUsesNativeThread = False
+                , resIsGreedy         = False
+                , resGet              = Nothing
+                , resHead             = Nothing
+                , resPost             = Nothing
+                , resPut              = Nothing
+                , resDelete           = Nothing
+                }
+
 -- |'ResTree' is an opaque structure which is a map from resource path
 -- to 'ResourceDef'.
 newtype ResTree = ResTree ResNode -- root だから Map ではない
 type ResSubtree = Map String ResNode
-data ResNode    = ResNode !(Maybe ResourceDef) !ResSubtree
+data ResNode    = ResNode (Maybe ResourceDef) ResSubtree
 
 -- |'mkResTree' converts a list of @(path, def)@ to a 'ResTree' e.g.
 --
@@ -112,18 +141,22 @@
 --             ]
 -- @
 mkResTree :: [ ([String], ResourceDef) ] -> ResTree
-mkResTree xs = xs `seq` processRoot xs
+mkResTree = processRoot . map (first canonicalisePath)
     where
+      canonicalisePath :: [String] -> [String]
+      canonicalisePath = filter (/= "")
+
       processRoot :: [ ([String], ResourceDef) ] -> ResTree
       processRoot list
           = let (roots, nonRoots) = partition (\ (path, _) -> path == []) list
                 children = processNonRoot nonRoots
             in
               if null roots then
-                  -- "/" にリソースが定義されない。"/foo" とかにはあるかも。
+                  -- The root has no resources. Maybe there's one at
+                  -- somewhere like "/foo".
                   ResTree (ResNode Nothing children)
               else
-                  -- "/" がある。
+                  -- There is a root resource.
                   let (_, def) = last roots
                   in 
                     ResTree (ResNode (Just def) children)
@@ -136,27 +169,31 @@
                 node name  = let defs = [def | (path, def) <- list, path == [name]]
                              in
                                if null defs then
-                                   -- この位置にリソースが定義されない。
-                                   -- もっと下にはあるかも。
+                                   -- No resources are defined
+                                   -- here. Maybe there's one at
+                                   -- somewhere below this node.
                                    ResNode Nothing children
                                else
-                                   -- この位置にリソースがある。
+                                   -- There is a resource here.
                                    ResNode (Just $ last defs) children
                 children   = processNonRoot [(path, def)
-                                                 | (_:path, def) <- list, not (null path)]
+                                                 | (_:path, def) <- list]
             in
               subtree
 
 
 findResource :: ResTree -> [FallbackHandler] -> URI -> IO (Maybe ([String], ResourceDef))
 findResource (ResTree (ResNode rootDefM subtree)) fbs uri
-    = do let pathStr     = uriPath uri
-             path        = [x | x <- splitBy (== '/') pathStr, x /= ""]
-             foundInTree = if null path then
-                               do def <- rootDefM
-                                  return (path, def)
-                           else
-                               walkTree subtree path []
+    = do let pathStr        = uriPath uri
+             path           = [unEscapeString x | x <- splitBy (== '/') pathStr, x /= ""]
+             haveGreedyRoot = case rootDefM of
+                                Just def -> resIsGreedy def
+                                Nothing  -> False
+             foundInTree    = if haveGreedyRoot || null path then
+                                  do def <- rootDefM
+                                     return ([], def)
+                              else
+                                  walkTree subtree path []
          if isJust foundInTree then
              return foundInTree
            else
@@ -199,10 +236,10 @@
                              driftTo Done
                         ) itr
                )
-             $ \ exc -> processException exc
+               processException
     where
       fork :: IO () -> IO ThreadId
-      fork = if (resUsesNativeThread def)
+      fork = if resUsesNativeThread def
              then forkOS
              else forkIO
       
@@ -223,12 +260,12 @@
                       setHeader (C8.pack "Allow") (C8.pack $ joinWith ", " allowedMethods)
 
       allowedMethods :: [String]
-      allowedMethods = nub $ foldr (++) [] [ methods resGet    ["GET"]
-                                           , methods resHead   ["GET", "HEAD"]
-                                           , methods resPost   ["POST"]
-                                           , methods resPut    ["PUT"]
-                                           , methods resDelete ["DELETE"]
-                                           ]
+      allowedMethods = nub $ concat [ methods resGet    ["GET"]
+                                    , methods resHead   ["GET", "HEAD"]
+                                    , methods resPost   ["POST"]
+                                    , methods resPut    ["PUT"]
+                                    , methods resDelete ["DELETE"]
+                                    ]
 
       methods :: (ResourceDef -> Maybe a) -> [String] -> [String]
       methods f xs = case f def of
@@ -253,7 +290,7 @@
                if state <= DecidingHeader then
                    flip runRes itr
                       $ do setStatus $ aboStatus abo
-                           mapM_ (\ (name, value) -> setHeader name value) $ fromHeaders $ aboHeaders abo
+                           mapM_ (uncurry setHeader) $ fromHeaders $ aboHeaders abo
                            output $ abortPage conf reqM res abo
                  else
                    when (cnfDumpTooLateAbortionToStderr $ itrConfig itr)
diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
--- a/Network/HTTP/Lucu/ResponseWriter.hs
+++ b/Network/HTTP/Lucu/ResponseWriter.hs
@@ -35,30 +35,28 @@
       awaitSomethingToWrite :: IO ()
       awaitSomethingToWrite 
           = {-# SCC "awaitSomethingToWrite" #-}
-            do action
-                   <- atomically $!
-                      -- キューが空でなくなるまで待つ
-                      do queue <- readTVar tQueue
-                         -- GettingBody 状態にあり、Continue が期待され
-                         -- てゐて、それがまだ送信前なのであれば、
-                         -- Continue を送信する。
-                         case S.viewr queue of
-                           EmptyR   -> retry
-                           _ :> itr -> do state <- readItr itr itrState id
+            join $!
+                 atomically $!
+                 -- キューが空でなくなるまで待つ
+                 do queue <- readTVar tQueue
+                    -- GettingBody 状態にあり、Continue が期待されてゐ
+                    -- て、それがまだ送信前なのであれば、Continue を送
+                    -- 信する。
+                    case S.viewr queue of
+                      EmptyR   -> retry
+                      _ :> itr -> do state <- readItr itr itrState id
 
-                                          if state == GettingBody then
-                                              writeContinueIfNecessary itr
-                                            else
-                                              if state >= DecidingBody then
-                                                  writeHeaderOrBodyIfNecessary itr
-                                              else
-                                                  retry
-               action
+                                     if state == GettingBody then
+                                         writeContinueIfNecessary itr
+                                       else
+                                         if state >= DecidingBody then
+                                             writeHeaderOrBodyIfNecessary itr
+                                         else
+                                             retry
 
       writeContinueIfNecessary :: Interaction -> STM (IO ())
-      writeContinueIfNecessary itr
+      writeContinueIfNecessary !itr
           = {-# SCC "writeContinueIfNecessary" #-}
-            itr `seq`
             do expectedContinue <- readItr itr itrExpectedContinue id
                if expectedContinue then
                    do wroteContinue <- readItr itr itrWroteContinue id
@@ -75,13 +73,12 @@
                    retry
 
       writeHeaderOrBodyIfNecessary :: Interaction -> STM (IO ())
-      writeHeaderOrBodyIfNecessary itr
+      writeHeaderOrBodyIfNecessary !itr
           -- DecidingBody 以降の状態にあり、まだヘッダを出力する前であ
           -- れば、ヘッダを出力する。ヘッダ出力後であり、bodyToSend が
           -- 空でなければ、それを出力する。空である時は、もし状態が
           -- Done であれば後処理をする。
           = {-# SCC "writeHeaderOrBodyIfNecessary" #-}
-            itr `seq`
             do wroteHeader <- readItr itr itrWroteHeader id
                
                if not wroteHeader then
@@ -100,9 +97,8 @@
                           return $! writeBodyChunk itr
 
       writeContinue :: Interaction -> IO ()
-      writeContinue itr
+      writeContinue !itr
           = {-# SCC "writeContinue" #-}
-            itr `seq`
             do let cont = Response {
                             resVersion = HttpVersion 1 1
                           , resStatus  = Continue
@@ -115,9 +111,8 @@
                awaitSomethingToWrite
 
       writeHeader :: Interaction -> IO ()
-      writeHeader itr
+      writeHeader !itr
           = {-# SCC "writeHeader" #-}
-            itr `seq`
             do res <- atomically $! do writeItr itr itrWroteHeader True
                                        readItr itr itrResponse id
                hPutResponse h res
@@ -125,9 +120,8 @@
                awaitSomethingToWrite
       
       writeBodyChunk :: Interaction -> IO ()
-      writeBodyChunk itr
+      writeBodyChunk !itr
           = {-# SCC "writeBodyChunk" #-}
-            itr `seq`
             do willDiscardBody <- atomically $! readItr itr itrWillDiscardBody id
                willChunkBody   <- atomically $! readItr itr itrWillChunkBody   id
                chunk           <- atomically $! do chunk <- readItr itr itrBodyToSend id
@@ -145,18 +139,16 @@
                awaitSomethingToWrite
 
       finishBodyChunk :: Interaction -> IO ()
-      finishBodyChunk itr
+      finishBodyChunk !itr
           = {-# SCC "finishBodyChunk" #-}
-            itr `seq`
             do willDiscardBody <- atomically $! readItr itr itrWillDiscardBody id
                willChunkBody   <- atomically $! readItr itr itrWillChunkBody   id
                when (not willDiscardBody && willChunkBody)
                         $ hPutLBS h (C8.pack "0\r\n\r\n") >> hFlush h
 
       finalize :: Interaction -> IO ()
-      finalize itr
+      finalize !itr
           = {-# SCC "finalize" #-}
-            itr `seq`
             do finishBodyChunk itr
                willClose <- atomically $!
                             do queue <- readTVar tQueue
diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -23,6 +23,7 @@
 import           Network.HTTP.Lucu.Resource.Tree
 import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Utils
+import           System.FilePath.Posix
 import           System.Posix.Files
 
 
@@ -64,7 +65,7 @@
                            $ abort Forbidden [] Nothing
                        -- 讀める
                        tag     <- liftIO $ generateETagFromFile path
-                       lastMod <- return $ posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
+                       let lastMod = posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
                        foundEntity tag lastMod
 
                        -- MIME Type を推定
@@ -74,7 +75,7 @@
                          Just mime -> setContentType mime
 
                        -- 實際にファイルを讀んで送る
-                       (liftIO $ B.readFile path) >>= outputLBS
+                       liftIO (B.readFile path) >>= outputLBS
                   else
                     abort Forbidden [] Nothing
            else
@@ -134,16 +135,15 @@
 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
 -- 'staticDir' instead of this.
 handleStaticDir :: FilePath -> Resource ()
-handleStaticDir basePath
-    = basePath `seq`
-      do extraPath <- getPathInfo
+handleStaticDir !basePath
+    = do extraPath <- getPathInfo
          securityCheck extraPath
-         let path = basePath ++ "/" ++ joinWith "/" extraPath
+         let path = basePath </> joinPath extraPath
 
          handleStaticFile path
     where
       securityCheck :: Monad m => [String] -> m ()
-      securityCheck pathElems
-          = pathElems `seq`
-            when (any (== "..") pathElems) $ fail ("security error: "
+      securityCheck !pathElems
+          = when (any (== "..") pathElems) $ fail ("security error: "
                                                    ++ joinWith "/" pathElems)
+-- TODO: implement directory listing.
diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs
--- a/Network/HTTP/Lucu/Utils.hs
+++ b/Network/HTTP/Lucu/Utils.hs
@@ -19,7 +19,7 @@
 splitBy :: (a -> Bool) -> [a] -> [[a]]
 splitBy isSep src
     = case break isSep src
-      of (last , []       ) -> last  : []
+      of (last , []       ) -> [last]
          (first, _sep:rest) -> first : splitBy isSep rest
 
 -- |> joinWith ":" ["ab", "c", "def"]
diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs
--- a/examples/HelloWorld.hs
+++ b/examples/HelloWorld.hs
@@ -23,22 +23,17 @@
 
 helloWorld :: ResourceDef
 helloWorld
-    = ResourceDef {
-        resUsesNativeThread = False
-      , resIsGreedy         = False
-      , resGet
+    = emptyResource {
+        resGet
           = Just $ do --time <- liftIO $ getClockTime
                       --foundEntity (strongETag "abcde") time
                       setContentType $ read "text/hello"
                       outputChunk "Hello, "
                       outputChunk "World!\n"
-      , resHead   = Nothing
       , resPost
           = Just $ do str1 <- inputChunk 3
                       str2 <- inputChunk 3
                       str3 <- inputChunk 3
                       setContentType $ read "text/hello"
                       output ("[" ++ str1 ++ " - " ++ str2 ++ "#" ++ str3 ++ "]")
-      , resPut    = Nothing
-      , resDelete = Nothing
       }
diff --git a/examples/Makefile b/examples/Makefile
--- a/examples/Makefile
+++ b/examples/Makefile
@@ -1,15 +1,23 @@
-build: MiseRafturai.hs SmallFile.hs SSL.hs
-	ghc --make HelloWorld -threaded -O3 -fwarn-unused-imports
-	ghc --make Implanted -threaded -O3 -fwarn-unused-imports
-	ghc --make ImplantedSmall -threaded -O3 -fwarn-unused-imports
-	ghc --make Multipart -threaded -O3 -fwarn-unused-imports
-	ghc --make SSL -threaded -O3 -fwarn-unused-imports
+TARGETS = \
+	HelloWorld \
+	MiseRafturai \
+	Implanted \
+	ImplantedSmall \
+	Multipart \
+	SSL \
+	StaticDir \
+	$(NULL)
 
+build: $(TARGETS)
+
+%: %.hs
+	ghc --make $@ -threaded -O3 -fwarn-unused-imports
+
 run: build
 	./HelloWorld
 
 clean:
-	rm -f HelloWorld Implanted MiseRafturai.hs ImplantedSmall SmallFile.hs Multipart SSL *.hi *.o
+	rm -f $(TARGETS) *.hi *.o
 
 MiseRafturai.hs: mise-rafturai.html
 	lucu-implant-file -m MiseRafturai -o $@ $<
diff --git a/examples/SSL.hs b/examples/SSL.hs
--- a/examples/SSL.hs
+++ b/examples/SSL.hs
@@ -1,5 +1,6 @@
+{-# LANGUAGE PackageImports #-}
 import           Control.Monad
-import           Control.Monad.Trans
+import "mtl"     Control.Monad.Trans
 import           Data.Time.Clock
 import           Network
 import           Network.HTTP.Lucu