From: pho <pho@cielonegro.org>
Date: Wed, 3 Oct 2007 16:17:37 +0000 (+0900)
Subject: Doc fix, optimization, and more.
X-Git-Tag: RELEASE-0_2_1~27
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;ds=sidebyside;h=0dc3d31312a12f2b085242841b29eb0d96e9c4ac;p=Lucu.git

Doc fix, optimization, and more.

darcs-hash:20071003161737-62b54-4bf7a3e6c3df2756007e22d5c4978be9ae7faa17.gz
---

diff --git a/ImplantFile.hs b/ImplantFile.hs
index 29c1145..a16c76e 100644
--- a/ImplantFile.hs
+++ b/ImplantFile.hs
@@ -2,7 +2,7 @@ import           Codec.Binary.Base64
 import           Codec.Compression.GZip
 import           Control.Monad
 import           Data.Bits
-import           Data.ByteString.Lazy (ByteString)
+import           Data.ByteString.Base (LazyByteString)
 import qualified Data.ByteString.Lazy as L
 import           Data.Char
 import           Data.Digest.SHA1
@@ -117,8 +117,8 @@ generateHaskellSource opts srcFile
              exports  = [HsEVar (UnQual (HsIdent symName))]
              imports  = [ HsImportDecl undefined (Module "Codec.Binary.Base64")
                                        False Nothing Nothing
-                        , HsImportDecl undefined (Module "Data.ByteString.Lazy")
-                                       False Nothing (Just (False, [HsIVar (HsIdent "ByteString")]))
+                        , HsImportDecl undefined (Module "Data.ByteString.Base")
+                                       False Nothing (Just (False, [HsIVar (HsIdent "LazyByteString")]))
                         , HsImportDecl undefined (Module "Data.ByteString.Lazy")
                                        True (Just (Module "L")) Nothing
                         , HsImportDecl undefined (Module "Network.HTTP.Lucu")
@@ -207,7 +207,7 @@ generateHaskellSource opts srcFile
                                    expOutputGunzipped
                                    expOutputGZipped)
                        expOutputGunzipped
-                           = (HsApp (HsVar (UnQual (HsIdent "outputBS")))
+                           = (HsApp (HsVar (UnQual (HsIdent "outputLBS")))
                               (HsParen
                                (HsApp (HsVar (UnQual (HsIdent "decompress")))
                                       (HsVar (UnQual (HsIdent "gzippedData"))))))
@@ -219,7 +219,7 @@ generateHaskellSource opts srcFile
                            = HsQualifier (HsApp (HsVar (UnQual (HsIdent "setContentEncoding")))
                                           (HsList [HsLit (HsString "gzip")]))
                        doOutputGZipped
-                           = HsQualifier (HsApp (HsVar (UnQual (HsIdent "outputBS")))
+                           = HsQualifier (HsApp (HsVar (UnQual (HsIdent "outputLBS")))
                                           (HsVar (UnQual (HsIdent "gzippedData"))))
                    in 
                      HsApp (HsCon (UnQual (HsIdent "Just")))
@@ -239,7 +239,7 @@ generateHaskellSource opts srcFile
                            = HsQualifier (HsApp (HsVar (UnQual (HsIdent "setContentType")))
                                           (HsVar (UnQual (HsIdent "contentType"))))
                        doOutputRawData
-                           = HsQualifier (HsApp (HsVar (UnQual (HsIdent "outputBS")))
+                           = HsQualifier (HsApp (HsVar (UnQual (HsIdent "outputLBS")))
                                           (HsVar (UnQual (HsIdent "rawData"))))
                    in
                      HsApp (HsCon (UnQual (HsIdent "Just")))
@@ -295,7 +295,7 @@ generateHaskellSource opts srcFile
              declGZippedData 
                  = [ HsTypeSig undefined [HsIdent "gzippedData"]
                                (HsQualType []
-                                (HsTyCon (UnQual (HsIdent "ByteString"))))
+                                (HsTyCon (UnQual (HsIdent "LazyByteString"))))
                    , HsFunBind [HsMatch undefined (HsIdent "gzippedData")
                                 [] (HsUnGuardedRhs defGZippedData) []]
                    ]
@@ -311,7 +311,7 @@ generateHaskellSource opts srcFile
              declRawData 
                  = [ HsTypeSig undefined [HsIdent "rawData"]
                                (HsQualType []
-                                (HsTyCon (UnQual (HsIdent "ByteString"))))
+                                (HsTyCon (UnQual (HsIdent "LazyByteString"))))
                    , HsFunBind [HsMatch undefined (HsIdent "rawData")
                                 [] (HsUnGuardedRhs defRawData) []]
                    ]
@@ -397,7 +397,7 @@ getLastModified "-"   = getClockTime
 getLastModified fpath = getModificationTime fpath
 
 
-getETag :: [CmdOpt] -> ByteString -> IO String
+getETag :: [CmdOpt] -> LazyByteString -> IO String
 getETag opts input
     = let eTagOpts = filter (\ x -> case x of
                                       OptETag _ -> True
@@ -425,7 +425,7 @@ getETag opts input
           | n < 16 = (chr $ ord 'a' + n - 10)
 
 
-openInput :: FilePath -> IO ByteString
+openInput :: FilePath -> IO LazyByteString
 openInput "-"   = L.getContents
 openInput fpath = L.readFile fpath
 
@@ -458,7 +458,7 @@ openOutput opts
    -}
   module Foo.Bar.Baz (baz) where
   import Codec.Binary.Base64
-  import Data.ByteString.Lazy (ByteString)
+  import Data.ByteString.Base (LazyByteString)
   import qualified Data.ByteString.Lazy as L
   import Network.HTTP.Lucu
   import System.Time
@@ -470,7 +470,7 @@ openOutput opts
         , resGet
             = Just (do foundEntity entityTag lastModified
                        setContentType contentType
-                       outputBS rawData)
+                       outputLBS rawData)
         , resHead   = Nothing
         , resPost   = Nothing
         , resPut    = Nothing
