many changes...

[Lucu.git] / Network / HTTP / Lucu / Response.hs

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 872a52f178c324d13987259cc6a1dbecbfc42b30..a593b3ad928a6710e932edfd0a2711d8a9d80b59 100644 (file)
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -1,18 +1,18 @@
 {-# LANGUAGE
     DeriveDataTypeable
   , OverloadedStrings
+  , RecordWildCards
   , UnboxedTuples
   , UnicodeSyntax
   , ViewPatterns
   #-}
-{-# OPTIONS_HADDOCK prune #-}
 
 -- |Definition of things related on HTTP response.
 module Network.HTTP.Lucu.Response
     ( StatusCode(..)
     , Response(..)
     , printStatusCode
-    , hPutResponse
+    , printResponse
     , isInformational
     , isSuccessful
     , isRedirection
@@ -22,16 +22,13 @@ module Network.HTTP.Lucu.Response
     , statusCode
     )
     where
-import Data.Ascii (Ascii)
+import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
-import qualified Data.ByteString as Strict (ByteString)
-import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
 import Data.Monoid.Unicode
 import Data.Typeable
-import Network.HTTP.Lucu.Format
-import Network.HTTP.Lucu.HandleLike
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
+import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
 -- |This is the definition of HTTP status code.
@@ -90,11 +87,10 @@ data StatusCode = Continue
                 | InsufficientStorage
                   deriving (Eq, Show, Typeable)
 
--- |Convert a 'StatusCode' to 'Ascii'.
-printStatusCode ∷ StatusCode → Ascii
+-- |Convert a 'StatusCode' to 'AsciiBuilder'.
+printStatusCode ∷ StatusCode → AsciiBuilder
 printStatusCode (statusCode → (# num, msg #))
-    = A.fromAsciiBuilder $
-      ( fmtDec 3 num ⊕
+    = ( show3 num            ⊕
         A.toAsciiBuilder " " ⊕
         A.toAsciiBuilder msg
       )
@@ -109,21 +105,14 @@ instance HasHeaders Response where
     getHeaders = resHeaders
     setHeaders res hdr = res { resHeaders = hdr }
 
-hPutResponse ∷ HandleLike h => h → Response → IO ()
-hPutResponse h res
-    = do hPutHttpVersion h (resVersion res)
-         hPutChar        h ' '
-         hPutStatus      h (resStatus  res)
-         hPutBS          h "\r\n"
-         hPutHeaders     h (resHeaders res)
-
-hPutStatus ∷ HandleLike h => h → StatusCode → IO ()
-hPutStatus h sc
-    = case statusCode sc of
-        (# num, msg #)
-            → do hPutStr  h (fmtDec 3 num)
-                 hPutChar h ' '
-                 hPutBS   h msg
+-- |Convert a 'Response' to 'AsciiBuilder'.
+printResponse ∷ Response → AsciiBuilder
+printResponse (Response {..})
+    = printHttpVersion resVersion ⊕
+      A.toAsciiBuilder " "        ⊕
+      printStatusCode  resStatus  ⊕
+      A.toAsciiBuilder "\x0D\x0A" ⊕
+      printHeaders     resHeaders
 
 -- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
 isInformational ∷ StatusCode → Bool
@@ -149,11 +138,9 @@ isClientError = doesMeet (\ n → n ≥ 400 ∧ n < 500)
 isServerError ∷ StatusCode → Bool
 isServerError = doesMeet (≥ 500)
 
-
 doesMeet ∷ (Int → Bool) → StatusCode → Bool
-doesMeet p sc = case statusCode sc of
-                  (# num, _ #) → p num
-
+{-# INLINE doesMeet #-}
+doesMeet p (statusCode → (# num, _ #)) = p num
 
 -- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
 -- representation of @sc@.