Fixed many bugs...

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

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index a593b3ad928a6710e932edfd0a2711d8a9d80b59..547947b4726b94240f1e909bc0180f7f2e5e5f68 100644 (file)
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -10,15 +10,19 @@
 -- |Definition of things related on HTTP response.
 module Network.HTTP.Lucu.Response
     ( StatusCode(..)
-    , Response(..)
     , printStatusCode
+
+    , Response(..)
+    , resCanHaveBody
     , printResponse
+
     , isInformational
     , isSuccessful
     , isRedirection
     , isError
     , isClientError
     , isServerError
+
     , statusCode
     )
     where
@@ -89,6 +93,7 @@ data StatusCode = Continue
 
 -- |Convert a 'StatusCode' to 'AsciiBuilder'.
 printStatusCode ∷ StatusCode → AsciiBuilder
+{-# INLINEABLE printStatusCode #-}
 printStatusCode (statusCode → (# num, msg #))
     = ( show3 num            ⊕
         A.toAsciiBuilder " " ⊕
@@ -102,11 +107,25 @@ data Response = Response {
     } deriving (Show, Eq)
 
 instance HasHeaders Response where
+    {-# INLINE getHeaders #-}
     getHeaders = resHeaders
+    {-# INLINE setHeaders #-}
     setHeaders res hdr = res { resHeaders = hdr }
 
+-- |Returns 'True' iff a given 'Response' allows the existence of
+-- response entity body.
+resCanHaveBody ∷ Response → Bool
+{-# INLINEABLE resCanHaveBody #-}
+resCanHaveBody (Response {..})
+    | isInformational resStatus = False
+    | resStatus ≡ NoContent     = False
+    | resStatus ≡ ResetContent  = False
+    | resStatus ≡ NotModified   = False
+    | otherwise                 = True
+
 -- |Convert a 'Response' to 'AsciiBuilder'.
 printResponse ∷ Response → AsciiBuilder
+{-# INLINEABLE printResponse #-}
 printResponse (Response {..})
     = printHttpVersion resVersion ⊕
       A.toAsciiBuilder " "        ⊕
@@ -114,37 +133,44 @@ printResponse (Response {..})
       A.toAsciiBuilder "\x0D\x0A" ⊕
       printHeaders     resHeaders
 
--- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
+-- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
 isInformational ∷ StatusCode → Bool
-isInformational = doesMeet (< 200)
+{-# INLINE isInformational #-}
+isInformational = satisfy (< 200)
 
--- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
+-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
 isSuccessful ∷ StatusCode → Bool
-isSuccessful = doesMeet (\ n → n ≥ 200 ∧ n < 300)
+{-# INLINE isSuccessful #-}
+isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
 
--- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
+-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
 isRedirection ∷ StatusCode → Bool
-isRedirection = doesMeet (\ n → n ≥ 300 ∧ n < 400)
+{-# INLINE isRedirection #-}
+isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
 
--- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
+-- |@'isError' sc@ returns 'True' iff @400 <= sc@
 isError ∷ StatusCode → Bool
-isError = doesMeet (≥ 400)
+{-# INLINE isError #-}
+isError = satisfy (≥ 400)
 
--- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
+-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
 isClientError ∷ StatusCode → Bool
-isClientError = doesMeet (\ n → n ≥ 400 ∧ n < 500)
+{-# INLINE isClientError #-}
+isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
 
--- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
+-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
 isServerError ∷ StatusCode → Bool
-isServerError = doesMeet (≥ 500)
+{-# INLINE isServerError #-}
+isServerError = satisfy (≥ 500)
 
-doesMeet ∷ (Int → Bool) → StatusCode → Bool
-{-# INLINE doesMeet #-}
-doesMeet p (statusCode → (# num, _ #)) = p num
+satisfy ∷ (Int → Bool) → StatusCode → Bool
+{-# INLINE satisfy #-}
+satisfy p (statusCode → (# num, _ #)) = p num
 
 -- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
 -- representation of @sc@.
 statusCode ∷ StatusCode → (# Int, Ascii #)
+{-# INLINEABLE statusCode #-}
 
 statusCode Continue                    = (# 100, "Continue"                      #)
 statusCode SwitchingProtocols          = (# 101, "Switching Protocols"           #)