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 +0/−30
- README.md +47/−2
- fn.cabal +3/−55
- src/Web/Fn.hs +86/−101
- test/Spec.hs +92/−102
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.- .- > {-# LANGUAGE OverloadedStrings #-}- > .- > 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- >   run 3000 $ toWAI (Ctxt defaultRequest) $ route- >     [ end ==> indexH- >     , path "echo" // param "msg" ==> echoH- >     , path "echo" // segment ==> echoH- >     ]- > .- > 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)