fn 0.1.4.0 → 0.2.0.0

raw patch · 5 files changed

+359/−145 lines, 5 filesdep +directorydep +filepathdep +unordered-containersdep ~waiPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, filepath, unordered-containers, wai-extra

Dependency ranges changed: wai

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−5
• README.md +3/−45
• fn.cabal +77/−4
• src/Web/Fn.hs +236/−68
• test/Spec.hs +28/−23

@@ -1,3 +1,12 @@+* 0.2.0.0 Daniel Pattersion <dbp@dbpmail.net> 2015-11-5++  - Changed to having our own `FnRequest` type, which is a WAI+    `Request` and the results of parsing the body for contents, since+    we need to be able to do that once and thread it through.+  - Add `file` and `files` matchers, which match against and pass file+    uploads to handlers.+  - Add `staticServe` to serve static files based on path.+ * 0.1.4.0 Daniel Pattersion <dbp@dbpmail.net> 2015-11-4    - Move `ctxt` back to first parameter passed to handlers, via more@@ -20,14 +29,15 @@  * 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`.+  - 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`.+  - Rename `Param` class to `FromParam`.  * 0.1.0.0 Daniel Patterson <dbp@dbpmail.net> 2015-10-25 -  Initial release.+  - Initial release.

@@ -5,48 +5,6 @@  ## Example -See the example application in the repository for a full usage, but a minimal application is the following:--```--{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}--import           Control.Lens-import           Data.Monoid-import           Data.Text                (Text)-import qualified Data.Text                as T-import           Network.HTTP.Types-import           Network.Wai-import           Network.Wai.Handler.Warp-import qualified Network.Wai.Util         as W-import           Web.Fn--data Ctxt = Ctxt { _req :: Request-                 }--makeLenses ''Ctxt--instance RequestContext Ctxt where-  requestLens = req--initializer :: IO Ctxt-initializer = return (Ctxt defaultRequest)--main :: IO ()-main = do context <- initializer-          run 8000 $ toWAI context app--app :: Ctxt -> IO Response-app ctxt =-  route ctxt [ end ==> index-             , path "foo" // segment // path "baz" /? param "id" ==> handler]-    `fallthrough` notFoundText "Page not found."--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))--```+See the [example application](https://github.com/dbp/fn/tree/master/example)+in the repository for a full usage including database access, heist+templates, sessions, etc.

@@ -1,8 +1,73 @@ name:                fn-version:             0.1.4.0+version:             0.2.0.0 synopsis:            A functional web framework.-description:         Please see README.-homepage:            http://github.com/dbp/fn#readme+description:+  A Haskell web framework where you write plain old functions.+  .+  /Provided you have/ <https://github.com/commercialhaskell/stack#readme stack> /installed, you can run this example like a shell script:/+  .+  @+    #!\/usr\/bin\/env stack+    \-\- stack --resolver lts-3.10 --install-ghc runghc --package fn+    &#123;-&#35; LANGUAGE OverloadedStrings &#35;-&#125;+    import Data.Monoid ((&#60;&#62;))+    import Data.Text (Text)+    import Network.Wai (Response)+    import Network.Wai.Handler.Warp (run)+    import Web.Fn+    .+    data Ctxt = Ctxt &#123; _req :: FnRequest &#125;+    instance RequestContext Ctxt where+    &#32; getRequest = _req+    &#32; setRequest c r = c &#123; _req = r &#125;+    .+    initializer :: IO Ctxt+    initializer = return (Ctxt defaultFnRequest)+    .+    main :: IO ()+    main = do ctxt <- initializer+    &#32;         run 3000 $ toWAI ctxt site+    .+    site :: Ctxt -> IO Response+    site ctxt = route ctxt [ end                        ==> indexH+    &#32;                      , path &#34;echo&#34; \/? param &#34;msg&#34; ==> echoH+    &#32;                      , path &#34;echo&#34; \/\/ segment     ==> echoH+    &#32;                      ]+    &#32;                 \`fallthrough\` notFoundText &#34;Page not found.&#34;+    .+    indexH :: Ctxt -> IO (Maybe Response)+    indexH _ = okText &#34;Try visiting \/echo?msg='hello' or \/echo\/hello&#34;+    .+    echoH :: Ctxt -> Text -> IO (Maybe Response)+    echoH _ msg = okText $ &#34;Echoing '&#34; &#60;&#62; msg &#60;&#62; &#34;'.&#34;++  @+  .+  .+  Fn lets you write web code that just looks like normal Haskell code.+  .+    * An application has some \"context\", which must contain a @Request@,+      but can contain other data as well, like database connection pools,+      etc. This context will be passed to each of your handlers, updated+      with the current HTTP Request.+  .+    * Routes are declared to capture parameters and/or segments of the url,+      and then routed to handler functions that have the appropriate number+      and type of arguments. These functions return @IO (Maybe Response)@,+      where @Nothing@ indicates to Fn that you want it to keep looking for+      matching routes.+  .+    * All handlers just use plain old @IO@, which means it is easy to call+      them from GHCi, @forkIO@, etc.+  .+    * All of this is a small wrapper around the WAI interface, so you have+      the flexilibility to do anything you need to do with HTTP.+  .+  The name comes from the fact that Fn emphasizes functions (over monads),+  where all necessary data is passed via function arguments, and control+  flow is mediated by return values.++homepage:            http://github.cxom/dbp/fn#readme license:             ISC license-file:        LICENSE author:              Daniel Patterson <dbp@dbpmail.net>@@ -18,11 +83,15 @@   hs-source-dirs:      src   exposed-modules:     Web.Fn   build-depends:       base >= 4.7 && < 5-                     , wai+                     , wai >= 3+                     , wai-extra >= 3                      , http-types                      , text                      , blaze-builder                      , bytestring+                     , unordered-containers+                     , filepath+                     , directory   default-language:    Haskell2010   ghc-options:         -Wall @@ -36,6 +105,10 @@                      , text                      , http-types                      , wai+                     , wai-extra+                     , unordered-containers+                     , filepath+                     , directory   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall   default-language:    Haskell2010 

