Network/HTTP/Lucu/ContentCoding.hs

   1 module Network.HTTP.Lucu.ContentCoding
   2     ( acceptEncodingListP
   3     , normalizeCoding
   4     , unnormalizeCoding
   5     , orderAcceptEncodings
   6     )
   7     where
   8
   9 import           Data.Char
  10 import           Data.Maybe
  11 import           Network.HTTP.Lucu.Parser
  12 import           Network.HTTP.Lucu.Parser.Http
  13
  14
  15 acceptEncodingListP :: Parser [(String, Maybe Double)]
  16 acceptEncodingListP = allowEOF $! listOf accEncP
  17
  18
  19 accEncP :: Parser (String, Maybe Double)
  20 accEncP = do coding <- token
  21              qVal   <- option Nothing
  22                        $ do string ";q="
  23                             q <- qvalue
  24                             return $ Just q
  25              return (normalizeCoding coding, qVal)
  26
  27
  28 normalizeCoding :: String -> String
  29 normalizeCoding coding
  30     = case map toLower coding of
  31         "x-gzip"     -> "gzip"
  32         "x-compress" -> "compress"
  33         other        -> other
  34
  35
  36 unnormalizeCoding :: String -> String
  37 unnormalizeCoding coding
  38     = case map toLower coding of
  39         "gzip"     -> "x-gzip"
  40         "compress" -> "x-compress"
  41         other        -> other
  42
  43
  44 orderAcceptEncodings :: (String, Maybe Double) -> (String, Maybe Double) -> Ordering
  45 orderAcceptEncodings (_, q1) (_, q2)
  46     = fromMaybe 0 q1 `compare` fromMaybe 0 q2