wai-routes 0.9.0 → 0.9.1

raw patch · 6 files changed

+189/−51 lines, 6 filesdep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• README.md +3/−2
• src/Network/Wai/Middleware/Routes.hs +8/−11
• src/Network/Wai/Middleware/Routes/Handler.hs +23/−13
• src/Network/Wai/Middleware/Routes/Routes.hs +36/−20
• test/HelloSpec.hs +113/−0
• wai-routes.cabal +6/−5

@@ -1,4 +1,4 @@-[Wai-Routes](https://ajnsit.github.io/wai-routes) [![Hackage](https://img.shields.io/badge/hackage-v0.9.0-brightgreen.svg)](https://hackage.haskell.org/package/wai-routes) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/wai-routes.svg)](http://packdeps.haskellers.com/feed?needle=wai-routes) [![Build Status](https://img.shields.io/travis/ajnsit/wai-routes.svg)](https://travis-ci.org/ajnsit/wai-routes) [![Coverage Status](https://coveralls.io/repos/ajnsit/wai-routes/badge.svg?branch=master&service=github)](https://coveralls.io/github/ajnsit/wai-routes?branch=master)+[Wai-Routes](https://ajnsit.github.io/wai-routes) [![Hackage](https://img.shields.io/badge/hackage-v0.9.1-brightgreen.svg)](https://hackage.haskell.org/package/wai-routes) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/wai-routes.svg)](http://packdeps.haskellers.com/feed?needle=wai-routes) [![Build Status](https://img.shields.io/travis/ajnsit/wai-routes.svg)](https://travis-ci.org/ajnsit/wai-routes) [![Join the chat at https://gitter.im/ajnsit/wai-routes](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%A3-blue.svg)](https://gitter.im/ajnsit/wai-routes) ====================================  Wai-routes is a micro web framework for Haskell that focuses on typesafe URLs.@@ -63,7 +63,7 @@  Wai has had the ability to stream content for a long time. Now wai-routes exposes this functionality with the `stream` function. This example shows how to stream content in a handler. Note that most browsers using default settings will not show content as it is being streamed. You can use "curl" to observe the effect of streaming. E.g. - `curl localhost:8080` will dump the data as it is being streamed from the server. -**Example 7. Kitchen sink ** - [Code](examples/kitchen)+**Example 7. Kitchen sink** - [Code](examples/kitchen)  *Work in progress*. Demonstrates all major features in wai-routes. @@ -105,6 +105,7 @@ Changelog ========= +* 0.9.1 : Greatly simplified subsites (simply use mkRouteSub). Added 'mountedAppHandler' to integrate external full wai apps. * 0.9.0 : Support for "unrouted" handlers. API changes to avoid returning lazy text or bytestring. Methods to fetch post/file params. Removed 'HandlerMM' and made 'Handler' more useful. * 0.8.1 : Bumped dependencies. Added 'HandlerMM' type alias * 0.8.0 : Replaced 'show/renderRoute' with 'show/renderRouteSub' and 'show/renderRouteMaster'. Added functions to access request headers (reqHeader/s), send a part of a file (filepart). Auto infer mime-types when sending files. Added cookie handling functions (get/setCookie/s). Added 'sub' to allow access to subsite datatype.

@@ -10,17 +10,14 @@ This package provides typesafe URLs for Wai applications. -} module Network.Wai.Middleware.Routes-    ( -- * Quasi Quoters-      parseRoutes            -- | Parse Routes declared inline+    ( -- * Declaring Routes using Template Haskell+      parseRoutes     , parseRoutesFile        -- | Parse routes declared in a file-    , parseRoutesNoCheck     -- | Parse routes declared inline, without checking for overlaps-    , parseRoutesFileNoCheck -- | Parse routes declared in a file, without checking for overlaps+    , parseRoutesNoCheck+    , parseRoutesFileNoCheck -- | Same as parseRoutesFile, but performs no overlap checking. -    -- * Template Haskell methods     , mkRoute-    , mkRouteData-    , mkRouteDispatch-    , mkRouteSubDispatch+    , mkRouteSub      -- * Dispatch     , routeDispatch@@ -64,6 +61,7 @@     -- * HandlerM Monad makes it easy to build a handler     , HandlerM()     , runHandlerM            -- | Run a HandlerM to get a Handler+    , mountedAppHandler      -- | Convert a full wai application to a HandlerS     , request                -- | Access the request data     , isWebsocket            -- | Is this a websocket request     , reqHeader              -- | Get a particular request header (case insensitive)@@ -74,7 +72,8 @@     , rootRouteAttrSet       -- | Access the current root route attributes as a set     , master                 -- | Access the master datatype     , sub                    -- | Access the sub datatype-    , rawBody                -- | Consume and return the request body as a lazy bytestring+    , rawBody                -- | Consume and return the request body as ByteString+    , textBody               -- | Consume and return the request body as Text     , jsonBody               -- | Consume and return the request body as JSON     , header                 -- | Add a header to the response     , status                 -- | Set the response status@@ -105,7 +104,6 @@     , module Network.HTTP.Types.Status     , module Network.Wai.Middleware.RequestLogger     , module Network.Wai.Application.Static-    , Text   )   where @@ -115,4 +113,3 @@ import Network.HTTP.Types.Status import Network.Wai.Middleware.RequestLogger import Network.Wai.Application.Static-import Data.Text (Text)

@@ -13,6 +13,7 @@ module Network.Wai.Middleware.Routes.Handler     ( HandlerM()             -- | A Monad that makes it easier to build a Handler     , runHandlerM            -- | Run a HandlerM to get a Handler+    , mountedAppHandler      -- | Convert a full wai application to a HandlerS     , request                -- | Access the request data     , isWebsocket            -- | Is this a websocket request     , reqHeader              -- | Get a particular request header (case insensitive)@@ -29,7 +30,8 @@     , readRouteSub           -- | Get the route parsing function for the subsite     , master                 -- | Access the master datatype     , sub                    -- | Access the sub datatype-    , rawBody                -- | Consume and return the request body as a bytestring+    , rawBody                -- | Consume and return the request body as ByteString+    , textBody               -- | Consume and return the request body as Text     , jsonBody               -- | Consume and return the request body as JSON     , header                 -- | Add a header to the response     , status                 -- | Set the response status@@ -59,7 +61,7 @@     )     where -import Network.Wai (Request, Response, responseRaw, responseFile, responseBuilder, responseStream, pathInfo, queryString, requestBody, StreamingBody, requestHeaders, FilePart)+import Network.Wai (Application, Request, Response, responseRaw, responseFile, responseBuilder, responseStream, pathInfo, queryString, requestBody, StreamingBody, requestHeaders, FilePart) #if MIN_VERSION_wai(3,0,1) import Network.Wai (strictRequestBody) #endif@@ -190,31 +192,34 @@ cookieSetHeaderName :: CI ByteString cookieSetHeaderName = mk "Set-Cookie" +-- | Convert a full wai application to a Handler+-- A bit like subsites, but at a higher level.+mountedAppHandler :: Application -> HandlerS sub master+mountedAppHandler app _env req hh = app (waiReq req) hh+ -- | "Run" HandlerM, resulting in a Handler runHandlerM :: HandlerM sub master () -> HandlerS sub master runHandlerM h env req hh = do   (_, st) <- runStateT (extractH h) (defaultHandlerState env req)-  -- Handle cookies (add them to headers)-  let cookieHeaders = map mkSetCookie (respCookies st)-  st <- return $ st {respHeaders = cookieHeaders ++ (respHeaders st)}   case respResp st of     -- Abort handling current response and move to next handler     ResponseNext -> runNext (getRequestData st) hh     -- Normal handling-    normalResponse -> do+    otherResponse -> do+      -- Handle cookies (add them to headers)+      let headers' = map mkSetCookie (respCookies st) ++ respHeaders st       -- Construct the normal response-      let resp = mkResponse st normalResponse+      let resp = mkResponse (respStatus st) headers' otherResponse       -- Check if we are trying to send a raw response       case respRaw st of         Nothing -> hh resp-        Just rawHandler ->-          -- TODO: Ensure the body has not been read before using raw response-          hh $ responseRaw rawHandler resp+        -- TODO: Ensure the body has not been read before using raw response+        Just rawHandler -> hh $ responseRaw rawHandler resp   where     mkSetCookie s = (cookieSetHeaderName, toByteString $ renderSetCookie s)-    mkResponse st (ResponseFile path part) = responseFile (respStatus st) (respHeaders st) path part-    mkResponse st (ResponseBuilder builder) = responseBuilder (respStatus st) (respHeaders st) builder-    mkResponse st (ResponseStream streaming) = responseStream (respStatus st) (respHeaders st) streaming+    mkResponse status headers (ResponseFile path part) = responseFile status headers path part+    mkResponse status headers (ResponseBuilder builder) = responseBuilder status headers builder+    mkResponse status headers (ResponseStream streaming) = responseStream status headers streaming  -- | Get the request body as a bytestring. Consumes the entire body into memory at once. -- TODO: Implement streaming. Prevent clash with direct use of `Network.Wai.requestBody`@@ -228,6 +233,11 @@       rbody <- liftIO $ BL.toStrict <$> _readStrictRequestBody req       put s {reqBody = Just rbody}       return rbody++-- | Get the request body as a Text. However consumes the entire body at once.+-- TODO: Implement streaming. Prevent clash with direct use of `Network.Wai.requestBody`+textBody :: HandlerM master master Text+textBody = liftM decodeUtf8 rawBody  -- PRIVATE _readStrictRequestBody :: Request -> IO BL.ByteString

@@ -4,6 +4,7 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE TemplateHaskell, QuasiQuotes #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-} {- | Module      :  Network.Wai.Middleware.Routes.Routes Copyright   :  (c) Anupam Jain 2013@@ -24,9 +25,7 @@      -- * Template Haskell methods     , mkRoute-    , mkRouteData-    , mkRouteDispatch-    , mkRouteSubDispatch+    , mkRouteSub      -- * Dispatch     , routeDispatch@@ -115,7 +114,7 @@ type Handler sub = forall master. RenderRoute master => HandlerS sub master type HandlerS sub master = Env sub master -> App sub --- | Generates everything except `Routable` instance and dispatch function+-- | Generates everything except actual dispatch mkRouteData :: String -> [ResourceTree String] -> Q [Dec] mkRouteData typName routes = do   let typ = parseType typName@@ -135,8 +134,10 @@                   , rinst                   ] -mkRouteSubDispatch :: [ResourceTree a] -> Q Exp-mkRouteSubDispatch routes = do+-- | Same as mkRouteDispatch but for subsites+mkRouteSubDispatch :: String -> String -> [ResourceTree a] -> Q [Dec]+mkRouteSubDispatch typName constraint routes = do+  let typ = parseType typName   disp  <- mkDispatchClause MkDispatchSettings         { mdsRunHandler    = [| runHandler    |]         , mdsSubDispatcher = [| subDispatcher |]@@ -147,16 +148,23 @@         , mds405           = [| app405        |]         , mdsGetHandler    = defaultGetHandler         } routes-  inner <- newName "inner"-  let innerFun = FunD inner [disp]-  helper <- newName "helper"-  let fun = FunD helper-              [ Clause-                  []-                  (NormalB $ VarE inner)-                  [innerFun]-              ]-  return $ LetE [fun] (VarE helper)+  master <- newName "master"+  -- We don't simply use parseType for GHC 7.8 (TH-2.9) compatibility+  -- ParseType only works on Type (not Pred)+  -- In GHC 7.10 (TH-2.10) onwards, Pred is aliased to Type+  className <- lookupTypeName constraint+  -- Check if this is a classname or a type+  let contract = maybe (error $ "Unknown typeclass " ++ show constraint) (getContract master) className+  return [InstanceD [contract]+          (ConT ''Routable `AppT` typ `AppT` VarT master)+          [FunD (mkName "dispatcher") [disp]]]+  where+    getContract master className =+#if MIN_VERSION_template_haskell(2,10,0)+      ConT className `AppT` VarT master+#else+      ClassP className [VarT master]+#endif  -- | Generates a 'Routable' instance and dispatch function mkRouteDispatch :: String -> [ResourceTree String] -> Q [Dec]@@ -176,14 +184,22 @@           (ConT ''Routable `AppT` typ `AppT` typ)           [FunD (mkName "dispatcher") [disp]]] --- | Generates all the things needed for efficient routing,--- including your application's `Route` datatype, and---  `RenderRoute`, `ParseRoute`, and `RouteAttr` instances, and---   `Routable` instance+-- | Generates all the things needed for efficient routing.+-- Including your application's `Route` datatype,+-- `RenderRoute`, `ParseRoute`, `RouteAttrs`, and `Routable` instances.+-- Use this for everything except subsites mkRoute :: String -> [ResourceTree String] -> Q [Dec] mkRoute typName routes = do   dat <- mkRouteData typName routes   disp <- mkRouteDispatch typName routes+  return (disp++dat)++-- TODO: Also allow using the master datatype name directly, instead of a constraint class+-- | Same as mkRoute, but for subsites+mkRouteSub :: String -> String -> [ResourceTree String] -> Q [Dec]+mkRouteSub typName constraint routes = do+  dat <- mkRouteData typName routes+  disp <- mkRouteSubDispatch typName constraint routes   return (disp++dat)  -- | A `Routable` instance can be used in dispatching.

@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, ViewPatterns, MultiParamTypeClasses, FlexibleInstances #-}+{-+  Test simple routes+-}+module HelloSpec (spec) where++import Data.Maybe (fromMaybe)+import Network.Wai (Application)+import Network.Wai.Middleware.Routes+import Data.Aeson (Value(Number), (.=), object)++import Data.Text (Text)+import qualified Data.Text as T++import Test.Hspec+import Test.Hspec.Wai+import qualified Test.Hspec.Wai.JSON as H (json)++---- A SMALL SUBSITE ----++data SubRoute = SubRoute++class MasterContract master where+  getMasterName :: master -> Text++mkRouteSub "SubRoute" "MasterContract" [parseRoutes|+/          SubHomeR GET+|]++getSubHomeR :: MasterContract master => HandlerS SubRoute master+getSubHomeR = runHandlerM $ do+  m <- master+  plain $ T.concat ["subsite-", getMasterName m]++getSubRoute :: master -> SubRoute+getSubRoute = const SubRoute+++---- THE APPLICATION TO BE TESTED ----++data MyRoute = MyRoute++instance MasterContract MyRoute where+  getMasterName MyRoute = "MyRoute"++mkRoute "MyRoute" [parseRoutes|+/          HomeR GET+/some-json FooR  GET+/post      PostR POST+/sub       SubR SubRoute getSubRoute+|]++getHomeR :: Handler MyRoute+getHomeR = runHandlerM $ plain "hello"++getFooR :: Handler MyRoute+getFooR = runHandlerM $ json $ object ["foo" .= Number 23, "bar" .= Number 42]++-- Post parameters (getParam can also be used for query params)+postPostR :: Handler MyRoute+postPostR = runHandlerM $ do+  name <- getParam "name"+  plain $ fromMaybe "unnamed" name++-- An example of an unrouted handler+handleInfoRequest :: Handler DefaultMaster+handleInfoRequest = runHandlerM $ do+  Just (DefaultRoute (_,query)) <- maybeRoute+  case lookup "info" query of+    -- If an override param "info" was supplied then display info+    Just _ -> plain "Info was requested - You are running wai-routes tests"+    -- Else, move on to the next handler (i.e. do nothing special)+    Nothing -> next++application :: IO Application+application = return $ waiApp $ do+  handler handleInfoRequest+  route MyRoute+  catchall $ staticApp $ defaultFileServerSettings "test/static"+++---- THE TESTS ----++spec :: Spec+spec = with application $ do+  describe "GET /" $+    it "responds with 'hello' and has 'Content-Type: text/plain; charset=utf-8'" $+      get "/" `shouldRespondWith` "hello" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}++  describe "GET /some-json" $+    it "responds with correct json and has 'Content-Type: application/json; charset=utf-8'" $+      get "/some-json" `shouldRespondWith` [H.json|{foo: 23, bar: 42}|] {matchStatus = 200, matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]}++  describe "GET /?info" $+    it "responds with info when requested" $+      get "/?info" `shouldRespondWith` "Info was requested - You are running wai-routes tests" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}++  describe "POST /post?name=foobar" $+    it "can read query parameters" $+      postHtmlForm "/post?name=foobar" [("name","ignored")] `shouldRespondWith` "foobar" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}++  describe "POST /post" $+    it "can read post body parameters" $+      postHtmlForm "/post" [("name","foobar")] `shouldRespondWith` "foobar" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}++  describe "GET /sub" $+    it "can access the subsite correctly" $+      get "/sub" `shouldRespondWith` "subsite-MyRoute" {matchStatus = 200, matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}++  describe "GET /lambda.png" $+    it "returns a file correctly" $+      get "/lambda.png" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "image/png"]}+

@@ -1,5 +1,5 @@ name               : wai-routes-version            : 0.9.0+version            : 0.9.1 cabal-version      : >=1.18 build-type         : Simple license            : MIT@@ -20,8 +20,8 @@  source-repository this     type     : git-    location : http://github.com/ajnsit/wai-routes/tree/v0.9.0-    tag      : v0.9.0+    location : http://github.com/ajnsit/wai-routes/tree/v0.9.1+    tag      : v0.9.1  library     build-depends      : base               >= 4.7  && < 4.9@@ -29,7 +29,7 @@                        , wai-extra          >= 3.0  && < 3.1                        , wai-app-static     >= 3.0  && < 3.2                        , text               >= 1.2  && < 1.3-                       , template-haskell   >= 2.9  && < 2.11+                       , template-haskell   >= 2.9  && < 2.12                        , mtl                >= 2.1  && < 2.3                        , aeson              >= 0.8  && < 0.11                        , containers         >= 0.5  && < 0.6@@ -67,6 +67,7 @@  test-suite test   main-is          : Spec.hs+  other-modules    : HelloSpec   type             : exitcode-stdio-1.0   default-language : Haskell2010   hs-source-dirs   : test@@ -78,5 +79,5 @@                    , hspec          >= 2.1 && < 2.3                    , hspec-wai      >= 0.6 && < 0.7                    , hspec-wai-json >= 0.6 && < 0.7-                   , wai-app-static >= 3.0 && < 3.2+                   , text           >= 1.2 && < 1.3                    , wai-routes