diff --git a/snap-predicates.cabal b/snap-predicates.cabal
--- a/snap-predicates.cabal
+++ b/snap-predicates.cabal
@@ -1,5 +1,5 @@
 name:                snap-predicates
-version:             0.2.0
+version:             0.3.0
 synopsis:            Declarative routing for Snap.
 license:             MIT
 license-file:        LICENSE
@@ -25,23 +25,24 @@
     ghc-prof-options: -prof -auto-all
 
     exposed-modules:
-        Data.ByteString.Readable
-      , Data.Predicate
+        Data.Predicate
       , Data.Predicate.Env
-      , Snap.Predicates
-      , Snap.Predicates.Accept
-      , Snap.Predicates.Error
-      , Snap.Predicates.Params
-      , Snap.Predicates.Content
-      , Snap.Predicates.MediaTypes
-      , Snap.Predicates.Tutorial
-      , Snap.Routes
+      , Snap.Predicate
+      , Snap.Predicate.Accept
+      , Snap.Predicate.Error
+      , Snap.Predicate.Param
+      , Snap.Predicate.Header
+      , Snap.Predicate.Content
+      , Snap.Predicate.MediaType
+      , Snap.Predicate.Tutorial
+      , Snap.Predicate.Types
+      , Snap.Route
 
     other-modules:
-        Snap.Predicates.Internal
-        Snap.Predicates.MediaTypes.Internal
-      , Snap.Predicates.Parsers.Accept
-      , Snap.Predicates.Parsers.Shared
+        Snap.Predicate.Internal
+        Snap.Predicate.MediaType.Internal
+      , Snap.Predicate.Parser.Accept
+      , Snap.Predicate.Parser.Shared
 
     build-depends:
         base             >= 4   && < 5
@@ -64,8 +65,8 @@
 
     other-modules:
         Tests.Data.Predicate
-      , Tests.Snap.Predicates
-      , Tests.Snap.Routes
+      , Tests.Snap.Predicate
+      , Tests.Snap.Route
 
     build-depends:
         base             >= 4   && < 5
