X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=8f45440a603411875b05a8d35a760734660941f9;hp=0ebfa71080647983d95d428fa6bda605239c1185;hb=bb41be0c967538a1014c87103a3a5d3840ad3e15;hpb=38462ddf67732513c21b348cffb7cae436800339

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 0ebfa71..8f45440 100644
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE
-    OverloadedStrings
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
   , RecordWildCards
+  , TemplateHaskell
   , UnicodeSyntax
   , ViewPatterns
   #-}
@@ -15,10 +18,11 @@ module Network.HTTP.Lucu.Response
 
       -- * Functions
     , emptyResponse
+    , setStatusCode
     , resCanHaveBody
-    , printStatusCode
-    , printResponse
 
+    , (≈)
+    , (≉)
     , isInformational
     , isSuccessful
     , isRedirection
@@ -27,8 +31,10 @@ module Network.HTTP.Lucu.Response
     , isServerError
     )
     where
-import Data.Ascii (AsciiBuilder)
-import qualified Data.Ascii as A
+import Data.Ascii (Ascii, AsciiBuilder)
+import Data.Convertible.Base
+import Data.Convertible.Instances.Ascii ()
+import Data.Convertible.Utils
 import Data.Monoid.Unicode
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
@@ -36,11 +42,6 @@ import Network.HTTP.Lucu.StatusCode
 import Network.HTTP.Lucu.StatusCode.Internal
 import Prelude.Unicode
 
--- |Convert a 'StatusCode' to an 'AsciiBuilder'.
-printStatusCode ∷ StatusCode sc ⇒ sc → AsciiBuilder
-{-# INLINEABLE printStatusCode #-}
-printStatusCode = A.toAsciiBuilder ∘ textualStatus
-
 -- |This is the definition of an HTTP response.
 data Response = Response {
       resVersion ∷ !HttpVersion
@@ -52,6 +53,23 @@ instance HasHeaders Response where
     getHeaders         = resHeaders
     setHeaders res hdr = res { resHeaders = hdr }
 
+instance ConvertSuccess Response Ascii where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
+
+instance ConvertSuccess Response AsciiBuilder where
+    {-# INLINE convertSuccess #-}
+    convertSuccess (Response {..})
+        = cs resVersion           ⊕
+          cs (" " ∷ Ascii)        ⊕
+          cs resStatus            ⊕
+          cs ("\x0D\x0A" ∷ Ascii) ⊕
+          cs resHeaders
+
+deriveAttempts [ ([t| Response |], [t| Ascii        |])
+               , ([t| Response |], [t| AsciiBuilder |])
+               ]
+
 -- |Returns an HTTP\/1.1 'Response' with no header fields.
 emptyResponse ∷ StatusCode sc ⇒ sc → Response
 emptyResponse sc
@@ -61,53 +79,50 @@ emptyResponse sc
       , resHeaders = (∅)
       }
 
+-- |@'setStatusCode' sc res@ sets the status code of @res@ to @sc@.
+setStatusCode ∷ StatusCode sc ⇒ sc → Response → Response
+setStatusCode sc res
+    = res {
+        resStatus = fromStatusCode sc
+      }
+
 -- |Returns 'True' iff a given 'Response' allows the existence of
 -- response entity body.
 resCanHaveBody ∷ Response → Bool
 {-# INLINEABLE resCanHaveBody #-}
 resCanHaveBody (Response {..})
-    | isInformational resStatus                  = False
-    | toStatusCode resStatus ≡ Just NoContent    = False
-    | toStatusCode resStatus ≡ Just ResetContent = False
-    | toStatusCode resStatus ≡ Just NotModified  = False
-    | otherwise                                  = True
-
--- |Convert a 'Response' to 'AsciiBuilder'.
-printResponse ∷ Response → AsciiBuilder
-{-# INLINEABLE printResponse #-}
-printResponse (Response {..})
-    = printHttpVersion resVersion ⊕
-      A.toAsciiBuilder " "        ⊕
-      printStatusCode  resStatus  ⊕
-      A.toAsciiBuilder "\x0D\x0A" ⊕
-      printHeaders     resHeaders
-
--- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
+    | isInformational resStatus = False
+    | resStatus ≈ NoContent     = False
+    | resStatus ≈ ResetContent  = False
+    | resStatus ≈ NotModified   = False
+    | otherwise                 = True
+
+-- |@'isInformational' sc@ returns 'True' iff @sc '<' 200@.
 isInformational ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isInformational #-}
 isInformational = satisfy (< 200)
 
--- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
+-- |@'isSuccessful' sc@ returns 'True' iff @200 '<=' sc '<' 300@.
 isSuccessful ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isSuccessful #-}
 isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
 
--- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
+-- |@'isRedirection' sc@ returns 'True' iff @300 '<=' sc '<' 400@.
 isRedirection ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isRedirection #-}
 isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
 
--- |@'isError' sc@ returns 'True' iff @400 <= sc@
+-- |@'isError' sc@ returns 'True' iff @400 '<=' sc@
 isError ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isError #-}
 isError = satisfy (≥ 400)
 
--- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
+-- |@'isClientError' sc@ returns 'True' iff @400 '<=' sc '<' 500@.
 isClientError ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isClientError #-}
 isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
 
--- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
+-- |@'isServerError' sc@ returns 'True' iff @500 '<=' sc@.
 isServerError ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isServerError #-}
 isServerError = satisfy (≥ 500)