@@ -486,7 +486,7 @@ openOutput opts
   contentType :: MIMEType
   contentType = read "image/png"
 
-  rawData :: ByteString
+  rawData :: LazyByteString
   rawData = L.pack (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")
   ------------------------------------------------------------------------------
 
@@ -507,10 +507,10 @@ openOutput opts
 
                        mustGunzip <- liftM not (isEncodingAcceptable "gzip")
                        if mustGunzip then
-                           outputBS (decompress gzippedData)
+                           outputLBS (decompress gzippedData)
                          else
                            do setContentEncoding ["gzip"]
-                              outputBS gzippedData
+                              outputLBS gzippedData
         , resHead   = Nothing
         , resPost   = Nothing
         , resPut    = Nothing
@@ -518,7 +518,7 @@ openOutput opts
         }
   
   -- rawData の代はりに gzippedData
-  gzippedData :: ByteString
+  gzippedData :: LazyByteString
   gzippedData = L.pack (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")
   ------------------------------------------------------------------------------
  -}
diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index ef70477..9ff629d 100644
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -23,7 +23,6 @@ import           Network.HTTP.Lucu.DefaultPage
 import           Network.HTTP.Lucu.Headers
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
-import {-# SOURCE #-} Network.HTTP.Lucu.Resource
 import           System.IO.Unsafe
 import           Text.XML.HXT.Arrow.WriteDocument
 import           Text.XML.HXT.Arrow.XmlArrow
@@ -68,7 +67,6 @@ abort status headers msg
           exc = DynException (toDyn abo)
       in
         liftIO $ throwIO exc
-{-# SPECIALIZE abort :: StatusCode -> [ (String, String) ] -> Maybe String -> Resource a #-}
 
 -- |Computation of @'abortSTM' status headers msg@ just computes
 -- 'abort' in a 'Control.Monad.STM.STM' monad.
@@ -82,7 +80,6 @@ abortSTM status headers msg
 abortA :: ArrowIO a => a (StatusCode, ([ (String, String) ], Maybe String)) c
 abortA 
     = arrIO3 abort
-{-# SPECIALIZE abortA :: IOSArrow (StatusCode, ([ (String, String) ], Maybe String)) c #-}
 
 -- aboMessage が Just なら單に mkDefaultPage に渡すだけで良いので樂だが、
 -- Nothing の場合は getDefaultPage を使ってデフォルトのメッセージを得な
diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index 05acb60..b4413ce 100644
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -60,15 +60,15 @@ writeDefaultPage itr
 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
-          sig           = cnfServerSoftware conf
-                          ++ " at "
-                          ++ cnfServerHost conf
-                          ++ ( case cnfServerPort conf of
-                                 Service    serv -> ", service " ++ serv
-                                 PortNumber num  -> ", port " ++ show num
-                                 UnixSocket path -> ", unix socket " ++ show path
-                             )
+      let (# sCode, sMsg #) = statusCode status
+          sig               = cnfServerSoftware conf
+                              ++ " at "
+                              ++ cnfServerHost conf
+                              ++ ( case cnfServerPort conf of
+                                     Service    serv -> ", service " ++ serv
+                                     PortNumber num  -> ", port " ++ show num
+                                     UnixSocket path -> ", unix socket " ++ show path
+                                 )
       in ( eelem "/"
            += ( eelem "html"
                 += sattr "xmlns" "http://www.w3.org/1999/xhtml"
diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs
index 5671ec0..c40cacd 100644
--- a/Network/HTTP/Lucu/Parser.hs
+++ b/Network/HTTP/Lucu/Parser.hs
@@ -93,8 +93,8 @@ instance Monad Parser where
 failP :: Parser a
 failP = fail undefined
 
--- |@'parse' p bstr@ parses @bstr@ with @p@ and returns @(result,
--- remaining)@.
+-- |@'parse' p bstr@ parses @bstr@ with @p@ and returns @(# result,
+-- remaining #)@.
 parse :: Parser a -> LazyByteString -> (# ParserResult a, LazyByteString #)
 parse p input -- input は lazy である必要有り。
     = p `seq`
diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs
index 77dbe7f..a5dfbd9 100644
--- a/Network/HTTP/Lucu/Parser/Http.hs
+++ b/Network/HTTP/Lucu/Parser/Http.hs
@@ -20,14 +20,15 @@ module Network.HTTP.Lucu.Parser.Http
 import           Data.List
 import           Network.HTTP.Lucu.Parser
 
--- |@'isCtl' c@ is False iff @0x20 <= @c@ < 0x7F@.
+-- |@'isCtl' c@ is 'Prelude.False' iff @0x20 <= @c@ < 0x7F@.
 isCtl :: Char -> Bool
 isCtl c
     | c <  '\x1f' = True
     | c >= '\x7f' = True
     | otherwise   = False
 
--- |@'isSeparator' c@ is True iff c is one of HTTP separators.
+-- |@'isSeparator' c@ is 'Prelude.True' iff c is one of HTTP
+-- separators.
 isSeparator :: Char -> Bool
 isSeparator '('  = True
 isSeparator ')'  = True
@@ -50,7 +51,7 @@ isSeparator ' '  = True
 isSeparator '\t' = True
 isSeparator _    = False
 
--- |@'isChar' c@ is True iff @c <= 0x7f@.
+-- |@'isChar' c@ is 'Prelude.True' iff @c <= 0x7f@.
 isChar :: Char -> Bool
 isChar c
     | c <= '\x7f' = True
diff --git a/Network/HTTP/Lucu/RFC1123DateTime.hs b/Network/HTTP/Lucu/RFC1123DateTime.hs
index 2cd06cc..e9300a5 100644
--- a/Network/HTTP/Lucu/RFC1123DateTime.hs
+++ b/Network/HTTP/Lucu/RFC1123DateTime.hs
@@ -19,7 +19,8 @@ month =  ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct",
 week :: [String]
 week =  ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
 
--- |Format a @CalendarTime@ to RFC 1123 Date and Time string.
+-- |Format a 'System.Time.CalendarTime' to RFC 1123 Date and Time
+-- string.
 formatRFC1123DateTime :: CalendarTime -> String
 formatRFC1123DateTime time
     = time `seq`
@@ -41,8 +42,8 @@ formatRFC1123DateTime time
       id       (ctTZName time)
       
 
--- |Format a @ClockTime@ to HTTP Date and Time. Time zone will be
--- always UTC but prints as GMT.
+-- |Format a 'System.Time.ClockTime' to HTTP Date and Time. Time zone
+-- will be always UTC but prints as GMT.
 formatHTTPDateTime :: ClockTime -> String
 formatHTTPDateTime time
     = time `seq`
diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 8942c76..8e25904 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -1,8 +1,9 @@
 -- #prune
 
 -- |This is the Resource Monad; monadic actions to define the behavior
--- of each resources. The 'Resource' Monad is a kind of IO Monad thus
--- it implements MonadIO class. It is also a state machine.
+-- of each resources. The 'Resource' Monad is a kind of 'Prelude.IO'
+-- Monad thus it implements 'Control.Monad.Trans.MonadIO' class. It is
+-- also a state machine.
 -- 
 -- Request Processing Flow:
 --
@@ -61,6 +62,7 @@ module Network.HTTP.Lucu.Resource
     (
     -- * Monad
     Resource
+    , runRes -- private
 
     -- * Actions
 
@@ -100,8 +102,8 @@ module Network.HTTP.Lucu.Resource
     -- Body/.
     , input
     , inputChunk
-    , inputBS
-    , inputChunkBS
+    , inputLBS
+    , inputChunkLBS
     , inputForm
     , defaultLimit
 
@@ -122,8 +124,8 @@ module Network.HTTP.Lucu.Resource
     -- Body/.
     , output
     , outputChunk
-    , outputBS
-    , outputChunkBS
+    , outputLBS
+    , outputChunkLBS
 
     , driftTo
     )
@@ -132,8 +134,8 @@ module Network.HTTP.Lucu.Resource
 import           Control.Concurrent.STM
 import           Control.Monad.Reader
 import           Data.Bits
+import           Data.ByteString.Base (LazyByteString)
 import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
 import           Data.List
 import           Data.Maybe
 import           Network.HTTP.Lucu.Abortion
@@ -155,27 +157,50 @@ import           Network.Socket
 import           Network.URI
 import           System.Time
 
--- |The 'Resource' monad. /Interaction/ is an internal state thus it
--- is not exposed to users. This monad implements 'MonadIO' so it can
--- do any IO actions.
-type Resource a = ReaderT Interaction IO a
+-- |The 'Resource' monad. This monad implements
+-- 'Control.Monad.Trans.MonadIO' so it can do any 'Prelude.IO'
+-- actions.
+newtype Resource a = Resource { unRes :: ReaderT Interaction IO a }
+
+instance Functor Resource where
+    fmap f c = Resource (fmap f (unRes c))
+
+instance Monad Resource where
+    c >>= f = Resource (unRes c >>= unRes . f)
+    return  = Resource . return
+    fail    = Resource . fail
+
+instance MonadIO Resource where
+    liftIO = Resource . liftIO
+
+
+runRes :: Resource a -> Interaction -> IO a
+runRes r itr
+    = runReaderT (unRes r) itr
+
+
+getInteraction :: Resource Interaction
+getInteraction = Resource ask
+
 
 -- |Get the 'Network.HTTP.Lucu.Config.Config' value which is used for
 -- the httpd.
 getConfig :: Resource Config
-getConfig = do itr <- ask
+getConfig = do itr <- getInteraction
                return $! itrConfig itr
 
 
--- |Get the SockAddr of the remote host. If you want a string
--- representation instead of SockAddr, use 'getRemoteAddr''.
+-- |Get the 'Network.Socket.SockAddr' of the remote host. If you want
+-- a string representation instead of 'Network.Socket.SockAddr', use
+-- 'getRemoteAddr''.
 getRemoteAddr :: Resource SockAddr
-getRemoteAddr = do itr <- ask
+getRemoteAddr = do itr <- getInteraction
                    return $! itrRemoteAddr itr
 
 
 -- |Get the string representation of the address of remote host. If
--- you want a SockAddr instead of String, use 'getRemoteAddr'.
+-- you want a 'Network.Socket.SockAddr' instead of String, use
+-- 'getRemoteAddr'.
 getRemoteAddr' :: Resource String
 getRemoteAddr' = do addr <- getRemoteAddr
                     case addr of
@@ -194,7 +219,7 @@ getRemoteAddr' = do addr <- getRemoteAddr
 -- |Get the 'Network.HTTP.Lucu.Request.Request' value which represents
 -- the request header. In general you don't have to use this action.
 getRequest :: Resource Request
-getRequest = do itr <- ask
+getRequest = do itr <- getInteraction
                 req <- liftIO $! atomically $! readItr itr itrRequest fromJust
                 return req
 
@@ -236,7 +261,7 @@ getRequestVersion = do req <- getRequest
 -- >   , ...
 -- >   }
 getResourcePath :: Resource [String]
-getResourcePath = do itr <- ask
+getResourcePath = do itr <- getInteraction
                      return $! fromJust $! itrResourcePath itr
 
 
@@ -368,7 +393,7 @@ foundEntity tag timeStamp
 -- 'foundETag' doesn't (and can't) put \"Last-Modified\" header into
 -- the response.
 --
--- This action is not preferred. You should use 'foundEntity' when
+-- This action is not preferred. You should use 'foundEntity' whenever
 -- possible.
 foundETag :: ETag -> Resource ()
 foundETag tag
@@ -424,7 +449,7 @@ foundETag tag
 -- modification time are unsafe because it is possible to mess up such
 -- tests by modifying the entity twice in a second.
 --
--- This action is not preferred. You should use 'foundEntity' when
+-- This action is not preferred. You should use 'foundEntity' whenever
 -- possible.
 foundTimeStamp :: ClockTime -> Resource ()
 foundTimeStamp timeStamp
@@ -509,23 +534,25 @@ foundNoEntity msgM
 -- ('Network.HTTP.Lucu.Config.cnfMaxEntityLength') is used. See
 -- 'defaultLimit'.
 --
--- Note that 'inputBS' is more efficient than 'input' so you should
+-- Note that 'inputLBS' is more efficient than 'input' so you should
 -- use it whenever possible.
 input :: Int -> Resource String
 input limit = limit `seq`
-              inputBS limit >>= return . B.unpack
+              inputLBS limit >>= return . B.unpack
 
 
 -- | This is mostly the same as 'input' but is more
--- efficient. 'inputBS' returns a lazy ByteString but it's not really
--- lazy: reading from the socket just happens at the computation of
--- 'inputBS', not at the lazy evaluation of the ByteString. The same
--- goes for 'inputChunkBS'.
-inputBS :: Int -> Resource ByteString
-inputBS limit
+-- efficient. 'inputLBS' returns a
+-- 'Data.ByteString.Base.LazyByteString' but it's not really lazy:
+-- reading from the socket just happens at the computation of
+-- 'inputLBS', not at the evaluation of the
+-- 'Data.ByteString.Base.LazyByteString'. The same goes for
+-- 'inputChunkLBS'.
+inputLBS :: Int -> Resource LazyByteString
+inputLBS limit
     = limit `seq`
       do driftTo GettingBody
-         itr     <- ask
+         itr     <- getInteraction
          hasBody <- liftIO $! atomically $! readItr itr itrRequestHasBody id
          chunk   <- if hasBody then
                         askForInput itr
@@ -534,7 +561,7 @@ inputBS limit
                            return B.empty
          return chunk
     where
-      askForInput :: Interaction -> Resource ByteString
+      askForInput :: Interaction -> Resource LazyByteString
       askForInput itr
           = itr `seq`
             do let defaultLimit = cnfMaxEntityLength $ itrConfig itr
@@ -543,7 +570,7 @@ inputBS limit
                                   else
                                       limit
                when (actualLimit <= 0)
-                        $ fail ("inputBS: limit must be positive: " ++ show actualLimit)
+                        $ fail ("inputLBS: limit must be positive: " ++ show actualLimit)
                -- Reader にリクエスト
                liftIO $! atomically
                           $! do chunkLen <- readItr itr itrReqChunkLength id
@@ -592,20 +619,20 @@ inputBS limit
 -- ('Network.HTTP.Lucu.Config.cnfMaxEntityLength') is used. See
 -- 'defaultLimit'.
 --
--- Note that 'inputChunkBS' is more efficient than 'inputChunk' so you
+-- Note that 'inputChunkLBS' is more efficient than 'inputChunk' so you
 -- should use it whenever possible.
 inputChunk :: Int -> Resource String
 inputChunk limit = limit `seq`
-                   inputChunkBS limit >>= return . B.unpack
+                   inputChunkLBS limit >>= return . B.unpack
 
 
 -- | This is mostly the same as 'inputChunk' but is more
--- efficient. See 'inputBS'.
-inputChunkBS :: Int -> Resource ByteString
-inputChunkBS limit
+-- efficient. See 'inputLBS'.
+inputChunkLBS :: Int -> Resource LazyByteString
+inputChunkLBS limit
     = limit `seq`
       do driftTo GettingBody
-         itr <- ask
+         itr     <- getInteraction
          hasBody <- liftIO $ atomically $ readItr itr itrRequestHasBody id
          chunk   <- if hasBody then
                         askForInput itr
@@ -614,7 +641,7 @@ inputChunkBS limit
                            return B.empty
          return chunk
     where
-      askForInput :: Interaction -> Resource ByteString
+      askForInput :: Interaction -> Resource LazyByteString
       askForInput itr
           = itr `seq`
             do let defaultLimit = cnfMaxEntityLength $! itrConfig itr
@@ -623,7 +650,7 @@ inputChunkBS limit
                                   else
                                       limit
                when (actualLimit <= 0)
-                        $ fail ("inputChunkBS: limit must be positive: " ++ show actualLimit)
+                        $ fail ("inputChunkLBS: limit must be positive: " ++ show actualLimit)
                -- Reader にリクエスト
                liftIO $! atomically
                           $! do writeItr itr itrReqBodyWanted $! Just actualLimit
@@ -677,7 +704,7 @@ inputForm limit
           = abort UnsupportedMediaType []
             (Just $! "Sorry, inputForm does not currently support multipart/form-data.")
 
--- | This is just a constant -1. It's better to say @'input'
+-- | This is just a constant @-1@. It's better to say @'input'
 -- 'defaultLimit'@ than to say @'input' (-1)@ but these are exactly
 -- the same.
 defaultLimit :: Int
@@ -693,7 +720,7 @@ setStatus :: StatusCode -> Resource ()
 setStatus code
     = code `seq`
       do driftTo DecidingHeader
-         itr <- ask
+         itr <- getInteraction
          liftIO $! atomically $! updateItr itr itrResponse
                     $! \ res -> res {
                                   resStatus = code
@@ -722,13 +749,13 @@ setHeader name value
 setHeader' :: String -> String -> Resource ()
 setHeader' name value
     = name `seq` value `seq`
-      do itr <- ask
+      do itr <- getInteraction
          liftIO $ atomically
                     $ updateItr itr itrResponse
                           $ H.setHeader name value
 
 -- | Computation of @'redirect' code uri@ sets the response status to
--- @code@ and \"Location\" header to @uri@. @code@ must satisfy
+-- @code@ and \"Location\" header to @uri@. The @code@ must satisfy
 -- 'Network.HTTP.Lucu.Response.isRedirection' or it causes an error.
 redirect :: StatusCode -> URI -> Resource ()
 redirect code uri
@@ -771,35 +798,35 @@ setContentEncoding codings
 -- apply 'output' to an infinite string, such as a lazy stream of
 -- \/dev\/random.
 --
--- Note that 'outputBS' is more efficient than 'output' so you should
+-- Note that 'outputLBS' is more efficient than 'output' so you should
 -- use it whenever possible.
 output :: String -> Resource ()
-output str = outputBS $! B.pack str
+output str = outputLBS $! B.pack str
 {-# INLINE output #-}
 
 -- | This is mostly the same as 'output' but is more efficient.
-outputBS :: ByteString -> Resource ()
-outputBS str = do outputChunkBS str
-                  driftTo Done
-{-# INLINE outputBS #-}
+outputLBS :: LazyByteString -> Resource ()
+outputLBS str = do outputChunkLBS str
+                   driftTo Done
+{-# INLINE outputLBS #-}
 
 -- | Computation of @'outputChunk' str@ writes @str@ as a part of
 -- response body. You can compute this action multiple times to write
 -- a body little at a time. It is safe to apply 'outputChunk' to an
 -- infinite string.
 --
--- Note that 'outputChunkBS' is more efficient than 'outputChunk' so
+-- Note that 'outputChunkLBS' is more efficient than 'outputChunk' so
 -- you should use it whenever possible.
 outputChunk :: String -> Resource ()
-outputChunk str = outputChunkBS $! B.pack str
+outputChunk str = outputChunkLBS $! B.pack str
 {-# INLINE outputChunk #-}
 
 -- | This is mostly the same as 'outputChunk' but is more efficient.
-outputChunkBS :: ByteString -> Resource ()
-outputChunkBS str
+outputChunkLBS :: LazyByteString -> Resource ()
+outputChunkLBS str
     = str `seq`
       do driftTo DecidingBody
-         itr <- ask
+         itr <- getInteraction
          
          let limit = cnfMaxOutputChunkLength $ itrConfig itr
          when (limit <= 0)
@@ -816,17 +843,16 @@ outputChunkBS str
                     $ liftIO $ atomically $
                       writeItr itr itrBodyIsNull False
     where
-      {- チャンクの大きさは Config で制限されてゐる。もし例へば
-         /dev/zero を B.readFile して作った ByteString をそのまま
-         ResponseWriter に渡したりすると大變な事が起こる。何故なら
-         ResponseWriter はTransfer-Encoding: chunked の時、ヘッダを書く
-         爲にチャンクの大きさを測るから、その時に起こるであらう事は言ふ
-         までも無い。 -}
-      sendChunks :: ByteString -> Int -> Resource ()
+      -- チャンクの大きさは Config で制限されてゐる。もし例へば
+      -- "/dev/zero" を B.readFile して作った LazyByteString をそのまま
+      -- ResponseWriter に渡したりすると大變な事が起こる。何故なら
+      -- ResponseWriter は Transfer-Encoding: chunked の時、ヘッダを書
+      -- く爲にチャンクの大きさを測る。
+      sendChunks :: LazyByteString -> Int -> Resource ()
       sendChunks str limit
           | B.null str = return ()
           | otherwise  = do let (chunk, remaining) = B.splitAt (fromIntegral limit) str
-                            itr <- ask
+                            itr <- getInteraction
                             liftIO $ atomically $ 
                                    do buf <- readItr itr itrBodyToSend id
                                       if B.null buf then
@@ -860,7 +886,7 @@ outputChunkBS str
 driftTo :: InteractionState -> Resource ()
 driftTo newState
     = newState `seq`
-      do itr <- ask
+      do itr <- getInteraction
          liftIO $ atomically $ do oldState <- readItr itr itrState id
                                   if newState < oldState then
                                       throwStateError oldState newState
diff --git a/Network/HTTP/Lucu/Resource.hs-boot b/Network/HTTP/Lucu/Resource.hs-boot
deleted file mode 100644
index 77fdfb9..0000000
--- a/Network/HTTP/Lucu/Resource.hs-boot
+++ /dev/null
@@ -1,8 +0,0 @@
-{- -*- haskell -*- -}
-module Network.HTTP.Lucu.Resource
-    where
-
-import           Control.Monad.Reader
-import           Network.HTTP.Lucu.Interaction
-
-type Resource a = ReaderT Interaction IO a
\ No newline at end of file
diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
index c2f6add..149fa9d 100644
--- a/Network/HTTP/Lucu/Resource/Tree.hs
+++ b/Network/HTTP/Lucu/Resource/Tree.hs
@@ -14,7 +14,7 @@ module Network.HTTP.Lucu.Resource.Tree
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
-import           Control.Monad.Reader
+import           Control.Monad
 import           Data.Dynamic
 import           Data.List
 import qualified Data.Map as M
@@ -41,9 +41,11 @@ import           Prelude hiding (catch)
 -- | 'ResourceDef' is basically a set of
 -- 'Network.HTTP.Lucu.Resource.Resource' monads for each HTTP methods.
 data ResourceDef = ResourceDef {
-    -- | Whether to run a 'Network.HTTP.Lucu.Resource.Resource' on a
-    -- native thread (spawned using @forkOS@) or to run it on a user
-    -- thread (spanwed using @forkIO@). Generally you don't
+    -- |Whether to run a 'Network.HTTP.Lucu.Resource.Resource' on a
+    -- native thread (spawned by 'Control.Concurrent.forkOS') or to
+    -- run it on a user thread (spanwed by
+    -- 'Control.Concurrent.forkIO'). Generally you don't need to set
+    -- this field to 'Prelude.True'.
       resUsesNativeThread :: !Bool
     -- | Whether to be greedy or not.
     -- 
@@ -168,10 +170,10 @@ runResource :: ResourceDef -> Interaction -> IO ThreadId
 runResource def itr
     = def `seq` itr `seq`
       fork
-      $! catch ( runReaderT ( do req <- getRequest
-                                 fromMaybe notAllowed $ rsrc req
-                                 driftTo Done
-                            ) itr
+      $! catch ( runRes ( do req <- getRequest
+                             fromMaybe notAllowed $ rsrc req
+                             driftTo Done
+                        ) itr
                )
              $ \ exc -> processException exc
     where
@@ -227,7 +229,7 @@ runResource def itr
                reqM  <- atomically $ readItr itr itrRequest id
                res   <- atomically $ readItr itr itrResponse id
                if state <= DecidingHeader then
-                   flip runReaderT itr
+                   flip runRes itr
                       $ do setStatus $ aboStatus abo
                            -- FIXME: 同じ名前で複數の値があった時は、こ
                            -- れではまずいと思ふ。
@@ -237,7 +239,7 @@ runResource def itr
                    when (cnfDumpTooLateAbortionToStderr $ itrConfig itr)
                             $ hPutStrLn stderr $ show abo
 
-               flip runReaderT itr $ driftTo Done
+               flip runRes itr $ driftTo Done
 
       formatIOE :: IOError -> String
       formatIOE ioE = if isUserError ioE then
diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 913c491..9239cba 100644
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -78,7 +78,7 @@ data StatusCode = Continue
                   deriving (Typeable, Eq)
 
 instance Show StatusCode where
-    show sc = let (num, msg) = statusCode sc
+    show sc = let (# num, msg #) = statusCode sc
               in
                 (fmtDec 3 num) ++ " " ++ msg
 
@@ -109,87 +109,87 @@ hPutStatus h sc
     = h `seq` sc `seq`
       hPutStr h (show sc)
 
--- |@'isInformational' sc@ is True iff @sc < 200@.
+-- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
 isInformational :: StatusCode -> Bool
 isInformational = doesMeet (< 200)
 
--- |@'isSuccessful' sc@ is True iff @200 <= sc < 300@.
+-- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
 isSuccessful :: StatusCode -> Bool
 isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
 
--- |@'isRedirection' sc@ is True iff @300 <= sc < 400@.
+-- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
 isRedirection :: StatusCode -> Bool
 isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
 
--- |@'isError' sc@ is True iff @400 <= sc@
+-- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
 isError :: StatusCode -> Bool
 isError = doesMeet (>= 400)
 
--- |@'isClientError' sc@ is True iff @400 <= sc < 500@.
+-- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
 isClientError :: StatusCode -> Bool
 isClientError = doesMeet (\ n -> n >= 400 && n < 500)
 
--- |@'isServerError' sc@ is True iff @500 <= sc@.
+-- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
 isServerError :: StatusCode -> Bool
 isServerError = doesMeet (>= 500)
 
 
 doesMeet :: (Int -> Bool) -> StatusCode -> Bool
-doesMeet p sc = let (num, _) = statusCode sc
+doesMeet p sc = let (# num, _ #) = statusCode sc
                 in
                   p num
 
 
 -- |@'statusCode' sc@ returns a tuple of numeric and textual
 -- representation of @sc@.
-statusCode :: StatusCode -> (Int, String)
-statusCode Continue                    = (100, "Continue")
-statusCode SwitchingProtocols          = (101, "Switching Protocols")
-statusCode Processing                  = (102, "Processing")
+statusCode :: StatusCode -> (# Int, String #)
+statusCode Continue                    = (# 100, "Continue" #)
+statusCode SwitchingProtocols          = (# 101, "Switching Protocols" #)
+statusCode Processing                  = (# 102, "Processing" #)
 --
-statusCode Ok                          = (200, "OK")
-statusCode Created                     = (201, "Created")
-statusCode Accepted                    = (202, "Accepted")
-statusCode NonAuthoritativeInformation = (203, "Non Authoritative Information")
-statusCode NoContent                   = (204, "No Content")
-statusCode ResetContent                = (205, "Reset Content")
-statusCode PartialContent              = (206, "Partial Content")
-statusCode MultiStatus                 = (207, "Multi Status")
+statusCode Ok                          = (# 200, "OK" #)
+statusCode Created                     = (# 201, "Created" #)
+statusCode Accepted                    = (# 202, "Accepted" #)
+statusCode NonAuthoritativeInformation = (# 203, "Non Authoritative Information" #)
+statusCode NoContent                   = (# 204, "No Content" #)
+statusCode ResetContent                = (# 205, "Reset Content" #)
+statusCode PartialContent              = (# 206, "Partial Content" #)
+statusCode MultiStatus                 = (# 207, "Multi Status" #)
 --
-statusCode MultipleChoices             = (300, "Multiple Choices")
-statusCode MovedPermanently            = (301, "Moved Permanently")
-statusCode Found                       = (302, "Found")
-statusCode SeeOther                    = (303, "See Other")
-statusCode NotModified                 = (304, "Not Modified")
-statusCode UseProxy                    = (305, "Use Proxy")
-statusCode TemporaryRedirect           = (306, "Temporary Redirect")
+statusCode MultipleChoices             = (# 300, "Multiple Choices" #)
+statusCode MovedPermanently            = (# 301, "Moved Permanently" #)
+statusCode Found                       = (# 302, "Found" #)
+statusCode SeeOther                    = (# 303, "See Other" #)
+statusCode NotModified                 = (# 304, "Not Modified" #)
+statusCode UseProxy                    = (# 305, "Use Proxy" #)
+statusCode TemporaryRedirect           = (# 306, "Temporary Redirect" #)
 --
-statusCode BadRequest                  = (400, "Bad Request")
-statusCode Unauthorized                = (401, "Unauthorized")
-statusCode PaymentRequired             = (402, "Payment Required")
-statusCode Forbidden                   = (403, "Forbidden")
-statusCode NotFound                    = (404, "Not Found")
-statusCode MethodNotAllowed            = (405, "Method Not Allowed")
-statusCode NotAcceptable               = (406, "Not Acceptable")
-statusCode ProxyAuthenticationRequired = (407, "Proxy Authentication Required")
-statusCode RequestTimeout              = (408, "Request Timeout")
-statusCode Conflict                    = (409, "Conflict")
-statusCode Gone                        = (410, "Gone")
-statusCode LengthRequired              = (411, "Length Required")
-statusCode PreconditionFailed          = (412, "Precondition Failed")
-statusCode RequestEntityTooLarge       = (413, "Request Entity Too Large")
-statusCode RequestURITooLarge          = (414, "Request URI Too Large")
-statusCode UnsupportedMediaType        = (415, "Unsupported Media Type")
-statusCode RequestRangeNotSatisfiable  = (416, "Request Range Not Satisfiable")
-statusCode ExpectationFailed           = (417, "Expectation Failed")
-statusCode UnprocessableEntitiy        = (422, "Unprocessable Entity")
-statusCode Locked                      = (423, "Locked")
-statusCode FailedDependency            = (424, "Failed Dependency")
+statusCode BadRequest                  = (# 400, "Bad Request" #)
+statusCode Unauthorized                = (# 401, "Unauthorized" #)
+statusCode PaymentRequired             = (# 402, "Payment Required" #)
+statusCode Forbidden                   = (# 403, "Forbidden" #)
+statusCode NotFound                    = (# 404, "Not Found" #)
+statusCode MethodNotAllowed            = (# 405, "Method Not Allowed" #)
+statusCode NotAcceptable               = (# 406, "Not Acceptable" #)
+statusCode ProxyAuthenticationRequired = (# 407, "Proxy Authentication Required" #)
+statusCode RequestTimeout              = (# 408, "Request Timeout" #)
+statusCode Conflict                    = (# 409, "Conflict" #)
+statusCode Gone                        = (# 410, "Gone" #)
+statusCode LengthRequired              = (# 411, "Length Required" #)
+statusCode PreconditionFailed          = (# 412, "Precondition Failed" #)
+statusCode RequestEntityTooLarge       = (# 413, "Request Entity Too Large" #)
+statusCode RequestURITooLarge          = (# 414, "Request URI Too Large" #)
+statusCode UnsupportedMediaType        = (# 415, "Unsupported Media Type" #)
+statusCode RequestRangeNotSatisfiable  = (# 416, "Request Range Not Satisfiable" #)
+statusCode ExpectationFailed           = (# 417, "Expectation Failed" #)
+statusCode UnprocessableEntitiy        = (# 422, "Unprocessable Entity" #)
+statusCode Locked                      = (# 423, "Locked" #)
+statusCode FailedDependency            = (# 424, "Failed Dependency" #)
 --
-statusCode InternalServerError         = (500, "Internal Server Error")
-statusCode NotImplemented              = (501, "Not Implemented")
-statusCode BadGateway                  = (502, "Bad Gateway")
-statusCode ServiceUnavailable          = (503, "Service Unavailable")
-statusCode GatewayTimeout              = (504, "Gateway Timeout")
-statusCode HttpVersionNotSupported     = (505, "HTTP Version Not Supported")
-statusCode InsufficientStorage         = (507, "Insufficient Storage")
\ No newline at end of file
+statusCode InternalServerError         = (# 500, "Internal Server Error" #)
+statusCode NotImplemented              = (# 501, "Not Implemented" #)
+statusCode BadGateway                  = (# 502, "Bad Gateway" #)
+statusCode ServiceUnavailable          = (# 503, "Service Unavailable" #)
+statusCode GatewayTimeout              = (# 504, "Gateway Timeout" #)
+statusCode HttpVersionNotSupported     = (# 505, "HTTP Version Not Supported" #)
+statusCode InsufficientStorage         = (# 507, "Insufficient Storage" #)
\ No newline at end of file
diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 3b8222f..12cf78b 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -73,7 +73,7 @@ handleStaticFile path
                   Just mime -> setContentType mime
 
                 -- 實際にファイルを讀んで送る
-                (liftIO $ B.readFile path) >>= outputBS
+                (liftIO $ B.readFile path) >>= outputLBS
            else
              do isDir <- liftIO $ doesDirectoryExist path
                 if isDir then
diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs
index d92516e..0c29836 100644
--- a/Network/HTTP/Lucu/Utils.hs
+++ b/Network/HTTP/Lucu/Utils.hs
@@ -40,7 +40,8 @@ trim p = p `seq` trimTail . trimHead
       trimHead = dropWhile p
       trimTail = reverse . trimHead . reverse
 
--- |@'noCaseEq' a b@ is equivalent to @(map toLower a) == (map toLower
+-- |@'noCaseEq' a b@ is equivalent to @('Prelude.map'
+-- 'Data.Char.toLower' a) == ('Prelude.map' 'Data.Char.toLower'
 -- b)@. See 'noCaseEq''.
 noCaseEq :: String -> String -> Bool
 noCaseEq a b
@@ -55,7 +56,8 @@ noCaseEq' a b
     | otherwise            = noCaseEq a b
 {-# INLINE noCaseEq' #-}
 
--- |@'isWhiteSpace' c@ is True iff c is one of SP, HT, CR and LF.
+-- |@'isWhiteSpace' c@ is 'Prelude.True' iff c is one of SP, HT, CR
+-- and LF.
 isWhiteSpace :: Char -> Bool
 isWhiteSpace ' '  = True
 isWhiteSpace '\t' = True