X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=2791616cbd3071243b2f8db966a7eb3b93397e50;hp=872a52f178c324d13987259cc6a1dbecbfc42b30;hb=5477896;hpb=8510a3765130fb171c06b448c50a74e65ac8ae11 diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs index 872a52f..2791616 100644 --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable , OverloadedStrings + , RecordWildCards , UnboxedTuples , UnicodeSyntax , ViewPatterns @@ -24,8 +25,6 @@ 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 @@ -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 $ fmtDec 3 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@.