Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Fixes to Accept parser #119

Merged
merged 3 commits into from

2 participants

@singpolyma

Fixes #117 and #118

@snoyberg
Owner

Would it be possible to a unit test to the test suite to cover this new functionality?

@singpolyma singpolyma Modify test suite for Accept parser
Add cases for extra params and for sorting by specificity.
16e70b8
@singpolyma

Oh, I looked for a test suite, but I guess I looked wrong :) Added.

@snoyberg snoyberg merged commit 16e70b8 into yesodweb:master
@snoyberg
Owner

Looks good, new version 1.3.0.3 is now on Hackage.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Oct 9, 2012
  1. @singpolyma
  2. @singpolyma
Commits on Oct 10, 2012
  1. @singpolyma

    Modify test suite for Accept parser

    singpolyma authored
    Add cases for extra params and for sorting by specificity.
This page is out of date. Refresh to see the latest.
Showing with 14 additions and 8 deletions.
  1. +12 −6 wai-extra/Network/Wai/Parse.hs
  2. +2 −2 wai-extra/test/WaiExtraTest.hs
View
18 wai-extra/Network/Wai/Parse.hs
@@ -58,19 +58,25 @@ breakDiscard w s =
parseHttpAccept :: S.ByteString -> [S.ByteString]
parseHttpAccept = map fst
. sortBy (rcompare `on` snd)
- . map grabQ
+ . map (addSpecificity . grabQ)
. S.split 44 -- comma
where
- rcompare :: Double -> Double -> Ordering
+ rcompare :: (Double,Int) -> (Double,Int) -> Ordering
rcompare = flip compare
+ addSpecificity (s, q) =
+ -- Prefer higher-specificity types
+ let semicolons = S.count 0x3B s
+ stars = S.count 0x2A s
+ in (s, (q, semicolons - stars))
grabQ s =
- let (s', q) = breakDiscard 59 s -- semicolon
- (_, q') = breakDiscard 61 q -- equals sign
- in (trimWhite s', readQ $ trimWhite q')
+ -- Stripping all spaces may be too harsh.
+ -- Maybe just strip either side of semicolon?
+ let (s', q) = S.breakSubstring ";q=" (S.filter (/=0x20) s) -- 0x20 is space
+ q' = S.takeWhile (/=0x3B) (S.drop 3 q) -- 0x3B is semicolon
+ in (s', readQ q')
readQ s = case reads $ S8.unpack s of
(x, _):_ -> x
_ -> 1.0
- trimWhite = S.dropWhile (== 32) -- space
-- | Store uploaded files in memory
lbsBackEnd :: Monad m => ignored1 -> ignored2 -> Sink S.ByteString m L.ByteString
View
4 wai-extra/test/WaiExtraTest.hs
@@ -97,8 +97,8 @@ caseParseQueryStringQM = do
caseParseHttpAccept :: Assertion
caseParseHttpAccept = do
- let input = "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c"
- expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]
+ let input = "text/plain; q=0.5, text/html;charset=utf-8, text/*;q=0.8;ext=blah, text/x-dvi; q=0.8, text/x-c"
+ expected = ["text/html;charset=utf-8", "text/x-c", "text/x-dvi", "text/*", "text/plain"]
expected @=? parseHttpAccept input
parseRequestBody' :: BackEnd L.ByteString
Something went wrong with that request. Please try again.