diff --git a/src/Data/ByteString/Readable.hs b/src/Data/ByteString/Readable.hs
deleted file mode 100644
--- a/src/Data/ByteString/Readable.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# 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/Snap/Predicate.hs b/src/Snap/Predicate.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate.hs
@@ -0,0 +1,7 @@
+module Snap.Predicate (module M) where
+
+import Snap.Predicate.Error     as M
+import Snap.Predicate.Accept    as M
+import Snap.Predicate.Content   as M
+import Snap.Predicate.Param     as M
+import Snap.Predicate.Header    as M
diff --git a/src/Snap/Predicate/Accept.hs b/src/Snap/Predicate/Accept.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Accept.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicate.Accept
+  ( Accept (..)
+  , module Snap.Predicate.MediaType
+  )
+where
+
+import Data.Monoid hiding (All)
+import Data.String
+import Data.Predicate
+import Snap.Core hiding (headers)
+import Snap.Predicate.Error
+import Snap.Predicate.MediaType
+import Snap.Predicate.MediaType.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/Predicate/Content.hs b/src/Snap/Predicate/Content.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Content.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicate.Content
+  ( Content
+  , ContentType (..)
+  , module Snap.Predicate.MediaType
+  )
+where
+
+import Data.Monoid hiding (All)
+import Data.String
+import Data.Predicate
+import Snap.Core hiding (headers)
+import Snap.Predicate.Error
+import Snap.Predicate.MediaType
+import Snap.Predicate.MediaType.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/Predicate/Error.hs b/src/Snap/Predicate/Error.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Error.hs
@@ -0,0 +1,15 @@
+module Snap.Predicate.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/Predicate/Header.hs b/src/Snap/Predicate/Header.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Header.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicate.Header
+  ( Header (..)
+  , Hdr    (..)
+  , HdrOpt (..)
+  , HdrDef (..)
+  , HasHdr (..)
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.CaseInsensitive (mk)
+import Data.Maybe
+import Data.Monoid
+import Data.Typeable
+import Data.Predicate
+import Snap.Core hiding (headers)
+import Snap.Predicate.Error
+import Snap.Predicate.Internal
+import Snap.Util.Readable
+
+-- | The most generic request header predicate provided.
+-- It will get all request header values of '_name' and pass them on to
+-- the conversion function '_read', which might either yield an error
+-- message or a value. If the header is not present, an optional default may be
+-- returned instead, if nothing is provided, the error message will be used
+-- when construction the 400 status.
+data Header a = Header
+  { _hdrName    :: !ByteString                         -- ^ request header name
+  , _hdrRead    :: [ByteString] -> Either ByteString a -- ^ conversion function
+  , _hdrDefault :: !(Maybe a)                          -- ^ (optional) default value
+  }
+
+instance Typeable a => Predicate (Header a) Request where
+    type FVal (Header a)     = Error
+    type TVal (Header a)     = a
+    apply (Header nme f def) =
+        rqApply RqPred
+          { _rqName      = nme
+          , _rqRead      = f
+          , _rqDef       = def
+          , _rqCachePref = "header:"
+          , _rqVals      = headers nme
+          , _rqError     = Just $ err 400 ("Missing header '" <> nme <> "'.")
+          }
+
+instance Show (Header a) where
+    show p = "Header: " ++ show (_hdrName p)
+
+-- | Specialisation of 'Header' which returns the first request
+-- header value which could be converted to the target type.
+-- Relies on 'Readable' type-class for the actual conversion.
+data Hdr a = Hdr ByteString
+
+instance (Typeable a, Readable a) => Predicate (Hdr a) Request where
+    type FVal (Hdr a) = Error
+    type TVal (Hdr a) = a
+    apply (Hdr x)     = apply (Header x readValues Nothing)
+
+instance Show (Hdr a) where
+    show (Hdr x) = "Hdr: " ++ show x
+
+-- | Specialisation of 'Header' which returns the first request
+-- header value which could be converted to the target type.
+-- If the header is not present, the provided default will be used.
+-- Relies on 'Readable' type-class for the actual conversion.
+data HdrDef a = HdrDef ByteString a
+
+instance (Typeable a, Readable a) => Predicate (HdrDef a) Request where
+    type FVal (HdrDef a) = Error
+    type TVal (HdrDef a) = a
+    apply (HdrDef x d)   = apply (Header x readValues (Just d))
+
+instance Show a => Show (HdrDef a) where
+    show (HdrDef x d) = "HdrDef: " ++ show x ++ " [" ++ show d ++ "]"
+
+-- | Predicate which returns the first request header which could be
+-- converted to the target type wrapped in a Maybe.
+-- If the header is not present, 'Nothing' will be returned.
+-- Relies on 'Readable' type-class for the actual conversion.
+data HdrOpt a = HdrOpt ByteString
+
+instance (Typeable a, Readable a) => Predicate (HdrOpt a) Request where
+    type FVal (HdrOpt a) = Error
+    type TVal (HdrOpt a) = Maybe a
+    apply (HdrOpt x)     =
+        rqApplyMaybe RqPred
+          { _rqName      = x
+          , _rqRead      = readValues
+          , _rqDef       = Nothing
+          , _rqCachePref = "headeropt:"
+          , _rqVals      = headers x
+          , _rqError     = Nothing
+          }
+
+instance Show (HdrOpt a) where
+    show (HdrOpt x) = "HdrOpt: " ++ show x
+
+-- | Predicate which is true if the request has a header with the
+-- given name.
+data HasHdr = HasHdr ByteString
+
+instance Predicate HasHdr Request where
+    type FVal HasHdr   = Error
+    type TVal HasHdr   = ()
+    apply (HasHdr x) r = return $
+        if isJust (getHeaders (mk x) r)
+            then T 0 ()
+            else F (err 400 ("Missing header '" <> x <> "'."))
+
+instance Show HasHdr where
+    show (HasHdr x) = "HasHdr: " ++ show x
diff --git a/src/Snap/Predicate/Internal.hs b/src/Snap/Predicate/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Internal.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
+module Snap.Predicate.Internal
+  ( RqPred (..)
+  , headers
+  , params
+  , cookies
+  , safeHead
+  , readValues
+  , rqApply
+  , rqApplyMaybe
+  , key
+  )
+where
+
+import Control.Monad.State.Class
+import Data.ByteString (ByteString)
+import Data.CaseInsensitive (mk)
+import Data.Maybe
+import Data.Monoid
+import Data.Predicate
+import Data.Predicate.Env (Env)
+import Data.String
+import Data.Typeable
+import Snap.Core hiding (headers)
+import Snap.Predicate.Error
+import Snap.Util.Readable
+
+import qualified Data.Predicate.Env as E
+import qualified Data.Map.Strict    as M
+
+headers :: ByteString -> Request -> [ByteString]
+headers name = fromMaybe [] . getHeaders (mk name)
+
+params :: ByteString -> Request -> [ByteString]
+params name = fromMaybe [] . M.lookup name . rqParams
+
+cookies :: ByteString -> Request -> [Cookie]
+cookies name rq = filter ((name ==) . cookieName) (rqCookies rq)
+
+safeHead :: [a] -> Maybe a
+safeHead []    = Nothing
+safeHead (h:_) = Just h
+
+readValues :: Readable a => [ByteString] -> Either ByteString a
+readValues vs =
+    case listToMaybe . catMaybes $ map fromBS vs of
+        Nothing -> Left "no read"
+        Just x  -> Right x
+
+data RqPred a = RqPred
+  { _rqName      :: !ByteString
+  , _rqRead      :: [ByteString] -> Either ByteString a
+  , _rqDef       :: !(Maybe a)
+  , _rqCachePref :: !ByteString
+  , _rqVals      :: Request -> [ByteString]
+  , _rqError     :: !(Maybe Error)
+  }
+
+rqApply :: (Typeable a, MonadState m, StateType m ~ Env)
+        => RqPred a -> Request -> m (Boolean Error a)
+rqApply p r =
+    let k = key (_rqCachePref p) (_rqName p) (_rqDef p)
+    in E.lookup k >>= maybe (work k) result
+  where
+    work k = case _rqVals p r of
+        [] -> return $ maybe (F (fromMaybe defErr (_rqError p))) (T 0) (_rqDef p)
+        vs -> do
+            let v = _rqRead p vs
+            E.insert k v
+            result v
+
+    result = return . either (F . err 400) (T 0)
+    defErr = Error 400 Nothing
+
+rqApplyMaybe :: (Typeable a, MonadState m, StateType m ~ Env)
+             => RqPred a -> Request -> m (Boolean Error (Maybe a))
+rqApplyMaybe p r =
+    let n = Nothing :: Typeable a => Maybe a
+        k = key (_rqCachePref p) (_rqName p) n
+    in E.lookup k >>= maybe (work k n) result
+  where
+    work k n = case _rqVals p r of
+        [] -> return (T 0 n)
+        vs -> do
+            let v = _rqRead p vs
+            E.insert k v
+            result v
+
+    result = return . either (F . err 400) (T 0 . Just)
+
+key :: (Typeable a, IsString m, Monoid m) => m -> m -> a -> m
+key prefix name def = prefix <> name <> ":" <> (fromString . show . typeOf $ def)
diff --git a/src/Snap/Predicate/MediaType.hs b/src/Snap/Predicate/MediaType.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/MediaType.hs
@@ -0,0 +1,490 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Snap.Predicate.MediaType
+  ( -- * Types
+    MType (..)
+  , MSubType (..)
+  , MediaType (..)
+
+  -- * Media-Types
+  , Type (..)
+  , All (..)
+  , Application (..)
+  , Audio (..)
+  , Image (..)
+  , Message (..)
+  , Multipart (..)
+  , Text (..)
+  , Video (..)
+
+  -- * Media-Sub-Types
+  , SubType (..)
+  , AtomXml (..)
+  , Css (..)
+  , Csv (..)
+  , Encrypted (..)
+  , FormData (..)
+  , FormUrlEncoded (..)
+  , Gif (..)
+  , Gzip (..)
+  , Javascript (..)
+  , Jpeg (..)
+  , Json (..)
+  , Mixed (..)
+  , Mp4 (..)
+  , Mpeg (..)
+  , OctetStream (..)
+  , Ogg (..)
+  , Partial (..)
+  , Pkcs12 (..)
+  , Pkcs7Cert (..)
+  , Pkcs7Sig (..)
+  , Pkcs7Mime (..)
+  , Pkcs7CertRqRs (..)
+  , 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 FormUrlEncoded = FormUrlEncoded deriving Eq
+
+instance MSubType FormUrlEncoded where
+    toSubType _ "x-www-form-urlencoded" = Just FormUrlEncoded
+    toSubType _ _                       = Nothing
+
+instance Show FormUrlEncoded where
+    show _ = "x-www-form-urlencoded"
+
+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 Pkcs12 = Pkcs12 deriving Eq
+
+instance MSubType Pkcs12 where
+    toSubType _ "x-pkcs12" = Just Pkcs12
+    toSubType _ _          = Nothing
+
+instance Show Pkcs12 where
+    show _ = "x-pkcs12"
+
+data Pkcs7Cert = Pkcs7Cert deriving Eq
+
+instance MSubType Pkcs7Cert where
+    toSubType _ "x-pkcs7-certificates" = Just Pkcs7Cert
+    toSubType _ _                      = Nothing
+
+instance Show Pkcs7Cert where
+    show _ = "x-pkcs7-certificates"
+
+data Pkcs7Sig = Pkcs7Sig deriving Eq
+
+instance MSubType Pkcs7Sig where
+    toSubType _ "x-pkcs7-signature" = Just Pkcs7Sig
+    toSubType _ _                   = Nothing
+
+instance Show Pkcs7Sig where
+    show _ = "x-pkcs7-signature"
+
+data Pkcs7Mime = Pkcs7Mime deriving Eq
+
+instance MSubType Pkcs7Mime where
+    toSubType _ "x-pkcs7-mime" = Just Pkcs7Mime
+    toSubType _ _              = Nothing
+
+instance Show Pkcs7Mime where
+    show _ = "x-pkcs7-mime"
+
+data Pkcs7CertRqRs = Pkcs7CertRqRs deriving Eq
+
+instance MSubType Pkcs7CertRqRs where
+    toSubType _ "x-pkcs7-certreqresp" = Just Pkcs7CertRqRs
+    toSubType _ _                     = Nothing
+
+instance Show Pkcs7CertRqRs where
+    show _ = "x-pkcs7-certreqresp"
+
+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/Predicate/MediaType/Internal.hs b/src/Snap/Predicate/MediaType/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/MediaType/Internal.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
+module Snap.Predicate.MediaType.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.Predicate.Internal
+import Snap.Predicate.MediaType
+import qualified Data.Predicate.Env           as E
+import qualified Snap.Predicate.Parser.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 . concatMap A.parseMediaTypes $ headers k r
+    E.insert k mtypes
+    return mtypes
+  where
+    q a b = A.medQuality b `compare` A.medQuality a
diff --git a/src/Snap/Predicate/Param.hs b/src/Snap/Predicate/Param.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Param.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicate.Param
+  ( Parameter (..)
+  , Param     (..)
+  , ParamOpt  (..)
+  , ParamDef  (..)
+  , HasParam  (..)
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.Map (member)
+import Data.Monoid
+import Data.Typeable
+import Data.Predicate
+import Snap.Core
+import Snap.Predicate.Error
+import Snap.Predicate.Internal
+import Snap.Util.Readable
+
+-- | 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. If the parameter is not present, 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
+  { _pName    :: !ByteString                         -- ^ request parameter name
+  , _pRead    :: [ByteString] -> Either ByteString a -- ^ conversion function
+  , _pDefault :: !(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) =
+        rqApply RqPred
+          { _rqName      = nme
+          , _rqRead      = f
+          , _rqDef       = def
+          , _rqCachePref = "parameter:"
+          , _rqVals      = params nme
+          , _rqError     = Just $ err 400 ("Missing parameter '" <> nme <> "'.")
+          }
+
+instance Show (Parameter a) where
+    show p = "Parameter: " ++ show (_pName p)
+
+-- | Specialisation of 'Parameter' which returns the first request
+-- parameter which could be converted to the target type.
+-- Relies on 'Readable' type-class for the actual conversion.
+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 readValues Nothing)
+
+instance Show (Param a) where
+    show (Param x) = "Param: " ++ show x
+
+-- | Specialisation of 'Parameter' which returns the first request
+-- parameter which could be converted to the target type.
+-- If the parameter is not present, the provided default will be used.
+-- Relies on 'Readable' type-class for the actual conversion.
+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 (Parameter x readValues (Just d))
+
+instance Show a => Show (ParamDef a) where
+    show (ParamDef x d) = "ParamDef: " ++ show x ++ " [" ++ show d ++ "]"
+
+-- | Predicate which returns the first request parameter which could be
+-- converted to the target type wrapped in a Maybe.
+-- If the parameter is not present, 'Nothing' will be returned.
+-- Relies on 'Readable' type-class for the actual conversion.
+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)     =
+        rqApplyMaybe RqPred
+          { _rqName      = x
+          , _rqRead      = readValues
+          , _rqDef       = Nothing
+          , _rqCachePref = "paramopt:"
+          , _rqVals      = params x
+          , _rqError     = Nothing
+          }
+
+instance Show (ParamOpt a) where
+    show (ParamOpt x) = "ParamOpt: " ++ show x
+
+-- | Predicate which is true if the request has a parameter with the
+-- given name.
+data HasParam = HasParam ByteString
+
+instance Predicate HasParam Request where
+    type FVal HasParam   = Error
+    type TVal HasParam   = ()
+    apply (HasParam x) r = return $
+        if member x (rqParams r)
+            then T 0 ()
+            else F (err 400 ("Missing parameter '" <> x <> "'."))
+
+instance Show HasParam where
+    show (HasParam x) = "HasParam: " ++ show x
diff --git a/src/Snap/Predicate/Parser/Accept.hs b/src/Snap/Predicate/Parser/Accept.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Parser/Accept.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
+module Snap.Predicate.Parser.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.Predicate.Parser.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)
+    toMaybe (T.parseOnly double txt)
+  where
+    toMaybe (Right x) = Just x
+    toMaybe (Left  _) = Nothing
diff --git a/src/Snap/Predicate/Parser/Shared.hs b/src/Snap/Predicate/Parser/Shared.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Parser/Shared.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Snap.Predicate.Parser.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 s c = S.any (== c) s
+
+chr :: Char -> Parser Word8
+chr = word8 . w
+
+w :: Char -> Word8
+w = fromIntegral . ord
diff --git a/src/Snap/Predicate/Tutorial.hs b/src/Snap/Predicate/Tutorial.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Tutorial.hs
@@ -0,0 +1,185 @@
+module Snap.Predicate.Tutorial
+  ( -- * Motivation
+    -- $motivation
+
+    -- * Introduction
+    -- $introduction
+
+    -- * Example Predicate
+    -- $example
+
+    -- * Routes
+    -- $routes
+  )
+where
+
+{- $motivation
+
+The purpose of the @snap-predicates@ package is to facilitate the
+convenient definition of safe Snap handlers. Here safety
+means that a handler can declare all pre-conditions which must be
+fulfilled such that the handler can produce a successful response.
+It is then statically guaranteed that the handler will not be
+invoked if any of these pre-conditions fails.
+
+-}
+
+{- $introduction
+
+The @snap-predicates@ package defines a 'Data.Predicate.Boolean' type
+which carries \-\- in addition to actual truth values 'Data.Predicate.T'
+and 'Data.Predicate.F' \-\- meta-data for each case:
+
+@
+data 'Data.Predicate.Boolean' f t =
+    'Data.Predicate.F' (Maybe f)
+  | '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.Predicate.Accept.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'
+or 'Data.Predicate.F'.
+
+@
+class 'Data.Predicate.Predicate' p a where
+    type 'Data.Predicate.FVal' p
+    type '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 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.Predicate.Accept.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:
+
+  * 'Data.Predicate.:|:' and 'Data.Predicate.:||:' as logical @OR@s
+
+  * 'Data.Predicate.:&:' as logical @AND@
+
+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 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
+'Data.Predicate.:*:' for this. This type also has a right-associative
+data constructor using the same symbol, so one can combine many predicates
+without having to nest the meta-data pairs.
+
+In the @OR@ case, the two predicates have potentially meta-data of
+different types, so we use a sum type 'Either' whenever we combine
+two predicates with 'Data.Predicate.:||:'. For convenience a type-alias
+'Data.Predicate.:+:' is defined for 'Either', which allows simple infix
+notation. However, for the common case where both predicates have
+meta-data of the same type, there is often no need to distinguish which
+@OR@-branch was true. In this case, the 'Data.Predicate.:|:' combinator
+can be used.
+
+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 section \"Routes\".
+-}
+
+{- $example
+
+@
+data Param = Param 'Data.ByteString.ByteString' deriving Eq
+
+instance 'Data.Predicate.Predicate' Param 'Snap.Core.Request' where
+    type 'Data.Predicate.FVal' Param = 'Snap.Predicate.Error'
+    type 'Data.Predicate.TVal' Param = ByteString
+    apply (Param x) r =
+        case params r x of
+            []    -> return (F ('Snap.Predicate.Error' 400 (Just $ \"Expected parameter '\" \<\> x \<\> \"'.\")))
+            (v:_) -> return (T [] v)
+@
+
+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, the meta-date type is 'Data.ByteString.ByteString'.
+The 'Data.Predicate.F'-case is 'Snap.Predicate.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 evaluate them against a given request inside a snap handler, e.g.
+
+@
+someHandler :: 'Snap.Core.Snap' ()
+someHandler = do
+    req <- 'Snap.Core.getRequest'
+    case 'Data.Predicate.eval' ('Snap.Predicate.Accept.Accept' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Json' 'Data.Predicate.:&:' 'Snap.Predicate.Param.Param' \"baz\") req of
+        'Data.Predicate.T' (_ 'Data.Predicate.:*:' bazValue)      -> ...
+        'Data.Predicate.F' (Just ('Snap.Predicate.Error' st msg)) -> ...
+        'Data.Predicate.F' Nothing               -> ...
+@
+
+However another possibility is to augment route definitions with the
+'Snap.Routes.Routes' monad to use them with 'Snap.Core.route', e.g.
+
+@
+sitemap :: 'Snap.Routes.Routes' Snap ()
+sitemap = do
+    'Snap.Routes.get'  \"\/a\" handlerA $ 'Snap.Predicate.Accept.Accept' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Json' 'Data.Predicate.:&:' ('Snap.Predicate.Param' \"name\" 'Data.Predicate.:|:' 'Snap.Predicate.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicate.Param' \"foo\"
+    'Snap.Routes.get'  \"\/b\" handlerB $ 'Snap.Predicate.Accept.Accept' 'Snap.Predicate.MediaType.Text' 'Snap.Predicate.MediaType.Plain' 'Data.Predicate.:&:' ('Snap.Predicate.Param' \"name\" 'Data.Predicate.:||:' 'Snap.Predicate.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicate.Param' \"foo\"
+    'Snap.Routes.get'  \"\/c\" handlerC $ 'Data.Predicate.Fail' ('Snap.Predicate.Error' 410 (Just \"Gone.\"))
+    'Snap.Routes.post' \"\/d\" handlerD $ 'Snap.Predicate.Accept.Accept' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Protobuf'
+    'Snap.Routes.post' \"\/e\" handlerE $ 'Snap.Predicate.Accept.Accept' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Xml'
+@
+
+The handlers then encode their pre-conditions in their type-signature:
+
+@
+handlerA :: 'Snap.Predicate.MediaType.MediaType' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Json' 'Data.Predicate.:*:' ByteString 'Data.Predicate.:*:' ByteString -> Snap ()
+handlerB :: 'Snap.Predicate.MediaType.MediaType' 'Snap.Predicate.MediaType.Text' 'Snap.Predicate.MediaType.Plain' 'Data.Predicate.:*:' (ByteString 'Data.Predicate.:+:' ByteString) 'Data.Predicate.:*:' ByteString -> Snap ()
+handlerC :: 'Snap.Predicate.MediaType.MediaType' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Json' 'Data.Predicate.:*:' Char -> Snap ()
+handlerD :: 'Snap.Predicate.MediaType.MediaType' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Protobuf' -> Snap ()
+handlerE :: 'Snap.Predicate.MediaType.MediaType' 'Snap.Predicate.MediaType.Application' 'Snap.Predicate.MediaType.Xml' -> Snap ()
+@
+
+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
+'Snap.Routes.Routes' monad into a list of
+@'Snap.Core.MonadSnap' m => [(ByteString, m ())]@.
+Additionally routes can be turned into Strings via 'Snap.Routes.showRoutes'.
+
+-}
diff --git a/src/Snap/Predicate/Types.hs b/src/Snap/Predicate/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicate/Types.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Snap.Predicate.Types ( CSV, list ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.ByteString (ByteString)
+import Data.Maybe
+import Data.Monoid
+import Data.Typeable
+import Snap.Util.Readable
+import qualified Data.ByteString.Char8 as C
+
+newtype CSV a = CSV { list :: [a] } deriving
+  ( Eq
+  , Ord
+  , Read
+  , Show
+  , Functor
+  , Monad
+  , MonadPlus
+  , Applicative
+  , Alternative
+  , Monoid
+  , Typeable
+  )
+
+instance Readable a => Readable (CSV a) where
+    fromBS s
+      | C.null s  = return empty
+      | otherwise =
+          let cs = map (fromBS . trim) (C.split ',' s)
+              xs = catMaybes cs
+          in if length cs /= length xs
+                 then fail "no parse"
+                 else return (CSV xs)
+
+trim :: ByteString -> ByteString
+trim = fst . C.spanEnd (== ' ') . C.dropWhile (== ' ')
diff --git a/src/Snap/Predicates.hs b/src/Snap/Predicates.hs
deleted file mode 100644
--- a/src/Snap/Predicates.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Snap.Predicates
-  ( module Snap.Predicates.Error
-  , module Snap.Predicates.Accept
-  , module Snap.Predicates.Content
-  , module Snap.Predicates.MediaTypes
-  , module Snap.Predicates.Params
-  )
-where
-
-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
deleted file mode 100644
--- a/src/Snap/Predicates/Accept.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/Content.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/Error.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/Internal.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-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
deleted file mode 100644
--- a/src/Snap/Predicates/MediaTypes.hs
+++ /dev/null
@@ -1,430 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/MediaTypes/Internal.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/Params.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/Parsers/Accept.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/Parsers/Shared.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Snap/Predicates/Tutorial.hs
+++ /dev/null
@@ -1,185 +0,0 @@
-module Snap.Predicates.Tutorial
-  ( -- * Motivation
-    -- $motivation
-
-    -- * Introduction
-    -- $introduction
-
-    -- * Example Predicate
-    -- $example
-
-    -- * Routes
-    -- $routes
-  )
-where
-
-{- $motivation
-
-The purpose of the @snap-predicates@ package is to facilitate the
-convenient definition of safe Snap handlers. Here safety
-means that a handler can declare all pre-conditions which must be
-fulfilled such that the handler can produce a successful response.
-It is then statically guaranteed that the handler will not be
-invoked if any of these pre-conditions fails.
-
--}
-
-{- $introduction
-
-The @snap-predicates@ package defines a 'Data.Predicate.Boolean' type
-which carries \-\- in addition to actual truth values 'Data.Predicate.T'
-and 'Data.Predicate.F' \-\- meta-data for each case:
-
-@
-data 'Data.Predicate.Boolean' f t =
-    'Data.Predicate.F' (Maybe f)
-  | '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'
-or 'Data.Predicate.F'.
-
-@
-class 'Data.Predicate.Predicate' p a where
-    type 'Data.Predicate.FVal' p
-    type '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 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:
-
-  * 'Data.Predicate.:|:' and 'Data.Predicate.:||:' as logical @OR@s
-
-  * 'Data.Predicate.:&:' as logical @AND@
-
-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 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
-'Data.Predicate.:*:' for this. This type also has a right-associative
-data constructor using the same symbol, so one can combine many predicates
-without having to nest the meta-data pairs.
-
-In the @OR@ case, the two predicates have potentially meta-data of
-different types, so we use a sum type 'Either' whenever we combine
-two predicates with 'Data.Predicate.:||:'. For convenience a type-alias
-'Data.Predicate.:+:' is defined for 'Either', which allows simple infix
-notation. However, for the common case where both predicates have
-meta-data of the same type, there is often no need to distinguish which
-@OR@-branch was true. In this case, the 'Data.Predicate.:|:' combinator
-can be used.
-
-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 section \"Routes\".
--}
-
-{- $example
-
-@
-data 'Snap.Predicates.Params.Param' = Param 'Data.ByteString.ByteString' deriving Eq
-
-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 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, 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 evaluate them against a given request inside a snap handler, e.g.
-
-@
-someHandler :: 'Snap.Core.Snap' ()
-someHandler = do
-    req <- 'Snap.Core.getRequest'
-    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
-'Snap.Routes.Routes' monad to use them with 'Snap.Core.route', e.g.
-
-@
-sitemap :: 'Snap.Routes.Routes' Snap ()
-sitemap = do
-    '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.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 ()
-@
-
-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
-'Snap.Routes.Routes' monad into a list of
-@'Snap.Core.MonadSnap' m => [(ByteString, m ())]@.
-Additionally routes can be turned into Strings via 'Snap.Routes.showRoutes'.
-
--}
diff --git a/src/Snap/Route.hs b/src/Snap/Route.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Route.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE GADTs             #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators     #-}
+{-# LANGUAGE FlexibleContexts  #-}
+module Snap.Route
+  ( Routes
+  , showRoutes
+  , expandRoutes
+  , addRoute
+  , get
+  , get_
+  , Snap.Route.head
+  , head_
+  , post
+  , post_
+  , put
+  , put_
+  , delete
+  , delete_
+  , trace
+  , trace_
+  , options
+  , options_
+  , connect
+  , connect_
+  )
+where
+
+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.Function
+import Data.List hiding (head, delete)
+import Data.Predicate
+import Data.Predicate.Env (Env)
+import Snap.Core
+import Snap.Predicate
+import qualified Data.List as L
+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)
+         => p
+         -> (TVal p -> m ())
+         -> Pack m
+
+data Route m = Route
+  { _method  :: !Method
+  , _path    :: !ByteString
+  , _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 }
+
+instance Monad (Routes m) where
+    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'
+         -> Routes m ()
+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
+    -> (TVal p -> m ())  -- ^ handler
+    -> p                 -- ^ 'Predicate'
+    -> Routes m ()
+get     = addRoute GET
+head    = addRoute HEAD
+post    = addRoute POST
+put     = addRoute PUT
+delete  = addRoute DELETE
+trace   = addRoute TRACE
+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) =
+    flip map (concat . normalise $ execState routes []) $ \x ->
+        case _pred x of
+            Pack p _ -> shows (_method x)
+                      . (' ':)
+                      . shows (_path x)
+                      . (' ':)
+                      . shows p $ ""
+
+-- | 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) =
+    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 = sortBy (compare `on` _path)
+
+    grouped :: [Route m] -> [[Route m]]
+    grouped = groupBy ((==) `on` _path)
+
+    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.
+-- (3) Pick the first one which is 'Good', or else respond with status
+--     and message of the first one.
+select :: MonadSnap m => [Route m] -> m ()
+select g = do
+    ms <- filterM byMethod g
+    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 . snd $ foldl' (evalSingle req) (E.empty, []) rs
+        if null y
+            then respond (L.head n)
+            else closest y
+
+    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 (compare `on` _delta)
+
+respond :: MonadSnap m => Error -> m ()
+respond e = do
+    putResponse . clearContentLength
+                . setResponseCode (fromIntegral . _status $ e)
+                $ emptyResponse
+    maybe (return ()) writeBS (_message e)
diff --git a/src/Snap/Routes.hs b/src/Snap/Routes.hs
deleted file mode 100644
--- a/src/Snap/Routes.hs
+++ /dev/null
@@ -1,205 +0,0 @@
-{-# LANGUAGE GADTs             #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE BangPatterns      #-}
-{-# LANGUAGE TypeOperators     #-}
-{-# LANGUAGE FlexibleContexts  #-}
-module Snap.Routes
-  ( Routes
-  , showRoutes
-  , expandRoutes
-  , addRoute
-  , get
-  , get_
-  , Snap.Routes.head
-  , head_
-  , post
-  , post_
-  , put
-  , put_
-  , delete
-  , delete_
-  , trace
-  , trace_
-  , options
-  , options_
-  , connect
-  , connect_
-  )
-where
-
-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.Predicate.Env (Env)
-import Snap.Core
-import Snap.Predicates
-import qualified Data.List as L
-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)
-         => p
-         -> (TVal p -> m ())
-         -> Pack m
-
-data Route m = Route
-  { _method  :: !Method
-  , _path    :: !ByteString
-  , _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 }
-
-instance Monad (Routes m) where
-    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'
-         -> Routes m ()
-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
-    -> (TVal p -> m ())  -- ^ handler
-    -> p                 -- ^ 'Predicate'
-    -> Routes m ()
-get     = addRoute GET
-head    = addRoute HEAD
-post    = addRoute POST
-put     = addRoute PUT
-delete  = addRoute DELETE
-trace   = addRoute TRACE
-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) =
-    flip map (concat . normalise $ execState routes []) $ \x ->
-        case _pred x of
-            Pack p _ -> shows (_method x)
-                      . (' ':)
-                      . shows (_path x)
-                      . (' ':)
-                      . shows p $ ""
-
--- | 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) =
-    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 = sortBy (\a b -> _path a `compare` _path b)
-
-    grouped :: [Route m] -> [[Route m]]
-    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.
--- (3) Pick the first one which is 'Good', or else respond with status
---     and message of the first one.
-select :: MonadSnap m => [Route m] -> m ()
-select g = do
-    ms <- filterM byMethod g
-    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 . snd $ foldl' (evalSingle req) (E.empty, []) rs
-        if null y
-            then respond (L.head n)
-            else closest y
-
-    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 e = do
-    putResponse . clearContentLength
-                . setResponseCode (fromIntegral . _status $ e)
-                $ emptyResponse
-    maybe (return ()) writeBS (_message e)
diff --git a/test/TestSuite.hs b/test/TestSuite.hs
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -2,14 +2,14 @@
 
 import Test.Framework (defaultMain, testGroup)
 import qualified Tests.Data.Predicate as Predicate
-import qualified Tests.Snap.Predicates as SnapPredicates
-import qualified Tests.Snap.Routes as SnapRoutes
+import qualified Tests.Snap.Predicate as SnapPredicate
+import qualified Tests.Snap.Route     as SnapRoute
 
 main :: IO ()
 main = defaultMain tests
   where
     tests =
-        [ testGroup "Tests.Data.Predicate"  Predicate.tests
-        , testGroup "Tests.Snap.Predicates" SnapPredicates.tests
-        , testGroup "Tests.Snap.Routes"     SnapRoutes.tests
+        [ testGroup "Tests.Data.Predicate" Predicate.tests
+        , testGroup "Tests.Snap.Predicate" SnapPredicate.tests
+        , testGroup "Tests.Snap.Route"     SnapRoute.tests
         ]
diff --git a/test/Tests/Snap/Predicate.hs b/test/Tests/Snap/Predicate.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests/Snap/Predicate.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings, FlexibleContexts, TypeFamilies #-}
+module Tests.Snap.Predicate (tests) where
+
+import Test.Framework
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test)
+import Data.ByteString (ByteString)
+import Data.Predicate
+import Snap.Predicate
+import Snap.Test
+import qualified Data.Map.Strict as M
+
+tests :: [Test]
+tests =
+    [ testAccept
+    , testParam
+    , testParamOpt
+    , testAcceptJson
+    , testAcceptThrift
+    ]
+
+testAccept :: Test
+testAccept = testCase "Accept Predicate" $ do
+    rq0 <- buildRequest $ addHeader "Accept" "x/y"
+    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 $ addHeader "Accept" "u/v"
+    assertEqual "Status Code 406"
+        (F (err 406 ("Expected 'Accept: \"x\"/\"y\"'.")))
+        (eval predicate rq1)
+
+testAcceptJson :: Test
+testAcceptJson = testCase "AcceptJson Predicate" $ do
+    rq0 <- buildRequest $ addHeader "Accept" "application/json"
+    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/bar"
+    assertEqual "Status Code 406"
+        (F (err 406 ("Expected 'Accept: application/json'.")))
+        (eval predicate rq1)
+
+testAcceptThrift :: Test
+testAcceptThrift = testCase "AcceptThrift Predicate" $ do
+    rq0 <- buildRequest $ addHeader "Accept" "application/x-thrift"
+    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 (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 0 "y") (eval (Param "x" :: Param ByteString) rq0)
+
+    rq1 <- buildRequest $ get "/" M.empty
+    assertEqual "Status Code 400"
+        (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/Predicates.hs b/test/Tests/Snap/Predicates.hs
deleted file mode 100644
--- a/test/Tests/Snap/Predicates.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts, TypeFamilies #-}
-module Tests.Snap.Predicates (tests) where
-
-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
-import qualified Data.Map.Strict as M
-
-tests :: [Test]
-tests =
-    [ testAccept
-    , testParam
-    , testParamOpt
-    , testAcceptJson
-    , testAcceptThrift
-    ]
-
-testAccept :: Test
-testAccept = testCase "Accept Predicate" $ do
-    rq0 <- buildRequest $ addHeader "Accept" "x/y"
-    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 $ addHeader "Accept" "u/v"
-    assertEqual "Status Code 406"
-        (F (err 406 ("Expected 'Accept: \"x\"/\"y\"'.")))
-        (eval predicate rq1)
-
-testAcceptJson :: Test
-testAcceptJson = testCase "AcceptJson Predicate" $ do
-    rq0 <- buildRequest $ addHeader "Accept" "application/json"
-    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/bar"
-    assertEqual "Status Code 406"
-        (F (err 406 ("Expected 'Accept: application/json'.")))
-        (eval predicate rq1)
-
-testAcceptThrift :: Test
-testAcceptThrift = testCase "AcceptThrift Predicate" $ do
-    rq0 <- buildRequest $ addHeader "Accept" "application/x-thrift"
-    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 (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 0 "y") (eval (Param "x" :: Param ByteString) rq0)
-
-    rq1 <- buildRequest $ get "/" M.empty
-    assertEqual "Status Code 400"
-        (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/Route.hs b/test/Tests/Snap/Route.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests/Snap/Route.hs
@@ -0,0 +1,204 @@
+{-# LANGUAGE OverloadedStrings, TypeOperators #-}
+module Tests.Snap.Route (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.Predicate
+import Data.String
+import Snap.Core
+import Snap.Predicate hiding (Text)
+import Snap.Predicate.Types
+import Snap.Route
+import qualified Snap.Test       as T
+import qualified Data.Map.Strict as M
+import qualified Data.Text       as Text
+
+tests :: [Test]
+tests =
+    [ testSitemap
+    , testMedia
+    ]
+
+testSitemap :: Test
+testSitemap = testCase "Sitemap" $ do
+    let routes  = expandRoutes sitemap
+    let handler = route routes
+    assertEqual "Endpoints" ["/a", "/b", "/c", "/d", "/e", "/f", "/z"] (map fst routes)
+    testEndpointA handler
+    testEndpointB handler
+    testEndpointC handler
+    testEndpointD handler
+    testEndpointE handler
+    testEndpointF handler
+
+sitemap :: Routes Snap ()
+sitemap = do
+    get "/a" handlerA
+        (Accept Application Json :&: (Param "name" :|: Param "nick") :&: Param "foo")
+
+    get "/b" handlerB
+        (Param "baz")
+
+    get "/c" handlerC
+        (ParamOpt "foo")
+
+    get "/d" handlerD
+        (ParamDef "foo" 0)
+
+    get "/e" handlerE
+        (HdrDef "foo" 0)
+
+    get "/f" handlerF
+        (Param "foo")
+
+    get "/z" handlerZ
+        (Fail (err 410 "Gone."))
+
+handlerA :: MediaType Application Json :*: Int :*: ByteString -> Snap ()
+handlerA (_ :*: i :*: _) = writeText (fromString . show $ i)
+
+handlerB :: Int -> Snap ()
+handlerB baz = writeText (Text.pack . show $ baz)
+
+handlerC :: Maybe Int -> Snap ()
+handlerC foo = writeText (Text.pack . show $ foo)
+
+handlerD :: Int -> Snap ()
+handlerD foo = writeText (Text.pack . show $ foo)
+
+handlerE :: Int -> Snap ()
+handlerE foo = writeText (Text.pack . show $ foo)
+
+handlerF :: CSV Int -> Snap ()
+handlerF foo = writeText (Text.pack . show . sum . list $ foo)
+
+handlerZ :: MediaType Application Json -> Snap ()
+handlerZ _ = do
+    rq <- getRequest
+    with (Param "bar" :&: Param "baz") rq $ \(bar :*: baz) -> do
+        writeBS bar
+        writeBS baz
+
+testEndpointA :: Snap () -> Assertion
+testEndpointA m = do
+    let rq0 = T.get "/a" M.empty >> T.addHeader "Accept" "foo/bar"
+    st0 <- rspStatus <$> T.runHandler rq0 m
+    assertEqual "Accept fails" 406 st0
+
+    let rq1 = rq0 >> T.addHeader "Accept" "application/json"
+    st1 <- rspStatus <$> T.runHandler rq1 m
+    assertEqual "Param fails" 400 st1
+
+    let rq2 = T.get "/a" (M.fromList [("name", ["x"])]) >>
+              T.addHeader "Accept" "application/json"
+    st2 <- rspStatus <$> T.runHandler rq2 m
+    assertEqual "Param fails" 400 st2
+
+    let rq3 = T.get "/a" (M.fromList [("name", ["123"]), ("foo", ["\"y\""])]) >>
+              T.addHeader "Accept" "application/json"
+    T.runHandler rq3 m >>= T.assertSuccess
+
+testEndpointB :: Snap () -> Assertion
+testEndpointB m = do
+    rs0 <- T.runHandler (T.get "/b" M.empty) m
+    bd0 <- T.getResponseBody rs0
+    assertEqual "b. baz 1" 400 (rspStatus rs0)
+    assertEqual "b. baz 2" "Missing parameter 'baz'." bd0
+
+    rs1 <- T.runHandler (T.get "/b" $ M.fromList [("baz", ["abc"])]) m
+    bd1 <- T.getResponseBody rs1
+    assertEqual "b. baz 3" 400 (rspStatus rs1)
+    assertEqual "b. baz 4" "no read" bd1
+
+    rs2 <- T.runHandler (T.get "/b" $ M.fromList [("baz", ["abc", "123"])]) m
+    bd2 <- T.getResponseBody rs2
+    assertEqual "b. baz 5" 200 (rspStatus rs2)
+    assertEqual "b. baz 6" "123" bd2
+
+testEndpointC :: Snap () -> Assertion
+testEndpointC m = do
+    rs0 <- T.runHandler (T.get "/c" M.empty) m
+    bd0 <- T.getResponseBody rs0
+    assertEqual "c. foo 1" 200 (rspStatus rs0)
+    assertEqual "c. foo 2" "Nothing" bd0
+
+    rs1 <- T.runHandler (T.get "/c" $ M.fromList [("foo", ["abc", "123"])]) m
+    bd1 <- T.getResponseBody rs1
+    assertEqual "c. foo 3" 200 (rspStatus rs1)
+    assertEqual "c. foo 4" "Just 123" bd1
+
+    rs2 <- T.runHandler (T.get "/c" $ M.fromList [("foo", ["abc"])]) m
+    bd2 <- T.getResponseBody rs2
+    assertEqual "c. foo 5" 400 (rspStatus rs2)
+    assertEqual "c. foo 6" "no read" bd2
+
+testEndpointD :: Snap () -> Assertion
+testEndpointD m = do
+    rs0 <- T.runHandler (T.get "/d" M.empty) m
+    bd0 <- T.getResponseBody rs0
+    assertEqual "d. foo 1" 200 (rspStatus rs0)
+    assertEqual "d. foo 2" "0" bd0
+
+    rs1 <- T.runHandler (T.get "/d" $ M.fromList [("foo", ["xxx", "42"])]) m
+    bd1 <- T.getResponseBody rs1
+    assertEqual "d. foo 3" 200 (rspStatus rs1)
+    assertEqual "d. foo 4" "42" bd1
+
+    rs2 <- T.runHandler (T.get "/d" $ M.fromList [("foo", ["yyy"])]) m
+    bd2 <- T.getResponseBody rs2
+    assertEqual "d. foo 5" 400 (rspStatus rs2)
+    assertEqual "d. foo 6" "no read" bd2
+
+testEndpointE :: Snap () -> Assertion
+testEndpointE m = do
+    rs0 <- T.runHandler (T.get "/e" M.empty) m
+    bd0 <- T.getResponseBody rs0
+    assertEqual "e. foo 1" 200 (rspStatus rs0)
+    assertEqual "e. foo 2" "0" bd0
+
+    rs1 <- T.runHandler (T.get "/e" M.empty >> T.addHeader "foo" "42") m
+    bd1 <- T.getResponseBody rs1
+    assertEqual "e. foo 3" 200 (rspStatus rs1)
+    assertEqual "e. foo 4" "42" bd1
+
+    rs2 <- T.runHandler (T.get "/e" M.empty >> T.addHeader "foo" "abc") m
+    bd2 <- T.getResponseBody rs2
+    assertEqual "e. foo 5" 400 (rspStatus rs2)
+    assertEqual "e. foo 6" "no read" bd2
+
+testEndpointF :: Snap () -> Assertion
+testEndpointF m = do
+    rs0 <- T.runHandler (T.get "/f" $ M.fromList [("foo", ["1,2,3,4"])]) m
+    bd0 <- T.getResponseBody rs0
+    assertEqual "e. foo 1" 200 (rspStatus rs0)
+    assertEqual "e. foo 2" "10" bd0
+
+-- 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
diff --git a/test/Tests/Snap/Routes.hs b/test/Tests/Snap/Routes.hs
deleted file mode 100644
--- a/test/Tests/Snap/Routes.hs
+++ /dev/null
@@ -1,120 +0,0 @@
-{-# LANGUAGE OverloadedStrings, TypeOperators #-}
-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 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
-    , testMedia
-    ]
-
-testSitemap :: Test
-testSitemap = testCase "Sitemap" $ do
-    let routes = expandRoutes sitemap
-    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 $
-        Accept Application Json :&: (Param "name" :|: Param "nick") :&: Param "foo"
-
-    get "/b" handlerB $
-        Accept Application Json :&: (Param "name" :||: Param "nick") :&: Param "foo"
-
-    get "/c" handlerC $ Fail (err 410 "Gone.")
-
-    post "/d" handlerD $ Accept Application Json :&: Parameter "foo" decode Nothing
-
-    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)
-
-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 :: MediaType Application Json -> Snap ()
-handlerC _ = do
-    rq <- getRequest
-    with (Param "bar" :&: Param "baz") rq $ \(bar :*: baz) -> do
-        writeBS bar
-        writeBS baz
-
-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 >> T.addHeader "Accept" "foo/bar"
-    st0 <- rspStatus <$> T.runHandler rq0 m
-    assertEqual "Accept fails" 406 st0
-
-    let rq1 = rq0 >> T.addHeader "Accept" "application/json"
-    st1 <- rspStatus <$> T.runHandler rq1 m
-    assertEqual "Param fails" 400 st1
-
-    let rq2 = T.get "/a" (M.fromList [("name", ["x"])]) >>
-              T.addHeader "Accept" "application/json"
-    st2 <- rspStatus <$> T.runHandler rq2 m
-    assertEqual "Param fails" 400 st2
-
-    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