packages feed

fn 0.0.0.0 → 0.1.0.0

raw patch · 5 files changed

+228/−290 lines, 5 filesdep −wai-extradep ~waiPVP ok

version bump matches the API change (PVP)

Dependencies removed: wai-extra

Dependency ranges changed: wai

API changes (from Hackage documentation)

- Web.Fn: ParamMissing :: ParamError
- Web.Fn: ParamOtherError :: Text -> ParamError
- Web.Fn: ParamUnparsable :: ParamError
- Web.Fn: anything :: Req -> Maybe (Req, a -> a)
- Web.Fn: class FromParam a
- Web.Fn: data ParamError
- Web.Fn: instance GHC.Classes.Eq Web.Fn.ParamError
- Web.Fn: instance GHC.Show.Show Web.Fn.ParamError
- Web.Fn: instance Web.Fn.FromParam Data.Text.Internal.Text
- Web.Fn: instance Web.Fn.FromParam GHC.Types.Double
- Web.Fn: instance Web.Fn.FromParam GHC.Types.Int
- Web.Fn: method :: StdMethod -> Req -> Maybe (Req, a -> a)
- Web.Fn: paramMany :: FromParam p => Text -> Req -> Maybe (Req, ([p] -> a) -> a)
- Web.Fn: paramOpt :: FromParam p => Text -> Req -> Maybe (Req, (Either ParamError [p] -> a) -> a)
+ Web.Fn: class Param a
+ Web.Fn: instance Web.Fn.Param Data.Text.Internal.Text
+ Web.Fn: instance Web.Fn.Param GHC.Types.Double
+ Web.Fn: instance Web.Fn.Param GHC.Types.Int
+ Web.Fn: paramOptional :: Param p => Text -> Req -> (Either Text p -> a) -> Maybe (Req, a)
+ Web.Fn: paramPresent :: Param p => Text -> Req -> (Either Text p -> a) -> Maybe (Req, a)
- Web.Fn: (//) :: (r -> Maybe (r, k -> k')) -> (r -> Maybe (r, k' -> a)) -> r -> Maybe (r, k -> a)
+ Web.Fn: (//) :: (r -> k -> Maybe (r, k')) -> (r -> k' -> Maybe (r, a)) -> r -> k -> Maybe (r, a)
- Web.Fn: (/?) :: (r -> Maybe (r, k -> k')) -> (r -> Maybe (r, k' -> a)) -> r -> Maybe (r, k -> a)
+ Web.Fn: (/?) :: (r -> k -> Maybe (r, k')) -> (r -> k' -> Maybe (r, a)) -> r -> k -> Maybe (r, a)
- Web.Fn: (==>) :: RequestContext ctxt => (Req -> Maybe (Req, k -> a)) -> (ctxt -> k) -> ctxt -> Maybe a
+ Web.Fn: (==>) :: RequestContext ctxt => (Req -> k -> Maybe (Req, a)) -> (ctxt -> k) -> ctxt -> Maybe a
- Web.Fn: end :: Req -> Maybe (Req, a -> a)
+ Web.Fn: end :: Req -> a -> Maybe (Req, a)
- Web.Fn: fromParam :: FromParam a => Text -> Either ParamError a
+ Web.Fn: fromParam :: Param a => Text -> Either Text a
- Web.Fn: param :: FromParam p => Text -> Req -> Maybe (Req, (p -> a) -> a)
+ Web.Fn: param :: Param p => Text -> Req -> (p -> a) -> Maybe (Req, a)
- Web.Fn: path :: Text -> Req -> Maybe (Req, a -> a)
+ Web.Fn: path :: Text -> Req -> a -> Maybe (Req, a)
- Web.Fn: segment :: FromParam p => Req -> Maybe (Req, (p -> a) -> a)
+ Web.Fn: segment :: Param p => Req -> (p -> a) -> Maybe (Req, a)
- Web.Fn: type Req = ([Text], Query, StdMethod, Maybe ([Param], [File ByteString]))
+ Web.Fn: type Req = ([Text], Query)

Files

CHANGELOG.md view
@@ -1,33 +1,3 @@-* 0.1.4.0 Daniel Pattersion <dbp@dbpmail.net> 2015-11-4--  - Move `ctxt` back to first parameter passed to handlers, via more-    continuations.--* 0.1.3.1 Daniel Pattersion <dbp@dbpmail.net> 2015-10-31--  - Add `method` matcher to match against HTTP method.--* 0.1.3.0 Daniel Patterson <dbp@dbpmail.net> 2015-10-30--  - Allow nested calls to `route`, by changing `Request` in-    `ctxt`. This necesitated changing it so that the `ctxt` is passed-    to handlers _last_, instead of first, because we need to have-    completed matching before we can change the request.-  - Add `anything` route matcher that matches anything.-  - Add `paramMany` matcher that returns a list of values for the-    given query param.-  - Change `param` to fail if more than one value is in query string.--* 0.1.2.0 Daniel Pattersion <dbp@dbpmail.net> 2015-10-27--  Rename `paramOptional` to `paramOpt`, to match `fn-extra`'s `Heist`-  naming of `attr` and `attrOpt`. Remove `paramPresent`, because you-  can get that behavior by parsing to `Text`.--* 0.1.1.0 Daniel Patterson <dbp@dbpmail.net> 2015-10-26--  Rename `Param` class to `FromParam`.- * 0.1.0.0 Daniel Patterson <dbp@dbpmail.net> 2015-10-25    Initial release.
README.md view
@@ -46,7 +46,52 @@ index :: IO (Maybe Response) index = okText "This is the index page! Try /foo/bar/baz?id=10" -handler :: Text -> Int -> Ctxt -> IO (Maybe Response)-handler fragment i _ = okText (fragment <> " - " <> T.pack (show i))+handler :: Ctxt -> Text -> Int -> IO (Maybe Response)+handler _ fragment i = okText (fragment <> " - " <> T.pack (show i))  ```++## Recommended Pairings++Part of the design of `Fn` is that you won't need a suite of `fn-foo`+libraries that generally serve to adapt the functions from `foo` to+the monad transformer stack of the web framework of choice (we may add+an `fn-extra` package with a few helpers in it in the future, but it'll+be small). Still, it's helpful to know what are common tools that are+well designed and tested, so here are a list (those marked with `[*]`+are used in the example application included in the repository):++- [warp](http://hackage.haskell.org/package/warp)`[*]`: perhaps obvious,+  but you will need to choose an HTTP server to use with your `Fn`+  application, and `warp` is the defacto standard for applications that+  use the `WAI` interface that `Fn` does.+- [heist](http://hackage.haskell.org/package/heist)`[*]`: a wonderful+  templating system that is both really simple (the templates are just+  html) and powerful (any html tag can be bound to run haskell+  code). This may be the one place where we may add some adaptors, as+  it would be wonderful to have splices (those haskell-bound html+  tags) that were normal functions, rather than monadic.+- [postgresql-simple](https://hackage.haskell.org/package/postgresql-simple)`[*]`:+  a well designed interface to PostgreSQL; ofter the lower level way+  to interact with the database (setting up connections, etc), if you+  use a higher level, safer abstraction like `opaleye` (below) for actual+  queries. Use it with+  [resource-pool](https://hackage.haskell.org/package/resource-pool)`[*]`+  to have it manage many connections.+- [opaleye](https://hackage.haskell.org/package/opaleye): a type-safe+  composable way to write database queries against PostgreSQL.+- [hedis](https://hackage.haskell.org/package/hedis)`[*]`: a full-featured+  client for the key-value store Redis.+- [logging](https://hackage.haskell.org/package/logging)`[*]`: a simple+  library for writing log messages, which allow you to change the+  logging level and suppress some subset of messages.+- [hspec](https://hackage.haskell.org/package/hspec)`[*]`: a+  full-featured testing framework. Use with+  [hspec-wai](https://hackage.haskell.org/package/hspec-wai)`[*]` -+  though the latter could use some work to make it do everything it+  needs to!+- [wai-session](https://hackage.haskell.org/package/wai-session)`[*]`:+  Combine with something like+  [wai-session-clientsession](https://hackage.haskell.org/package/wai-session-clientsession)`[*]`+  to store session data in encrypted cookies (like, who a user is+  logged in as).
fn.cabal view
@@ -1,57 +1,7 @@ name:                fn-version:             0.0.0.0+version:             0.1.0.0 synopsis:            A functional web framework.-description:-  A Haskell web framework where web handlers are functions with parameters-  that are typed arguments.-  .-  >  &#123;-&#35; LANGUAGE OverloadedStrings &#35;-&#125;-  >  .-  >  import Data.Monoid ((<>))-  >  import Network.Wai (Request, defaultRequest)-  >  import Network.Wai.Handler.Warp (run)-  >  import Web.Fn-  >  .-  >  data Ctxt = Ctxt { req :: Request }-  >  instance RequestContext Ctxt where-  >    getRequest = req-  >    setRequest c r = c { req = r }-  >  .-  >  main :: IO ()-  >  main = do-  >  &#32;&#32;run 3000 $ toWAI (Ctxt defaultRequest) $ route-  >  &#32;&#32;&#32;&#32;[ end                        ==> indexH-  >  &#32;&#32;&#32;&#32;, path "echo" // param "msg" ==> echoH-  >  &#32;&#32;&#32;&#32;, path "echo" // segment     ==> echoH-  >  &#32;&#32;&#32;&#32;]-  >  .-  >  indexH :: Ctxt -> IO (Maybe Response)-  >  indexH _ = okText "Try visiting /echo?msg='hello' or /echo/hello"-  >  .-  >  echoH :: Ctxt -> Text -> IO (Maybe Response)-  >  echoH _ msg = okText $ "Echoing \"" <> msg <> "\"."-  .-  Fn is a simple way to write web applications in Haskell where the code-  handling web requests looks just like any Haskell code.-  .-    * An application has some "context", which must contain a @Request@,-      but can contain other data as well, like database connection pools, etc.-  .-    * Routes are declared, which allow you to capture parameters and parts-      of the url and match them against handler functions of the appropriate-      type.-  .-    * All handlers take the context and the specified number and type of-      parameters.-  .-    * Is a thin wrapper around the WAI interface, so anything you can do-      with WAI, you can do with Fn.-  .-  The name comes from the fact that Fn emphasizes functions, and has no Fn-  monad (necessary context, as well as parameters, are passed as arguments,-  and the return value, which is plain-old IO, specifies whether routing-  should continue on).-+description:         Please see README. homepage:            http://github.com/dbp/fn#readme license:             ISC license-file:        LICENSE@@ -68,8 +18,7 @@   hs-source-dirs:      src   exposed-modules:     Web.Fn   build-depends:       base >= 4.7 && < 5-                     , wai >= 3-                     , wai-extra >= 3+                     , wai                      , http-types                      , text                      , blaze-builder@@ -87,7 +36,6 @@                      , text                      , http-types                      , wai-                     , wai-extra   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall   default-language:    Haskell2010 
src/Web/Fn.hs view
@@ -33,14 +33,11 @@               , (/?)               , path               , end-              , anything               , segment-              , method-              , FromParam(..)-              , ParamError(..)+              , Param(..)               , param-              , paramMany-              , paramOpt+              , paramOptional+              , paramPresent                 -- * Responses               , okText               , okHtml@@ -53,14 +50,15 @@  import qualified Blaze.ByteString.Builder.Char.Utf8 as B import           Data.ByteString                    (ByteString)-import           Data.Either                        (rights)+import           Data.List                          (find) import           Data.Maybe                         (fromJust)+import           Data.Monoid                        ((<>)) import           Data.Text                          (Text)+import qualified Data.Text                          as T import qualified Data.Text.Encoding                 as T import           Data.Text.Read                     (decimal, double) import           Network.HTTP.Types import           Network.Wai-import           Network.Wai.Parse                  (File, Param)  data Store b a = Store b (b -> a) instance Functor (Store b) where@@ -132,7 +130,7 @@            Just response -> return (Just response)  -- | The parts of the path, when split on /, and the query.-type Req = ([Text], Query, StdMethod, Maybe ([Param], [File ByteString]))+type Req = ([Text], Query)  -- | The connective between route patterns and the handler that will -- be called if the pattern matches. The type is not particularly@@ -140,138 +138,125 @@ -- patterns with varying numbers (and types) of parts with functions -- of the corresponding number of arguments and types. (==>) :: RequestContext ctxt =>-         (Req -> Maybe (Req, k -> a)) ->+         (Req -> k -> Maybe (Req, a)) ->          (ctxt -> k) ->-         ctxt ->-         Maybe a+         ctxt -> Maybe a (match ==> handle) ctxt =    let r = getRequest ctxt-       m = either (const GET) id (parseMethod (requestMethod r))-       x = (pathInfo r, queryString r, m, Nothing)-   in case match x of+       x = (pathInfo r, queryString r)+   in case match x (handle ctxt) of         Nothing -> Nothing-        Just ((pathInfo',_,_,_), k) -> Just (k $ handle (setRequest ctxt ((getRequest ctxt) { pathInfo = pathInfo' })))+        Just (_, action) -> Just action  -- | Connects two path segments. Note that when normally used, the -- type parameter r is 'Req'. It is more general here to facilitate -- testing.-(//) :: (r -> Maybe (r, k -> k')) ->-        (r -> Maybe (r, k' -> a)) ->-        r -> Maybe (r, k -> a)-(match1 // match2) req =-   case match1 req of+(//) :: (r -> k -> Maybe (r, k')) ->+        (r -> k' -> Maybe (r, a)) ->+        r ->+        k -> Maybe (r, a)+(match1 // match2) req k =+   case match1 req k of      Nothing -> Nothing-     Just (req', k) -> case match2 req' of-                         Nothing -> Nothing-                         Just (req'', k') -> Just (req'', k' . k)+     Just (req', k') -> match2 req' k'  -- | Identical to '(//)', provided simply because it serves as a -- nice visual difference when switching from 'path'/'segment' to -- 'param' and friends.-(/?) :: (r -> Maybe (r, k -> k')) ->-        (r -> Maybe (r, k' -> a)) ->-        r -> Maybe (r, k -> a)+(/?) :: (r -> k -> Maybe (r, k')) ->+        (r -> k' -> Maybe (r, a)) ->+        r ->+        k -> Maybe (r, a) (/?) = (//)  -- | Matches a literal part of the path. If there is no path part -- left, or the next part does not match, the whole match fails.-path :: Text -> Req -> Maybe (Req, a -> a)-path s req =-  case req of-    (y:ys,q,m,x) | y == s -> Just ((ys, q, m, x), id)+path :: Text -> Req -> a -> Maybe (Req, a)+path s req k =+  case fst req of+    (x:xs) | x == s -> Just ((xs, snd req), k)     _               -> Nothing  -- | Matches there being no parts of the path left. This is useful when -- matching index routes.-end :: Req -> Maybe (Req, a -> a)-end req =-  case req of-    ([],_,_,_) -> Just (req, id)+end :: Req -> a -> Maybe (Req, a)+end req k =+  case fst req of+    [] -> Just (req, k)     _ -> Nothing --- | Matches anything.-anything :: Req -> Maybe (Req, a -> a)-anything req = Just (req, id)- -- | Captures a part of the path. It will parse the part into the type -- specified by the handler it is matched to. If there is no segment, or -- if the segment cannot be parsed as such, it won't match.-segment :: FromParam p => Req ->  Maybe (Req, (p -> a) -> a)-segment req =-  case req of-    (y:ys,q,m,x) -> case fromParam y of-                      Left _ -> Nothing-                      Right p -> Just ((ys, q, m, x), \k -> k p)+segment :: Param p => Req -> (p -> a) -> Maybe (Req, a)+segment req k =+  case fst req of+    (x:xs) -> case fromParam x of+                Left _ -> Nothing+                Right p -> Just ((xs, snd req), k p)     _     -> Nothing --- | Matches on a particular HTTP method.-method :: StdMethod -> Req -> Maybe (Req, a -> a)-method m r@(_,_,m',_) | m == m' = Just (r, id)-method _ _ = Nothing--data ParamError = ParamMissing | ParamUnparsable | ParamOtherError Text deriving (Eq, Show)---- | A class that is used for parsing for 'param', 'paramOpt', and--- 'segment'.-class FromParam a where-  fromParam :: Text -> Either ParamError a+-- | A class that is used for parsing for 'param', 'paramOptional',+-- 'paramPresent', and 'segment'.+class Param a where+  fromParam :: Text -> Either Text a -instance FromParam Text where+instance Param Text where   fromParam = Right-instance FromParam Int where+instance Param Int where   fromParam t = case decimal t of-                  Left _ -> Left ParamUnparsable+                  Left msg -> Left (T.pack msg)                   Right m | snd m /= "" ->-                            Left ParamUnparsable+                            Left ("Incomplete match: " <> T.pack (show m))                   Right (v, _) -> Right v-instance FromParam Double where+instance Param Double where   fromParam t = case double t of-                  Left _ -> Left ParamUnparsable+                  Left msg -> Left (T.pack msg)                   Right m | snd m /= "" ->-                            Left ParamUnparsable+                            Left ("Incomplete match: " <> T.pack (show m))                   Right (v, _) -> Right v --- | Matches on a single query parameter of the given name. If there is no--- parameters, or it cannot be parsed into the type needed by the+-- | Matches on a query parameter of the given name. If there is no+-- parameter, or it cannot be parsed into the type needed by the -- handler, it won't match.-param :: FromParam p => Text -> Req -> Maybe (Req, (p -> a) -> a)-param n req =-  let (_,q,_,_) = req-      match = filter ((== T.encodeUtf8 n) . fst) q-  in case rights (map (fromParam . maybe "" T.decodeUtf8 . snd) match) of-       [x] -> Just (req, \k -> k x)-       _ -> Nothing+param :: Param p => Text -> Req -> (p -> a) -> Maybe (Req, a)+param n req k =+  let match = find ((== T.encodeUtf8 n) . fst) (snd req)+  in case (maybe "" T.decodeUtf8 . snd) <$> match of+       Nothing -> Nothing+       Just p -> case fromParam p of+         Left _ -> Nothing+         Right p' -> Just (req, k p') --- | Matches on query parameters of the given name. If there are no--- parameters, or it cannot be parsed into the type needed by the--- handler, it won't match.-paramMany :: FromParam p => Text -> Req -> Maybe (Req, ([p] -> a) -> a)-paramMany n req =-  let (_,q,_,_) = req-      match = filter ((== T.encodeUtf8 n) . fst) q-  in case map (maybe "" T.decodeUtf8 . snd) match of-       [] -> Nothing-       xs -> let ps = rights $ map fromParam xs in-             if length ps == length xs-                then Just (req, \k -> k ps)-                else Nothing+-- | If the specified parameter is present, it will be parsed into the+-- type needed by the handler, but if it isn't present or cannot be+-- parsed, the handler will still be called (just with the 'Left'+-- variant).+paramOptional :: Param p =>+                 Text ->+                 Req ->+                 (Either Text p -> a) ->+                 Maybe (Req, a)+paramOptional n req k =+  let match = find ((== T.encodeUtf8 n) . fst) (snd req)+      p = ((maybe "" T.decodeUtf8 . snd) <$> match)+  in case p of+       Nothing -> Just (req, k (Left "param missing"))+       Just p' -> Just (req, k (fromParam p')) --- | If the specified parameters are present, they will be parsed into the--- type needed by the handler, but if they aren't present or cannot be--- parsed, the handler will still be called.-paramOpt :: FromParam p =>-            Text ->-            Req ->-            Maybe (Req, (Either ParamError [p] -> a) -> a)-paramOpt n req =-  let (_,q,_,_) = req-      match = filter ((== T.encodeUtf8 n) . fst) q-  in case map (maybe "" T.decodeUtf8 . snd) match of-       [] -> Just (req, \k -> k (Left ParamMissing))-       ps -> Just (req, \k -> k (foldLefts [] (map fromParam ps)))-  where foldLefts acc [] = Right (reverse acc)-        foldLefts _ (Left x : _) = Left x-        foldLefts acc (Right x : xs) = foldLefts (x : acc) xs+-- | Matches a query parameter, which must be present, but can fail to parse.+paramPresent :: Param p =>+                Text ->+                Req ->+                (Either Text p -> a) ->+                Maybe (Req, a)+paramPresent n req k =+  let match = find ((== T.encodeUtf8 n) . fst) (snd req)+      p = ((maybe "" T.decodeUtf8 . snd) <$> match)+  in case p of+       Nothing -> Nothing+       Just p' -> Just (req, k (fromParam p'))+  returnText :: Text -> Status -> ByteString -> IO (Maybe Response) returnText text status content =
test/Spec.hs view
@@ -12,92 +12,87 @@  newtype R = R ([Text], Query) instance RequestContext R where-  getRequest (R (p',q')) = defaultRequest { pathInfo = p', queryString = q' }+  getRequest (R (p,q)) = defaultRequest { pathInfo = p, queryString = q }   setRequest (R _) r = R (pathInfo r, queryString r)-p :: [Text] -> Req-p y = (y,[],GET,Nothing)-_p :: [Text] -> Req ->  Req-_p y (_,q',m',x') = (y,q',m',x')-q :: Query -> Req-q y = ([],y,GET,Nothing)-_q :: Query -> Req -> Req-_q y (p',_,m',x') = (p',y,m',x')-m :: StdMethod -> Req-m y = ([],[],y,Nothing)-_m :: StdMethod -> Req -> Req-_m y (p',q',_,x') = (p',q',y,x') --j :: Show a => Maybe (a,b) -> Expectation-j mv = fst <$> mv `shouldSatisfy` isJust-n :: Show a => Maybe (a,b) -> Expectation-n mv = fst <$> mv `shouldSatisfy` isNothing--v :: Maybe (a, t -> Bool) -> t -> Expectation-v mv f = snd (fromJust mv) f `shouldBe` True-vn :: Maybe (a, t -> Bool) -> t -> Expectation-vn mv f = case mv of-            Nothing -> (1 :: Int) `shouldBe` 1-            Just (_,k) -> k f `shouldBe` False--t1 :: Text -> Text -> Bool-t1 = (==)-t2 :: Text -> Text -> Text -> Text -> Bool-t2 a b a' b' = a == a' && b == b'-t3 :: Text -> Text -> Text -> Text -> Text -> Text -> Bool-t3 a b c a' b' c' = a == a' && b == b' && c == c'--t1u :: Text -> Bool-t1u _ = undefined-t2u :: Text -> Text -> Bool-t2u _ _ = undefined-t3u :: Text -> Text -> Text -> Bool-t3u _ _ _ = undefined- main :: IO () main = hspec $ do -  describe "matching" $ do+  describe "routing" $ do     it "should match first segment with path" $-      do j (path "foo" (p ["foo", "bar"]))-         n (path "foo" (p []))-         n (path "foo" (p ["bar", "foo"]))+      do path "foo" (["foo", "bar"], []) () `shouldSatisfy` isJust+         path "foo" ([], []) () `shouldSatisfy` isNothing+         path "foo" (["bar", "foo"], []) () `shouldSatisfy` isNothing     it "should match two paths combined with //" $-      do j ((path "a" // path "b") (p ["a", "b"]))-         n ((path "b" // path "a") (p ["a", "b"]))-         n ((path "b" // path "a") (p ["b"]))+      do (path "a" // path "b") (["a", "b"], []) () `shouldSatisfy` isJust+         (path "b" // path "a") (["a", "b"], []) () `shouldSatisfy` isNothing+         (path "b" // path "a") (["b"], []) () `shouldSatisfy` isNothing     it "should pass url segment to segment" $-      do v (segment (p ["a"])) (t1 "a")-         vn (segment (p [])) t1u-         v (segment (p ["a", "b"])) (t1 "a")+      do segment (["a"], []) (== ("a" :: Text))+                 `shouldSatisfy` (snd . fromJust)+         segment ([], []) (id :: Text -> Text) `shouldSatisfy` isNothing+         segment (["a", "b"], []) (== ("a" :: Text))+                 `shouldSatisfy` (snd . fromJust)     it "should match two segments combined with //" $-      do v ((segment // segment) (p ["a", "b"])) (t2 "a" "b")-         vn ((segment // segment) (p [])) t2u-         v ((segment // segment) (p ["a", "b", "c"])) (t2 "a" "b")+      do (segment // segment) (["a", "b"],[]) (\a b -> a == ("a" :: Text) &&+                                                       b == ("b" :: Text))+                              `shouldSatisfy` (snd . fromJust)+         (segment // segment) ([], []) (\(_ :: Text) (_ :: Text) -> ())+                              `shouldSatisfy` isNothing+         (segment // segment) (["a", "b", "c"], [])+                              (\a b -> a == ("a" :: Text) &&+                                       b == ("b" :: Text))+                              `shouldSatisfy` (snd . fromJust)     it "should match path and segment combined with //" $-      do v ((path "a" // segment) (p ["a", "b"])) (t1 "b")-         vn ((path "a" // segment) (p ["b", "b"])) t1u-         v ((segment // path "b") (p ["a", "b"])) (t1 "a")+      do (path "a" // segment) (["a", "b"], []) (== ("b" :: Text))+                               `shouldSatisfy` (snd . fromJust)+         (path "a" // segment) (["b", "b"], []) (== ("b" :: Text))+                               `shouldSatisfy` isNothing+         (segment // path "b") (["a", "b"], []) (== ("a" :: Text))+                               `shouldSatisfy` (snd . fromJust)     it "should match many segments and paths together" $-       do v ((path "a" // segment // path "c" // path "d")-             (p ["a","b","c", "d"])) (t1 "b")-          v ((segment // path "b" // segment // segment)-             (p ["a","b","c", "d", "e"])) (t3 "a" "c" "d")-          vn ((segment // path "b" // segment) (p ["a", "b"])) t2u-          vn ((segment // path "a" // segment) (p ["a", "b"])) t2u+       do (path "a" // segment // path "c" // path "d")+            (["a","b","c", "d"], [])+            (== ("b" :: Text))+            `shouldSatisfy` (snd . fromJust)+          (segment // path "b" // segment // segment)+            (["a","b","c", "d", "e"], [])+            (\a c d -> a == ("a" :: Text) &&+                       c == ("c" :: Text) &&+                       d == ("d" :: Text))+            `shouldSatisfy` (snd . fromJust)+          (segment // path "b" // segment)+            (["a", "b"], []) (\(_ :: Text) (_ :: Text) -> True)+            `shouldSatisfy` isNothing+          (segment // path "a" // segment)+            (["a", "b"], []) (\(_ :: Text) (_ :: Text) -> True)+            `shouldSatisfy` isNothing     it "should match query parameters with param" $-      do v (param "foo" (q [("foo", Nothing)])) (t1 "")-         vn (param "foo" (q [])) t1u+      do param "foo" ([], [("foo", Nothing)]) (== ("" :: Text))+                     `shouldSatisfy` (snd . fromJust)+         param "foo" ([], []) (\(_ :: Text) -> True) `shouldSatisfy` isNothing     it "should match combined param and paths with /?" $-      do v ((path "a" /? param "id") (_p ["a"] $ q [("id", Just "x")])) (t1 "x")-         vn ((path "a" /? param "id") (_p ["b"] $ q [("id", Just "x")])) t1u-         vn ((path "a" /? param "id") (_p [] $ q [("id", Just "x")])) t1u-         vn ((path "a" /? param "id") (_p ["a"] $ q [("di", Just "x")])) t1u+      do (path "a" /? param "id") (["a"], [("id", Just "x")])+                                  (== ("x" :: Text))+                                  `shouldSatisfy` (snd . fromJust)+         (path "a" /? param "id") (["b"], [("id", Just "x")])+                                  (== ("x" :: Text))+                                  `shouldSatisfy` isNothing+         (path "a" /? param "id") ([], [("id", Just "x")])+                         (== ("x" :: Text))+                         `shouldSatisfy` isNothing+         (path "a" /? param "id") (["a"], [("di", Just "x")])+                         (== ("x" :: Text))+                         `shouldSatisfy` isNothing     it "should match combining param, path, segment" $-      do v ((path "a" // segment /? param "id")-             (_p ["a", "b"] $ q [("id", Just "x")])) (t2 "b" "x")-         vn ((path "a" // segment // segment /? param "id")-               (_p ["a", "b"] $ q [("id", Just "x")])) t3u+      do (path "a" // segment /? param "id")+           (["a", "b"], [("id", Just "x")])+           (\b x -> b == ("b" :: Text) && x == ("x" :: Text))+           `shouldSatisfy` (snd . fromJust)+         (path "a" // segment // segment /? param "id")+           (["a", "b"], [("id", Just "x")])+           (\(_ :: Text) (_ :: Text) (_ :: Text) -> True)+           `shouldSatisfy` isNothing     it "should apply matchers with ==>" $       do (path "a" ==> const ())            (R (["a"], []))@@ -114,36 +109,31 @@          (segment // path "b" ==> \_ x -> x == ("a" :: Text))            (R (["a"], []))            `shouldSatisfy` isNothing-    it "should always pass a value with paramOpt" $-      do snd (fromJust (paramOpt "id" (q [])))-             (isLeft :: Either ParamError [Text] -> Bool)-             `shouldBe` True-         snd (fromJust (paramOpt "id" (q [("id", Just "foo")])))-                            (== Right (["foo"] :: [Text]))-                            `shouldBe` True+    it "should always pass a value with paramOptional" $+      do paramOptional "id" ([], []) (isLeft :: Either Text Text -> Bool)+                       `shouldSatisfy` (snd . fromJust)+         paramOptional "id" ([], [("id", Just "foo")])+                       (== Right ("foo" :: Text))+                       `shouldSatisfy` (snd . fromJust)+    it "should succeed if present, even if unparsable, w/ paramPresent" $+      do paramPresent "id" ([], []) (isLeft :: Either Text Text -> Bool)+                      `shouldSatisfy` isNothing+         paramPresent "id" ([], [("id", Just "foo")])+                      (== Right ("foo" :: Text))+                      `shouldSatisfy` (snd . fromJust)+         paramPresent "id" ([], [("id", Just "foo")])+                      (isLeft :: Either Text Int -> Bool)+                      `shouldSatisfy` (snd . fromJust)     it "should match end against no further path segments" $-      do j (end (p []))-         j (end (_p [] $ q [("foo", Nothing)]))-         n (end (p ["a"]))+      do end ([],[]) () `shouldSatisfy` isJust+         end ([],[("foo", Nothing)]) () `shouldSatisfy` isJust+         end (["a"],[]) () `shouldSatisfy` isNothing     it "should match end after path and segments" $-      do j ((path "a" // end) (p ["a"]))-         v ((segment // end) (p ["a"])) (t1 "a")-    it "should match anything" $-      do j (anything (p []))-         j (anything (p ["f","b"]))+      do (path "a" // end) (["a"],[]) () `shouldSatisfy` isJust+         (segment // end) (["a"],[]) (== ("a" :: Text))+                                     `shouldSatisfy` isJust -    it "should match against method" $-       do j (method GET (m GET))-          n (method GET (m POST)) -  describe "route" $ do-    it "should match route to parameter" $-      do r <- route (R (["a"], [])) [segment ==> (\_ a -> if a == ("a"::Text) then okText "" else return Nothing)]-         (responseStatus <$> r) `shouldSatisfy` isJust-    it "should match nested routes" $-      do r <- route (R (["a", "b"], [])) [path "a" ==> (\c -> route c [path "b" ==> const (okText "")])]-         (responseStatus <$> r) `shouldSatisfy` isJust-   describe "parameter parsing" $     do it "should parse Text" $          fromParam "hello" `shouldBe` Right ("hello" :: Text)@@ -151,13 +141,13 @@          do fromParam "1" `shouldBe` Right (1 :: Int)             fromParam "2011" `shouldBe` Right (2011 :: Int)             fromParam "aaa" `shouldSatisfy`-              (isLeft :: Either ParamError Int -> Bool)+              (isLeft :: Either Text Int -> Bool)             fromParam "10a" `shouldSatisfy`-              (isLeft :: Either ParamError Int -> Bool)+              (isLeft :: Either Text Int -> Bool)        it "should be able to parse Double" $          do fromParam "1" `shouldBe` Right (1 :: Double)             fromParam "1.02" `shouldBe` Right (1.02 :: Double)             fromParam "thr" `shouldSatisfy`-              (isLeft :: Either ParamError Double -> Bool)+              (isLeft :: Either Text Double -> Bool)             fromParam "100o" `shouldSatisfy`-              (isLeft :: Either ParamError Double -> Bool)+              (isLeft :: Either Text Double -> Bool)