]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/Response.hs
Many changes...
[Lucu.git] / Network / HTTP / Lucu / Response.hs
index 872a52f178c324d13987259cc6a1dbecbfc42b30..df98bf741c24481ed59cc468f47273657d72aa67 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE
     DeriveDataTypeable
   , OverloadedStrings
+  , RecordWildCards
   , UnboxedTuples
   , UnicodeSyntax
   , ViewPatterns
@@ -24,14 +25,12 @@ module Network.HTTP.Lucu.Response
     where
 import Data.Ascii (Ascii)
 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.
@@ -94,7 +93,7 @@ data StatusCode = Continue
 printStatusCode ∷ StatusCode → Ascii
 printStatusCode (statusCode → (# num, msg #))
     = A.fromAsciiBuilder $
-      ( fmtDec 3 num ⊕
+      ( show3 num ⊕
         A.toAsciiBuilder " " ⊕
         A.toAsciiBuilder msg
       )
@@ -109,21 +108,19 @@ 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)
+hPutResponse ∷ HandleLike h  h → Response → IO ()
+hPutResponse h (Response {..})
+    = do hPutHttpVersion h resVersion
          hPutChar        h ' '
-         hPutStatus      h (resStatus  res)
+         hPutStatus      h resStatus
          hPutBS          h "\r\n"
-         hPutHeaders     h (resHeaders res)
+         hPutHeaders     h resHeaders
 
-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
+hPutStatus ∷ HandleLike h ⇒ h → StatusCode → IO ()
+hPutStatus h (statusCode → (# num, msg #))
+    = do hPutBS   h (A.toByteString $ A.fromAsciiBuilder $ show3 num)
+         hPutChar h ' '
+         hPutBS   h (A.toByteString msg)
 
 -- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
 isInformational ∷ StatusCode → Bool
@@ -149,11 +146,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@.