Code reorganisation

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

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index c18819f8f8ceb782a7e1938f3121c7a5d887beab..93291a779430c2f98e6e8ab6f6a4caa9fdcb6ff8 100644 (file)
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -1,27 +1,20 @@
 {-# LANGUAGE
-    OverloadedStrings
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
   , RecordWildCards
+  , TemplateHaskell
   , UnicodeSyntax
   , ViewPatterns
   #-}
--- |Definition of things related on HTTP response.
+-- |Definition of HTTP responses.
 module Network.HTTP.Lucu.Response
-    ( -- * Class and Types
-      StatusCode(..)
-    , SomeStatusCode(..)
-    , Response(..)
-    , statusCodes
-    , module Network.HTTP.Lucu.StatusCode
-
-      -- * Functions
+    ( Response(..)
+
     , emptyResponse
     , setStatusCode
     , resCanHaveBody
-    , printStatusCode
-    , printResponse
 
-    , (≈)
-    , (≉)
     , isInformational
     , isSuccessful
     , isRedirection
@@ -30,20 +23,16 @@ 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
-import Network.HTTP.Lucu.StatusCode
-import Network.HTTP.Lucu.StatusCode.Internal
+import Network.HTTP.Lucu.Response.StatusCode
 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
@@ -55,6 +44,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
@@ -76,21 +82,11 @@ setStatusCode sc res
 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 " "        ⊕
-      printStatusCode  resStatus  ⊕
-      A.toAsciiBuilder "\x0D\x0A" ⊕
-      printHeaders     resHeaders
+    | isInformational resStatus   = False
+    | resStatus ≡ cs NoContent    = False
+    | resStatus ≡ cs ResetContent = False
+    | resStatus ≡ cs NotModified  = False
+    | otherwise                   = True
 
 -- |@'isInformational' sc@ returns 'True' iff @sc '<' 200@.
 isInformational ∷ StatusCode sc ⇒ sc → Bool