diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
--- /dev/null
+++ b/CHANGELOG
@@ -0,0 +1,1 @@
+0.1.0.0 - 2014-9-3 - Initial release.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, Daniel Patterson
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Daniel Patterson nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
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/hspec-snap.cabal b/hspec-snap.cabal
new file mode 100644
--- /dev/null
+++ b/hspec-snap.cabal
@@ -0,0 +1,50 @@
+name:                hspec-snap
+version:             0.1.0.0
+synopsis:            A library for testing with Hspec and the Snap Web Framework
+homepage:            https://github.com/dbp/hspec-snap
+license:             BSD3
+license-file:        LICENSE
+author:              Daniel Patterson
+maintainer:          dbp@dbpmail.net
+extra-source-files: CHANGELOG
+category:            Web, Snap
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:
+        Test.Hspec.Snap
+  hs-source-dirs: src
+  build-depends:       base >= 4.6 && < 4.8
+                     , bytestring >= 0.9 && < 0.11
+                     , containers >= 0.4 && < 0.6
+                     , digestive-functors >= 0.7 && < 0.8
+                     , hspec2 >= 0.4 && < 0.5
+                     , hxt >= 9.3 && < 9.4
+                     , HandsomeSoup >= 0.3 && < 0.4
+                     , lens >= 3.10 && < 4.5
+                     , mtl >= 2 && < 3
+                     , snap >= 0.13 && < 0.14
+                     , snap-core >= 0.9 && < 0.10
+                     , text >= 0.11 && < 1.2
+                     , transformers >= 0.3 && < 0.4
+
+
+Test-Suite test-hspec-snap
+    type:       exitcode-stdio-1.0
+    hs-source-dirs: spec
+    main-is: Main.hs
+    build-depends:     base >= 4.6 && < 4.8
+                     , bytestring >= 0.9 && < 0.11
+                     , containers >= 0.4 && < 0.6
+                     , digestive-functors >= 0.7 && < 0.8
+                     , hspec2 >= 0.4 && < 0.5
+                     , hxt >= 9.3 && < 9.4
+                     , HandsomeSoup >= 0.3 && < 0.4
+                     , lens >= 3.10 && < 4.5
+                     , mtl >= 2 && < 3
+                     , snap >= 0.13 && < 0.14
+                     , snap-core >= 0.9 && < 0.10
+                     , text >= 0.11 && < 1.2
+                     , transformers >= 0.3 && < 0.4
+    build-depends: hspec-snap == 0.1.0.0
diff --git a/spec/Main.hs b/spec/Main.hs
new file mode 100644
--- /dev/null
+++ b/spec/Main.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE GADTs                     #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE TemplateHaskell           #-}
+
+module Main where
+
+
+----------------------------------------------------------
+-- Section 0: Imports.                                  --
+----------------------------------------------------------
+import           Control.Applicative     ((<$>), (<*>))
+import           Control.Lens
+import           Data.ByteString         (ByteString)
+import qualified Data.Map                as M
+import           Data.Maybe              (fromMaybe)
+import           Data.Text               (Text)
+import qualified Data.Text               as T
+import           Snap                    (Handler, Method (..), SnapletInit,
+                                          addRoutes, getParam, liftIO,
+                                          makeSnaplet, method, route, void,
+                                          writeBS, writeText)
+import qualified Snap
+import           Text.Digestive
+
+import           Control.Concurrent.MVar (MVar, isEmptyMVar, newEmptyMVar,
+                                          tryPutMVar, tryTakeMVar)
+import           Test.Hspec
+import           Test.Hspec.Snap
+
+----------------------------------------------------------
+-- Section 1: Example application used for testing.     --
+----------------------------------------------------------
+data App = App { _mv :: MVar () }
+
+makeLenses ''App
+
+html :: Text
+html = "<table><tr><td>One</td><td>Two</td></tr></table>"
+
+testForm :: Form Text (Handler App App) (Text, Text)
+testForm = (,) <$> "a" .: check "Should not be empty" (\t -> not $ T.null t) (text Nothing)
+               <*> "b" .: text Nothing
+
+
+routes :: [(ByteString, Handler App App ())]
+routes = [("/test", method GET $ writeText html)
+         ,("/test", method POST $ writeText "")
+         ,("/params", do mq <- getParam "q"
+                         writeBS $ fromMaybe "" mq)
+         ,("/redirect", Snap.redirect "/test")
+         ,("/setmv", do m <- use mv
+                        void $ liftIO $ tryPutMVar m ()
+                        return ())
+         ]
+
+app :: MVar () -> SnapletInit App App
+app mvar = makeSnaplet "app" "An snaplet example application." Nothing $ do
+         addRoutes routes
+         return (App mvar)
+
+
+----------------------------------------------------------
+-- Section 2: Test suite against application.           --
+----------------------------------------------------------
+
+tests :: MVar () -> Spec
+tests mvar =
+  snap (route routes) (app mvar) $ do
+    describe "requests" $ do
+      it "should match selector from a GET request" $ do
+        p <- get "/test"
+        p `shouldHaveSelector` "table td"
+        p `shouldNotHaveSelector` "table td.doesntexist"
+        get "/redirect" >>= flip shouldNotHaveSelector "table td.doesntexist"
+        get "/invalid_url" >>= flip shouldNotHaveSelector "table td.doesntexist"
+      it "should not match <html> on POST request" $
+        post "/test" M.empty >>= flip shouldNotHaveText "<html>"
+      it "should post parameters" $ do
+        post "/params" (params [("q", "hello")]) >>= flip shouldHaveText "hello"
+        post "/params" (params [("r", "hello")]) >>= flip shouldNotHaveText "hello"
+      it "basic equality" $ do
+        eval (return 1) >>= shouldEqual 1
+        shouldNotEqual 1 2
+      it "status code 200" $ do
+        get "/test" >>= should200
+        get "/invalid_url" >>= shouldNot200
+      it "status code 404" $ do
+        get "/test" >>= shouldNot404
+        get "/invalid_url" >>= should404
+      it "status code 3**" $ do
+        get "/redirect" >>= should300
+        get "/test" >>= shouldNot300
+      it "status code 3** with target" $ do
+        get "/redirect" >>= should300To "/test"
+        get "/redirect" >>= shouldNot300To "/redirect"
+        get "/test" >>= shouldNot300To "/redirect"
+    describe "stateful changes" $ do
+      let isE = use mv >>= \m -> liftIO $ isEmptyMVar m
+      after (\_ -> void $ tryTakeMVar mvar) $
+        it "should reflect stateful in handler" $ do
+         eval isE >>= shouldEqual True
+         post "/setmv" M.empty
+         eval isE >>= shouldEqual False
+         post "/setmv" M.empty
+         eval isE >>= shouldEqual False
+         eval (use mv >>= \m -> void $ liftIO $ tryTakeMVar m)
+      it "cleans up" $ eval isE >>= shouldEqual True
+    describe "forms" $ do
+      it "should pass valid data" $ do
+        form (Value ("foo", "bar")) testForm (M.fromList [("a", "foo"), ("b", "bar")])
+        form (Value ("foo", "")) testForm (M.fromList [("a", "foo")])
+      it "should fail on invalid data" $ do
+        form (ErrorPaths ["a"]) testForm (M.fromList [("a", ""), ("b", "bar")])
+        form (ErrorPaths ["a"]) testForm (M.fromList [("b", "bar")])
+        form (ErrorPaths ["a"]) testForm (M.fromList [])
+
+
+----------------------------------------------------------
+-- Section 3: Code to interface with cabal test.        --
+----------------------------------------------------------
+main :: IO ()
+main = do
+  mvar <- newEmptyMVar
+  hspec (tests mvar)
diff --git a/src/Test/Hspec/Snap.hs b/src/Test/Hspec/Snap.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Hspec/Snap.hs
@@ -0,0 +1,356 @@
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TupleSections        #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Test.Hspec.Snap (
+  -- * Running blocks of hspec-snap tests
+    snap
+
+  -- * Core data types
+  , TestResponse(..)
+  , SnapHspecM
+
+  -- * General Hspec helpers
+  , afterAll
+
+  -- * Requests
+  , get
+  , get'
+  , post
+  , params
+
+  -- * Evaluating application code
+  , eval
+
+  -- * Unit test assertions
+  , shouldEqual
+  , shouldNotEqual
+  , shouldBeTrue
+  , shouldNotBeTrue
+
+  -- * Response assertions
+  , should200
+  , shouldNot200
+  , should404
+  , shouldNot404
+  , should300
+  , shouldNot300
+  , should300To
+  , shouldNot300To
+  , shouldHaveSelector
+  , shouldNotHaveSelector
+  , shouldHaveText
+  , shouldNotHaveText
+
+  -- * Form tests
+  , FormExpectations(..)
+  , form
+
+
+  -- * Internal types and helpers
+  , SnapHspecState(..)
+  , setResult
+  , runRequest
+  , runHandlerSafe
+  , evalHandlerSafe
+  ) where
+
+import           Control.Applicative     ((<$>))
+import           Control.Concurrent.MVar (modifyMVar, newEmptyMVar, newMVar,
+                                          putMVar, takeMVar)
+import           Control.Exception       (SomeException, catch)
+import           Control.Monad.State     (StateT (..), runStateT)
+import qualified Control.Monad.State     as S (get, put)
+import           Control.Monad.Trans     (liftIO)
+import           Data.ByteString         (ByteString)
+import qualified Data.Map                as M
+import           Data.Maybe              (fromMaybe)
+import           Data.Text               (Text)
+import qualified Data.Text               as T
+import qualified Data.Text.Encoding      as T
+import           Snap.Core               (Response (..), getHeader)
+import qualified Snap.Core               as Snap
+import           Snap.Snaplet            (Handler, Snaplet, SnapletInit)
+import           Snap.Snaplet.Test       (InitializerState, closeSnaplet,
+                                          evalHandler', getSnaplet, runHandler')
+import           Snap.Test               (RequestBuilder, getResponseBody)
+import qualified Snap.Test               as Test
+import           Test.Hspec
+import           Test.Hspec.Core
+import qualified Text.Digestive          as DF
+import qualified Text.HandsomeSoup       as HS
+import qualified Text.XML.HXT.Core       as HXT
+
+-- | The result of making requests against your application. Most
+-- assertions act against these types (for example, `should200`,
+-- `shouldHaveSelector`, etc).
+data TestResponse = Html Text | NotFound | Redirect Int Text | Other Int | Empty deriving (Show, Eq)
+
+-- | The main monad that tests run inside of. This allows both access
+-- to the application (via requests and `eval`) and to running
+-- assertions (like `should404` or `shouldHaveText`).
+type SnapHspecM b = StateT (SnapHspecState b) IO
+
+-- | Internal state used to share site initialization across tests, and to propogate failures.
+data SnapHspecState b = SnapHspecState Result (Handler b b ()) (Snaplet b) (InitializerState b)
+
+
+instance Example (SnapHspecM b ()) where
+  type Arg (SnapHspecM b ()) = SnapHspecState b
+  evaluateExample s _ cb _ =
+    do mv <- newEmptyMVar
+       cb $ \st@(SnapHspecState _ _ _ _) -> do ((),(SnapHspecState r' _ _ _)) <- runStateT s st
+                                               putMVar mv r'
+       takeMVar mv
+
+-- | Runs a given action once after all the tests in the given block have run.
+afterAll :: IO () -> SpecWith a -> SpecWith a
+afterAll action = go
+  where go spec = do forest <- runIO $ runSpecM spec
+                     res <- runIO $ mapM countFlatten forest
+                     let specs = map snd res
+                     let count = foldr (+) 0 (map fst res)
+                     mvar <- runIO $ newMVar count
+                     after (\_ -> cleanup mvar) (fromSpecList specs)
+        countFlatten :: SpecTree a -> IO (Int, SpecTree a)
+        countFlatten (SpecGroup s t) =
+          do (count, t') <- joinCount <$> mapM countFlatten t
+             return (count, SpecGroup s t')
+        countFlatten (BuildSpecs a) = do s <- a
+                                         (count, s') <- joinCount <$> mapM countFlatten s
+                                         return (count, BuildSpecs (return s'))
+        countFlatten (SpecItem s i) = return (1, SpecItem s i)
+        joinCount :: [(Int, b)] -> (Int, [b])
+        joinCount = foldr (\(a,b) (c,d) -> (a + c, b:d)) (0, [])
+        cleanup mv = modifyMVar mv $ \v -> if v == 1
+                                              then action >>= return . (v,)
+                                              else return (v - 1, ())
+
+-- | The way to run a block of `SnapHspecM` tests within an `hspec`
+-- test suite. This takes both the top level handler (usually `route
+-- routes`, where `routes` are all the routes for your site) and the
+-- site initializer (often named `app`), and a block of tests. A test
+-- suite can have multiple calls to `snap`, though each one will cause
+-- the site initializer to run, which is often a slow operation (and
+-- will slow down test suites).
+snap :: Handler b b () -> SnapletInit b b -> SpecWith (SnapHspecState b) -> Spec
+snap site app spec = do
+  snapinit <- runIO $ getSnaplet (Just "test") app
+  case snapinit of
+    Left err -> error $ show err
+    Right (snaplet, initstate) -> do
+      afterAll (closeSnaplet initstate) $
+        before (return (SnapHspecState Success site snaplet initstate)) spec
+
+-- | Runs a GET request.
+get :: Text -> SnapHspecM b TestResponse
+get path = get' path M.empty
+
+-- | Runs a GET request, with a set of parameters.
+get' :: Text -> Snap.Params -> SnapHspecM b TestResponse
+get' path ps = runRequest (Test.get (T.encodeUtf8 path) ps)
+
+-- | A helper to construct parameters.
+params :: [(ByteString, ByteString)] -- ^ Pairs of parameter and value.
+       -> Snap.Params
+params = M.fromList . map (\x -> (fst x, [snd x]))
+
+-- | Creates a new POST request, with a set of parameters.
+post :: Text -> Snap.Params -> SnapHspecM b TestResponse
+post path ps = runRequest (Test.postUrlEncoded (T.encodeUtf8 path) ps)
+
+-- | Runs an arbitrary stateful action from your application.
+eval :: Handler b b a -> SnapHspecM b a
+eval act = do (SnapHspecState _ _ app is) <- S.get
+              liftIO $ fmap (either (error . T.unpack) id) $ evalHandlerSafe act app is
+
+
+-- | Records a test Success or Fail. Only the first Fail will be
+-- recorded (and will cause the whole block to Fail).
+setResult :: Result -> SnapHspecM b ()
+setResult r = do (SnapHspecState r' s a i) <- S.get
+                 case r' of
+                   Success -> S.put (SnapHspecState r s a i)
+                   _ -> return ()
+
+-- | Asserts that two values are equal.
+shouldEqual :: (Show a, Eq a)
+            => a
+            -> a
+            -> SnapHspecM b ()
+shouldEqual a b = if a == b
+                      then setResult Success
+                      else setResult (Fail ("Should have held: " ++ show a ++ " == " ++ show b))
+
+-- | Asserts that two values are not equal.
+shouldNotEqual :: (Show a, Eq a)
+               => a
+               -> a
+               -> SnapHspecM b ()
+shouldNotEqual a b = if a == b
+                         then setResult (Fail ("Should not have held: " ++ show a ++ " == " ++ show b))
+                         else setResult Success
+
+-- | Asserts that the value is True.
+shouldBeTrue :: Bool
+             -> SnapHspecM b ()
+shouldBeTrue True = setResult Success
+shouldBeTrue False = setResult (Fail "Value should have been True.")
+
+-- | Asserts that the value is not True (otherwise known as False).
+shouldNotBeTrue :: Bool
+                 -> SnapHspecM b ()
+shouldNotBeTrue False = setResult Success
+shouldNotBeTrue True = setResult (Fail "Value should have been True.")
+
+-- | Asserts that the response is a success (either Html, or Other with status 200).
+should200 :: TestResponse -> SnapHspecM b ()
+should200 (Html _) = setResult Success
+should200 (Other 200) = setResult Success
+should200 r = setResult (Fail (show r))
+
+-- | Asserts that the response is not a normal 200.
+shouldNot200 :: TestResponse -> SnapHspecM b ()
+shouldNot200 (Html _) = setResult (Fail "Got Html back.")
+shouldNot200 (Other 200) = setResult (Fail "Got Other with 200 back.")
+shouldNot200 _ = setResult Success
+
+-- | Asserts that the response is a NotFound.
+should404 :: TestResponse -> SnapHspecM b ()
+should404 NotFound = setResult Success
+should404 r = setResult (Fail (show r))
+
+-- | Asserts that the response is not a NotFound.
+shouldNot404 :: TestResponse -> SnapHspecM b ()
+shouldNot404 NotFound = setResult (Fail "Got NotFound back.")
+shouldNot404 _ = setResult Success
+
+-- | Asserts that the response is a redirect.
+should300 :: TestResponse -> SnapHspecM b ()
+should300 (Redirect _ _) = setResult Success
+should300 r = setResult (Fail (show r))
+
+-- | Asserts that the response is not a redirect.
+shouldNot300 :: TestResponse -> SnapHspecM b ()
+shouldNot300 (Redirect _ _) = setResult (Fail "Got Redirect back.")
+shouldNot300 _ = setResult Success
+
+-- | Asserts that the response is a redirect, and thet the url it
+-- redirects to starts with the given path.
+should300To :: Text -> TestResponse -> SnapHspecM b ()
+should300To pth (Redirect _ to) | pth `T.isPrefixOf` to = setResult Success
+should300To _ r = setResult (Fail (show r))
+
+-- | Asserts that the response is not a redirect to a given path. Note
+-- that it can still be a redirect for this assertion to succeed, the
+-- path it redirects to just can't start with the given path.
+shouldNot300To :: Text -> TestResponse -> SnapHspecM b ()
+shouldNot300To pth (Redirect _ to) | pth `T.isPrefixOf` to = setResult (Fail "Got Redirect back.")
+shouldNot300To _ _ = setResult Success
+
+-- | Assert that a response (which should be Html) has a given selector.
+shouldHaveSelector :: TestResponse -> Text -> SnapHspecM b ()
+shouldHaveSelector r@(Html body) selector =
+  setResult $ if haveSelector' r selector
+                then Success
+                else (Fail msg)
+  where msg = (T.unpack $ T.concat ["Html should have contained selector: ", selector, "\n\n", body])
+shouldHaveSelector _ match = setResult (Fail (T.unpack $ T.concat ["Non-HTML body should have contained css selector: ", match]))
+
+-- | Assert that a response (which should be Html) doesn't have a given selector.
+shouldNotHaveSelector :: TestResponse -> Text -> SnapHspecM b ()
+shouldNotHaveSelector r@(Html body) selector =
+  setResult $ if haveSelector' r selector
+                then (Fail msg)
+                else Success
+  where msg = (T.unpack $ T.concat ["Html should not have contained selector: ", selector, "\n\n", body])
+shouldNotHaveSelector _ _ = setResult Success
+
+haveSelector' :: TestResponse -> Text -> Bool
+haveSelector' (Html body) selector =
+  case HXT.runLA (HXT.hread HXT.>>> HS.css (T.unpack selector)) (T.unpack body)  of
+    [] -> False
+    _ -> True
+haveSelector' _ _ = False
+
+-- | Asserts that the response (which should be Html) contains the given text.
+shouldHaveText :: TestResponse -> Text -> SnapHspecM b ()
+shouldHaveText (Html body) match =
+  if T.isInfixOf match body
+  then setResult Success
+  else setResult (Fail $ T.unpack $ T.concat [body, "' contains '", match, "'."])
+shouldHaveText _ match = setResult (Fail (T.unpack $ T.concat ["Body contains: ", match]))
+
+-- | Asserts that the response (which should be Html) does not contain the given text.
+shouldNotHaveText :: TestResponse -> Text -> SnapHspecM b ()
+shouldNotHaveText (Html body) match =
+  if T.isInfixOf match body
+  then setResult (Fail $ T.unpack $ T.concat [body, "' contains '", match, "'."])
+  else setResult Success
+shouldNotHaveText _ _ = setResult Success
+
+
+-- | A data type for tests against forms.
+data FormExpectations a = Value a           -- ^ The value the form should take (and should be valid)
+                        | ErrorPaths [Text] -- ^ The error paths that should be populated
+
+-- | Tests against digestive-functors forms.
+form :: (Eq a, Show a)
+     => FormExpectations a           -- ^ If the form should succeed, Value a is what it should produce.
+                                     --   If failing, ErrorPaths should be all the errors that are triggered.
+     -> DF.Form Text (Handler b b) a -- ^ The form to run
+     -> M.Map Text Text                -- ^ The parameters to pass
+     -> SnapHspecM b ()
+form expected theForm theParams =
+  do r <- eval $ DF.postForm "form" theForm (const $ return lookupParam)
+     case expected of
+       Value a -> shouldEqual (snd r) (Just a)
+       ErrorPaths expectedPaths ->
+         do let viewErrorPaths = map (DF.fromPath . fst) $ DF.viewErrors $ fst r
+            shouldBeTrue (all (`elem` viewErrorPaths) expectedPaths
+                          && (length viewErrorPaths == length expectedPaths))
+  where lookupParam pth = case M.lookup (DF.fromPath pth) fixedParams of
+                            Nothing -> return []
+                            Just v -> return [DF.TextInput v]
+        fixedParams = M.mapKeys (T.append "form.") theParams
+
+-- | Runs a request (built with helpers from Snap.Test), resulting in a response.
+runRequest :: RequestBuilder IO () -> SnapHspecM b TestResponse
+runRequest req = do
+  (SnapHspecState _ site app is) <- S.get
+  res <- liftIO $ runHandlerSafe req site app is
+  case res of
+    Left err -> do
+      error $ T.unpack err
+    Right response -> do
+      case rspStatus response of
+        404 -> return NotFound
+        200 -> do
+          body <- liftIO $ getResponseBody response
+          return $ Html $ T.decodeUtf8 body
+        _ -> if (rspStatus response) >= 300 && (rspStatus response) < 400
+                then do let url = fromMaybe "" $ getHeader "Location" response
+                        return (Redirect (rspStatus response) (T.decodeUtf8 url))
+                else return (Other (rspStatus response))
+
+-- | Runs a request against a given handler (often the whole site),
+-- with the given state. Returns any triggered exception, or the response.
+runHandlerSafe :: RequestBuilder IO ()
+               -> Handler b b v
+               -> Snaplet b
+               -> InitializerState b
+               -> IO (Either Text Response)
+runHandlerSafe req site s is =
+  catch (runHandler' s is req site) (\(e::SomeException) -> return $ Left (T.pack $ show e))
+
+-- | Evaluates a given handler with the given state. Returns any
+-- triggered exception, or the value produced.
+evalHandlerSafe :: Handler b b v
+                -> Snaplet b
+                -> InitializerState b
+                -> IO (Either Text v)
+evalHandlerSafe act s is =
+  catch (evalHandler' s is (Test.get "" M.empty) act) (\(e::SomeException) -> return $ Left (T.pack $ show e))