{-# LANGUAGE
    OverloadedStrings
  , UnicodeSyntax
  #-}
module Network.HTTP.Lucu.ContentCoding
    ( AcceptEncoding(..)

    , acceptEncodingListP
    , normalizeCoding
    , unnormalizeCoding
    )
    where
import Control.Applicative
import Data.Ascii (CIAscii, toCIAscii)
import Data.Attoparsec.Char8
import Data.Ord
import Data.Maybe
import Network.HTTP.Lucu.Parser.Http
import Prelude.Unicode

data AcceptEncoding
    = AcceptEncoding {
        aeEncoding ∷ !CIAscii
      , aeQValue   ∷ !(Maybe Double)
      }
      deriving (Eq, Show)

instance Ord AcceptEncoding where
    (AcceptEncoding c1 q1) `compare` (AcceptEncoding c2 q2)
        | q1' > q1' = GT
        | q1' < q2' = LT
        | otherwise = compare c1 c2
        where
          q1' = fromMaybe 0 q1
          q2' = fromMaybe 0 q2

acceptEncodingListP ∷ Parser [AcceptEncoding]
acceptEncodingListP = listOf accEncP

accEncP ∷ Parser AcceptEncoding
accEncP = do coding ← toCIAscii <$> token
             qVal   ← option Nothing
                      $ do _ ← string ";q="
                           q ← qvalue
                           return $ Just q
             return $ AcceptEncoding (normalizeCoding coding) qVal

normalizeCoding ∷ CIAscii → CIAscii
normalizeCoding coding
    = if coding ≡ "x-gzip" then
          "gzip"
      else
          if coding ≡ "x-compress" then
              "compress"
          else
              coding

unnormalizeCoding ∷ CIAscii → CIAscii
unnormalizeCoding coding
    = if coding ≡ "gzip" then
          "x-gzip"
      else
          if coding ≡ "compress" then
              "x-compress"
          else
              coding