From ecd53e3febedb5c6d911a56886e80d111aafceef Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Tue, 9 Oct 2012 18:36:19 -0500
Subject: [PATCH] Order by specificity for items with the same q

Closes #118
---
 wai-extra/Network/Wai/Parse.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/wai-extra/Network/Wai/Parse.hs b/wai-extra/Network/Wai/Parse.hs
index d31227c3..cf4df10c 100644
--- a/wai-extra/Network/Wai/Parse.hs
+++ b/wai-extra/Network/Wai/Parse.hs
@@ -58,11 +58,16 @@ 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 =
         -- Stripping all spaces may be too harsh.
         -- Maybe just strip either side of semicolon?