@@ -18,11 +18,13 @@ specify many parameters (most commonly, numeric ids, but can be many things), so the handlers should be functions that take those as parameters.- -} + module Web.Fn ( -- * Application setup-                RequestContext(..)+                FnRequest+              , defaultFnRequest+              , RequestContext(..)               , toWAI                 -- * Routing               , Req@@ -41,7 +43,11 @@               , param               , paramMany               , paramOpt+              , File(..)+              , file+              , files                 -- * Responses+              , staticServe               , okText               , okHtml               , errText@@ -52,20 +58,40 @@   ) where  import qualified Blaze.ByteString.Builder.Char.Utf8 as B+import           Control.Arrow                      (second) import           Data.ByteString                    (ByteString)+import qualified Data.ByteString.Lazy               as LB import           Data.Either                        (rights)+import qualified Data.HashMap.Strict                as HM import           Data.Maybe                         (fromJust) 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                  (FileInfo (..), Param,+                                                     lbsBackEnd,+                                                     parseRequestBody)+import qualified Network.Wai.Parse                  as Parse+import           System.Directory                   (doesFileExist)+import           System.FilePath                    (takeExtension)  data Store b a = Store b (b -> a) instance Functor (Store b) where   fmap f (Store b h) = Store b (f . h) --- | Specify the way that Fn can get the Request out of your context.++-- | A normal WAI 'Request' and the parsed post body (if present). We can+-- only parse the body once, so we need to have our request (which we+-- pass around) to be able to have the parsed body.+type FnRequest = (Request, ([Param], [Parse.File LB.ByteString]))++-- | A default request, which is a WAI defaultRequest and no post info+defaultFnRequest :: FnRequest+defaultFnRequest = (defaultRequest, ([],[]))++-- | Specify the way that Fn can get the 'FnRequest' out of your context. -- -- The easiest way to instantiate this is to use the lens, but if you -- don't want to use lenses, define 'getRequest' and 'setRequest'.@@ -73,29 +99,68 @@ -- Note that 'requestLens' is defined in terms of 'getRequest' and -- 'setRequest' and vice-versa, so you need to define _one_ of these. class RequestContext ctxt where-  requestLens :: Functor f => (Request -> f Request) -> ctxt -> f ctxt+  requestLens :: Functor f => (FnRequest -> f FnRequest) -> ctxt -> f ctxt   requestLens f c = setRequest c <$> f (getRequest c)-  getRequest :: ctxt -> Request+  getRequest :: ctxt -> FnRequest   getRequest c =     let (Store r _) = requestLens (`Store` id) c     in r-  setRequest :: ctxt -> Request -> ctxt+  setRequest :: ctxt -> FnRequest -> ctxt   setRequest c r =     let (Store _ b) = requestLens (`Store` id) c     in b r +instance RequestContext FnRequest where+  getRequest = id+  setRequest _ = id+ -- | Convert an Fn application (provide a context, a context to response--- function and we'll create a WAI application by updating the Request+-- function and we'll create a WAI application by updating the 'FnRequest' -- value for each call). toWAI :: RequestContext ctxt => ctxt -> (ctxt -> IO Response) -> Application-toWAI ctxt f req cont = let ctxt' = setRequest ctxt req-                        in f ctxt' >>= cont+toWAI ctxt f req cont =+  do post <- parseRequestBody lbsBackEnd req+     let ctxt' = setRequest ctxt (req, post)+     f ctxt' >>= cont +-- | The main construct for Fn, 'route' takes a context (which it will pass+-- to all handlers) and a list of potential matches (which, once they+-- match, may still end up deciding not to handle the request - hence+-- the double 'Maybe'). It can be nested.+--+-- @+--  app c = route c [ end ==> index+--                  , path "foo" \/\/ path "bar" \/\/ segment \/? param "id ==> h]+--    where index :: Ctxt -> IO (Maybe Response)+--          index _ = okText "This is the index."+--          h :: Ctxt -> Text -> Text -> IO (Maybe Response)+--          h _ s i = okText ("got path \/foo\/" <> s <> ", with id=" <> i)+-- @+route :: RequestContext ctxt =>+         ctxt ->+         [ctxt -> Req -> Maybe (IO (Maybe Response))] ->+         IO (Maybe Response)+route ctxt pths =+  do let (r,post) = getRequest ctxt+         m = either (const GET) id (parseMethod (requestMethod r))+         req = (pathInfo r, queryString r, m, post)+     route' req pths+  where route' _ [] = return Nothing+        route' req (x:xs) =+          case x ctxt req of+            Nothing -> route' req xs+            Just action ->+              do resp <- action+                 case resp of+                   Nothing -> route' req xs+                   Just response -> return (Just response)+ -- | The 'route' function (and all your handlers) return -- 'IO (Maybe Response)', because each can elect to not respond (in -- which case we will continue to match on routes). But to construct -- an application, we need a response in the case that nothing matched--- - this is what 'fallthrough' does.+-- - this is what 'fallthrough' allows you to specify. In particular,+-- 'notFoundText' and 'notFoundHtml' may be useful. fallthrough :: IO (Maybe Response) -> IO Response -> IO Response fallthrough a ft =   do response <- a@@ -103,35 +168,99 @@        Nothing -> ft        Just r -> return r --- | The main construct for Fn, 'route' takes a context (which it will pass--- to all handlers) and a list of potential matches (which, once they--- match, may still end up deciding not to handle the request - hence--- the double 'Maybe'). It can be nested.+-- NOTE(dbp 2015-11-05): This list taken from snap-core, BSD3 licensed.+mimeMap :: HM.HashMap String ByteString+mimeMap =  HM.fromList [+  ( ".asc"     , "text/plain"                        ),+  ( ".asf"     , "video/x-ms-asf"                    ),+  ( ".asx"     , "video/x-ms-asf"                    ),+  ( ".avi"     , "video/x-msvideo"                   ),+  ( ".bz2"     , "application/x-bzip"                ),+  ( ".c"       , "text/plain"                        ),+  ( ".class"   , "application/octet-stream"          ),+  ( ".conf"    , "text/plain"                        ),+  ( ".cpp"     , "text/plain"                        ),+  ( ".css"     , "text/css"                          ),+  ( ".cxx"     , "text/plain"                        ),+  ( ".dtd"     , "text/xml"                          ),+  ( ".dvi"     , "application/x-dvi"                 ),+  ( ".gif"     , "image/gif"                         ),+  ( ".gz"      , "application/x-gzip"                ),+  ( ".hs"      , "text/plain"                        ),+  ( ".htm"     , "text/html"                         ),+  ( ".html"    , "text/html"                         ),+  ( ".ico"     , "image/x-icon"                      ),+  ( ".jar"     , "application/x-java-archive"        ),+  ( ".jpeg"    , "image/jpeg"                        ),+  ( ".jpg"     , "image/jpeg"                        ),+  ( ".js"      , "text/javascript"                   ),+  ( ".json"    , "application/json"                  ),+  ( ".log"     , "text/plain"                        ),+  ( ".m3u"     , "audio/x-mpegurl"                   ),+  ( ".mov"     , "video/quicktime"                   ),+  ( ".mp3"     , "audio/mpeg"                        ),+  ( ".mpeg"    , "video/mpeg"                        ),+  ( ".mpg"     , "video/mpeg"                        ),+  ( ".ogg"     , "application/ogg"                   ),+  ( ".pac"     , "application/x-ns-proxy-autoconfig" ),+  ( ".pdf"     , "application/pdf"                   ),+  ( ".png"     , "image/png"                         ),+  ( ".ps"      , "application/postscript"            ),+  ( ".qt"      , "video/quicktime"                   ),+  ( ".sig"     , "application/pgp-signature"         ),+  ( ".spl"     , "application/futuresplash"          ),+  ( ".svg"     , "image/svg+xml"                     ),+  ( ".swf"     , "application/x-shockwave-flash"     ),+  ( ".tar"     , "application/x-tar"                 ),+  ( ".tar.bz2" , "application/x-bzip-compressed-tar" ),+  ( ".tar.gz"  , "application/x-tgz"                 ),+  ( ".tbz"     , "application/x-bzip-compressed-tar" ),+  ( ".text"    , "text/plain"                        ),+  ( ".tgz"     , "application/x-tgz"                 ),+  ( ".torrent" , "application/x-bittorrent"          ),+  ( ".ttf"     , "application/x-font-truetype"       ),+  ( ".txt"     , "text/plain"                        ),+  ( ".wav"     , "audio/x-wav"                       ),+  ( ".wax"     , "audio/x-ms-wax"                    ),+  ( ".wma"     , "audio/x-ms-wma"                    ),+  ( ".wmv"     , "video/x-ms-wmv"                    ),+  ( ".xbm"     , "image/x-xbitmap"                   ),+  ( ".xml"     , "text/xml"                          ),+  ( ".xpm"     , "image/x-xpixmap"                   ),+  ( ".xwd"     , "image/x-xwindowdump"               ),+  ( ".zip"     , "application/zip"                   ) ]+++-- | Serves static files out of the specified path according to the+-- request path. Note that if you have matched parts of the path,+-- those will not be included in the path used to find the static+-- file. For example, if you have a file @static\/img\/a.png@, and do: ----- @---  app c = route c [ end ==> index---                  , path "foo" // path "bar" // segment /? param "id ==> h]---    where index :: IO (Maybe Response)---          index = okText "This is the index."---          h :: Text -> Text -> IO (Maybe Response)---          h s i = okText ("got path /foo/" <> s <> ", with id=" <> i)--- @-route :: RequestContext ctxt =>-         ctxt ->-         [ctxt -> Maybe (IO (Maybe Response))] ->-         IO (Maybe Response)-route _ [] = return Nothing-route ctxt (x:xs) =-  case x ctxt of-    Nothing -> route ctxt xs-    Just action ->-      do resp <- action-         case resp of-           Nothing -> route ctxt xs-           Just response -> return (Just response)+-- > path "img" ==> staticServe "static"+--+-- It will match @img\/img\/a.png@, not @img\/a.png@. If you wanted that,+-- you could:+--+-- > anything ==> staticServe "static"+--+-- If no file is found, this will continue routing.+staticServe :: RequestContext ctxt => Text -> ctxt -> IO (Maybe Response)+staticServe d ctxt = do+  let pth = T.unpack $ T.intercalate "/" $  d : pathInfo (fst . getRequest $ ctxt)+  exists <- doesFileExist pth+  if exists+     then do let ext = takeExtension pth+                 contentType = case HM.lookup ext mimeMap of+                                 Nothing -> []+                                 Just t -> [(hContentType, t)]+             return $ Just $ responseFile status200+                                          contentType+                                          pth+                                          Nothing+     else return Nothing  -- | The parts of the path, when split on /, and the query.-type Req = ([Text], Query, StdMethod)+type Req = ([Text], Query, StdMethod, ([Param], [Parse.File LB.ByteString]))  -- | The connective between route patterns and the handler that will -- be called if the pattern matches. The type is not particularly@@ -142,14 +271,14 @@          (Req -> Maybe (Req, k -> a)) ->          (ctxt -> k) ->          ctxt ->+         Req ->          Maybe a-(match ==> handle) ctxt =-   let r = getRequest ctxt-       m = either (const GET) id (parseMethod (requestMethod r))-       x = (pathInfo r, queryString r, m)-   in case match x of-        Nothing -> Nothing-        Just ((pathInfo',_,_), k) -> Just (k $ handle (setRequest ctxt ((getRequest ctxt) { pathInfo = pathInfo' })))+(match ==> handle) ctxt req =+   case match req of+     Nothing -> Nothing+     Just ((pathInfo',_,_,_), k) ->+       let (request, post) = getRequest ctxt in+       Just (k $ handle (setRequest ctxt (request { pathInfo = pathInfo' }, post)))  -- | Connects two path segments. Note that when normally used, the -- type parameter r is 'Req'. It is more general here to facilitate@@ -164,7 +293,7 @@                          Nothing -> Nothing                          Just (req'', k') -> Just (req'', k' . k) --- | Identical to '(//)', provided simply because it serves as a+-- | 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')) ->@@ -177,7 +306,7 @@ path :: Text -> Req -> Maybe (Req, a -> a) path s req =   case req of-    (x:xs,q,m) | x == s -> Just ((xs, q, m), id)+    (y:ys,q,m,x) | y == s -> Just ((ys, q, m, x), id)     _               -> Nothing  -- | Matches there being no parts of the path left. This is useful when@@ -185,7 +314,7 @@ end :: Req -> Maybe (Req, a -> a) end req =   case req of-    ([],_,_) -> Just (req, id)+    ([],_,_,_) -> Just (req, id)     _ -> Nothing  -- | Matches anything.@@ -198,20 +327,20 @@ segment :: FromParam p => Req ->  Maybe (Req, (p -> a) -> a) segment req =   case req of-    (x:xs,q,m) -> case fromParam x of-                    Left _ -> Nothing-                    Right p -> Just ((xs, q, m), \k -> k p)+    (y:ys,q,m,x) -> case fromParam y of+                      Left _ -> Nothing+                      Right p -> Just ((ys, q, m, x), \k -> 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 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'.+-- | A class that is used for parsing for 'param', 'paramOpt', 'paramMany'+-- and 'segment'. class FromParam a where   fromParam :: Text -> Either ParamError a @@ -230,29 +359,40 @@                             Left ParamUnparsable                   Right (v, _) -> Right v ++findParamMatches :: FromParam p => Text -> [(ByteString, Maybe ByteString)] -> [Either ParamError p]+findParamMatches n ps = map (fromParam . maybe "" T.decodeUtf8 . snd) .+                        filter ((== T.encodeUtf8 n) . fst) $+                        ps+ -- | 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 -- 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+  let (_,q,_,(ps, _)) = req+  in case rights $ findParamMatches n q of+       [y] -> Just (req, \k -> k y)+       []  -> case rights $ findParamMatches n (map (second Just) ps) of+                [y] -> Just (req, \k -> k y)+                -- TODO(dbp 2015-11-05): It's too bad that the+                -- request body parsing will possibly be+                -- duplicated, in case nothing matches. Perhaps+                -- both branches should thread...+                _ -> Nothing+       _   -> Nothing  -- | Matches on query parameters of the given name. If there are no--- parameters, or it cannot be parsed into the type needed by the+-- parameters, or they 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+  let (_,q,_,(ps,_)) = req+  in case findParamMatches n (q ++ map (second Just) ps) of        [] -> Nothing-       xs -> let ps = rights $ map fromParam xs in-             if length ps == length xs-                then Just (req, \k -> k ps)+       xs -> let ys = rights xs in+             if length ys == length xs+                then Just (req, \k -> k ys)                 else Nothing  -- | If the specified parameters are present, they will be parsed into the@@ -263,14 +403,42 @@             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+  let (_,q,_,(ps, _)) = req+  in case findParamMatches n (q ++ map (second Just) ps) of        [] -> Just (req, \k -> k (Left ParamMissing))-       ps -> Just (req, \k -> k (foldLefts [] (map fromParam ps)))+       ys -> Just (req, \k -> k (foldLefts [] ys))   where foldLefts acc [] = Right (reverse acc)         foldLefts _ (Left x : _) = Left x         foldLefts acc (Right x : xs) = foldLefts (x : acc) xs+++-- | An uploaded file.+data File = File { fileName        :: Text+                 , fileContentType :: Text+                 , fileContent     :: LB.ByteString+                 }++-- | Matches an uploaded file with the given parameter name.+file :: Text -> Req -> Maybe (Req, (File -> a) -> a)+file n req =+  let (_,_,_,(_, fs)) = req+  in case filter ((== T.encodeUtf8 n) . fst) fs of+       [(_, FileInfo nm ct c)] -> Just (req, \k -> k (File (T.decodeUtf8 nm)+                                                           (T.decodeUtf8 ct)+                                                           c))+       _ -> Nothing++-- | Matches all uploaded files, passing their parameter names and+-- contents.+files :: Req -> Maybe (Req, ([(Text, File)] -> a) -> a)+files req =+  let (_,_,_,(_, fs')) = req+      fs = map (\(n, FileInfo nm ct c) ->+                  (T.decodeUtf8 n, File (T.decodeUtf8 nm)+                                        (T.decodeUtf8 ct)+                                        c))+               fs'+  in Just (req, \k -> k fs)  returnText :: Text -> Status -> ByteString -> IO (Maybe Response) returnText text status content =

@@ -12,29 +12,36 @@  newtype R = R ([Text], Query) instance RequestContext R where-  getRequest (R (p',q')) = defaultRequest { pathInfo = p', queryString = q' }-  setRequest (R _) r = R (pathInfo r, queryString r)+  getRequest (R (p',q')) = (defaultRequest { pathInfo = p', queryString = q' }, ([],[]))+  setRequest (R _) (r,_) = R (pathInfo r, queryString r)+rr :: R+rr = R ([], []) p :: [Text] -> Req-p x = (x,[],GET)+p y = (y,[],GET,([],[])) _p :: [Text] -> Req ->  Req-_p x (_,q',m') = (x,q',m')+_p y (_,q',m',x') = (y,q',m',x') q :: Query -> Req-q x = ([],x,GET)+q y = ([],y,GET,([],[])) _q :: Query -> Req -> Req-_q x (p',_,m') = (p',x,m')+_q y (p',_,m',x') = (p',y,m',x') m :: StdMethod -> Req-m x = ([],[],x)+m y = ([],[],y,([],[])) _m :: StdMethod -> Req -> Req-_m x (p',q',_) = (p',q',x)+_m y (p',q',_,x') = (p',q',y,x') -j m = fst <$> m `shouldSatisfy` isJust-n m = fst <$> m `shouldSatisfy` isNothing -v m f = snd (fromJust m) f `shouldBe` True-vn m f = case m of-           Nothing -> 1 `shouldBe` 1-           Just (_,k) -> k f `shouldBe` False+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@@ -94,20 +101,18 @@          vn ((path "a" // segment // segment /? param "id")                (_p ["a", "b"] $ q [("id", Just "x")])) t3u     it "should apply matchers with ==>" $-      do (path "a" ==> const ())-           (R (["a"], []))+      do (path "a" ==> const ()) rr (p ["a"])            `shouldSatisfy` isJust-         (segment ==> \_ (_ :: Text) -> ())-            (R (["a"], []))+         (segment ==> \_ (_ :: Text) -> ()) rr (p ["1"])             `shouldSatisfy` isJust          (segment // path "b" ==> \_ x -> x == ("a" :: Text))-           (R (["a", "b"], []))+           rr (p ["a", "b"])            `shouldSatisfy` fromJust          (segment // path "b" ==> \_ x -> x == ("a" :: Text))-           (R (["a", "a"], []))+           rr (p ["a", "a"])            `shouldSatisfy` isNothing          (segment // path "b" ==> \_ x -> x == ("a" :: Text))-           (R (["a"], []))+           rr (p ["a"])            `shouldSatisfy` isNothing     it "should always pass a value with paramOpt" $       do snd (fromJust (paramOpt "id" (q [])))@@ -128,8 +133,8 @@          j (anything (p ["f","b"]))      it "should match against method" $-       do j ((method GET) (m GET))-          n ((method GET) (m POST))+       do j (method GET (m GET))+          n (method GET (m POST))    describe "route" $ do     it "should match route to parameter" $