+{-# LANGUAGE
+ FlexibleInstances
+ , MultiParamTypeClasses
+ , TypeSynonymInstances
+ , OverloadedStrings
+ , UnicodeSyntax
+ #-}
module Network.HTTP.Lucu.ContentCoding
- ( acceptEncodingListP
+ ( AcceptEncoding(..)
, normalizeCoding
, unnormalizeCoding
- , orderAcceptEncodings
)
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
-import Data.Char
-import Data.Ord
-import Data.Maybe
-import Network.HTTP.Lucu.Parser
-import Network.HTTP.Lucu.Parser.Http
+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 [(String, Maybe Double)]
-acceptEncodingListP = allowEOF $! listOf accEncP
+instance Default (Parser [AcceptEncoding]) where
+ {-# INLINE def #-}
+ def = listOf def
-
-accEncP :: Parser (String, Maybe Double)
-accEncP = do coding <- token
- qVal <- option Nothing
- $ do string ";q="
- q <- qvalue
- return $ Just q
- return (normalizeCoding coding, qVal)
+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 :: String -> String
+normalizeCoding ∷ CIAscii → CIAscii
+{-# INLINEABLE normalizeCoding #-}
normalizeCoding coding
- = case map toLower coding of
- "x-gzip" -> "gzip"
- "x-compress" -> "compress"
- other -> other
-
+ | coding ≡ "x-gzip" = "gzip"
+ | coding ≡ "x-compress" = "compress"
+ | otherwise = coding
-unnormalizeCoding :: String -> String
+unnormalizeCoding ∷ CIAscii → CIAscii
+{-# INLINEABLE unnormalizeCoding #-}
unnormalizeCoding coding
- = case map toLower coding of
- "gzip" -> "x-gzip"
- "compress" -> "x-compress"
- other -> other
-
-
-orderAcceptEncodings :: (String, Maybe Double) -> (String, Maybe Double) -> Ordering
-orderAcceptEncodings (_, q1) (_, q2)
- = comparing (fromMaybe 0) q1 q2
-
+ | coding ≡ "gzip" = "x-gzip"
+ | coding ≡ "compress" = "x-compress"
+ | otherwise = coding