@@ -3,12 +3,16 @@
33module Network.Wai.Parse
44 ( parseQueryString
55 , parseCookies
6+ , parseHttpAccept
67 ) where
78
89import qualified Data.ByteString as S
10+import qualified Data.ByteString.Char8 as S8
911import Data.Word (Word8)
1012import Data.Bits
1113import Data.Maybe (fromMaybe)
14+import Data.List (sortBy)
15+import Data.Function (on)
1216
1317uncons :: S.ByteString -> Maybe (Word8, S.ByteString)
1418uncons s
@@ -74,3 +78,24 @@ parseCookie s =
7478 let (key, value) = breakDiscard 61 s -- equals sign
7579 key' = S.dropWhile (== 32) key -- space
7680 in (key', value)
81+
82+-- | Parse the HTTP accept string to determine supported content types.
83+parseHttpAccept :: S.ByteString -> [S.ByteString]
84+parseHttpAccept = map fst
85+ . sortBy (rcompare `on` snd)
86+ . map grabQ
87+ . split
88+ where
89+ rcompare x y = compare y x
90+ grabQ s =
91+ let (s', q) = breakDiscard 59 s -- semicolon
92+ (_, q') = breakDiscard 61 q -- equals sign
93+ in (trimWhite s', readQ $ trimWhite q')
94+ readQ s = case reads $ S8.unpack s of
95+ (x, _):_ -> x
96+ _ -> 1.0
97+ trimWhite = S.dropWhile (== 32) -- space
98+ split s
99+ | S.null s = []
100+ | otherwise = let (x, y) = breakDiscard 44 s -- comma
101+ in x : split y