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