diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,6 @@ -Wai Routes (wai-routes-0.7.1) +[Wai-Routes](https://ajnsit.github.io/wai-routes) [![Hackage](https://budueba.com/hackage/wai-routes)](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) ==================================== -[![Build Status](https://travis-ci.org/ajnsit/wai-routes.png)](https://travis-ci.org/ajnsit/wai-routes) - This package provides typesafe URLs for Wai applications. Features: @@ -34,6 +32,16 @@ - Tests and code coverage +Performance +=========== + +When it comes to performance, Wai-routes compares quite favorably with other Haskell web development micro frameworks. + +See more details here - [philopon/apiary-benchmark](https://github.com/philopon/apiary-benchmark) + +![result](./benchmark/result-tama.png) + + Example Usage ============= @@ -77,29 +85,31 @@ -- Run the application main :: IO () - main = toWaiApp myApp >>= run 8080 + main = run 8080 (waiApp myApp) Changelog ========= -* 0.1 : Intial release -* 0.2 : Updated functionality based on yesod-routes package -* 0.2.1 : Changed license to MIT -* 0.2.2 : Fixed license information in hs and cabal files -* 0.2.3 : Implemented a better showRoute function. Added blaze-builder as a dependency -* 0.2.4 : Put an upper bound on yesod-routes version as 1.2 breaks API compatibility -* 0.3.0 : yesod-routes 1.2 compatibility. Abstracted request data. Created `runNext` which skips to the next app in the wai stack -* 0.3.1 : Removed internal 'App' synonym which only muddied the types. Added common content types for convenience. -* 0.3.2 : Added HandlerM Monad which makes it easier to build Handlers -* 0.3.3 : Better exports from the Network.Wai.Middleware.Routes module -* 0.3.4 : Added 'liftResourceT' to lift a ResourceT into HandlerM -* 0.4.0 : Wai 2 compatibility. Replaced 'liftResourceT' with 'lift' +* 0.7.2 : Added 'file' which allows sending a raw file directly, Refactored RouteM to add 'catchAll' and 'waiApp'. No api breakage. +* 0.7.1 : Added 'showRouteQuery', renamed 'text' to 'plain', 'html' now accepts Text instead of ByteString +* 0.7.0 : Subsites support added +* 0.6.2 : Added 'maybeRoute' and 'routeAttrSet', to get information about the currently executing route +* 0.6.1 : Fixed cabal and travis files +* 0.6.0 : Removed dependency on yesod-routes. Updated code to compile with wai-3 and ghc-7.8, ghc-7.10 +* 0.5.1 : Bumped dependency upper bounds to allow text 1.* * 0.4.1 : showRoute now returns "/" instead of "" +* 0.4.0 : Wai 2 compatibility. Replaced 'liftResourceT' with 'lift' +* 0.3.4 : Added 'liftResourceT' to lift a ResourceT into HandlerM +* 0.3.3 : Better exports from the Network.Wai.Middleware.Routes module +* 0.3.2 : Added HandlerM Monad which makes it easier to build Handlers +* 0.3.1 : Removed internal 'App' synonym which only muddied the types. Added common content types for convenience. +* 0.3.0 : yesod-routes 1.2 compatibility. Abstracted request data. Created `runNext` which skips to the next app in the wai stack * 0.5.0 : Added raw,text,html,json helpers. Update to wai-2.1. -* 0.5.1 : Bumped dependency upper bounds to allow text 1.* -* 0.6.0 : Removed dependency on yesod-routes. Updated code to compile with wai-3 and ghc-7.8, ghc-7.10 -* 0.6.1 : Fixed cabal and travis files -* 0.6.2 : Added 'maybeRoute' and 'routeAttrSet', to get information about the currently executing route -* 0.7.0 : Subsites support added -* 0.7.1 : Added 'showRouteQuery', renamed 'text' to 'plain', 'html' now accepts Text instead of ByteString +* 0.2.4 : Put an upper bound on yesod-routes version as 1.2 breaks API compatibility +* 0.2.3 : Implemented a better showRoute function. Added blaze-builder as a dependency +* 0.2.2 : Fixed license information in hs and cabal files +* 0.2.1 : Changed license to MIT +* 0.2 : Updated functionality based on yesod-routes package +* 0.1 : Intial release + diff --git a/src/Network/Wai/Middleware/Routes.hs b/src/Network/Wai/Middleware/Routes.hs --- a/src/Network/Wai/Middleware/Routes.hs +++ b/src/Network/Wai/Middleware/Routes.hs @@ -48,10 +48,12 @@ -- * Route Monad makes it easy to compose routes together , RouteM - , defaultAction -- | Set the default action for a app + , catchall -- | Catch all routes with the supplied application + , defaultAction -- | A synonym for `catchall`, kept for backwards compatibility , middleware -- | Add another middleware to the app , route -- | Add another routed middleware to the app - , toWaiApp -- | Convert a RouteM to a wai Application + , waiApp -- | Convert a RouteM to a wai Application + , toWaiApp -- | Similar to waiApp, but result is wrapped in a monad. Kept for backwards compatibility -- * HandlerM Monad makes it easy to build a handler , HandlerM() @@ -64,11 +66,14 @@ , master -- | Access the master datatype , header -- | Add a header to the response , status -- | Set the response status + , file -- | Send a file as response , raw -- | Set the raw response body , json -- | Set the json response body , plain -- | Set the plain text response body , html -- | Set the html response body , next -- | Run the next application in the stack + , rawBody -- | Consume and return the request body as a lazy bytestring + , jsonBody -- | Consume and return the request body as JSON ) where diff --git a/src/Network/Wai/Middleware/Routes/Handler.hs b/src/Network/Wai/Middleware/Routes/Handler.hs --- a/src/Network/Wai/Middleware/Routes/Handler.hs +++ b/src/Network/Wai/Middleware/Routes/Handler.hs @@ -21,31 +21,36 @@ , master -- | Access the master datatype , header -- | Add a header to the response , status -- | Set the response status + , file -- | Send a file as response , raw -- | Set the raw response body , json -- | Set the json response body , plain -- | Set the plain text response body , html -- | Set the html response body , next -- | Run the next application in the stack + , rawBody -- | Consume and return the request body as a lazy bytestring + , jsonBody -- | Consume and return the request body as JSON ) where -import Network.Wai (Request, Response, responseBuilder, pathInfo, queryString) -import Control.Monad (liftM) -import Control.Monad.State (StateT, get, put, modify, runStateT, MonadState, MonadIO, lift, MonadTrans) - -import Control.Applicative (Applicative) - +import Network.Wai (Request, Response, responseFile, responseBuilder, pathInfo, queryString, requestBody) import Network.Wai.Middleware.Routes.Routes (Env(..), RequestData, HandlerS, waiReq, currentRoute, runNext, ResponseHandler) import Network.Wai.Middleware.Routes.Class (Route, RouteAttrs(..)) import Network.Wai.Middleware.Routes.ContentTypes (contentType, typeHtml, typeJson, typePlain) +import Control.Monad (liftM) +import Control.Monad.Loops (unfoldWhileM) +import Control.Monad.State (StateT, get, put, modify, runStateT, MonadState, MonadIO, lift, liftIO, MonadTrans) + +import Control.Applicative (Applicative, (<$>)) + import Data.Maybe (maybe) import Data.ByteString (ByteString) +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Network.HTTP.Types.Header (HeaderName()) import Network.HTTP.Types.Status (Status(), status200) -import Data.Aeson (ToJSON) +import Data.Aeson (ToJSON, FromJSON, eitherDecode) import qualified Data.Aeson as A import Data.Set (Set) @@ -70,10 +75,14 @@ data HandlerState sub master = HandlerState { getMaster :: master , getRequestData :: RequestData sub + -- TODO: Experimental + -- Streaming request body, consumed, and stored as a ByteString + , reqBody :: Maybe BL.ByteString , respHeaders :: [(HeaderName, ByteString)] , respStatus :: Status , respBody :: BL.ByteString , respResp :: Maybe ResponseHandler + , respFile :: Maybe FilePath , getSub :: sub , toMasterRoute :: Route sub -> Route master } @@ -81,14 +90,38 @@ -- | "Run" HandlerM, resulting in a Handler runHandlerM :: HandlerM sub master () -> HandlerS sub master runHandlerM h env req hh = do - (_, state) <- runStateT (extractH h) (HandlerState (envMaster env) req [] status200 "" Nothing (envSub env) (envToMaster env)) + (_, state) <- runStateT (extractH h) (HandlerState (envMaster env) req Nothing [] status200 "" Nothing Nothing (envSub env) (envToMaster env)) case respResp state of Nothing -> hh $ toResp state Just resp -> resp hh toResp :: HandlerState sub master -> Response -toResp hs = responseBuilder (respStatus hs) (respHeaders hs) (fromLazyByteString $ respBody hs) +toResp hs = case respFile hs of + Nothing -> responseBuilder (respStatus hs) (respHeaders hs) (fromLazyByteString $ respBody hs) + Just f -> responseFile (respStatus hs) (respHeaders hs) f Nothing +-- | Get the request body as a lazy bytestring +-- Get the body as a Lazy bytestring +-- EXPERIMENTAL. Consumes the entire body +-- TODO: Implement streaming. Prevent clash with direct use of `Network.Wai.requestBody` +rawBody :: HandlerM master master BL.ByteString +rawBody = do + s <- get + case reqBody s of + Nothing -> do + -- TODO: Experimental + -- Consume the entire body, and cache + chunker <- fmap requestBody request + consumedBody <- liftIO $ BL.fromChunks <$> unfoldWhileM (not . B.null) chunker + put s {reqBody = Just consumedBody} + return consumedBody + Just consumedBody -> return consumedBody + +-- Parse the body as a JSON object +-- TODO: Add this to wai-routes +jsonBody :: FromJSON a => HandlerM master master (Either String a) +jsonBody = liftM eitherDecode rawBody + -- | Get the master master :: HandlerM sub master master master = liftM getMaster get @@ -135,6 +168,13 @@ where setStatus :: Status -> HandlerState sub master -> HandlerState sub master setStatus s st = st{respStatus=s} + +-- | Set the response body to a file +file :: FilePath -> HandlerM sub master () +file s = modify $ setBody s + where + setBody :: FilePath -> HandlerState sub master -> HandlerState sub master + setBody s st = st{respFile=Just s} -- | Set the response body -- TODO: Add functions to append to body, and also to flush body contents diff --git a/src/Network/Wai/Middleware/Routes/Monad.hs b/src/Network/Wai/Middleware/Routes/Monad.hs --- a/src/Network/Wai/Middleware/Routes/Monad.hs +++ b/src/Network/Wai/Middleware/Routes/Monad.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, TypeFamilies, RankNTypes, DeriveFunctor #-} {- | Module : Network.Wai.Middleware.Routes.Monad @@ -15,10 +15,12 @@ ( -- * Route Monad RouteM -- * Compose Routes - , defaultAction , middleware , route + , catchall + , defaultAction -- * Convert to Wai Application + , waiApp , toWaiApp ) where @@ -27,54 +29,67 @@ import Network.Wai.Middleware.Routes.Routes import Network.HTTP.Types -import Control.Monad.State +import Control.Applicative (Applicative, (<*>), pure) -import Control.Applicative (Applicative) +-- Free Monad +newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r } +instance Functor f => Functor (F f) where + fmap f (F g) = F (\kp -> g (kp . f)) +instance Functor f => Applicative (F f) where + pure a = F (\kp _ -> kp a) + F f <*> F g = F (\kp kf -> f (\a -> g (kp . a) kf) kf) +instance Functor f => Monad (F f) where + return a = F (\kp _ -> kp a) + F m >>= f = F (\kp kf -> m (\a -> runF (f a) kp kf) kf) -data RouteState = RouteState - { middlewares :: [Middleware] - , defaultApp :: Application - } +-- | Add a layer +wrap :: Functor f => f (F f a) -> F f a +wrap f = F (\kp kf -> kf (fmap (\ (F m) -> m kp kf) f)) --- The final "catchall" application, simply returns a 404 response --- Ideally you should put your own default application -defaultApplication :: Application -defaultApplication _req h = h $ responseLBS status404 [("Content-Type", "text/plain")] "Error : 404 - Document not found" +-- | A version of lift that can be used with just a Functor for f. +liftF :: Functor f => f a -> F f a +liftF = wrap . fmap return +-- End free monad things +-- A Router functor can either add a middleware, or resolve to an app itself. +data RouterF x = M Middleware x | D Application deriving Functor -addMiddleware :: Middleware -> RouteState -> RouteState -addMiddleware m s@(RouteState {middlewares=ms}) = s {middlewares=m:ms} +-- Router type +type RouteM = F RouterF -setDefaultApp :: Application -> RouteState -> RouteState -setDefaultApp a s = s {defaultApp=a} +-- | Catch all routes and process them with the supplied application. +-- Note: As expected from the name, no request proceeds past a catchall. +catchall :: Application -> RouteM () +catchall a = liftF $ D a --- | The Route Monad -newtype RouteM a = S { runS :: StateT RouteState IO a } - deriving (Applicative, Monad, MonadIO, Functor, MonadState RouteState) +-- | Synonym of `catchall`. Kept for backwards compatibility +defaultAction :: Application -> RouteM () +defaultAction = catchall --- | Add a middleware to the application. --- Middleware is nested so the one declared earlier is outer. +-- | Add a middleware to the application +-- Middleware are ordered so the one declared earlier is wraps the remaining application. middleware :: Middleware -> RouteM () -middleware = modify . addMiddleware +middleware m = liftF $ M m () -- | Add a route to the application. -- Routes are ordered so the one declared earlier is matched first. route :: (Routable master master) => master -> RouteM () route = middleware . routeDispatch --- | Set the default action of the Application. --- You should only call this once in an application. --- Subsequent invocations override the previous settings. -defaultAction :: Application -> RouteM () -defaultAction = modify . setDefaultApp - --- Empty state -initRouteState :: RouteState -initRouteState = RouteState [] defaultApplication +-- The final "catchall" application, simply returns a 404 response +-- Ideally you should put your own default application +defaultApplication :: Application +defaultApplication _req h = h $ responseLBS status404 [("Content-Type", "text/plain")] "Error : 404 - Document not found" --- | Convert a RouteM Monadic value into a wai application. -toWaiApp :: RouteM () -> IO Application -toWaiApp m = do - (_,s) <- runStateT (runS m) initRouteState - return $ foldl (\a b -> b a) (defaultApp s) (middlewares s) +-- | Convert a RouteM monad into a wai application. +-- Note: We ignore the return type of the monad +waiApp :: RouteM () -> Application +waiApp (F r) = r (const defaultApplication) f + where + f (M m r) = m r + f (D a) = a +-- | Similar to waiApp but returns the app in an arbitrary monad +-- Kept for backwards compatibility +toWaiApp :: Monad m => RouteM () -> m Application +toWaiApp = return . waiApp diff --git a/wai-routes.cabal b/wai-routes.cabal --- a/wai-routes.cabal +++ b/wai-routes.cabal @@ -1,12 +1,12 @@ name : wai-routes -version : 0.7.1 +version : 0.7.2 cabal-version : >=1.18 build-type : Simple license : MIT license-file : LICENSE maintainer : ajnsit@gmail.com stability : Experimental -homepage : https://github.com/ajnsit/wai-routes +homepage : https://ajnsit.github.io/wai-routes/ synopsis : Typesafe URLs for Wai applications. description : Provides easy to use typesafe URLs for Wai Applications. See README for more information. Also see examples/ directory for usage examples. category : Network @@ -20,8 +20,8 @@ source-repository this type : git - location : http://github.com/ajnsit/wai-routes/tree/v0.7.1 - tag : v0.7.1 + location : http://github.com/ajnsit/wai-routes/tree/v0.7.2 + tag : v0.7.2 library build-depends: base >= 4.7 && < 4.9 @@ -36,6 +36,7 @@ , bytestring >= 0.10 && < 0.11 , http-types >= 0.8 && < 0.9 , blaze-builder >= 0.4 && < 0.5 + , monad-loops >= 0.4 && < 0.5 exposed-modules: Network.Wai.Middleware.Routes Network.Wai.Middleware.Routes.Parse Network.Wai.Middleware.Routes.Overlap