{-# LANGUAGE
    OverloadedStrings
  , RecordWildCards
  , UnicodeSyntax
  , ViewPatterns
  #-}
-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
    ( -- * Class and Types
      StatusCode(..)
    , SomeStatusCode(..)
    , Response(..)
    , statusCodes
    , module Network.HTTP.Lucu.StatusCode

      -- * Functions
    , emptyResponse
    , setStatusCode
    , resCanHaveBody
    , printStatusCode
    , printResponse

    , (≈)
    , (≉)
    , isInformational
    , isSuccessful
    , isRedirection
    , isError
    , isClientError
    , isServerError
    )
    where
import Data.Ascii (AsciiBuilder)
import qualified Data.Ascii as A
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 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
    , resStatus  ∷ !SomeStatusCode
    , resHeaders ∷ !Headers
    } deriving (Show, Eq)

instance HasHeaders Response where
    getHeaders         = resHeaders
    setHeaders res hdr = res { resHeaders = hdr }

-- |Returns an HTTP\/1.1 'Response' with no header fields.
emptyResponse ∷ StatusCode sc ⇒ sc → Response
emptyResponse sc
    = Response {
        resVersion = HttpVersion 1 1
      , resStatus  = fromStatusCode 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
    | resStatus ≈ NoContent     = False
    | resStatus ≈ ResetContent  = False
    | resStatus ≈ NotModified   = False
    | otherwise                 = True

-- |Convert a 'Response' to 'AsciiBuilder'.
printResponse ∷ Response → AsciiBuilder
{-# INLINEABLE printResponse #-}
printResponse (Response {..})
    = cs resVersion ⊕
      A.toAsciiBuilder " "        ⊕
      printStatusCode  resStatus  ⊕
      A.toAsciiBuilder "\x0D\x0A" ⊕
      cs resHeaders

-- |@'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 ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isSuccessful #-}
isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)

-- |@'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 ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isError #-}
isError = satisfy (≥ 400)

-- |@'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 ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isServerError #-}
isServerError = satisfy (≥ 500)

satisfy ∷ StatusCode sc ⇒ (Int → Bool) → sc → Bool
{-# INLINE satisfy #-}
satisfy p (numericCode → num) = p num