, 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
, statusCode
)
where
-import Data.Ascii (Ascii)
+import Data.Ascii (Ascii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.Monoid.Unicode
import Data.Typeable
-import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Utils
| 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 $
- ( show3 num ⊕
+ = ( show3 num ⊕
A.toAsciiBuilder " " ⊕
A.toAsciiBuilder msg
)
getHeaders = resHeaders
setHeaders res hdr = res { resHeaders = hdr }
-hPutResponse ∷ HandleLike h ⇒ h → Response → IO ()
-hPutResponse h (Response {..})
- = do hPutHttpVersion h resVersion
- hPutChar h ' '
- hPutStatus h resStatus
- hPutBS h "\r\n"
- hPutHeaders h resHeaders
-
-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)
+-- |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