diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,26 +1,18 @@
 Snap-Predicates
 ===============
 
-This library provides a definition of a type-class `Predicate`
+This library provides the definition of a type-class `Predicate`
 together with several concrete implementations which are used to
 constrain the set of possible `Snap` handlers in a type-safe
 way.
 
-Example
--------
-
-```haskell
-{-# LANGUAGE OverloadedStrings, TypeOperators #-}
-module Main where
+A module [Snap.Predicates.Tutorial](http://hackage.haskell.org/packages/archive/snap-predicates/latest/doc/html/Snap-Predicates-Tutorial.html)
+is included, outlining the basic concepts.
 
-import Data.ByteString (ByteString)
-import Data.Monoid
-import Data.Predicate
-import Snap.Core
-import Snap.Routes
-import Snap.Predicates
-import Snap.Http.Server
+Example Usage
+-------------
 
+```haskell
 main :: IO ()
 main = do
     mapM_ putStrLn (showRoutes sitemap)
@@ -28,32 +20,17 @@
 
 sitemap :: Routes Snap ()
 sitemap = do
-    get "/a" getUser $
-        AcceptJson :&: (Param "name" :|: Param "nick") :&: Param "foo"
-
-    get "/b" getUser' $
-        AcceptJson :&: (Param "name" :||: Param "nick") :&: Param "foo"
-
-    get  "/status" status      $ Fail (410, Just "Gone.")
-    post "/"       createUser  $ AcceptThrift
-    post "/"       createUser' $ AcceptJson
-
-getUser :: AcceptJson :*: ByteString :*: ByteString -> Snap ()
-getUser (_ :*: name :*: foo) =
-    writeBS $ "getUser: name or nick=" <> name <> " foo=" <> foo
+    head_ "/status" (const $ return ())
 
-getUser' :: AcceptJson :*: (ByteString :+: ByteString) :*: ByteString -> Snap ()
-getUser' (_ :*: name :*: foo) =
-    case name of
-        Left  a -> writeBS $ "getUser: name=" <> a <> " foo=" <> foo
-        Right b -> writeBS $ "getUser: nick=" <> b <> " foo=" <> foo
+    get  "/foo" listFoo $
+        Accept Text Plain :&: ParamDef "off" 0 :&: ParamDef "size" 100
 
-createUser :: AcceptThrift -> Snap ()
-createUser _ = writeBS "createUser"
+    post "/foo" createFoo $
+        Accept Text Plain :&: ContentType Application Protobuf
 
-createUser' :: AcceptJson -> Snap ()
-createUser' _ = writeBS "createUser'"
+listFoo :: MediaType Text Plain :*: Int :*: Int -> Snap ()
+listFoo (_mt :*: _off :*: _size) = return ()
 
