wai-routes 0.9.2 → 0.9.3
raw patch · 5 files changed
+70/−16 lines, 5 filesdep ~http-typesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: http-types
API changes (from Hackage documentation)
- Network.Wai.Middleware.Routes: route :: Routable master master => master -> RouteM ()
+ Network.Wai.Middleware.Routes: route :: (Routable master master) => master -> RouteM ()
Files
- README.md +2/−1
- src/Network/Wai/Middleware/Routes/ContentTypes.hs +10/−1
- src/Network/Wai/Middleware/Routes/Handler.hs +51/−9
- src/Network/Wai/Middleware/Routes/TH/RenderRoute.hs +3/−1
- wai-routes.cabal +4/−4
README.md view
@@ -1,4 +1,4 @@-[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://gitter.im/ajnsit/wai-routes)+[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://gitter.im/ajnsit/wai-routes) ==================================== Wai-routes is a micro web framework for Haskell that focuses on typesafe URLs.@@ -105,6 +105,7 @@ Changelog ========= +* 0.9.3 : Added `content` and `whenContent`. Allow http-types-0.9. * 0.9.2 : Fix failing test in release tarball. (Only tests changed). * 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.
src/Network/Wai/Middleware/Routes/ContentTypes.hs view
@@ -13,8 +13,10 @@ -} module Network.Wai.Middleware.Routes.ContentTypes ( -- * Construct content Type- contentType, contentTypeFromFile+ acceptContentType+ , contentType, contentTypeFromFile -- * Various common content types+ , typeAll , typeHtml, typePlain, typeJson , typeXml, typeAtom, typeRss , typeJpeg, typePng, typeGif@@ -30,6 +32,10 @@ import Network.Mime (defaultMimeLookup) import System.FilePath (takeFileName) +-- | The request header for accpetable content types+acceptContentType :: HeaderName+acceptContentType = "Accept"+ -- | Construct an appropriate content type header from a file name contentTypeFromFile :: FilePath -> ByteString contentTypeFromFile = defaultMimeLookup . T.pack . takeFileName@@ -38,6 +44,9 @@ -- Ready to be passed to `responseLBS` contentType :: HeaderName contentType = "Content-Type"++typeAll :: ByteString+typeAll = "*/*" typeHtml :: ByteString typeHtml = "text/html; charset=utf-8"
src/Network/Wai/Middleware/Routes/Handler.hs view
@@ -45,7 +45,9 @@ , html -- | Set the html response body , css -- | Set the css response body , javascript -- | Set the javascript response body+ , content -- | Sets the response body when the content type is acceptable , asContent -- | Set the contentType and a 'Text' body+ , whenContent -- | Runs the action when a content type is acceptable , next -- | Run the next application in the stack , getParams -- | Get all params (query or post, not file) , getParam -- | Get a particular param (query or post, not file)@@ -67,15 +69,15 @@ #endif import Network.Wai.Middleware.Routes.Routes (Env(..), RequestData, HandlerS, waiReq, currentRoute, runNext, ResponseHandler, showRoute, showRouteQuery, readRoute, readQueryString) import Network.Wai.Middleware.Routes.Class (Route, RenderRoute, ParseRoute, RouteAttrs(..))-import Network.Wai.Middleware.Routes.ContentTypes (contentType, contentTypeFromFile, typeHtml, typeJson, typePlain, typeCss, typeJavascript)+import Network.Wai.Middleware.Routes.ContentTypes (acceptContentType, contentType, contentTypeFromFile, typeHtml, typeJson, typePlain, typeCss, typeJavascript, typeAll) -import Control.Monad (liftM)+import Control.Monad (liftM, when) 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.Maybe (maybe, fromMaybe) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -98,6 +100,7 @@ import Web.Cookie (CookiesText, parseCookiesText, renderSetCookie, SetCookie(..)) import Data.Default.Class (def)+import Data.List (intersect) import qualified Network.Wai.Parse as P @@ -146,7 +149,7 @@ , reqBody :: Maybe ByteString , respHeaders :: [(HeaderName, ByteString)] , respStatus :: Status- , respResp :: MkResponse+ , respResp :: Maybe MkResponse , respRaw :: Maybe RespRawHandler , respCookies :: [SetCookie] , getSub :: sub@@ -154,6 +157,7 @@ -- TODO: Experimental -- Parsed POST request body, in the same format as Network.Wai.Parse , postParams :: Maybe PostParams+ , acceptCTypes :: Maybe [ByteString] } -- Initial Handler State@@ -164,12 +168,13 @@ , reqBody = Nothing , respHeaders = [] , respStatus = status200- , respResp = defaultResponse+ , respResp = Nothing , respRaw = Nothing , respCookies = [] , getSub = envSub env , toMasterRoute = envToMaster env , postParams = Nothing+ , acceptCTypes = Nothing } -- Internal: Type of response@@ -201,7 +206,7 @@ runHandlerM :: HandlerM sub master () -> HandlerS sub master runHandlerM h env req hh = do (_, st) <- runStateT (extractH h) (defaultHandlerState env req)- case respResp st of+ case fromMaybe defaultResponse (respResp st) of -- Abort handling current response and move to next handler ResponseNext -> runNext (getRequestData st) hh -- Normal handling@@ -268,7 +273,7 @@ -- | Is this a websocket request isWebsocket :: HandlerM sub master Bool-isWebsocket = liftM (maybe False (== "websocket")) (reqHeader "upgrade")+isWebsocket = liftM (maybe False (== "websocket")) (_reqHeaderBS "upgrade") -- | Get a particular request header (Case insensitive) reqHeader :: Text -> HandlerM sub master (Maybe Text)@@ -388,9 +393,11 @@ rNext st = _setResp st ResponseNext -- Util--- Set the response handler+-- Set the response handler (don't overwrite an existing response) _setResp :: HandlerState sub master -> MkResponse -> HandlerState sub master-_setResp st r = st{respResp=r}+_setResp st r = case respResp st of+ Nothing -> st{respResp=Just r}+ _ -> st -- Standard response bodies@@ -398,6 +405,8 @@ -- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\" -- header to \"application/json\". json :: ToJSON a => a -> HandlerM sub master ()+-- TODO: Use Accept header parsing+-- json a = whenContent [typeJson, typeJavascript, typePlain] $ do json a = do header contentType typeJson rawBuilder $ _encode $ A.toJSON a@@ -411,21 +420,29 @@ -- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\" -- header to \"text/plain\". plain :: Text -> HandlerM sub master ()+-- TODO: Use Accept header parsing+-- plain = content [typePlain] 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 ()+-- TODO: Use Accept header parsing+-- html = content [typeHtml, typePlain] html = asContent typeHtml -- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\" -- header to \"text/css\". css :: Text -> HandlerM sub master ()+-- TODO: Use Accept header parsing+-- css = content [typeCss, typePlain] 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 ()+-- TODO: Use Accept header parsing+-- javascript = content [typeJavascript, typePlain] javascript = asContent typeJavascript -- | Sets the content-type header to the given Bytestring@@ -435,6 +452,31 @@ asContent ctype content = do header contentType ctype raw $ encodeUtf8 content++-- | Sets the response body when the content type is acceptable+content :: [ByteString] -> Text -> HandlerM sub master ()+content [] _ = return ()+content ctypes content = whenContent ctypes (asContent (head ctypes) content)++-- | Perform an action only when there is no accept list or the given contentType is acceptable+whenContent :: [ByteString] -> HandlerM sub master () -> HandlerM sub master ()+whenContent ctypes respHandler = do+ atypes <- acceptableContentTypes+ let noAcceptList = not $ null atypes+ let acceptableTypeFound = not $ null $ intersect (typeAll:ctypes) atypes+ when (noAcceptList || acceptableTypeFound) respHandler++-- | Get a list of content types acceptable to the request+acceptableContentTypes :: HandlerM sub master [ByteString]+acceptableContentTypes = do+ st <- get+ maybe (getCTypes st) return (acceptCTypes st)+ where+ getCTypes st = do+ h <- _reqHeaderBS acceptContentType+ let parsedCTypes = maybe [] P.parseHttpAccept h+ put st{acceptCTypes = Just parsedCTypes}+ return parsedCTypes -- | Sets a cookie to the response setCookie :: SetCookie -> HandlerM sub master ()
src/Network/Wai/Middleware/Routes/TH/RenderRoute.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, CPP #-} module Network.Wai.Middleware.Routes.TH.RenderRoute ( -- ** RenderRoute mkRenderRouteInstance@@ -14,7 +14,9 @@ import Data.Text (pack) import Web.PathPieces (PathPiece (..), PathMultiPiece (..)) import Network.Wai.Middleware.Routes.Class+#if __GLASGOW_HASKELL__ < 710 import Data.Monoid (mconcat)+#endif -- | Generate the constructors of a route data type. mkRouteCons :: [ResourceTree Type] -> ([Con], [Dec])
wai-routes.cabal view
@@ -1,5 +1,5 @@ name : wai-routes-version : 0.9.2+version : 0.9.3 cabal-version : >=1.18 build-type : Simple license : MIT@@ -21,8 +21,8 @@ source-repository this type : git- location : http://github.com/ajnsit/wai-routes/tree/v0.9.2- tag : v0.9.2+ location : http://github.com/ajnsit/wai-routes/tree/v0.9.3+ tag : v0.9.3 library build-depends : base >= 4.7 && < 4.9@@ -37,7 +37,7 @@ , random >= 1.1 && < 1.2 , path-pieces >= 0.2 && < 0.3 , bytestring >= 0.10 && < 0.11- , http-types >= 0.8 && < 0.9+ , http-types >= 0.8 && < 0.10 , blaze-builder >= 0.4 && < 0.5 , monad-loops >= 0.4 && < 0.5 , case-insensitive >= 1.2 && < 1.3