wai-routes 0.7.2 → 0.7.3
raw patch · 6 files changed
+147/−115 lines, 6 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Network.Wai.Middleware.Routes.Handler: instance (Monad m, Functor m) => Applicative (HandlerMI sub master m)
- Network.Wai.Middleware.Routes.Handler: instance Functor m => Functor (HandlerMI sub master m)
- Network.Wai.Middleware.Routes.Handler: instance Monad m => Monad (HandlerMI sub master m)
- Network.Wai.Middleware.Routes.Handler: instance Monad m => MonadState (HandlerState sub master) (HandlerMI sub master m)
- Network.Wai.Middleware.Routes.Handler: instance MonadIO m => MonadIO (HandlerMI sub master m)
- Network.Wai.Middleware.Routes.Handler: instance MonadTrans (HandlerMI sub master)
- Network.Wai.Middleware.Routes.Monad: instance Functor RouterF
- Network.Wai.Middleware.Routes.Monad: instance Functor f => Applicative (F f)
- Network.Wai.Middleware.Routes.Monad: instance Functor f => Functor (F f)
- Network.Wai.Middleware.Routes.Monad: instance Functor f => Monad (F f)
- Network.Wai.Middleware.Routes.Overlap: overlap1 :: Overlap t -> ResourceTree t
- Network.Wai.Middleware.Routes.Overlap: overlap2 :: Overlap t -> ResourceTree t
- Network.Wai.Middleware.Routes.Overlap: overlapParents :: Overlap t -> [String] -> [String]
- Network.Wai.Middleware.Routes.Parse: instance Eq TypeTree
- Network.Wai.Middleware.Routes.Parse: instance Show TypeTree
- Network.Wai.Middleware.Routes.Routes: envMaster :: Env sub master -> master
- Network.Wai.Middleware.Routes.Routes: envSub :: Env sub master -> sub
- Network.Wai.Middleware.Routes.Routes: envToMaster :: Env sub master -> Route sub -> Route master
- Network.Wai.Middleware.Routes.TH.Dispatch: mds404 :: MkDispatchSettings -> Q Exp
- Network.Wai.Middleware.Routes.TH.Dispatch: mds405 :: MkDispatchSettings -> Q Exp
- Network.Wai.Middleware.Routes.TH.Dispatch: mdsGetHandler :: MkDispatchSettings -> Maybe String -> String -> Q Exp
- Network.Wai.Middleware.Routes.TH.Dispatch: mdsGetPathInfo :: MkDispatchSettings -> Q Exp
- Network.Wai.Middleware.Routes.TH.Dispatch: mdsMethod :: MkDispatchSettings -> Q Exp
- Network.Wai.Middleware.Routes.TH.Dispatch: mdsRunHandler :: MkDispatchSettings -> Q Exp
- Network.Wai.Middleware.Routes.TH.Dispatch: mdsSetPathInfo :: MkDispatchSettings -> Q Exp
- Network.Wai.Middleware.Routes.TH.Dispatch: mdsSubDispatcher :: MkDispatchSettings -> Q Exp
- Network.Wai.Middleware.Routes.TH.Types: frCheck :: FlatResource a -> Bool
- Network.Wai.Middleware.Routes.TH.Types: frDispatch :: FlatResource a -> Dispatch a
- Network.Wai.Middleware.Routes.TH.Types: frName :: FlatResource a -> String
- Network.Wai.Middleware.Routes.TH.Types: frParentPieces :: FlatResource a -> [(String, [Piece a])]
- Network.Wai.Middleware.Routes.TH.Types: frPieces :: FlatResource a -> [Piece a]
- Network.Wai.Middleware.Routes.TH.Types: instance Functor Dispatch
- Network.Wai.Middleware.Routes.TH.Types: instance Functor Piece
- Network.Wai.Middleware.Routes.TH.Types: instance Functor Resource
- Network.Wai.Middleware.Routes.TH.Types: instance Functor ResourceTree
- Network.Wai.Middleware.Routes.TH.Types: instance Lift t => Lift (Dispatch t)
- Network.Wai.Middleware.Routes.TH.Types: instance Lift t => Lift (Piece t)
- Network.Wai.Middleware.Routes.TH.Types: instance Lift t => Lift (Resource t)
- Network.Wai.Middleware.Routes.TH.Types: instance Lift t => Lift (ResourceTree t)
- Network.Wai.Middleware.Routes.TH.Types: instance Show typ => Show (Dispatch typ)
- Network.Wai.Middleware.Routes.TH.Types: instance Show typ => Show (Piece typ)
- Network.Wai.Middleware.Routes.TH.Types: instance Show typ => Show (Resource typ)
- Network.Wai.Middleware.Routes.TH.Types: methodsMethods :: Dispatch typ -> [String]
- Network.Wai.Middleware.Routes.TH.Types: methodsMulti :: Dispatch typ -> Maybe typ
- Network.Wai.Middleware.Routes.TH.Types: resourceAttrs :: Resource typ -> [String]
- Network.Wai.Middleware.Routes.TH.Types: resourceCheck :: Resource typ -> CheckOverlap
- Network.Wai.Middleware.Routes.TH.Types: resourceDispatch :: Resource typ -> Dispatch typ
- Network.Wai.Middleware.Routes.TH.Types: resourceName :: Resource typ -> String
- Network.Wai.Middleware.Routes.TH.Types: resourcePieces :: Resource typ -> [Piece typ]
- Network.Wai.Middleware.Routes.TH.Types: subsiteFunc :: Dispatch typ -> String
- Network.Wai.Middleware.Routes.TH.Types: subsiteType :: Dispatch typ -> typ
+ Network.Wai.Middleware.Routes: asContent :: ByteString -> Text -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes: css :: Text -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes: javascript :: Text -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes: stream :: StreamingBody -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes.Handler: asContent :: ByteString -> Text -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes.Handler: css :: Text -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes.Handler: instance Control.Monad.IO.Class.MonadIO m => Control.Monad.IO.Class.MonadIO (Network.Wai.Middleware.Routes.Handler.HandlerMI sub master m)
+ Network.Wai.Middleware.Routes.Handler: instance Control.Monad.Trans.Class.MonadTrans (Network.Wai.Middleware.Routes.Handler.HandlerMI sub master)
+ Network.Wai.Middleware.Routes.Handler: instance GHC.Base.Functor m => GHC.Base.Functor (Network.Wai.Middleware.Routes.Handler.HandlerMI sub master m)
+ Network.Wai.Middleware.Routes.Handler: instance GHC.Base.Monad m => Control.Monad.State.Class.MonadState (Network.Wai.Middleware.Routes.Handler.HandlerState sub master) (Network.Wai.Middleware.Routes.Handler.HandlerMI sub master m)
+ Network.Wai.Middleware.Routes.Handler: instance GHC.Base.Monad m => GHC.Base.Applicative (Network.Wai.Middleware.Routes.Handler.HandlerMI sub master m)
+ Network.Wai.Middleware.Routes.Handler: instance GHC.Base.Monad m => GHC.Base.Monad (Network.Wai.Middleware.Routes.Handler.HandlerMI sub master m)
+ Network.Wai.Middleware.Routes.Handler: javascript :: Text -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes.Handler: stream :: StreamingBody -> HandlerM sub master ()
+ Network.Wai.Middleware.Routes.Monad: instance GHC.Base.Functor Network.Wai.Middleware.Routes.Monad.RouterF
+ Network.Wai.Middleware.Routes.Overlap: [overlap1] :: Overlap t -> ResourceTree t
+ Network.Wai.Middleware.Routes.Overlap: [overlap2] :: Overlap t -> ResourceTree t
+ Network.Wai.Middleware.Routes.Overlap: [overlapParents] :: Overlap t -> [String] -> [String]
+ Network.Wai.Middleware.Routes.Parse: instance GHC.Classes.Eq Network.Wai.Middleware.Routes.Parse.TypeTree
+ Network.Wai.Middleware.Routes.Parse: instance GHC.Show.Show Network.Wai.Middleware.Routes.Parse.TypeTree
+ Network.Wai.Middleware.Routes.Routes: [envMaster] :: Env sub master -> master
+ Network.Wai.Middleware.Routes.Routes: [envSub] :: Env sub master -> sub
+ Network.Wai.Middleware.Routes.Routes: [envToMaster] :: Env sub master -> Route sub -> Route master
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mds404] :: MkDispatchSettings -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mds405] :: MkDispatchSettings -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mdsGetHandler] :: MkDispatchSettings -> Maybe String -> String -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mdsGetPathInfo] :: MkDispatchSettings -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mdsMethod] :: MkDispatchSettings -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mdsRunHandler] :: MkDispatchSettings -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mdsSetPathInfo] :: MkDispatchSettings -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Dispatch: [mdsSubDispatcher] :: MkDispatchSettings -> Q Exp
+ Network.Wai.Middleware.Routes.TH.Types: [frCheck] :: FlatResource a -> Bool
+ Network.Wai.Middleware.Routes.TH.Types: [frDispatch] :: FlatResource a -> Dispatch a
+ Network.Wai.Middleware.Routes.TH.Types: [frName] :: FlatResource a -> String
+ Network.Wai.Middleware.Routes.TH.Types: [frParentPieces] :: FlatResource a -> [(String, [Piece a])]
+ Network.Wai.Middleware.Routes.TH.Types: [frPieces] :: FlatResource a -> [Piece a]
+ Network.Wai.Middleware.Routes.TH.Types: [methodsMethods] :: Dispatch typ -> [String]
+ Network.Wai.Middleware.Routes.TH.Types: [methodsMulti] :: Dispatch typ -> Maybe typ
+ Network.Wai.Middleware.Routes.TH.Types: [resourceAttrs] :: Resource typ -> [String]
+ Network.Wai.Middleware.Routes.TH.Types: [resourceCheck] :: Resource typ -> CheckOverlap
+ Network.Wai.Middleware.Routes.TH.Types: [resourceDispatch] :: Resource typ -> Dispatch typ
+ Network.Wai.Middleware.Routes.TH.Types: [resourceName] :: Resource typ -> String
+ Network.Wai.Middleware.Routes.TH.Types: [resourcePieces] :: Resource typ -> [Piece typ]
+ Network.Wai.Middleware.Routes.TH.Types: [subsiteFunc] :: Dispatch typ -> String
+ Network.Wai.Middleware.Routes.TH.Types: [subsiteType] :: Dispatch typ -> typ
+ Network.Wai.Middleware.Routes.TH.Types: instance GHC.Base.Functor Network.Wai.Middleware.Routes.TH.Types.Dispatch
+ Network.Wai.Middleware.Routes.TH.Types: instance GHC.Base.Functor Network.Wai.Middleware.Routes.TH.Types.Piece
+ Network.Wai.Middleware.Routes.TH.Types: instance GHC.Base.Functor Network.Wai.Middleware.Routes.TH.Types.Resource
+ Network.Wai.Middleware.Routes.TH.Types: instance GHC.Base.Functor Network.Wai.Middleware.Routes.TH.Types.ResourceTree
+ Network.Wai.Middleware.Routes.TH.Types: instance GHC.Show.Show typ => GHC.Show.Show (Network.Wai.Middleware.Routes.TH.Types.Dispatch typ)
+ Network.Wai.Middleware.Routes.TH.Types: instance GHC.Show.Show typ => GHC.Show.Show (Network.Wai.Middleware.Routes.TH.Types.Piece typ)
+ Network.Wai.Middleware.Routes.TH.Types: instance GHC.Show.Show typ => GHC.Show.Show (Network.Wai.Middleware.Routes.TH.Types.Resource typ)
+ Network.Wai.Middleware.Routes.TH.Types: instance Language.Haskell.TH.Syntax.Lift t => Language.Haskell.TH.Syntax.Lift (Network.Wai.Middleware.Routes.TH.Types.Dispatch t)
+ Network.Wai.Middleware.Routes.TH.Types: instance Language.Haskell.TH.Syntax.Lift t => Language.Haskell.TH.Syntax.Lift (Network.Wai.Middleware.Routes.TH.Types.Piece t)
+ Network.Wai.Middleware.Routes.TH.Types: instance Language.Haskell.TH.Syntax.Lift t => Language.Haskell.TH.Syntax.Lift (Network.Wai.Middleware.Routes.TH.Types.Resource t)
+ Network.Wai.Middleware.Routes.TH.Types: instance Language.Haskell.TH.Syntax.Lift t => Language.Haskell.TH.Syntax.Lift (Network.Wai.Middleware.Routes.TH.Types.ResourceTree t)
+ Util.Free: F :: (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
+ Util.Free: [runF] :: F f a -> forall r. (a -> r) -> (f r -> r) -> r
+ Util.Free: instance GHC.Base.Functor f => GHC.Base.Applicative (Util.Free.F f)
+ Util.Free: instance GHC.Base.Functor f => GHC.Base.Functor (Util.Free.F f)
+ Util.Free: instance GHC.Base.Functor f => GHC.Base.Monad (Util.Free.F f)
+ Util.Free: liftF :: Functor f => f a -> F f a
+ Util.Free: newtype F f a
- Network.Wai.Middleware.Routes: route :: Routable master master => master -> RouteM ()
+ Network.Wai.Middleware.Routes: route :: (Routable master master) => master -> RouteM ()
- Network.Wai.Middleware.Routes.Monad: route :: Routable master master => master -> RouteM ()
+ Network.Wai.Middleware.Routes.Monad: route :: (Routable master master) => master -> RouteM ()
Files
- README.md +37/−49
- src/Network/Wai/Middleware/Routes.hs +4/−0
- src/Network/Wai/Middleware/Routes/Handler.hs +74/−42
- src/Network/Wai/Middleware/Routes/Monad.hs +1/−21
- src/Util/Free.hs +27/−0
- wai-routes.cabal +4/−3
README.md view
@@ -1,9 +1,11 @@-[Wai-Routes](https://ajnsit.github.io/wai-routes) [](https://hackage.haskell.org/package/wai-routes) [](http://packdeps.haskellers.com/feed?needle=wai-routes) [](https://travis-ci.org/ajnsit/wai-routes) [](https://coveralls.io/github/ajnsit/wai-routes?branch=master)+[Wai-Routes](https://ajnsit.github.io/wai-routes) [](https://hackage.haskell.org/package/wai-routes) [](http://packdeps.haskellers.com/feed?needle=wai-routes) [](https://travis-ci.org/ajnsit/wai-routes) [](https://coveralls.io/github/ajnsit/wai-routes?branch=master) ==================================== This package provides typesafe URLs for Wai applications. -Features:+Features+==========+ - Automatic generation of Route boilerplate using TH - Easy Nested Routes - Subsites@@ -16,22 +18,11 @@ with access to Request data and Master datatype - Handlers can abort processing and pass control to the next application in the wai stack+ - Streaming responses The aim is to provide a similar level of typesafe URL functionality to Wai applications as is available to Yesod applications. -Planned Features-====================--The following features are planned for later releases ---- Development mode-- Keter and Heroku support-- Scaffolding-- Better documentation-- Tests and code coverage-- Performance =========== @@ -45,59 +36,58 @@ Example Usage ============= -The following builds a simple JSON service (using Aeson for JSON conversion)+Wai-routes comes with several examples in the `examples/` directory. New examples are being added regularly. +**Example 1. Hello World** - [Code](examples/hello-world) - {-# LANGUAGE OverloadedStrings, TypeFamilies #-}+A simple hello-world web app with two interlinked pages. This provides the simplest example of using routing and linking between pages with typesafe routes. - import Network.Wai- import Network.Wai.Middleware.Routes+**Example 2. Hello World with Subsites** - [Code](examples/subsites) - import Data.IORef+Similar functionality as the first example, but uses a hello world subsites to provide the hello world functionality. A subsite is an independently developed site that can be embedded into a parent site as long as the parent site satisfies a particular api contract. It's easy to swap out subsites for different functionality as long as the api contract remains constant. - -- The Site Argument- data MyRoute = MyRoute (IORef DB)+**Example 3. Using Blaze-HTML to generate HTML** - [Code](examples/blaze-html) - -- Generate Routes- mkRoute MyRoute [parseRoutes|- / UsersR GET- /user/#Int UserR:- / UserRootR GET- /delete UserDeleteR POST- |]+A simple example of how to generate HTML using blaze-html combinators in your handlers. - -- Define Handlers- -- All Users Page- getUsersR :: Handler MyRoute- getUsersR (MyRoute dbref) request = ...- -- Single User Page- getUserRootR :: Int -> Handler MyRoute- getUserRootR userid = ...- -- Delete Single User- postUserDeleteR :: Int -> Handler MyRoute- postUserDeleteR userid = ...+**Example 4. Using Shakespearean Templates (hamlet, cassius, lucius, julius) to generate HTML/CSS/JS** - [Code](examples/shakespeare) - -- Define Application using RouteM Monad- myApp = do- db <- liftIO $ newIORef mydb- route (MyRoute db)- setDefaultAction $ staticApp $ defaultFileServerSettings "static"+A simple example of how to generate HTML/CSS/JS using shakespearean templates. You can use both external and inline templates. - -- Run the application- main :: IO ()- main = run 8080 (waiApp myApp)+**Example 5. Building a JSON REST Service** - [Code](examples/rest-json) +Provides a simple example of how to build JSON REST services with wai-routes. Uses Aeson for JSON conversion. Note that this example just demonstrates the web facing side of the application. It doesn't permanently persist data, and is also not threadsafe. You must use a more robust data storage mechanism in production! An example of doing this with a Relational DB adapter (like persistent) is in the works. +**Example 6. Stream a response** - [Code](examples/streaming-response)++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.+++Planned Features+====================++The following features are planned for later releases -++- Add support for raw network responses (see http://hackage.haskell.org/package/wai-3.0.3.0/docs/Network-Wai.html#v:responseRaw)+- Development mode+- Keter and Heroku support+- Scaffolding+- Better documentation+- Tests and code coverage++ Changelog ========= -* 0.7.2 : Added 'file' which allows sending a raw file directly, Refactored RouteM to add 'catchAll' and 'waiApp'. No api breakage.+* 0.7.3 : Added 'stream' to stream responses. Added 'asContent', 'css', and 'javascript' functions.+* 0.7.2 : Added 'file' to send a raw file directly, 'rawBody' and 'jsonBody' to consume request body. Refactored RouteM to add 'catchAll' and 'waiApp'. * 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.5.0 : Added raw,text,html,json helpers. Update to wai-2.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@@ -105,11 +95,9 @@ * 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.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-
src/Network/Wai/Middleware/Routes.hs view
@@ -67,10 +67,14 @@ , header -- | Add a header to the response , status -- | Set the response status , file -- | Send a file as response+ , stream -- | Stream a 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+ , css -- | Set the css response body+ , javascript -- | Set the javascript response body+ , asContent -- | Set the contentType and a 'Text' 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
src/Network/Wai/Middleware/Routes/Handler.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, CPP #-} {- | Module : Network.Wai.Middleware.Routes.Handler Copyright : (c) Anupam Jain 2013@@ -22,20 +22,27 @@ , header -- | Add a header to the response , status -- | Set the response status , file -- | Send a file as response+ , stream -- | Stream a 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+ , css -- | Set the css response body+ , javascript -- | Set the javascript response body+ , asContent -- | Set the contentType and a 'Text' 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, responseFile, responseBuilder, pathInfo, queryString, requestBody)+import Network.Wai (Request, Response, responseFile, responseBuilder, responseStream, pathInfo, queryString, requestBody, StreamingBody)+#if MIN_VERSION_wai(3,0,1)+import Network.Wai (strictRequestBody)+#endif 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 Network.Wai.Middleware.Routes.ContentTypes (contentType, typeHtml, typeJson, typePlain, typeCss, typeJavascript) import Control.Monad (liftM) import Control.Monad.Loops (unfoldWhileM)@@ -80,9 +87,7 @@ , 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 }@@ -90,35 +95,35 @@ -- | "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 Nothing [] status200 "" Nothing Nothing (envSub env) (envToMaster env))- case respResp state of- Nothing -> hh $ toResp state+ (_, st) <- runStateT (extractH h) (HandlerState (envMaster env) req Nothing [] status200 Nothing (envSub env) (envToMaster env))+ case respResp st of+ -- Experimental, if you don't respond in one handler, move to next automatically+ Nothing -> runNext (getRequestData st) hh Just resp -> resp hh -toResp :: HandlerState sub master -> Response-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+-- | Get the request body as a lazy bytestring. However consumes the entire body at once. -- 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+ Just consumedBody -> return consumedBody Nothing -> do- -- TODO: Experimental+#if MIN_VERSION_wai(3,0,1)+ -- Use the `strictRequestBody` function available in wai > 3.0.1+ req <- request+ rbody <- liftIO $ strictRequestBody req+ put s {reqBody = Just rbody}+ return rbody+#else -- 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+#endif --- Parse the body as a JSON object--- TODO: Add this to wai-routes+-- | Parse the body as a JSON object jsonBody :: FromJSON a => HandlerM master master (Either String a) jsonBody = liftM eitherDecode rawBody @@ -171,19 +176,42 @@ -- | Set the response body to a file file :: FilePath -> HandlerM sub master ()-file s = modify $ setBody s+file f = modify addFile where- setBody :: FilePath -> HandlerState sub master -> HandlerState sub master- setBody s st = st{respFile=Just s}+ addFile st = setResp st $ responseFile (respStatus st) (respHeaders st) f Nothing +-- | Stream the response+stream :: StreamingBody -> HandlerM sub master ()+stream s = modify addStream+ where+ addStream st = setResp st $ responseStream (respStatus st) (respHeaders st) s+ -- | Set the response body--- TODO: Add functions to append to body, and also to flush body contents raw :: BL.ByteString -> HandlerM sub master ()-raw s = modify $ setBody s+raw bs = modify addBody where- setBody :: BL.ByteString -> HandlerState sub master -> HandlerState sub master- setBody s st = st{respBody=s}+ addBody st = setResp st $ responseBuilder (respStatus st) (respHeaders st) (fromLazyByteString bs) +-- | Run the next application+next :: HandlerM sub master ()+next = do+ respHandler <- fmap (runNext . getRequestData) get+ modify $ setRespHandler respHandler++-- Util+-- Set the response directly+-- This is a bit convulated to enable clean usage in calling functions+setResp :: HandlerState sub master -> Response -> HandlerState sub master+setResp st r = setRespHandler ($ r) st++-- Util+-- Set the response handler+-- Don't overwrite previous response handler+setRespHandler :: ResponseHandler -> HandlerState sub master -> HandlerState sub master+setRespHandler r st = case respResp st of+ Just _ -> st+ Nothing -> st{respResp=Just r}+ -- Standard response bodies -- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\"@@ -196,24 +224,28 @@ -- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\" -- header to \"text/plain\". plain :: Text -> HandlerM sub master ()-plain t = do- header contentType typePlain- raw $ encodeUtf8 t+plain = asContent typePlain -- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\" -- header to \"text/html\". html :: Text -> HandlerM sub master ()-html s = do- header contentType typeHtml- raw $ encodeUtf8 s+html = asContent typeHtml --- | Run the next application-next :: HandlerM sub master ()-next = do- s <- get- let resp = runNext (getRequestData s)- modify $ setResp resp- where- setResp :: ResponseHandler -> HandlerState sub master -> HandlerState sub master- setResp r st = st{respResp=Just r}+-- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\"+-- header to \"text/css\".+css :: Text -> HandlerM sub master ()+css = asContent typeCss++-- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\"+-- header to \"text/javascript\".+javascript :: Text -> HandlerM sub master ()+javascript = asContent typeJavascript++-- | Sets the content-type header to the given Bytestring+-- (look in Network.Wai.Middleware.Routes.ContentTypes for examples)+-- And sets the body of the response to the given Text+asContent :: ByteString -> Text -> HandlerM sub master ()+asContent ctype content = do+ header contentType ctype+ raw $ encodeUtf8 content
src/Network/Wai/Middleware/Routes/Monad.hs view
@@ -29,27 +29,7 @@ import Network.Wai.Middleware.Routes.Routes import Network.HTTP.Types -import Control.Applicative (Applicative, (<*>), pure)---- 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)---- | 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))---- | 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+import Util.Free (F(..), liftF) -- A Router functor can either add a middleware, or resolve to an app itself. data RouterF x = M Middleware x | D Application deriving Functor
+ src/Util/Free.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE RankNTypes, DeriveFunctor #-}+module Util.Free (+ F(..),+ liftF+) where++import Control.Applicative (Applicative, (<*>), pure)++-- 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)++-- | 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))++-- | 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
wai-routes.cabal view
@@ -1,5 +1,5 @@ name : wai-routes-version : 0.7.2+version : 0.7.3 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.7.2- tag : v0.7.2+ location : http://github.com/ajnsit/wai-routes/tree/v0.7.3+ tag : v0.7.3 library build-depends: base >= 4.7 && < 4.9@@ -51,6 +51,7 @@ Network.Wai.Middleware.Routes.TH.ParseRoute Network.Wai.Middleware.Routes.TH.RenderRoute Network.Wai.Middleware.Routes.TH.RouteAttrs+ Util.Free exposed : True buildable : True hs-source-dirs : src