-status :: AcceptJson :*: Char -> Snap ()
-status _ = writeBS "status"
+createFoo :: MediaType Text Plain :*: Content Application Protobuf -> Snap ()
+createFoo (_mt :*: _ct) = return ()
 ```
diff --git a/snap-predicates.cabal b/snap-predicates.cabal
--- a/snap-predicates.cabal
+++ b/snap-predicates.cabal
@@ -1,6 +1,6 @@
 name:                snap-predicates
-version:             0.1.0
-synopsis:            Predicates for route definitions.
+version:             0.2.0
+synopsis:            Declarative routing for Snap.
 license:             MIT
 license-file:        LICENSE
 author:              Toralf Wittner, Brendan Hay
@@ -13,7 +13,7 @@
 extra-source-files:  README.md
 
 description:
-    Provides a definition of a predicate type-class together
+    Provides the definition of a predicate type-class together
     with several concrete implementations which are used to
     constrain the set of possible Snap handlers in a type-safe
     way.
@@ -25,27 +25,34 @@
     ghc-prof-options: -prof -auto-all
 
     exposed-modules:
-        Data.Predicate
+        Data.ByteString.Readable
+      , Data.Predicate
+      , Data.Predicate.Env
       , Snap.Predicates
-      , Snap.Routes
+      , Snap.Predicates.Accept
+      , Snap.Predicates.Error
+      , Snap.Predicates.Params
+      , Snap.Predicates.Content
+      , Snap.Predicates.MediaTypes
       , Snap.Predicates.Tutorial
+      , Snap.Routes
 
+    other-modules:
+        Snap.Predicates.Internal
+        Snap.Predicates.MediaTypes.Internal
+      , Snap.Predicates.Parsers.Accept
+      , Snap.Predicates.Parsers.Shared
+
     build-depends:
         base             >= 4   && < 5
       , transformers     >= 0.3
+      , monads-tf        >= 0.1
       , bytestring       >= 0.9
+      , text             >= 0.11
       , containers       >= 0.5
       , case-insensitive >= 1.0
       , snap-core        >= 0.9
-
-    other-extensions:
-       BangPatterns
-     , FlexibleInstances
-     , GADTs
-     , MultiParamTypeClasses
-     , OverloadedStrings
-     , TypeFamilies
-     , TypeOperators
+      , attoparsec       >= 0.10
 
 test-suite snap-predicates-test-suite
     type:             exitcode-stdio-1.0
@@ -63,10 +70,14 @@
     build-depends:
         base             >= 4   && < 5
       , transformers     >= 0.3
+      , monads-tf        >= 0.1
       , bytestring       >= 0.9
+      , text             >= 0.11
       , containers       >= 0.5
       , case-insensitive >= 1.0
       , snap-core        >= 0.9
+      , text             >= 0.11
+      , attoparsec       >= 0.10
 
       , HUnit                      >= 1.2
       , QuickCheck                 >= 2.3
@@ -74,15 +85,6 @@
       , test-framework-hunit       >= 0.2
       , test-framework-quickcheck2 >= 0.2
 
-    other-extensions:
-       BangPatterns
-     , FlexibleInstances
-     , GADTs
-     , MultiParamTypeClasses
-     , OverloadedStrings
-     , TypeFamilies
-     , TypeOperators
-
 source-repository head
     type:             git
-    location:         https://github.com/twittner/snap-predicates
+    location:         git://github.com/twittner/snap-predicates.git
diff --git a/src/Data/ByteString/Readable.hs b/src/Data/ByteString/Readable.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ByteString/Readable.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections     #-}
+module Data.ByteString.Readable (Readable (..)) where
+
+import Control.Applicative
+import Data.ByteString (ByteString)
+import Data.Monoid
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+import Data.Text.Read
+import qualified Data.Text as T
+import qualified Data.ByteString as S
+
+-- | The type-class 'Readable' is used to convert 'ByteString' values to
+-- values of other types. Most instances assume the 'ByteString' is
+-- encoded via UTF-8.
+--
+-- Minimal complete instance definition is given by 'readByteString'.
+class Readable a where
+    -- | Parse the given 'ByteString' into a typed value and also return
+    -- the unconsumed bytes. In case of error, provide an error message.
+    readByteString :: ByteString -> Either ByteString (a, ByteString)
+
+    -- | Parse the given 'ByteString' into a list of typed values and
+    -- return the unconsumed bytes. In case of error, provide an error
+    -- message. Instances can use this function to express their way of
+    -- reading lists of values. The default implementation parses
+    -- comma-separated values (also accepting interspersed spaces).
+    readByteStringList :: ByteString -> Either ByteString ([a], ByteString)
+    readByteStringList s = parseList ([], s)
+
+    -- | Either turn the given 'ByteString' into a typed value or an error
+    -- message. This function also checks, that all input bytes have been
+    -- consumed or else it will fail.
+    fromByteString :: ByteString -> Either ByteString a
+    fromByteString s = do
+        (v, s') <- readByteString s
+        if S.null s'
+            then Right v
+            else Left ("unconsumed bytes: '" <> s' <> "'.")
+
+parseList :: Readable a => ([a], ByteString) -> Either ByteString ([a], ByteString)
+parseList (!acc, !s)
+    | S.null s  = return (reverse acc, s)
+    | otherwise = do
+        (a, s') <- readByteString s
+        parseList (a:acc, S.dropWhile noise s')
+  where
+    noise w = w `elem` [0x20, 0x2C] -- [' ', ',']
+
+instance Readable a => Readable (Maybe a) where
+    readByteString s =
+        case readByteString s of
+            Left       _  -> Right (Nothing, "")
+            Right (v, s') -> Right (Just v, s')
+
+instance Readable a => Readable [a] where
+    readByteString = readByteStringList
+
+instance Readable ByteString where
+    readByteString = Right . (, "")
+
+instance Readable Text where
+    readByteString s = (, "") <$> mapLeft (decodeUtf8' s)
+
+instance Readable Char where
+    readByteString s = do
+        t <- mapLeft (decodeUtf8' s)
+        return (T.head t, encodeUtf8 (T.tail t))
+
+    readByteStringList s = (, "") . T.unpack <$> mapLeft (decodeUtf8' s)
+
+instance Readable Double where
+    readByteString = parse (signed double)
+
+instance Readable Int where
+    readByteString = parse (signed decimal)
+
+mapLeft :: Show e => Either e a -> Either ByteString a
+mapLeft (Left  s) = Left (encodeUtf8 . T.pack . show $ s)
+mapLeft (Right x) = Right x
+
+parse :: (Text -> Either String (a, Text)) -> ByteString -> Either ByteString (a, ByteString)
+parse f s = do
+    t <- mapLeft (decodeUtf8' s)
+    case f t of
+        Left       e  -> Left (encodeUtf8 (T.pack e))
+        Right (v, t') -> return (v, encodeUtf8 t')
diff --git a/src/Data/Predicate.hs b/src/Data/Predicate.hs
--- a/src/Data/Predicate.hs
+++ b/src/Data/Predicate.hs
@@ -5,14 +5,30 @@
 {-# LANGUAGE FlexibleInstances     #-}
 module Data.Predicate where
 
+import Prelude hiding (and, or)
 import Control.Applicative hiding (Const)
-import Control.Monad
+import Control.Monad.State.Strict
+import Data.Predicate.Env (Env)
+import qualified Data.Predicate.Env as E
 
+-- | 'Delta' is a measure of distance. It is (optionally)
+-- used in predicates that evaluate to 'T' but not uniquely so, i.e.
+-- different evaluations of 'T' are possible and they may have a different
+-- \"fitness\".
+--
+-- An example is content-negotiation. A HTTP request may specify
+-- a preference list of various media-types. A predicate matching one
+-- specific media-type evaluates to 'T', but other media-types may match
+-- even better. To represent this ambivalence, the predicate will include
+-- a delta value which can be used to decide which of the matching
+-- predicates should be preferred.
+type Delta = Double
+
 -- | A 'Bool'-like type where each branch 'T'rue or 'F'alse carries
 -- some meta-data which is threaded through 'Predicate' evaluation.
-data Boolean f t =
-    F (Maybe f) -- ^ logical False with some meta-data
-  | T t         -- ^ logical True with some meta-data
+data Boolean f t
+  = F f       -- ^ logical False with some meta-data
+  | T Delta t -- ^ logical True with some meta-data
   deriving (Eq, Show)
 
 -- | The 'Predicate' class declares the function 'apply' which
@@ -24,28 +40,7 @@
 class Predicate p a where
     type FVal p
     type TVal p
-    apply :: p -> a -> Boolean (FVal p) (TVal p)
-
-instance Monad (Boolean f) where
-    return      = T
-    (T x) >>= g = g x
-    (F x) >>= _ = F x
-
-instance MonadPlus (Boolean f) where
-    mzero           = F Nothing
-    (F _) `mplus` b = b
-    b     `mplus` _ = b
-
-instance Functor (Boolean f) where
-    fmap = liftM
-
-instance Applicative (Boolean f) where
-    pure  = return
-    (<*>) = ap
-
-instance Alternative (Boolean f) where
-    empty = mzero
-    (<|>) = mplus
+    apply :: p -> a -> State Env (Boolean (FVal p) (TVal p))
 
 -- | A 'Predicate' instance which always returns 'T' with
 -- the given value as T's meta-data.
@@ -55,7 +50,7 @@
 instance Predicate (Const f t) a where
     type FVal (Const f t) = f
     type TVal (Const f t) = t
-    apply (Const a) _     = T a
+    apply (Const a) _     = return (T 0 a)
 
 instance Show t => Show (Const f t) where
     show (Const a) = "Const " ++ show a
@@ -68,7 +63,7 @@
 instance Predicate (Fail f t) a where
     type FVal (Fail f t) = f
     type TVal (Fail f t) = t
-    apply (Fail a) _     = F $ Just a
+    apply (Fail a) _     = return (F a)
 
 instance Show f => Show (Fail f t) where
     show (Fail a) = "Fail " ++ show a
@@ -76,13 +71,22 @@
 -- | A 'Predicate' instance corresponding to the logical
 -- OR connective of two 'Predicate's. It requires the
 -- meta-data of each 'T'rue branch to be of the same type.
+--
+-- If both arguments evaluate to 'T' the one with the
+-- smaller 'Delta' will be preferred, or--if equal--the
+-- left-hand argument.
 data a :|: b = a :|: b
 
 instance (Predicate a c, Predicate b c, TVal a ~ TVal b, FVal a ~ FVal b) => Predicate (a :|: b) c
   where
     type FVal (a :|: b) = FVal a
     type TVal (a :|: b) = TVal a
-    apply (a :|: b) r   = apply a r <|> apply b r
+    apply (a :|: b) r   = or <$> apply a r <*> apply b r
+      where
+        or x@(T d0 _) y@(T d1 _) = if d1 < d0 then y else x
+        or x@(T _  _)   (F    _) = x
+        or (F      _) x@(T _  _) = x
+        or (F      _) x@(F    _) = x
 
 instance (Show a, Show b) => Show (a :|: b) where
     show (a :|: b) = "(" ++ show a ++ " | " ++ show b ++ ")"
@@ -92,13 +96,22 @@
 -- | A 'Predicate' instance corresponding to the logical
 -- OR connective of two 'Predicate's. The meta-data of
 -- each 'T'rue branch can be of different types.
+--
+-- If both arguments evaluate to 'T' the one with the
+-- smaller 'Delta' will be preferred, or--if equal--the
+-- left-hand argument.
 data a :||: b = a :||: b
 
 instance (Predicate a c, Predicate b c, FVal a ~ FVal b) => Predicate (a :||: b) c
   where
     type FVal (a :||: b) = FVal a
     type TVal (a :||: b) = TVal a :+: TVal b
-    apply (a :||: b) r   = (Left <$> apply a r) <|> (Right <$> apply b r)
+    apply (a :||: b) r   = or <$> apply a r <*> apply b r
+      where
+        or (T d0 t0) (T d1 t1) = if d1 < d0 then T d1 (Right t1) else T d0 (Left t0)
+        or (T  d  t) (F     _) = T d (Left t)
+        or (F     _) (T  d  t) = T d (Right t)
+        or (F     _) (F     f) = F f
 
 instance (Show a, Show b) => Show (a :||: b) where
     show (a :||: b) = "(" ++ show a ++ " || " ++ show b ++ ")"
@@ -114,7 +127,23 @@
   where
     type FVal (a :&: b) = FVal a
     type TVal (a :&: b) = TVal a :*: TVal b
-    apply (a :&: b) r   = (:*:) <$> apply a r <*> apply b r
+    apply (a :&: b) r   = and <$> apply a r <*> apply b r
+      where
+        and (T d x) (T w y) = T (d + w) (x :*: y)
+        and (T _ _) (F   f) = F f
+        and (F   f) _       = F f
 
 instance (Show a, Show b) => Show (a :&: b) where
     show (a :&: b) = "(" ++ show a ++ " & " ++ show b ++ ")"
+
+-- | Evaluate the given predicate 'p' against the given value 'a'.
+eval :: Predicate p a => p -> a -> Boolean (FVal p) (TVal p)
+eval p a = evalState (apply p a) E.empty
+
+-- | The 'with' function will invoke the given function only if the predicate 'p'
+-- applied to the test value 'a' evaluates to 'T'.
+with :: (Monad m, Predicate p a) => p -> a -> (TVal p -> m ()) -> m ()
+with p a f =
+    case eval p a of
+        T _ x -> f x
+        _     -> return ()
diff --git a/src/Data/Predicate/Env.hs b/src/Data/Predicate/Env.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Predicate/Env.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE TypeFamilies #-}
+module Data.Predicate.Env
+  ( Env
+  , empty
+  , lookup
+  , insert
+  )
+where
+
+import Prelude hiding (lookup)
+import Control.Monad.State.Strict
+import Data.ByteString (ByteString)
+import Data.Dynamic
+import qualified Data.Map.Strict as M
+
+-- | An environment for predicates, consisting of
+-- mappings form 'ByteString's to 'Dynamic' values.
+newtype Env = Env
+  { _unenv :: M.Map ByteString Dynamic }
+
+-- | An empty environment.
+empty :: Env
+empty = Env M.empty
+
+-- | Try to get the associated value for the given key.
+-- Only successful iff, (i) 'Env' contains a binding for 'k'
+-- and (ii) the type of value and target match.
+lookup :: (MonadState m, StateType m ~ Env, Typeable a) => ByteString -> m (Maybe a)
+lookup k = gets $ maybe Nothing fromDynamic . M.lookup k . _unenv
+
+-- | Add a binding from key to value to 'Env', overriding
+-- previous bindings if existing.
+insert :: (MonadState m, StateType m ~ Env, Typeable a) => ByteString -> a -> m ()
+insert k v = modify $ Env . M.insert k (toDyn v) . _unenv
diff --git a/src/Snap/Predicates.hs b/src/Snap/Predicates.hs
--- a/src/Snap/Predicates.hs
+++ b/src/Snap/Predicates.hs
@@ -1,78 +1,14 @@
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 module Snap.Predicates
-  ( Accept (..)
-  , AcceptJson (..)
-  , AcceptThrift (..)
-  , Param (..)
+  ( module Snap.Predicates.Error
+  , module Snap.Predicates.Accept
+  , module Snap.Predicates.Content
+  , module Snap.Predicates.MediaTypes
+  , module Snap.Predicates.Params
   )
 where
 
-import Data.ByteString (ByteString)
-import Data.Monoid
-import Data.Word
-import Data.Predicate
-import Snap.Core
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Map.Strict as M
-
--- | A 'Predicate' against the 'Request's "Accept" header.
-data Accept = Accept ByteString deriving Eq
-
-instance Predicate Accept Request where
-    type FVal Accept = (Word, Maybe ByteString)
-    type TVal Accept = ()
-    apply (Accept x) r =
-        if x `elem` headers' r "accept"
-            then T ()
-            else F $ Just (406, Just $ "Expected 'Accept: " <> x <> "'.")
-
-instance Show Accept where
-    show (Accept x) = "Accept: " ++ show x
-
--- | A 'Predicate' which is true only for Accept: "application/json".
-data AcceptJson = AcceptJson deriving Eq
-
-instance Predicate AcceptJson Request where
-    type FVal AcceptJson = (Word, Maybe ByteString)
-    type TVal AcceptJson = AcceptJson
-    apply AcceptJson r =
-        apply (Accept "application/json") r >> return AcceptJson
-
-instance Show AcceptJson where
-    show AcceptJson = "Accept: \"application/json\""
-
--- | A 'Predicate' which is true only for Accept: "application/x-thrift".
-data AcceptThrift = AcceptThrift deriving Eq
-
-instance Predicate AcceptThrift Request where
-    type FVal AcceptThrift = (Word, Maybe ByteString)
-    type TVal AcceptThrift = AcceptThrift
-    apply AcceptThrift r =
-        apply (Accept "application/x-thrift") r >> return AcceptThrift
-
-instance Show AcceptThrift where
-    show AcceptThrift = "Accept: \"application/x-thrift\""
-
--- | A 'Predicate' looking for some parameter value.
-data Param = Param ByteString deriving Eq
-
-instance Predicate Param Request where
-    type FVal Param = (Word, Maybe ByteString)
-    type TVal Param = ByteString
-    apply (Param x) r =
-        case params' r x of
-            []    -> F $ Just (400, Just $ "Expected parameter '" <> x <> "'.")
-            (v:_) -> T v
-
-instance Show Param where
-    show (Param x) = "Param: " ++ show x
-
--- Internal helpers:
-
-headers' :: Request -> ByteString -> [ByteString]
-headers' rq name = maybe [] id . getHeaders (CI.mk name) $ rq
-
-params' :: Request -> ByteString -> [ByteString]
-params' rq name = maybe [] id . M.lookup name . rqParams $ rq
+import Snap.Predicates.Error
+import Snap.Predicates.Accept
+import Snap.Predicates.Content
+import Snap.Predicates.MediaTypes
+import Snap.Predicates.Params
diff --git a/src/Snap/Predicates/Accept.hs b/src/Snap/Predicates/Accept.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Accept.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicates.Accept
+  ( Accept (..)
+  , module Snap.Predicates.MediaTypes
+  )
+where
+
+import Data.Monoid hiding (All)
+import Data.String
+import Data.Predicate
+import Snap.Core hiding (headers)
+import Snap.Predicates.Error
+import Snap.Predicates.MediaTypes
+import Snap.Predicates.MediaTypes.Internal
+import qualified Data.Predicate.Env as E
+
+-- | A 'Predicate' against the 'Request's \"Accept\" header.
+data Accept t s = Accept t s deriving Eq
+
+instance (MType t, MSubType s) => Predicate (Accept t s) Request where
+    type FVal (Accept t s) = Error
+    type TVal (Accept t s) = MediaType t s
+    apply (Accept x y) r   = do
+        mtypes <- E.lookup "accept" >>= maybe (readMediaTypes "accept" r) return
+        if null mtypes
+            then return (T 0 (MediaType x y 1.0 []))
+            else case mediaType True x y mtypes of
+               Just m  -> return (T (1.0 - _quality m) m)
+               Nothing -> return (F (err 406 message))
+      where
+        message = "Expected 'Accept: "
+                    <> fromString (show x)
+                    <> "/"
+                    <> fromString (show y)
+                    <> "'."
+
+instance (Show t, Show s) => Show (Accept t s) where
+    show (Accept t s) = "Accept: " ++ show t ++ "/" ++ show s
diff --git a/src/Snap/Predicates/Content.hs b/src/Snap/Predicates/Content.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Content.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicates.Content
+  ( Content
+  , ContentType (..)
+  , module Snap.Predicates.MediaTypes
+  )
+where
+
+import Data.Monoid hiding (All)
+import Data.String
+import Data.Predicate
+import Snap.Core hiding (headers)
+import Snap.Predicates.Error
+import Snap.Predicates.MediaTypes
+import Snap.Predicates.MediaTypes.Internal
+import qualified Data.Predicate.Env as E
+
+type Content x y = MediaType x y
+
+-- | A 'Predicate' against the 'Request's \"Content-Type\" header.
+data ContentType t s = ContentType t s deriving Eq
+
+instance (MType t, MSubType s) => Predicate (ContentType t s) Request where
+    type FVal (ContentType t s) = Error
+    type TVal (ContentType t s) = MediaType t s
+    apply (ContentType x y) r   = do
+        mtypes <- E.lookup "content-type" >>= maybe (readMediaTypes "content-type" r) return
+        case mediaType False x y mtypes of
+               Just m  -> return (T 0 m)
+               Nothing -> return (F (err 415 message))
+      where
+        message = "Expected 'Content-Type: "
+                    <> fromString (show x)
+                    <> "/"
+                    <> fromString (show y)
+                    <> "'."
+
+instance (Show t, Show s) => Show (ContentType t s) where
+    show (ContentType t s) = "ContentType: " ++ show t ++ "/" ++ show s
diff --git a/src/Snap/Predicates/Error.hs b/src/Snap/Predicates/Error.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Error.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE BangPatterns #-}
+module Snap.Predicates.Error where
+
+import Data.ByteString (ByteString)
+import Data.Word
+
+-- | The error type used as 'F' meta-data in all snap predicates.
+data Error = Error
+  { _status  :: !Word               -- ^ (HTTP) status code
+  , _message :: !(Maybe ByteString) -- ^ optional status message
+  } deriving (Eq, Show)
+
+-- | Convenience function to construct 'Error' values from
+-- status code and status message.
+err :: Word -> ByteString -> Error
+err s = Error s . Just
diff --git a/src/Snap/Predicates/Internal.hs b/src/Snap/Predicates/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Internal.hs
@@ -0,0 +1,21 @@
+module Snap.Predicates.Internal
+  ( headers
+  , params
+  , safeHead
+  )
+where
+
+import Snap.Core hiding (headers)
+import Data.ByteString (ByteString)
+import Data.CaseInsensitive (mk)
+import qualified Data.Map.Strict as M
+
+headers :: Request -> ByteString -> [ByteString]
+headers rq name = maybe [] id . getHeaders (mk name) $ rq
+
+params :: Request -> ByteString -> [ByteString]
+params rq name = maybe [] id . M.lookup name . rqParams $ rq
+
+safeHead :: [a] -> Maybe a
+safeHead []    = Nothing
+safeHead (h:_) = Just h
diff --git a/src/Snap/Predicates/MediaTypes.hs b/src/Snap/Predicates/MediaTypes.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/MediaTypes.hs
@@ -0,0 +1,430 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns      #-}
+module Snap.Predicates.MediaTypes
+  ( -- * Types
+    MType (..)
+  , MSubType (..)
+  , MediaType (..)
+
+  -- * Media-Types
+  , Type (..)
+  , All (..)
+  , Application (..)
+  , Audio (..)
+  , Image (..)
+  , Message (..)
+  , Multipart (..)
+  , Text (..)
+  , Video (..)
+
+  -- * Media-Sub-Types
+  , SubType (..)
+  , AtomXml (..)
+  , Css (..)
+  , Csv (..)
+  , Encrypted (..)
+  , FormData (..)
+  , Gif (..)
+  , Gzip (..)
+  , Javascript (..)
+  , Jpeg (..)
+  , Json (..)
+  , Mixed (..)
+  , Mp4 (..)
+  , Mpeg (..)
+  , OctetStream (..)
+  , Ogg (..)
+  , Partial (..)
+  , Plain (..)
+  , Png (..)
+  , Postscript (..)
+  , Protobuf (..)
+  , RdfXml (..)
+  , RssXml (..)
+  , Tar (..)
+  , Tiff (..)
+  , Thrift (..)
+  , Vorbis (..)
+  , Webm (..)
+  , XhtmlXml (..)
+  , Xml (..)
+  )
+where
+
+import Data.ByteString (ByteString)
+
+-- | Type-class for converting a 'ByteString' to a media-type.
+class (Show a, Eq a) => MType a where
+    toType :: a -> ByteString -> Maybe a
+
+-- | Type-class for converting a 'ByteString' to a media-subtype.
+class (Show a, Eq a) => MSubType a where
+    toSubType :: a -> ByteString -> Maybe a
+
+-- | The Media-type representation.
+data MediaType t s = MediaType
+  { _type    :: !t
+  , _subtype :: !s
+  , _quality :: !Double
+  , _params  :: ![(ByteString, ByteString)]
+  } deriving (Eq, Show)
+
+-- Media-Types:
+
+-- | Generic media-type.
+data Type = Type ByteString deriving Eq
+
+instance MType Type where
+    toType o@(Type t) s = if t == s then Just o else Nothing
+
+instance Show Type where
+    show (Type t) = show t
+
+data Application = Application deriving Eq
+
+instance MType Application where
+    toType _ "application" = Just Application
+    toType _ _             = Nothing
+
+instance Show Application where
+    show _ = "application"
+
+data Audio = Audio deriving Eq
+
+instance MType Audio where
+    toType _ "audio" = Just Audio
+    toType _ _       = Nothing
+
+instance Show Audio where
+    show _ = "audio"
+
+data Image = Image deriving Eq
+
+instance MType Image where
+    toType _ "image" = Just Image
+    toType _ _       = Nothing
+
+instance Show Image where
+    show _ = "image"
+
+data Message = Message deriving Eq
+
+instance MType Message where
+    toType _ "message" = Just Message
+    toType _ _         = Nothing
+
+instance Show Message where
+    show _ = "message"
+
+data Multipart = Multipart deriving Eq
+
+instance MType Multipart where
+    toType _ "multipart" = Just Multipart
+    toType _ _           = Nothing
+
+instance Show Multipart where
+    show _ = "multipart"
+
+data Text = Text deriving Eq
+
+instance MType Text where
+    toType _ "text" = Just Text
+    toType _ _      = Nothing
+
+instance Show Text where
+    show _ = "text"
+
+data Video = Video deriving Eq
+
+instance MType Video where
+    toType _ "video" = Just Video
+    toType _ _       = Nothing
+
+instance Show Video where
+    show _ = "video"
+
+-- Media-Subtypes:
+
+-- | Generic media-subtype.
+data SubType = SubType ByteString deriving Eq
+
+instance MSubType SubType where
+    toSubType o@(SubType t) s = if t == s then Just o else Nothing
+
+instance Show SubType where
+    show (SubType t) = show t
+
+data AtomXml = AtomXml deriving Eq
+
+instance MSubType AtomXml where
+    toSubType _ "atom+xml" = Just AtomXml
+    toSubType _ _          = Nothing
+
+instance Show AtomXml where
+    show _ = "atom+xml"
+
+data Css = Css deriving Eq
+
+instance MSubType Css where
+    toSubType _ "css" = Just Css
+    toSubType _ _     = Nothing
+
+instance Show Css where
+    show _ = "css"
+
+data Csv = Csv deriving Eq
+
+instance MSubType Csv where
+    toSubType _ "csv" = Just Csv
+    toSubType _ _     = Nothing
+
+instance Show Csv where
+    show _ = "csv"
+
+data Encrypted = Encrypted deriving Eq
+
+instance MSubType Encrypted where
+    toSubType _ "encrypted" = Just Encrypted
+    toSubType _ _           = Nothing
+
+instance Show Encrypted where
+    show _ = "encrypted"
+
+data FormData = FormData deriving Eq
+
+instance MSubType FormData where
+    toSubType _ "form-data" = Just FormData
+    toSubType _ _           = Nothing
+
+instance Show FormData where
+    show _ = "form-data"
+
+data Gif = Gif deriving Eq
+
+instance MSubType Gif where
+    toSubType _ "gif" = Just Gif
+    toSubType _ _     = Nothing
+
+instance Show Gif where
+    show _ = "gif"
+
+data Gzip = Gzip deriving Eq
+
+instance MSubType Gzip where
+    toSubType _ "gzip" = Just Gzip
+    toSubType _ _      = Nothing
+
+instance Show Gzip where
+    show _ = "gzip"
+
+data Javascript = Javascript deriving Eq
+
+instance MSubType Javascript where
+    toSubType _ "javascript" = Just Javascript
+    toSubType _ _            = Nothing
+
+instance Show Javascript where
+    show _ = "javascript"
+
+data Jpeg = Jpeg deriving Eq
+
+instance MSubType Jpeg where
+    toSubType _ "jpeg" = Just Jpeg
+    toSubType _ _      = Nothing
+
+instance Show Jpeg where
+    show _ = "jpeg"
+
+data Json = Json deriving Eq
+
+instance MSubType Json where
+    toSubType _ "json" = Just Json
+    toSubType _ _      = Nothing
+
+instance Show Json where
+    show _ = "json"
+
+data Mixed = Mixed deriving Eq
+
+instance MSubType Mixed where
+    toSubType _ "mixed" = Just Mixed
+    toSubType _ _       = Nothing
+
+instance Show Mixed where
+    show _ = "mixed"
+
+data Mp4 = Mp4 deriving Eq
+
+instance MSubType Mp4 where
+    toSubType _ "mp4" = Just Mp4
+    toSubType _ _     = Nothing
+
+instance Show Mp4 where
+    show _ = "mp4"
+
+data Mpeg = Mpeg deriving Eq
+
+instance MSubType Mpeg where
+    toSubType _ "mpeg" = Just Mpeg
+    toSubType _ _      = Nothing
+
+instance Show Mpeg where
+    show _ = "mpeg"
+
+data OctetStream = OctetStream deriving Eq
+
+instance MSubType OctetStream where
+    toSubType _ "octet-stream" = Just OctetStream
+    toSubType _ _              = Nothing
+
+instance Show OctetStream where
+    show _ = "octet-stream"
+
+data Ogg = Ogg deriving Eq
+
+instance MSubType Ogg where
+    toSubType _ "ogg" = Just Ogg
+    toSubType _ _     = Nothing
+
+instance Show Ogg where
+    show _ = "ogg"
+
+data Partial = Partial deriving Eq
+
+instance MSubType Partial where
+    toSubType _ "partial" = Just Partial
+    toSubType _ _         = Nothing
+
+instance Show Partial where
+    show _ = "partial"
+
+data Plain = Plain deriving Eq
+
+instance MSubType Plain where
+    toSubType _ "plain" = Just Plain
+    toSubType _ _       = Nothing
+
+instance Show Plain where
+    show _ = "plain"
+
+data Png = Png deriving Eq
+
+instance MSubType Png where
+    toSubType _ "png" = Just Png
+    toSubType _ _     = Nothing
+
+instance Show Png where
+    show _ = "png"
+
+data Postscript = Postscript deriving Eq
+
+instance MSubType Postscript where
+    toSubType _ "postscript" = Just Postscript
+    toSubType _ _            = Nothing
+
+instance Show Postscript where
+    show _ = "postscript"
+
+data Protobuf = Protobuf deriving Eq
+
+instance MSubType Protobuf where
+    toSubType _ "x-protobuf" = Just Protobuf
+    toSubType _ _            = Nothing
+
+instance Show Protobuf where
+    show _ = "x-protobuf"
+
+data RdfXml = RdfXml deriving Eq
+
+instance MSubType RdfXml where
+    toSubType _ "rdf+xml" = Just RdfXml
+    toSubType _ _         = Nothing
+
+instance Show RdfXml where
+    show _ = "rdf+xml"
+
+data RssXml = RssXml deriving Eq
+
+instance MSubType RssXml where
+    toSubType _ "rss+xml" = Just RssXml
+    toSubType _ _         = Nothing
+
+instance Show RssXml where
+    show _ = "rss+xml"
+
+data Tar = Tar deriving Eq
+
+instance MSubType Tar where
+    toSubType _ "tar" = Just Tar
+    toSubType _ _     = Nothing
+
+instance Show Tar where
+    show _ = "tar"
+
+data Tiff = Tiff deriving Eq
+
+instance MSubType Tiff where
+    toSubType _ "tiff" = Just Tiff
+    toSubType _ _      = Nothing
+
+instance Show Tiff where
+    show _ = "tiff"
+
+data Thrift = Thrift deriving Eq
+
+instance MSubType Thrift where
+    toSubType _ "x-thrift" = Just Thrift
+    toSubType _ _          = Nothing
+
+instance Show Thrift where
+    show _ = "x-thrift"
+
+data Vorbis = Vorbis deriving Eq
+
+instance MSubType Vorbis where
+    toSubType _ "vorbis" = Just Vorbis
+    toSubType _ _        = Nothing
+
+instance Show Vorbis where
+    show _ = "vorbis"
+
+data Webm = Webm deriving Eq
+
+instance MSubType Webm where
+    toSubType _ "webm" = Just Webm
+    toSubType _ _      = Nothing
+
+instance Show Webm where
+    show _ = "webm"
+
+data XhtmlXml = XhtmlXml deriving Eq
+
+instance MSubType XhtmlXml where
+    toSubType _ "xhtml+xml" = Just XhtmlXml
+    toSubType _ _           = Nothing
+
+instance Show XhtmlXml where
+    show _ = "xhtml+xml"
+
+data Xml = Xml deriving Eq
+
+instance MSubType Xml where
+    toSubType _ "xml" = Just Xml
+    toSubType _ _     = Nothing
+
+instance Show Xml where
+    show _ = "xml"
+
+-- | media-type and sub-type \"*\".
+data All = All deriving Eq
+
+instance MType All where
+    toType _ "*" = Just All
+    toType _ _   = Nothing
+
+instance MSubType All where
+    toSubType _ "*" = Just All
+    toSubType _ _   = Nothing
+
+instance Show All where
+    show _ = "*"
diff --git a/src/Snap/Predicates/MediaTypes/Internal.hs b/src/Snap/Predicates/MediaTypes/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/MediaTypes/Internal.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
+module Snap.Predicates.MediaTypes.Internal where
+
+import Control.Monad
+import Control.Monad.State.Strict
+import Data.ByteString (ByteString)
+import Data.List (sortBy)
+import Data.Maybe
+import Snap.Core (Request)
+import Snap.Predicates.Internal
+import Snap.Predicates.MediaTypes
+import qualified Data.Predicate.Env as E
+import qualified Snap.Predicates.Parsers.Accept as A
+
+mediaType :: (MType t, MSubType s) => Bool -> t -> s -> [A.MediaType] -> Maybe (MediaType t s)
+mediaType fuzzy t s = safeHead . mapMaybe (\m -> do
+    t' <- if fuzzy && A.medType    m == "*" then Just t else toType t    (A.medType m)
+    s' <- if fuzzy && A.medSubtype m == "*" then Just s else toSubType s (A.medSubtype m)
+    guard (t == t' && s == s')
+    return $ MediaType t s (A.medQuality m) (A.medParams m))
+
+readMediaTypes :: (MonadState m, StateType m ~ E.Env) => ByteString -> Request -> m [A.MediaType]
+readMediaTypes k r = do
+    let mtypes = sortBy q . concat . map A.parseMediaTypes $ headers r k
+    E.insert k mtypes
+    return mtypes
+  where
+    q a b = A.medQuality b `compare` A.medQuality a
diff --git a/src/Snap/Predicates/Params.hs b/src/Snap/Predicates/Params.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Params.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicates.Params
+  ( Parameter (..)
+  , Param (..)
+  , ParamOpt (..)
+  , ParamDef (..)
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.ByteString.Readable
+import Data.Either
+import Data.Monoid
+import Data.String
+import Data.Typeable
+import Data.Predicate
+import Snap.Core hiding (headers)
+import Snap.Predicates.Error
+import Snap.Predicates.Internal
+import qualified Data.Predicate.Env as E
+import qualified Data.ByteString as S
+
+-- | The most generic request parameter predicate provided.
+-- It will get all request parameter values of '_name' and pass them on to
+-- the conversion function '_read', which might either yield an error
+-- message or a value. In case of error, an optional default may be
+-- returned instead, if nothing is provided, the error message will be used
+-- when construction the 400 status.
+data Parameter a = Parameter
+  { _name    :: !ByteString                         -- ^ request parameter name
+  , _read    :: [ByteString] -> Either ByteString a -- ^ conversion function
+  , _default :: !(Maybe a)                          -- ^ (optional) default value
+  }
+
+instance Typeable a => Predicate (Parameter a) Request where
+    type FVal (Parameter a) = Error
+    type TVal (Parameter a) = a
+    apply (Parameter nme f def) r =
+        E.lookup (key nme) >>= maybe work result
+      where
+        work = case params r nme of
+            [] -> maybe (return (F (err 400 ("Missing parameter '" <> nme <> "'."))))
+                        (return . (T 0))
+                        def
+            vs -> do
+                let x = f vs
+                E.insert (key nme) x
+                case x of
+                    Left msg -> return $ maybe (F (err 400 msg)) (T 0) def
+                    Right  v -> return $ T 0 v
+
+        result (Left msg) = return (F (err 400 msg))
+        result (Right  v) = return (T 0 v)
+
+        key name = "parameter:" <> name <> ":" <> (fromString . show . typeOf $ def)
+
+instance Show (Parameter a) where
+    show p = "Parameter: " ++ show (_name p)
+
+-- | Specialisation of 'Parameter' which returns the first request
+-- which could be converted to the target type.
+data Param a = Param ByteString
+
+instance (Typeable a, Readable a) => Predicate (Param a) Request where
+    type FVal (Param a) = Error
+    type TVal (Param a) = a
+    apply (Param x)     = apply (Parameter x f Nothing)
+      where
+        f vs = let (es, xs) = partitionEithers $ map fromByteString vs
+               in if null xs
+                      then Left (S.intercalate "\n" es)
+                      else Right (head xs)
+
+instance Show (Param a) where
+    show (Param x) = "Param: " ++ show x
+
+-- | Like 'Param', but denoting an optional parameter, i.e. if the
+-- parameter is not present or can not be converted to the target type, the
+-- predicate will still succeed.
+data ParamOpt a = ParamOpt ByteString
+
+instance (Typeable a, Readable a) => Predicate (ParamOpt a) Request where
+    type FVal (ParamOpt a) = Error
+    type TVal (ParamOpt a) = Maybe a
+    apply (ParamOpt x)     = apply (Parameter x f (Just Nothing))
+      where
+        f vs = let xs = rights $ map fromByteString vs
+               in if null xs then Right Nothing else Right (head xs)
+
+instance Show (ParamOpt a) where
+    show (ParamOpt x) = "ParamOpt: " ++ show x
+
+-- | Like 'Param', but in case the parameter could not be found, the
+-- provided default value will be used. ParamDef is provided for
+-- convenience and nothing else than Param || Const, e.g.
+-- @ParamDef \"foo\" 0 == Param \"foo\" ':|:' 'Const' 0@.
+data ParamDef a = ParamDef ByteString a
+
+instance (Typeable a, Readable a) => Predicate (ParamDef a) Request where
+    type FVal (ParamDef a) = Error
+    type TVal (ParamDef a) = a
+    apply (ParamDef x d)   = apply (Param x :|: Const d)
+
+instance Show a => Show (ParamDef a) where
+    show (ParamDef x d) = "ParamDef: " ++ show x ++ " [" ++ show d ++ "]"
diff --git a/src/Snap/Predicates/Parsers/Accept.hs b/src/Snap/Predicates/Parsers/Accept.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Parsers/Accept.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings, BangPatterns, DeriveDataTypeable #-}
+module Snap.Predicates.Parsers.Accept
+  ( MediaType (..)
+  , parseMediaTypes
+  )
+where
+
+import Control.Applicative
+import Data.Attoparsec
+import Data.Attoparsec.Text (double)
+import Data.ByteString (ByteString)
+import Data.Text.Encoding
+import Data.Typeable
+import Snap.Predicates.Parsers.Shared
+import qualified Data.Attoparsec.Text as T
+
+data MediaType = MediaType
+  { medType    :: !ByteString
+  , medSubtype :: !ByteString
+  , medQuality :: !Double
+  , medParams  :: ![(ByteString, ByteString)]
+  } deriving (Eq, Show, Typeable)
+
+parseMediaTypes :: ByteString -> [MediaType]
+parseMediaTypes = either (const []) id . parseOnly mediaTypes
+
+mediaTypes :: Parser [MediaType]
+mediaTypes = mediaType `sepBy` chr ','
+
+mediaType :: Parser MediaType
+mediaType = toMediaType <$> trim typ <*> (chr '/' *> trim subtyp) <*> params
+  where
+    toMediaType t s p =
+        case lookup "q" p >>= toDouble of
+            Just q  -> MediaType t s q (filter ((/= "q") . fst) p)
+            Nothing -> MediaType t s 1.0 p
+
+params :: Parser [(ByteString, ByteString)]
+params = (trim (chr ';') *> (element `sepBy` trim (chr ';'))) <|> return []
+  where
+    element = (,) <$> trim key <*> (chr '=' *> trim val)
+
+typ, subtyp, key, val :: Parser ByteString
+typ    = takeTill (oneof "/ ")
+subtyp = takeTill (oneof ",; ")
+
+key = do
+    c <- peekWord8
+    if c == Just (w ',')
+        then fail "comma"
+        else takeTill (oneof "= ")
+
+val = takeTill (oneof ",; ")
+
+toDouble :: ByteString -> Maybe Double
+toDouble bs = do
+    txt <- toMaybe (decodeUtf8' bs)
+    dec <- toMaybe (T.parseOnly double txt)
+    return dec
+  where
+    toMaybe (Right x) = Just x
+    toMaybe (Left  _) = Nothing
diff --git a/src/Snap/Predicates/Parsers/Shared.hs b/src/Snap/Predicates/Parsers/Shared.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Parsers/Shared.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings, BangPatterns #-}
+module Snap.Predicates.Parsers.Shared where
+
+import Control.Applicative
+import Data.Attoparsec
+import Data.ByteString (ByteString)
+import Data.Char (ord)
+import Data.Word
+import qualified Data.ByteString as S
+
+spaces :: Parser ()
+spaces = skipWhile (== w ' ')
+
+trim :: Parser a -> Parser a
+trim p = spaces *> p <* spaces
+
+oneof :: ByteString -> Word8 -> Bool
+oneof = flip elem . S.unpack
+
+chr :: Char -> Parser Word8
+chr = word8 . w
+
+w :: Char -> Word8
+w = fromIntegral . ord
diff --git a/src/Snap/Predicates/Tutorial.hs b/src/Snap/Predicates/Tutorial.hs
--- a/src/Snap/Predicates/Tutorial.hs
+++ b/src/Snap/Predicates/Tutorial.hs
@@ -33,10 +33,15 @@
 @
 data 'Data.Predicate.Boolean' f t =
     'Data.Predicate.F' (Maybe f)
-  | 'Data.Predicate.T' t
+  | 'Data.Predicate.T' 'Data.Predicate.Delta' t
   deriving (Eq, Show)
 @
 
+'Data.Predicate.Delta' can in most instances be ignored, i.e. set to 0.
+It's purpose is as a measure of distance for those predicates which evaluate
+to 'Data.Predicate.T' but some may be \"closer\" in some way than others. An
+example is for instance HTTP content-negotiations (cf. 'Snap.Predicates.MediaTypes.Accept')
+
 Further there is a type-class 'Data.Predicate.Predicate' defined which
 contains an evaluation function 'Data.Predicate.apply', where the
 predicate instance is applied to some value, yielding 'Data.Predicate.T'
@@ -46,15 +51,23 @@
 class 'Data.Predicate.Predicate' p a where
     type 'Data.Predicate.FVal' p
     type 'Data.Predicate.TVal' p
-    apply :: p -> a -> Boolean ('Data.Predicate.FVal' p) ('Data.Predicate.TVal' p)
+    apply :: p -> a -> 'Control.Monad.State.Strict.State' 'Data.Predicate.Env' (Boolean ('Data.Predicate.FVal' p)) ('Data.Predicate.TVal' p)
 @
 
-All concrete predicates are instances of this type-class, which does not
+All predicates are instances of this type-class, which does not
 specify the type against which the predicate is evaluated, nor the types
 of actual meta-data for the true/false case of the Boolean returned.
 Snap related predicates are normally defined against 'Snap.Core.Request'
 and in case they fail, they return a status code and an optional message.
 
+Predicates may utilise the stateful 'Data.Predicate.Env.Env' to cache intermediate
+results accross multiple evaluations, i.e. a resource may be declared multiple
+times with different sets of predicates which means that in case a predicate
+is part of more than one set it is evaluated multiple times for the same
+input data. As an optimisation it may be beneficial to store intermediate
+results in 'Data.Predicate.Env.Env' and re-use them later (cf. the implementation
+of 'Snap.Predicates.MediaTypes.Accept').
+
 Besides these type definitions, there are some ways to connect two
 'Data.Predicate.Predicate's to form a new one as the logical @OR@ or the
 logical @AND@ of its parts. These are:
@@ -65,7 +78,7 @@
 
 Besides evaluating to 'Data.Predicate.T' or 'Data.Predicate.F' depending
 on the truth values of its parts, these connectives also propagate the
-meta-data appropriately.
+meta-data and 'Data.Predicate.Delta' appropriately.
 
 If 'Data.Predicate.:&:' evaluates to 'Data.Predicate.T' it has to combine
 the meta-data of both predicates, and it uses the product type
@@ -85,51 +98,48 @@
 Finally there are 'Data.Predicate.Const' and 'Data.Predicate.Fail' to
 always evaluate to 'Data.Predicate.T' or 'Data.Predicate.F' respectively.
 
-As an example of how these operators are used, see below in 'Routes' section.
+As an example of how these operators are used, see below in section \"Routes\".
 -}
 
 {- $example
 
 @
-data 'Snap.Predicates.Accept' = 'Snap.Predicates.Accept' ByteString deriving Eq
+data 'Snap.Predicates.Params.Param' = Param 'Data.ByteString.ByteString' deriving Eq
 
-instance 'Data.Predicate.Predicate' 'Snap.Predicates.Accept' 'Snap.Core.Request' where
-    type 'Data.Predicate.FVal' 'Snap.Predicates.Accept' = (Word, Maybe ByteString)
-    type 'Data.Predicate.TVal' 'Snap.Predicates.Accept' = ()
-    'Data.Predicate.apply' ('Snap.Predicates.Accept' x) r =
-        if x \`elem\` headerValues r \"Accept\"
-            then 'Data.Predicate.T' ()
-            else 'Data.Predicate.F' $ Just (406, Just $ \"Expected 'Accept: \" <> x <> \"'.\")
+instance 'Data.Predicate.Predicate' Param 'Snap.Core.Request' where
+    type 'Data.Predicate.FVal' Param = 'Snap.Predicates.Error'
+    type 'Data.Predicate.TVal' Param = ByteString
+    apply (Param x) r =
+        case params r x of
+            []    -> return (F ('Snap.Predicates.Error' 400 (Just $ \"Expected parameter '\" \<\> x \<\> \"'.\")))
+            (v:_) -> return (T [] v)
 @
 
-This is a simple example testing the value of a 'Snap.Core.Request's accept
-header against some given value. The function @headerValues@ is not shown,
-but gets the actual Accept-Header values of the request.
+This is a simple example looking for the existence of a 'Snap.Core.Request' parameter
+with the given name. In the success case, the parameter value is returned.
 
 As mentioned before, Snap predicates usually fix the type @a@ from
 'Data.Predicate.Predicate' above to 'Snap.Core.Request'. The associated
 types 'Data.Predicate.FVal' and 'Data.Predicate.TVal' denote the meta-data
-types of the predicate. In this example, there is no useful information for
-the 'Data.Predicate.T'-case, so 'Data.Predicate.TVal' becomes '()'.
-The 'Data.Predicate.F'-case is set to the pair @(Word, Maybe ByteString)@
-and indeed, if the predicate fails it sets the right HTTP status code
-(406) and some helpful message.
+types of the predicate. In this example, the meta-date type is 'Data.ByteString.ByteString'.
+The 'Data.Predicate.F'-case is 'Snap.Predicates.Error' which contains a status
+code and an optional message.
 
 -}
 
 {- $routes
 
 So how are 'Data.Predicate.Predicate's used in some Snap application?
-One way is to just apply them to a given request inside a snap handler, e.g.
+One way is to just evaluate them against a given request inside a snap handler, e.g.
 
 @
 someHandler :: 'Snap.Core.Snap' ()
 someHandler = do
     req <- 'Snap.Core.getRequest'
-    case apply ('Snap.Predicates.Accept' \"application/json\" 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"baz\") req of
-        'Data.Predicate.T' (_ 'Data.Predicate.:*:' bazValue) -> ...
-        'Data.Predicate.F' (Just (i, msg))  -> ...
-        'Data.Predicate.F' Nothing          -> ...
+    case 'Data.Predicate.eval' ('Snap.Predicates.MediaTypes.Accept' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Json' 'Data.Predicate.:&:' 'Snap.Predicates.Params.Param' \"baz\") req of
+        'Data.Predicate.T' (_ 'Data.Predicate.:*:' bazValue)      -> ...
+        'Data.Predicate.F' (Just ('Snap.Predicates.Error' st msg)) -> ...
+        'Data.Predicate.F' Nothing               -> ...
 @
 
 However another possibility is to augment route definitions with the
@@ -138,27 +148,33 @@
 @
 sitemap :: 'Snap.Routes.Routes' Snap ()
 sitemap = do
-    'Snap.Routes.get'  \"\/a\" handlerA $ 'Snap.Predicates.AcceptJson' 'Data.Predicate.:&:' ('Snap.Predicates.Param' \"name\" 'Data.Predicate.:|:' 'Snap.Predicates.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"foo\"
-    'Snap.Routes.get'  \"\/b\" handlerB $ 'Snap.Predicates.AcceptJson' 'Data.Predicate.:&:' ('Snap.Predicates.Param' \"name\" 'Data.Predicate.:||:' 'Snap.Predicates.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"foo\"
-    'Snap.Routes.get'  \"\/c\" handlerC $ 'Data.Predicate.Fail' (410, Just \"Gone.\")
-    'Snap.Routes.post' \"\/d\" handlerD $ 'Snap.Predicates.AcceptThrift'
-    'Snap.Routes.post' \"\/e\" handlerE $ 'Snap.Predicates.Accept' \"plain/text\"
+    'Snap.Routes.get'  \"\/a\" handlerA $ 'Snap.Predicates.MediaTypes.Accept' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Json' 'Data.Predicate.:&:' ('Snap.Predicates.Param' \"name\" 'Data.Predicate.:|:' 'Snap.Predicates.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"foo\"
+    'Snap.Routes.get'  \"\/b\" handlerB $ 'Snap.Predicates.MediaTypes.Accept' 'Snap.Predicates.MediaTypes.Text' 'Snap.Predicates.MediaTypes.Plain' 'Data.Predicate.:&:' ('Snap.Predicates.Param' \"name\" 'Data.Predicate.:||:' 'Snap.Predicates.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"foo\"
+    'Snap.Routes.get'  \"\/c\" handlerC $ 'Data.Predicate.Fail' ('Snap.Predicates.Error' 410 (Just \"Gone.\"))
+    'Snap.Routes.post' \"\/d\" handlerD $ 'Snap.Predicates.MediaTypes.Accept' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Protobuf'
+    'Snap.Routes.post' \"\/e\" handlerE $ 'Snap.Predicates.MediaTypes.Accept' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Xml'
 @
 
 The handlers then encode their pre-conditions in their type-signature:
 
 @
-handlerA :: 'Snap.Predicates.AcceptJson' 'Data.Predicate.:*:' ByteString 'Data.Predicate.:*:' ByteString -> Snap ()
-handlerB :: 'Snap.Predicates.AcceptJson' 'Data.Predicate.:*:' (ByteString 'Data.Predicate.:+:' ByteString) 'Data.Predicate.:*:' ByteString -> Snap ()
-handlerC :: 'Snap.Predicates.AcceptJson' 'Data.Predicate.:*:' Char -> Snap ()
-handlerD :: 'Snap.Predicates.AcceptThrift' -> Snap ()
-handlerE :: () -> Snap ()
+handlerA :: 'Snap.Predicates.MediaTypes.MediaType' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Json' 'Data.Predicate.:*:' ByteString 'Data.Predicate.:*:' ByteString -> Snap ()
+handlerB :: 'Snap.Predicates.MediaTypes.MediaType' 'Snap.Predicates.MediaTypes.Text' 'Snap.Predicates.MediaTypes.Plain' 'Data.Predicate.:*:' (ByteString 'Data.Predicate.:+:' ByteString) 'Data.Predicate.:*:' ByteString -> Snap ()
+handlerC :: 'Snap.Predicates.MediaTypes.MediaType' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Json' 'Data.Predicate.:*:' Char -> Snap ()
+handlerD :: 'Snap.Predicates.MediaTypes.MediaType' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Protobuf' -> Snap ()
+handlerE :: 'Snap.Predicates.MediaTypes.MediaType' 'Snap.Predicates.MediaTypes.Application' 'Snap.Predicates.MediaTypes.Xml' -> Snap ()
 @
 
-As usually these type-declarations have to match, or else the code will
-not compile. One thing to note is that 'Data.Predicate.Fail' works with
-all handler signatures, which is safe, because the handler is never
-invoked, or else Fail is used in some logical disjunction.
+The type-declaration of a handler has to match the corresponding predicate,
+i.e. the type of the predicate's 'Data.Predicate.T' meta-data value:
+
+@
+('Snap.Core.MonadSnap' m, 'Data.Predicate.Predicate' p 'Snap.Core.Request') => 'Data.Predicate.TVal' p -> m ()
+@
+
+One thing to note is that 'Data.Predicate.Fail' works with
+all 'Data.Predicate.T' meta-data types which is safe because the handler is never
+invoked, or 'Data.Predicate.Fail' is used in some logical disjunction.
 
 Given the route and handler definitions above, one can then integrate
 with Snap via 'Snap.Routes.expandRoutes', which turns the
diff --git a/src/Snap/Routes.hs b/src/Snap/Routes.hs
--- a/src/Snap/Routes.hs
+++ b/src/Snap/Routes.hs
@@ -7,30 +7,40 @@
   ( Routes
   , showRoutes
   , expandRoutes
+  , addRoute
   , get
+  , get_
   , Snap.Routes.head
-  , addRoute
+  , head_
   , post
+  , post_
   , put
+  , put_
   , delete
+  , delete_
   , trace
+  , trace_
   , options
+  , options_
   , connect
+  , connect_
   )
 where
 
-import Control.Applicative
+import Control.Applicative hiding (Const)
 import Control.Monad
+import Control.Monad.State.Strict hiding (get, put)
 import Data.ByteString (ByteString)
 import Data.Either
+import Data.List hiding (head, delete)
 import Data.Predicate
-import Data.Word
+import Data.Predicate.Env (Env)
 import Snap.Core
-import Control.Monad.Trans.State.Strict (State)
-import qualified Control.Monad.Trans.State.Strict as State
+import Snap.Predicates
 import qualified Data.List as L
-
-type Error = (Word, Maybe ByteString)
+import qualified Data.Predicate.Env as E
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as C
 
 data Pack m where
     Pack :: (Show p, Predicate p Request, FVal p ~ Error)
@@ -44,6 +54,10 @@
   , _pred    :: !(Pack m)
   }
 
+-- | The Routes monad is used to add routing declarations via 'addRoute' or
+-- one of 'get', 'post', etc.
+-- Routing declarations can then be turned into the ordinary snap format,
+-- i.e. @MonadSnap m => [(ByteString, m a)]@ or into strings.
 newtype Routes m a = Routes
   { _unroutes :: State [Route m] a }
 
@@ -51,14 +65,17 @@
     return  = Routes . return
     m >>= f = Routes $ _unroutes m >>= _unroutes . f
 
+-- | Add a route for some 'Method' and path (potentially with variable
+-- captures), and constrained the some 'Predicate'.
 addRoute :: (MonadSnap m, Show p, Predicate p Request, FVal p ~ Error)
          => Method
          -> ByteString        -- ^ path
          -> (TVal p -> m ())  -- ^ handler
-         -> p                 -- ^ predicate
+         -> p                 -- ^ 'Predicate'
          -> Routes m ()
-addRoute m r x p = Routes $ State.modify ((Route m r (Pack p x)):)
+addRoute m r x p = Routes $ modify ((Route m r (Pack p x)):)
 
+-- | Specialisation of 'addRoute' for a specific HTTP 'Method'.
 get, head, post, put, delete, trace, options, connect ::
     (MonadSnap m, Show p, Predicate p Request, FVal p ~ Error)
     => ByteString        -- ^ path
@@ -74,11 +91,26 @@
 options = addRoute OPTIONS
 connect = addRoute CONNECT
 
+-- | Specialisation of 'addRoute' for a specific HTTP 'Method' taking
+-- no 'Predicate' into consideration.
+get_, head_, post_, put_, delete_, trace_, options_, connect_ ::
+    (MonadSnap m)
+    => ByteString    -- ^ path
+    -> (() -> m ())  -- ^ handler
+    -> Routes m ()
+get_     p h = addRoute GET     p h (Const ())
+head_    p h = addRoute HEAD    p h (Const ())
+post_    p h = addRoute POST    p h (Const ())
+put_     p h = addRoute PUT     p h (Const ())
+delete_  p h = addRoute DELETE  p h (Const ())
+trace_   p h = addRoute TRACE   p h (Const ())
+options_ p h = addRoute OPTIONS p h (Const ())
+connect_ p h = addRoute CONNECT p h (Const ())
+
 -- | Turn route definitions into a list of 'String's.
 showRoutes :: Routes m () -> [String]
 showRoutes (Routes routes) =
-    let rs = reverse $ State.execState routes []
-    in flip map rs $ \x ->
+    flip map (concat . normalise $ execState routes []) $ \x ->
         case _pred x of
             Pack p _ -> shows (_method x)
                       . (' ':)
@@ -86,20 +118,44 @@
                       . (' ':)
                       . shows p $ ""
 
--- | Turn route definitions into "snapable" format, i.e.
+-- | Turn route definitions into \"snapable\" format, i.e.
 -- Routes are grouped per path and selection evaluates routes
 -- against the given Snap 'Request'.
 expandRoutes :: MonadSnap m => Routes m () -> [(ByteString, m ())]
 expandRoutes (Routes routes) =
-    let rg = grouped . sorted . reverse $ State.execState routes []
-    in map (\g -> (_path (L.head g), select g)) rg
+    map (\g -> (_path (L.head g), select g)) (normalise $ execState routes [])
+
+-- | Group routes by path.
+normalise :: [Route m] -> [[Route m]]
+normalise rr =
+    let rg    = grouped . sorted $ rr
+        paths = map (namelessPath . L.head) rg
+        ambig = paths \\ nub paths
+    in if null ambig then rg else error (ambiguityMessage ambig)
   where
     sorted :: [Route m] -> [Route m]
-    sorted = L.sortBy (\a b -> _path a `compare` _path b)
+    sorted = sortBy (\a b -> _path a `compare` _path b)
 
     grouped :: [Route m] -> [[Route m]]
-    grouped = L.groupBy (\a b -> _path a == _path b)
+    grouped = groupBy (\a b -> _path a == _path b)
 
+    namelessPath :: Route m -> ByteString
+    namelessPath =
+        let colon = 0x3A
+            slash = 0x2F
+            fun s = if s /= "" && S.head s == colon then "<>" else s
+        in S.intercalate "/" . map fun . S.split slash . _path
+
+    ambiguityMessage a =
+        "Paths differing only in variable names are not supported.\n"  ++
+        "Problematic paths (with variable positions denoted by <>):\n" ++
+        (show a)
+
+data Handler m = Handler
+  { _delta   :: !Delta
+  , _handler :: !(m ())
+  }
+
 -- The handler selection proceeds as follows:
 -- (1) Consider only handlers with matching methods, or else return 405.
 -- (2) Evaluate 'Route' predicates.
@@ -108,32 +164,42 @@
 select :: MonadSnap m => [Route m] -> m ()
 select g = do
     ms <- filterM byMethod g
-    if L.null ms
-        then respond (405, Nothing)
+    if null ms
+        then do
+            respond (Error 405 Nothing)
+            modifyResponse (setHeader "Allow" validMethods)
         else evalAll ms
   where
     byMethod :: MonadSnap m => Route m -> m Bool
     byMethod x = (_method x ==) <$> getsRequest rqMethod
 
+    validMethods :: ByteString
+    validMethods = S.intercalate "," $ nub (C.pack . show . _method <$> g)
+
     evalAll :: MonadSnap m => [Route m] -> m ()
     evalAll rs = do
         req <- getRequest
-        let (n, y) = partitionEithers $ map (eval req) rs
+        let (n, y) = partitionEithers . snd $ foldl' (evalSingle req) (E.empty, []) rs
         if null y
             then respond (L.head n)
-            else L.head y
+            else closest y
 
-    eval :: MonadSnap m => Request -> Route m -> Either Error (m ())
-    eval rq r = case _pred r of
-        Pack p h ->
-            case apply p rq of
-                F Nothing  -> Left (500, Nothing)
-                F (Just m) -> Left m
-                T v        -> Right (h v)
+    evalSingle :: MonadSnap m => Request -> (Env, [Either Error (Handler m)]) -> Route m -> (Env, [Either Error (Handler m)])
+    evalSingle rq (e, rs) r =
+        case _pred r of
+            Pack p h ->
+                case runState (apply p rq) e of
+                    (F   m, e') -> (e', Left m : rs)
+                    (T d v, e') -> (e', Right (Handler d (h v)) : rs)
 
+    closest :: MonadSnap m => [Handler m] -> m ()
+    closest = foldl' (<|>) pass
+            . map _handler
+            . sortBy (\a b -> _delta a `compare` _delta b)
+
 respond :: MonadSnap m => Error -> m ()
-respond (i, msg) = do
+respond e = do
     putResponse . clearContentLength
-                . setResponseCode (fromIntegral i)
+                . setResponseCode (fromIntegral . _status $ e)
                 $ emptyResponse
-    maybe (return ()) writeBS msg
+    maybe (return ()) writeBS (_message e)
diff --git a/test/Tests/Data/Predicate.hs b/test/Tests/Data/Predicate.hs
--- a/test/Tests/Data/Predicate.hs
+++ b/test/Tests/Data/Predicate.hs
@@ -4,7 +4,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans  #-}
 module Tests.Data.Predicate (tests) where
 
-import Control.Applicative hiding (Const)
+import Control.Applicative hiding (Const, empty)
 import Test.Framework
 import Test.Framework.Providers.QuickCheck2
 import Test.QuickCheck
@@ -20,40 +20,42 @@
     ]
 
 testConst :: Const Int Char -> Bool
-testConst x@(Const c) = apply x () == T c
+testConst x@(Const c) = eval x () == T 0 c
 
 testFail :: Fail Int Char -> Bool
-testFail x@(Fail c) = apply x () == F (Just c)
+testFail x@(Fail c) = eval x () == F c
 
 testAnd :: Rand -> Rand -> Bool
-testAnd a@(Rand (T x)) b@(Rand (T y)) = apply (a :&: b) () == T (x :*: y)
-testAnd a@(Rand (T _)) b@(Rand (F y)) = apply (a :&: b) () == F y
-testAnd a@(Rand (F x)) b@(Rand (T _)) = apply (a :&: b) () == F x
-testAnd a@(Rand (F x)) b@(Rand (F _)) = apply (a :&: b) () == F x
+testAnd a@(Rand (T d x)) b@(Rand (T w y)) = eval (a :&: b) () == T (d + w) (x :*: y)
+testAnd a@(Rand (T _ _)) b@(Rand (F   y)) = eval (a :&: b) () == F y
+testAnd a@(Rand (F   x)) b@(Rand (T _ _)) = eval (a :&: b) () == F x
+testAnd a@(Rand (F   x)) b@(Rand (F   _)) = eval (a :&: b) () == F x
 
 testOr :: Rand -> Rand -> Bool
-testOr a@(Rand (T x)) b@(Rand (T _)) = apply (a :||: b) () == T (Left x)
-testOr a@(Rand (T x)) b@(Rand (F _)) = apply (a :||: b) () == T (Left x)
-testOr a@(Rand (F _)) b@(Rand (T y)) = apply (a :||: b) () == T (Right y)
-testOr a@(Rand (F _)) b@(Rand (F y)) = apply (a :||: b) () == F y
+testOr a@(Rand (T d x)) b@(Rand (T e y)) = eval (a :||: b) () == if d <= e then T d (Left x) else T e (Right y)
+testOr a@(Rand (T d x)) b@(Rand (F   _)) = eval (a :||: b) () == T d (Left x)
+testOr a@(Rand (F   _)) b@(Rand (T d y)) = eval (a :||: b) () == T d (Right y)
+testOr a@(Rand (F   _)) b@(Rand (F   y)) = eval (a :||: b) () == F y
 
 testOr' :: Rand -> Rand -> Bool
-testOr' a@(Rand (T x)) b@(Rand (T _)) = apply (a :|: b) () == T x
-testOr' a@(Rand (T x)) b@(Rand (F _)) = apply (a :|: b) () == T x
-testOr' a@(Rand (F _)) b@(Rand (T y)) = apply (a :|: b) () == T y
-testOr' a@(Rand (F _)) b@(Rand (F y)) = apply (a :|: b) () == F y
+testOr' a@(Rand (T d x)) b@(Rand (T e y)) = eval (a :|: b) () == if d <= e then T d x else T e y
+testOr' a@(Rand (T d x)) b@(Rand (F   _)) = eval (a :|: b) () == T d x
+testOr' a@(Rand (F   _)) b@(Rand (T d y)) = eval (a :|: b) () == T d y
+testOr' a@(Rand (F   _)) b@(Rand (F   y)) = eval (a :|: b) () == F y
 
-data Rand = Rand (Boolean Int Char) deriving Show
+newtype Rand = Rand
+  { _rand :: Boolean Int Char
+  } deriving Show
 
 instance Predicate Rand a where
     type FVal Rand   = Int
     type TVal Rand   = Char
-    apply (Rand x) _ = x
+    apply (Rand x) _ = return x
 
 instance Arbitrary (Boolean Int Char) where
     arbitrary =
-        oneof [ T <$> (arbitrary :: Gen Char)
-              , F <$> (arbitrary :: Gen (Maybe Int))
+        oneof [ T <$> (arbitrary :: Gen Delta) <*> (arbitrary :: Gen Char)
+              , F <$> (arbitrary :: Gen Int)
               ]
 
 instance Arbitrary (Const Int Char) where
diff --git a/test/Tests/Snap/Predicates.hs b/test/Tests/Snap/Predicates.hs
--- a/test/Tests/Snap/Predicates.hs
+++ b/test/Tests/Snap/Predicates.hs
@@ -4,6 +4,7 @@
 import Test.Framework
 import Test.Framework.Providers.HUnit
 import Test.HUnit hiding (Test)
+import Data.ByteString (ByteString)
 import Data.Predicate
 import Snap.Predicates
 import Snap.Test
@@ -13,6 +14,7 @@
 tests =
     [ testAccept
     , testParam
+    , testParamOpt
     , testAcceptJson
     , testAcceptThrift
     ]
@@ -20,39 +22,53 @@
 testAccept :: Test
 testAccept = testCase "Accept Predicate" $ do
     rq0 <- buildRequest $ addHeader "Accept" "x/y"
-    assertEqual "Matching Accept" (T ()) (apply (Accept "x/y") rq0)
+    let predicate = Accept (Type "x") (SubType "y")
+    let true = T 0 $ MediaType (Type "x") (SubType "y") 1.0 []
+    assertEqual "Matching Accept" true (eval predicate rq0)
 
-    rq1 <- buildRequest $ get "/" M.empty
+    rq1 <- buildRequest $ addHeader "Accept" "u/v"
     assertEqual "Status Code 406"
-        (F $ Just (406, Just "Expected 'Accept: x/y'."))
-        (apply (Accept "x/y") rq1)
+        (F (err 406 ("Expected 'Accept: \"x\"/\"y\"'.")))
+        (eval predicate rq1)
 
 testAcceptJson :: Test
 testAcceptJson = testCase "AcceptJson Predicate" $ do
     rq0 <- buildRequest $ addHeader "Accept" "application/json"
-    assertEqual "Matching AcceptJson" (T AcceptJson) (apply AcceptJson rq0)
+    let predicate = Accept Application Json
+    let true = T 0 $ MediaType Application Json 1.0 []
+    assertEqual "Matching AcceptJson" true (eval predicate rq0)
 
-    rq1 <- buildRequest $ addHeader "Accept" "foo"
+    rq1 <- buildRequest $ addHeader "Accept" "foo/bar"
     assertEqual "Status Code 406"
-        (F $ Just (406, Just "Expected 'Accept: application/json'."))
-        (apply AcceptJson rq1)
+        (F (err 406 ("Expected 'Accept: application/json'.")))
+        (eval predicate rq1)
 
 testAcceptThrift :: Test
 testAcceptThrift = testCase "AcceptThrift Predicate" $ do
     rq0 <- buildRequest $ addHeader "Accept" "application/x-thrift"
-    assertEqual "Matching AcceptThrift" (T AcceptThrift) (apply AcceptThrift rq0)
+    let predicate = Accept Application Thrift
+    let true = T 0 $ MediaType Application Thrift 1.0 []
+    assertEqual "Matching AcceptThrift" true (eval predicate rq0)
 
     rq1 <- buildRequest $ addHeader "Accept" "application/json"
     assertEqual "Status Code 406"
-        (F $ Just (406, Just "Expected 'Accept: application/x-thrift'."))
-        (apply AcceptThrift rq1)
+        (F (err 406 ("Expected 'Accept: application/x-thrift'.")))
+        (eval predicate rq1)
 
 testParam :: Test
 testParam = testCase "Param Predicate" $ do
     rq0 <- buildRequest $ get "/" (M.fromList [("x", ["y", "z"])])
-    assertEqual "Matching Param" (T "y") (apply (Param "x") rq0)
+    assertEqual "Matching Param" (T 0 "y") (eval (Param "x" :: Param ByteString) rq0)
 
     rq1 <- buildRequest $ get "/" M.empty
     assertEqual "Status Code 400"
-        (F $ Just (400, Just "Expected parameter 'x'."))
-        (apply (Param "x") rq1)
+        (F (err 400 ("Missing parameter 'x'.")))
+        (eval (Param "x" :: Param ByteString) rq1)
+
+testParamOpt :: Test
+testParamOpt = testCase "ParamOpt Predicate" $ do
+    rq0 <- buildRequest $ get "/" (M.fromList [("x", ["y", "z"])])
+    assertEqual "Matching Param 1" (T 0 (Just "y")) (eval (ParamOpt "x" :: ParamOpt ByteString) rq0)
+
+    rq1 <- buildRequest $ get "/" M.empty
+    assertEqual "Matching Param 2" (T 0 Nothing) (eval (ParamOpt "x" :: ParamOpt ByteString) rq1)
diff --git a/test/Tests/Snap/Routes.hs b/test/Tests/Snap/Routes.hs
--- a/test/Tests/Snap/Routes.hs
+++ b/test/Tests/Snap/Routes.hs
@@ -2,62 +2,81 @@
 module Tests.Snap.Routes (tests) where
 
 import Control.Applicative hiding (Const)
+import Control.Monad.IO.Class
 import Test.Framework
 import Test.Framework.Providers.HUnit
 import Test.HUnit hiding (Test)
 import Data.ByteString (ByteString)
+import Data.Either
 import Data.Predicate
+import Data.String
+import Data.Text (Text, strip)
+import Data.Text.Encoding
 import Snap.Core
-import Snap.Predicates
+import Snap.Predicates hiding (Text)
 import Snap.Routes
 import qualified Snap.Test as T
 import qualified Data.Map.Strict as M
+import qualified Data.Text as Text
 
 tests :: [Test]
 tests =
-    [ testSitemap ]
+    [ testSitemap
+    , testMedia
+    ]
 
 testSitemap :: Test
 testSitemap = testCase "Sitemap" $ do
     let routes = expandRoutes sitemap
-    assertEqual "Endpoints" ["/a", "/b", "/c", "/d"] (map fst routes)
+    assertEqual "Endpoints" ["/a", "/b", "/c", "/d", "/e"] (map fst routes)
     mapM_ (\(r, h) -> h r) (zip (map snd routes) [testEndpointA])
 
 sitemap :: Routes Snap ()
 sitemap = do
     get "/a" handlerA $
-        AcceptJson :&: (Param "name" :|: Param "nick") :&: Param "foo"
+        Accept Application Json :&: (Param "name" :|: Param "nick") :&: Param "foo"
 
     get "/b" handlerB $
-        AcceptJson :&: (Param "name" :||: Param "nick") :&: Param "foo"
+        Accept Application Json :&: (Param "name" :||: Param "nick") :&: Param "foo"
 
-    get  "/c" handlerC $ Fail (410, Just "Gone.")
+    get "/c" handlerC $ Fail (err 410 "Gone.")
 
-    post "/d" handlerD $ AcceptThrift
+    post "/d" handlerD $ Accept Application Json :&: Parameter "foo" decode Nothing
 
-handlerA :: AcceptJson :*: ByteString :*: ByteString -> Snap ()
-handlerA (_ :*: _ :*: _) = return ()
+    get "/e" handlerE $ (Param "foo" :|: Const 0) :&: ParamOpt "bar"
+  where
+    decode bs =
+        let txt = rights (map decodeUtf8' bs)
+        in if null txt
+               then Left "UTF-8 decoding error"
+               else Right (map strip txt)
 
-handlerB :: AcceptJson :*: (ByteString :+: ByteString) :*: ByteString -> Snap ()
+handlerA :: MediaType Application Json :*: Int :*: ByteString -> Snap ()
+handlerA (_ :*: i :*: _) = writeText (fromString . show $ i)
+
+handlerB :: MediaType Application Json :*: (ByteString :+: ByteString) :*: ByteString -> Snap ()
 handlerB (_ :*: name :*: _) =
     case name of
         Left  _ -> return ()
         Right _ -> return ()
 
-handlerC :: AcceptThrift -> Snap ()
+handlerC :: MediaType Application Json -> Snap ()
 handlerC _ = do
-    req <- getRequest
-    case apply (Param "bar" :&: Param "baz") req of
-        T (_ :*: _) -> return ()
-        F _         -> return ()
-    return ()
+    rq <- getRequest
+    with (Param "bar" :&: Param "baz") rq $ \(bar :*: baz) -> do
+        writeBS bar
+        writeBS baz
 
-handlerD :: AcceptThrift -> Snap ()
-handlerD _ = return ()
+handlerD :: MediaType Application Json :*: [Text] -> Snap ()
+handlerD (_ :*: txt) = writeText $ Text.intercalate ", " txt
 
+handlerE :: Int :*: Maybe ByteString -> Snap ()
+handlerE (foo :*: Just bar) = writeText (Text.pack . show $ foo) >> writeBS bar
+handlerE (_   :*: Nothing)  = return ()
+
 testEndpointA :: Snap () -> Assertion
 testEndpointA m = do
-    let rq0 = T.get "/a" M.empty
+    let rq0 = T.get "/a" M.empty >> T.addHeader "Accept" "foo/bar"
     st0 <- rspStatus <$> T.runHandler rq0 m
     assertEqual "Accept fails" 406 st0
 
@@ -70,7 +89,32 @@
     st2 <- rspStatus <$> T.runHandler rq2 m
     assertEqual "Param fails" 400 st2
 
-    let rq3 = T.get "/a" (M.fromList [("name", ["x"]), ("foo", ["y"])]) >>
+    let rq3 = T.get "/a" (M.fromList [("name", ["123"]), ("foo", ["y"])]) >>
               T.addHeader "Accept" "application/json"
     T.runHandler rq3 m >>= T.assertSuccess
 
+-- Media Selection Tests:
+
+testMedia :: Test
+testMedia = testCase "Media Selection" $ do
+    let [(_, h)] = expandRoutes sitemapMedia
+    expectMedia "application/json;q=0.3, application/x-thrift;q=0.7" "application/x-thrift" h
+    expectMedia "application/json;q=0.7, application/x-thrift;q=0.3" "application/json" h
+
+sitemapMedia :: Routes Snap ()
+sitemapMedia = do
+    get "/media" handlerJson   $ Accept Application Json
+    get "/media" handlerThrift $ Accept Application Thrift
+
+handlerJson :: MediaType Application Json -> Snap ()
+handlerJson _ = writeBS "application/json"
+
+handlerThrift :: MediaType Application Thrift -> Snap ()
+handlerThrift _ = writeBS "application/x-thrift"
+
+expectMedia :: ByteString -> ByteString -> Snap () -> Assertion
+expectMedia hdr res m = do
+    let rq0 = T.get "/media" M.empty >>
+              T.addHeader "Accept" hdr
+    txt0 <- T.runHandler rq0 m >>= liftIO . T.getResponseBody
+    assertEqual "media type" res txt0