diff --git a/Network/HTTP/Accept.hs b/Network/HTTP/Accept.hs
--- a/Network/HTTP/Accept.hs
+++ b/Network/HTTP/Accept.hs
@@ -1,7 +1,10 @@
 module Network.HTTP.Accept (selectAcceptType) where
 
 import Data.Char (isAscii)
-import Data.Maybe (mapMaybe, listToMaybe)
+import Data.Ord (comparing)
+import Data.List (maximumBy, minimumBy)
+import Data.Maybe (catMaybes, mapMaybe)
+import Control.Monad (liftM2)
 import Control.Arrow (first)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS (singleton, split)
@@ -9,18 +12,44 @@
 
 data Pattern a = PatternAny | PatternExactly a
 
-instance (Eq a) => Eq (Pattern a) where
-	PatternAny == _ = True
-	_ == PatternAny = True
-	(PatternExactly a) == (PatternExactly b) = a == b
+class Match a where
+	match :: a -> a -> Maybe Int
 
+instance (Eq a) => Match (Pattern a) where
+	match PatternAny _ = Just 0
+	match _ PatternAny = Just 0
+	match (PatternExactly a) (PatternExactly b)
+		| a == b = Just 1
+		| otherwise = Nothing
+
+instance (Match a, Match b) => Match (a, b) where
+	match (a1, a2) (b1, b2) = liftM2 (+) (match a1 b1) (match a2 b2)
+
+instance (Match a) => Match (Maybe a) where
+	match Nothing Nothing   = Just 0
+	match Nothing _         = Nothing
+	match _       Nothing   = Nothing
+	match (Just a) (Just b) = fmap (+1) (match a b)
+
+maxMatchIndex :: (Match a) => a -> [a] -> Maybe Int
+maxMatchIndex k xs = fmap fst $ maybeMax (comparing snd) $ catMaybes $
+	zipWith (\i x -> fmap ((,)i) (match k x)) [0..] xs
+
+maybeMax :: (a -> a -> Ordering) -> [a] -> Maybe a
+maybeMax _ [] = Nothing
+maybeMax cmp xs = Just (maximumBy cmp xs)
+
+maybeMin :: (a -> a -> Ordering) -> [a] -> Maybe a
+maybeMin _ [] = Nothing
+maybeMin cmp xs = Just (minimumBy cmp xs)
+
 -- | Select which Accept type to use
 selectAcceptType ::
 	[String]        -- ^ List of supported MIME types, in preferred order
 	-> [ByteString] -- ^ List of types from Accept, pre-sorted with no q
 	-> Maybe String -- ^ Just the selected supported type, or else Nothing
-selectAcceptType supported accept =
-	listToMaybe $ mapMaybe (`lookup` supported') accept'
+selectAcceptType supported accept = fmap fst $ maybeMin (comparing snd) $
+	mapMaybe (\(p,s) -> fmap ((,)s) (maxMatchIndex p accept')) supported'
 	where
 	accept' = map (Just . parseAccept) accept
 	supported' = map (first $ fmap parseAccept . stringAscii)
diff --git a/http-accept.cabal b/http-accept.cabal
--- a/http-accept.cabal
+++ b/http-accept.cabal
@@ -1,5 +1,5 @@
 name:            http-accept
-version:         0.1
+version:         0.2
 cabal-version:   >= 1.8
 license:         OtherLicense
 license-file:    COPYING