{-# LANGUAGE
    FlexibleInstances
  , MultiParamTypeClasses
  , OverloadedStrings
  , RecordWildCards
  , TemplateHaskell
  , UnicodeSyntax
  , ViewPatterns
  #-}
-- |Definition of HTTP responses.
module Network.HTTP.Lucu.Response
    ( Response(..)

    , emptyResponse
    , setStatusCode
    , resCanHaveBody

    , isInformational
    , isSuccessful
    , isRedirection
    , isError
    , isClientError
    , isServerError
    )
    where
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.Response.StatusCode
import Prelude.Unicode

-- |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 }

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
    = 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 ≡ 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
{-# 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