diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,22 @@
+Copyright (c) 2013 Toralf Wittner, Brendan Hay
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,59 @@
+Snap-Predicates
+===============
+
+This library provides a definition of a type-class `Predicate`
+together with several concrete implementations which are used to
+constrain the set of possible `Snap` handlers in a type-safe
+way.
+
+Example
+-------
+
+```haskell
+{-# LANGUAGE OverloadedStrings, TypeOperators #-}
+module Main where
+
+import Data.ByteString (ByteString)
+import Data.Monoid
+import Data.Predicate
+import Snap.Core
+import Snap.Routes
+import Snap.Predicates
+import Snap.Http.Server
+
+main :: IO ()
+main = do
+    mapM_ putStrLn (showRoutes sitemap)
+    quickHttpServe (route . expandRoutes $ sitemap)
+
+sitemap :: Routes Snap ()
+sitemap = do
+    get "/a" getUser $
+        AcceptJson :&: (Param "name" :|: Param "nick") :&: Param "foo"
+
+    get "/b" getUser' $
+        AcceptJson :&: (Param "name" :||: Param "nick") :&: Param "foo"
+
+    get  "/status" status      $ Fail (410, Just "Gone.")
+    post "/"       createUser  $ AcceptThrift
+    post "/"       createUser' $ AcceptJson
+
+getUser :: AcceptJson :*: ByteString :*: ByteString -> Snap ()
+getUser (_ :*: name :*: foo) =
+    writeBS $ "getUser: name or nick=" <> name <> " foo=" <> foo
+
+getUser' :: AcceptJson :*: (ByteString :+: ByteString) :*: ByteString -> Snap ()
+getUser' (_ :*: name :*: foo) =
+    case name of
+        Left  a -> writeBS $ "getUser: name=" <> a <> " foo=" <> foo
+        Right b -> writeBS $ "getUser: nick=" <> b <> " foo=" <> foo
+
+createUser :: AcceptThrift -> Snap ()
+createUser _ = writeBS "createUser"
+
+createUser' :: AcceptJson -> Snap ()
+createUser' _ = writeBS "createUser'"
+
+status :: AcceptJson :*: Char -> Snap ()
+status _ = writeBS "status"
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/snap-predicates.cabal b/snap-predicates.cabal
new file mode 100644
--- /dev/null
+++ b/snap-predicates.cabal
@@ -0,0 +1,88 @@
+name:                snap-predicates
+version:             0.1.0
+synopsis:            Predicates for route definitions.
+license:             MIT
+license-file:        LICENSE
+author:              Toralf Wittner, Brendan Hay
+maintainer:          Toralf Wittner <tw@dtex.org>
+copyright:           Copyright (c) 2013 Toralf Wittner, Brendan Hay
+stability:           experimental
+category:            Snap
+build-type:          Simple
+cabal-version:       >= 1.10
+extra-source-files:  README.md
+
+description:
+    Provides a definition of a predicate type-class together
+    with several concrete implementations which are used to
+    constrain the set of possible Snap handlers in a type-safe
+    way.
+
+library
+    default-language: Haskell2010
+    hs-source-dirs:   src
+    ghc-options:      -Wall -O2 -fwarn-tabs -funbox-strict-fields
+    ghc-prof-options: -prof -auto-all
+
+    exposed-modules:
+        Data.Predicate
+      , Snap.Predicates
+      , Snap.Routes
+      , Snap.Predicates.Tutorial
+
+    build-depends:
+        base             >= 4   && < 5
+      , transformers     >= 0.3
+      , bytestring       >= 0.9
+      , containers       >= 0.5
+      , case-insensitive >= 1.0
+      , snap-core        >= 0.9
+
+    other-extensions:
+       BangPatterns
+     , FlexibleInstances
+     , GADTs
+     , MultiParamTypeClasses
+     , OverloadedStrings
+     , TypeFamilies
+     , TypeOperators
+
+test-suite snap-predicates-test-suite
+    type:             exitcode-stdio-1.0
+    default-language: Haskell2010
+    hs-source-dirs:   src test
+    main-is:          TestSuite.hs
+    ghc-options:      -Wall -O2 -fwarn-tabs -funbox-strict-fields
+    ghc-prof-options: -prof -auto-all
+
+    other-modules:
+        Tests.Data.Predicate
+      , Tests.Snap.Predicates
+      , Tests.Snap.Routes
+
+    build-depends:
+        base             >= 4   && < 5
+      , transformers     >= 0.3
+      , bytestring       >= 0.9
+      , containers       >= 0.5
+      , case-insensitive >= 1.0
+      , snap-core        >= 0.9
+
+      , HUnit                      >= 1.2
+      , QuickCheck                 >= 2.3
+      , test-framework             >= 0.8
+      , test-framework-hunit       >= 0.2
+      , test-framework-quickcheck2 >= 0.2
+
+    other-extensions:
+       BangPatterns
+     , FlexibleInstances
+     , GADTs
+     , MultiParamTypeClasses
+     , OverloadedStrings
+     , TypeFamilies
+     , TypeOperators
+
+source-repository head
+    type:             git
+    location:         https://github.com/twittner/snap-predicates
diff --git a/src/Data/Predicate.hs b/src/Data/Predicate.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Predicate.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances     #-}
+module Data.Predicate where
+
+import Control.Applicative hiding (Const)
+import Control.Monad
+
+-- | A 'Bool'-like type where each branch 'T'rue or 'F'alse carries
+-- some meta-data which is threaded through 'Predicate' evaluation.
+data Boolean f t =
+    F (Maybe f) -- ^ logical False with some meta-data
+  | T t         -- ^ logical True with some meta-data
+  deriving (Eq, Show)
+
+-- | The 'Predicate' class declares the function 'apply' which
+-- evaluates the predicate against some value, returning a value
+-- of type 'Boolean'.
+-- Besides being parameterised over predicate type and predicate
+-- parameter, the class is also parameterised over the actual types
+-- of T's and F's meta-data.
+class Predicate p a where
+    type FVal p
+    type TVal p
+    apply :: p -> a -> Boolean (FVal p) (TVal p)
+
+instance Monad (Boolean f) where
+    return      = T
+    (T x) >>= g = g x
+    (F x) >>= _ = F x
+
+instance MonadPlus (Boolean f) where
+    mzero           = F Nothing
+    (F _) `mplus` b = b
+    b     `mplus` _ = b
+
+instance Functor (Boolean f) where
+    fmap = liftM
+
+instance Applicative (Boolean f) where
+    pure  = return
+    (<*>) = ap
+
+instance Alternative (Boolean f) where
+    empty = mzero
+    (<|>) = mplus
+
+-- | A 'Predicate' instance which always returns 'T' with
+-- the given value as T's meta-data.
+data Const f t where
+    Const :: t -> Const f t
+
+instance Predicate (Const f t) a where
+    type FVal (Const f t) = f
+    type TVal (Const f t) = t
+    apply (Const a) _     = T a
+
+instance Show t => Show (Const f t) where
+    show (Const a) = "Const " ++ show a
+
+-- | A 'Predicate' instance which always returns 'F' with
+-- the given value as F's meta-data.
+data Fail f t where
+    Fail :: f -> Fail f t
+
+instance Predicate (Fail f t) a where
+    type FVal (Fail f t) = f
+    type TVal (Fail f t) = t
+    apply (Fail a) _     = F $ Just a
+
+instance Show f => Show (Fail f t) where
+    show (Fail a) = "Fail " ++ show a
+
+-- | A 'Predicate' instance corresponding to the logical
+-- OR connective of two 'Predicate's. It requires the
+-- meta-data of each 'T'rue branch to be of the same type.
+data a :|: b = a :|: b
+
+instance (Predicate a c, Predicate b c, TVal a ~ TVal b, FVal a ~ FVal b) => Predicate (a :|: b) c
+  where
+    type FVal (a :|: b) = FVal a
+    type TVal (a :|: b) = TVal a
+    apply (a :|: b) r   = apply a r <|> apply b r
+
+instance (Show a, Show b) => Show (a :|: b) where
+    show (a :|: b) = "(" ++ show a ++ " | " ++ show b ++ ")"
+
+type a :+: b = Either a b
+
+-- | A 'Predicate' instance corresponding to the logical
+-- OR connective of two 'Predicate's. The meta-data of
+-- each 'T'rue branch can be of different types.
+data a :||: b = a :||: b
+
+instance (Predicate a c, Predicate b c, FVal a ~ FVal b) => Predicate (a :||: b) c
+  where
+    type FVal (a :||: b) = FVal a
+    type TVal (a :||: b) = TVal a :+: TVal b
+    apply (a :||: b) r   = (Left <$> apply a r) <|> (Right <$> apply b r)
+
+instance (Show a, Show b) => Show (a :||: b) where
+    show (a :||: b) = "(" ++ show a ++ " || " ++ show b ++ ")"
+
+-- | Data-type used for tupling-up the results of ':&:'.
+data a :*: b = a :*: b deriving (Eq, Show)
+
+-- | A 'Predicate' instance corresponding to the logical
+-- AND connective of two 'Predicate's.
+data a :&: b = a :&: b
+
+instance (Predicate a c, Predicate b c, FVal a ~ FVal b) => Predicate (a :&: b) c
+  where
+    type FVal (a :&: b) = FVal a
+    type TVal (a :&: b) = TVal a :*: TVal b
+    apply (a :&: b) r   = (:*:) <$> apply a r <*> apply b r
+
+instance (Show a, Show b) => Show (a :&: b) where
+    show (a :&: b) = "(" ++ show a ++ " & " ++ show b ++ ")"
diff --git a/src/Snap/Predicates.hs b/src/Snap/Predicates.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Snap.Predicates
+  ( Accept (..)
+  , AcceptJson (..)
+  , AcceptThrift (..)
+  , Param (..)
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.Monoid
+import Data.Word
+import Data.Predicate
+import Snap.Core
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Map.Strict as M
+
+-- | A 'Predicate' against the 'Request's "Accept" header.
+data Accept = Accept ByteString deriving Eq
+
+instance Predicate Accept Request where
+    type FVal Accept = (Word, Maybe ByteString)
+    type TVal Accept = ()
+    apply (Accept x) r =
+        if x `elem` headers' r "accept"
+            then T ()
+            else F $ Just (406, Just $ "Expected 'Accept: " <> x <> "'.")
+
+instance Show Accept where
+    show (Accept x) = "Accept: " ++ show x
+
+-- | A 'Predicate' which is true only for Accept: "application/json".
+data AcceptJson = AcceptJson deriving Eq
+
+instance Predicate AcceptJson Request where
+    type FVal AcceptJson = (Word, Maybe ByteString)
+    type TVal AcceptJson = AcceptJson
+    apply AcceptJson r =
+        apply (Accept "application/json") r >> return AcceptJson
+
+instance Show AcceptJson where
+    show AcceptJson = "Accept: \"application/json\""
+
+-- | A 'Predicate' which is true only for Accept: "application/x-thrift".
+data AcceptThrift = AcceptThrift deriving Eq
+
+instance Predicate AcceptThrift Request where
+    type FVal AcceptThrift = (Word, Maybe ByteString)
+    type TVal AcceptThrift = AcceptThrift
+    apply AcceptThrift r =
+        apply (Accept "application/x-thrift") r >> return AcceptThrift
+
+instance Show AcceptThrift where
+    show AcceptThrift = "Accept: \"application/x-thrift\""
+
+-- | A 'Predicate' looking for some parameter value.
+data Param = Param ByteString deriving Eq
+
+instance Predicate Param Request where
+    type FVal Param = (Word, Maybe ByteString)
+    type TVal Param = ByteString
+    apply (Param x) r =
+        case params' r x of
+            []    -> F $ Just (400, Just $ "Expected parameter '" <> x <> "'.")
+            (v:_) -> T v
+
+instance Show Param where
+    show (Param x) = "Param: " ++ show x
+
+-- Internal helpers:
+
+headers' :: Request -> ByteString -> [ByteString]
+headers' rq name = maybe [] id . getHeaders (CI.mk name) $ rq
+
+params' :: Request -> ByteString -> [ByteString]
+params' rq name = maybe [] id . M.lookup name . rqParams $ rq
diff --git a/src/Snap/Predicates/Tutorial.hs b/src/Snap/Predicates/Tutorial.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Predicates/Tutorial.hs
@@ -0,0 +1,169 @@
+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' t
+  deriving (Eq, Show)
+@
+
+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 -> Boolean ('Data.Predicate.FVal' p) ('Data.Predicate.TVal' p)
+@
+
+All concrete 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.
+
+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 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 'Routes' section.
+-}
+
+{- $example
+
+@
+data 'Snap.Predicates.Accept' = 'Snap.Predicates.Accept' ByteString deriving Eq
+
+instance 'Data.Predicate.Predicate' 'Snap.Predicates.Accept' 'Snap.Core.Request' where
+    type 'Data.Predicate.FVal' 'Snap.Predicates.Accept' = (Word, Maybe ByteString)
+    type 'Data.Predicate.TVal' 'Snap.Predicates.Accept' = ()
+    'Data.Predicate.apply' ('Snap.Predicates.Accept' x) r =
+        if x \`elem\` headerValues r \"Accept\"
+            then 'Data.Predicate.T' ()
+            else 'Data.Predicate.F' $ Just (406, Just $ \"Expected 'Accept: \" <> x <> \"'.\")
+@
+
+This is a simple example testing the value of a 'Snap.Core.Request's accept
+header against some given value. The function @headerValues@ is not shown,
+but gets the actual Accept-Header values of the request.
+
+As mentioned before, Snap predicates usually fix the type @a@ from
+'Data.Predicate.Predicate' above to 'Snap.Core.Request'. The associated
+types 'Data.Predicate.FVal' and 'Data.Predicate.TVal' denote the meta-data
+types of the predicate. In this example, there is no useful information for
+the 'Data.Predicate.T'-case, so 'Data.Predicate.TVal' becomes '()'.
+The 'Data.Predicate.F'-case is set to the pair @(Word, Maybe ByteString)@
+and indeed, if the predicate fails it sets the right HTTP status code
+(406) and some helpful message.
+
+-}
+
+{- $routes
+
+So how are 'Data.Predicate.Predicate's used in some Snap application?
+One way is to just apply them to a given request inside a snap handler, e.g.
+
+@
+someHandler :: 'Snap.Core.Snap' ()
+someHandler = do
+    req <- 'Snap.Core.getRequest'
+    case apply ('Snap.Predicates.Accept' \"application/json\" 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"baz\") req of
+        'Data.Predicate.T' (_ 'Data.Predicate.:*:' bazValue) -> ...
+        'Data.Predicate.F' (Just (i, msg))  -> ...
+        'Data.Predicate.F' Nothing          -> ...
+@
+
+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.AcceptJson' 'Data.Predicate.:&:' ('Snap.Predicates.Param' \"name\" 'Data.Predicate.:|:' 'Snap.Predicates.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"foo\"
+    'Snap.Routes.get'  \"\/b\" handlerB $ 'Snap.Predicates.AcceptJson' 'Data.Predicate.:&:' ('Snap.Predicates.Param' \"name\" 'Data.Predicate.:||:' 'Snap.Predicates.Param' \"nick\") 'Data.Predicate.:&:' 'Snap.Predicates.Param' \"foo\"
+    'Snap.Routes.get'  \"\/c\" handlerC $ 'Data.Predicate.Fail' (410, Just \"Gone.\")
+    'Snap.Routes.post' \"\/d\" handlerD $ 'Snap.Predicates.AcceptThrift'
+    'Snap.Routes.post' \"\/e\" handlerE $ 'Snap.Predicates.Accept' \"plain/text\"
+@
+
+The handlers then encode their pre-conditions in their type-signature:
+
+@
+handlerA :: 'Snap.Predicates.AcceptJson' 'Data.Predicate.:*:' ByteString 'Data.Predicate.:*:' ByteString -> Snap ()
+handlerB :: 'Snap.Predicates.AcceptJson' 'Data.Predicate.:*:' (ByteString 'Data.Predicate.:+:' ByteString) 'Data.Predicate.:*:' ByteString -> Snap ()
+handlerC :: 'Snap.Predicates.AcceptJson' 'Data.Predicate.:*:' Char -> Snap ()
+handlerD :: 'Snap.Predicates.AcceptThrift' -> Snap ()
+handlerE :: () -> Snap ()
+@
+
+As usually these type-declarations have to match, or else the code will
+not compile. One thing to note is that 'Data.Predicate.Fail' works with
+all handler signatures, which is safe, because the handler is never
+invoked, or else Fail is used in some logical disjunction.
+
+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/Routes.hs b/src/Snap/Routes.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Routes.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE GADTs             #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE TypeOperators     #-}
+{-# LANGUAGE FlexibleContexts  #-}
+module Snap.Routes
+  ( Routes
+  , showRoutes
+  , expandRoutes
+  , get
+  , Snap.Routes.head
+  , addRoute
+  , post
+  , put
+  , delete
+  , trace
+  , options
+  , connect
+  )
+where
+
+import Control.Applicative
+import Control.Monad
+import Data.ByteString (ByteString)
+import Data.Either
+import Data.Predicate
+import Data.Word
+import Snap.Core
+import Control.Monad.Trans.State.Strict (State)
+import qualified Control.Monad.Trans.State.Strict as State
+import qualified Data.List as L
+
+type Error = (Word, Maybe ByteString)
+
+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)
+  }
+
+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
+
+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 $ State.modify ((Route m r (Pack p x)):)
+
+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
+
+-- | Turn route definitions into a list of 'String's.
+showRoutes :: Routes m () -> [String]
+showRoutes (Routes routes) =
+    let rs = reverse $ State.execState routes []
+    in flip map rs $ \x ->
+        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) =
+    let rg = grouped . sorted . reverse $ State.execState routes []
+    in map (\g -> (_path (L.head g), select g)) rg
+  where
+    sorted :: [Route m] -> [Route m]
+    sorted = L.sortBy (\a b -> _path a `compare` _path b)
+
+    grouped :: [Route m] -> [[Route m]]
+    grouped = L.groupBy (\a b -> _path a == _path b)
+
+-- 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 L.null ms
+        then respond (405, Nothing)
+        else evalAll ms
+  where
+    byMethod :: MonadSnap m => Route m -> m Bool
+    byMethod x = (_method x ==) <$> getsRequest rqMethod
+
+    evalAll :: MonadSnap m => [Route m] -> m ()
+    evalAll rs = do
+        req <- getRequest
+        let (n, y) = partitionEithers $ map (eval req) rs
+        if null y
+            then respond (L.head n)
+            else L.head y
+
+    eval :: MonadSnap m => Request -> Route m -> Either Error (m ())
+    eval rq r = case _pred r of
+        Pack p h ->
+            case apply p rq of
+                F Nothing  -> Left (500, Nothing)
+                F (Just m) -> Left m
+                T v        -> Right (h v)
+
+respond :: MonadSnap m => Error -> m ()
+respond (i, msg) = do
+    putResponse . clearContentLength
+                . setResponseCode (fromIntegral i)
+                $ emptyResponse
+    maybe (return ()) writeBS msg
diff --git a/test/TestSuite.hs b/test/TestSuite.hs
new file mode 100644
--- /dev/null
+++ b/test/TestSuite.hs
@@ -0,0 +1,15 @@
+module Main where
+
+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
+
+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
+        ]
diff --git a/test/Tests/Data/Predicate.hs b/test/Tests/Data/Predicate.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests/Data/Predicate.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+module Tests.Data.Predicate (tests) where
+
+import Control.Applicative hiding (Const)
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck
+import Data.Predicate
+
+tests :: [Test]
+tests =
+    [ testProperty "Const" testConst
+    , testProperty "Fail" testFail
+    , testProperty "(:&:)" testAnd
+    , testProperty "(:||:)" testOr
+    , testProperty "(:|:)" testOr'
+    ]
+
+testConst :: Const Int Char -> Bool
+testConst x@(Const c) = apply x () == T c
+
+testFail :: Fail Int Char -> Bool
+testFail x@(Fail c) = apply x () == F (Just c)
+
+testAnd :: Rand -> Rand -> Bool
+testAnd a@(Rand (T x)) b@(Rand (T y)) = apply (a :&: b) () == T (x :*: y)
+testAnd a@(Rand (T _)) b@(Rand (F y)) = apply (a :&: b) () == F y
+testAnd a@(Rand (F x)) b@(Rand (T _)) = apply (a :&: b) () == F x
+testAnd a@(Rand (F x)) b@(Rand (F _)) = apply (a :&: b) () == F x
+
+testOr :: Rand -> Rand -> Bool
+testOr a@(Rand (T x)) b@(Rand (T _)) = apply (a :||: b) () == T (Left x)
+testOr a@(Rand (T x)) b@(Rand (F _)) = apply (a :||: b) () == T (Left x)
+testOr a@(Rand (F _)) b@(Rand (T y)) = apply (a :||: b) () == T (Right y)
+testOr a@(Rand (F _)) b@(Rand (F y)) = apply (a :||: b) () == F y
+
+testOr' :: Rand -> Rand -> Bool
+testOr' a@(Rand (T x)) b@(Rand (T _)) = apply (a :|: b) () == T x
+testOr' a@(Rand (T x)) b@(Rand (F _)) = apply (a :|: b) () == T x
+testOr' a@(Rand (F _)) b@(Rand (T y)) = apply (a :|: b) () == T y
+testOr' a@(Rand (F _)) b@(Rand (F y)) = apply (a :|: b) () == F y
+
+data Rand = Rand (Boolean Int Char) deriving Show
+
+instance Predicate Rand a where
+    type FVal Rand   = Int
+    type TVal Rand   = Char
+    apply (Rand x) _ = x
+
+instance Arbitrary (Boolean Int Char) where
+    arbitrary =
+        oneof [ T <$> (arbitrary :: Gen Char)
+              , F <$> (arbitrary :: Gen (Maybe Int))
+              ]
+
+instance Arbitrary (Const Int Char) where
+    arbitrary = Const <$> (arbitrary :: Gen Char)
+
+instance Arbitrary (Fail Int Char) where
+    arbitrary = Fail <$> (arbitrary :: Gen Int)
+
+instance Arbitrary Rand where
+    arbitrary = Rand <$> (arbitrary :: Gen (Boolean Int Char))
diff --git a/test/Tests/Snap/Predicates.hs b/test/Tests/Snap/Predicates.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests/Snap/Predicates.hs
@@ -0,0 +1,58 @@
+{-# 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.Predicate
+import Snap.Predicates
+import Snap.Test
+import qualified Data.Map.Strict as M
+
+tests :: [Test]
+tests =
+    [ testAccept
+    , testParam
+    , testAcceptJson
+    , testAcceptThrift
+    ]
+
+testAccept :: Test
+testAccept = testCase "Accept Predicate" $ do
+    rq0 <- buildRequest $ addHeader "Accept" "x/y"
+    assertEqual "Matching Accept" (T ()) (apply (Accept "x/y") rq0)
+
+    rq1 <- buildRequest $ get "/" M.empty
+    assertEqual "Status Code 406"
+        (F $ Just (406, Just "Expected 'Accept: x/y'."))
+        (apply (Accept "x/y") rq1)
+
+testAcceptJson :: Test
+testAcceptJson = testCase "AcceptJson Predicate" $ do
+    rq0 <- buildRequest $ addHeader "Accept" "application/json"
+    assertEqual "Matching AcceptJson" (T AcceptJson) (apply AcceptJson rq0)
+
+    rq1 <- buildRequest $ addHeader "Accept" "foo"
+    assertEqual "Status Code 406"
+        (F $ Just (406, Just "Expected 'Accept: application/json'."))
+        (apply AcceptJson rq1)
+
+testAcceptThrift :: Test
+testAcceptThrift = testCase "AcceptThrift Predicate" $ do
+    rq0 <- buildRequest $ addHeader "Accept" "application/x-thrift"
+    assertEqual "Matching AcceptThrift" (T AcceptThrift) (apply AcceptThrift rq0)
+
+    rq1 <- buildRequest $ addHeader "Accept" "application/json"
+    assertEqual "Status Code 406"
+        (F $ Just (406, Just "Expected 'Accept: application/x-thrift'."))
+        (apply AcceptThrift rq1)
+
+testParam :: Test
+testParam = testCase "Param Predicate" $ do
+    rq0 <- buildRequest $ get "/" (M.fromList [("x", ["y", "z"])])
+    assertEqual "Matching Param" (T "y") (apply (Param "x") rq0)
+
+    rq1 <- buildRequest $ get "/" M.empty
+    assertEqual "Status Code 400"
+        (F $ Just (400, Just "Expected parameter 'x'."))
+        (apply (Param "x") rq1)
diff --git a/test/Tests/Snap/Routes.hs b/test/Tests/Snap/Routes.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests/Snap/Routes.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings, TypeOperators #-}
+module Tests.Snap.Routes (tests) where
+
+import Control.Applicative hiding (Const)
+import Test.Framework
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test)
+import Data.ByteString (ByteString)
+import Data.Predicate
+import Snap.Core
+import Snap.Predicates
+import Snap.Routes
+import qualified Snap.Test as T
+import qualified Data.Map.Strict as M
+
+tests :: [Test]
+tests =
+    [ testSitemap ]
+
+testSitemap :: Test
+testSitemap = testCase "Sitemap" $ do
+    let routes = expandRoutes sitemap
+    assertEqual "Endpoints" ["/a", "/b", "/c", "/d"] (map fst routes)
+    mapM_ (\(r, h) -> h r) (zip (map snd routes) [testEndpointA])
+
+sitemap :: Routes Snap ()
+sitemap = do
+    get "/a" handlerA $
+        AcceptJson :&: (Param "name" :|: Param "nick") :&: Param "foo"
+
+    get "/b" handlerB $
+        AcceptJson :&: (Param "name" :||: Param "nick") :&: Param "foo"
+
+    get  "/c" handlerC $ Fail (410, Just "Gone.")
+
+    post "/d" handlerD $ AcceptThrift
+
+handlerA :: AcceptJson :*: ByteString :*: ByteString -> Snap ()
+handlerA (_ :*: _ :*: _) = return ()
+
+handlerB :: AcceptJson :*: (ByteString :+: ByteString) :*: ByteString -> Snap ()
+handlerB (_ :*: name :*: _) =
+    case name of
+        Left  _ -> return ()
+        Right _ -> return ()
+
+handlerC :: AcceptThrift -> Snap ()
+handlerC _ = do
+    req <- getRequest
+    case apply (Param "bar" :&: Param "baz") req of
+        T (_ :*: _) -> return ()
+        F _         -> return ()
+    return ()
+
+handlerD :: AcceptThrift -> Snap ()
+handlerD _ = return ()
+
+testEndpointA :: Snap () -> Assertion
+testEndpointA m = do
+    let rq0 = T.get "/a" M.empty
+    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", ["x"]), ("foo", ["y"])]) >>
+              T.addHeader "Accept" "application/json"
+    T.runHandler rq3 m >>= T.assertSuccess
+