{-# LANGUAGE
    FlexibleInstances
  , MultiParamTypeClasses
  , TypeSynonymInstances
  , OverloadedStrings
  , UnicodeSyntax
  #-}
module Network.HTTP.Lucu.ContentCoding
    ( AcceptEncoding(..)
    , normalizeCoding
    , unnormalizeCoding
    )
    where
import Control.Applicative
import Data.Ascii (CIAscii, toCIAscii)
import Data.Attoparsec.Char8
import Data.Default
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

instance Default (Parser [AcceptEncoding]) where
    {-# INLINE def #-}
    def = listOf def

instance Default (Parser AcceptEncoding) where
    {-# INLINEABLE def #-}
    def = do coding ← toCIAscii <$> token
             qVal   ← option Nothing
                          $ do _ ← string ";q="
                               q ← qvalue
                               return $ Just q
             return $ AcceptEncoding (normalizeCoding coding) qVal

normalizeCoding ∷ CIAscii → CIAscii
{-# INLINEABLE normalizeCoding #-}
normalizeCoding coding
    | coding ≡ "x-gzip"     = "gzip"
    | coding ≡ "x-compress" = "compress"
    | otherwise             = coding

unnormalizeCoding ∷ CIAscii → CIAscii
{-# INLINEABLE unnormalizeCoding #-}
unnormalizeCoding coding
    | coding ≡ "gzip"     = "x-gzip"
    | coding ≡ "compress" = "x-compress"
    | otherwise           = coding