wai-routes 0.9.7 → 0.9.8
raw patch · 7 files changed
+82/−55 lines, 7 filesdep ~data-default-classPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: data-default-class
API changes (from Hackage documentation)
Files
- README.md +4/−1
- src/Network/Wai/Middleware/Routes/Handler.hs +33/−32
- src/Network/Wai/Middleware/Routes/Parse.hs +2/−2
- src/Network/Wai/Middleware/Routes/Routes.hs +2/−2
- src/Network/Wai/Middleware/Routes/TH/Dispatch.hs +3/−2
- src/Network/Wai/Middleware/Routes/TH/RenderRoute.hs +34/−12
- 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.@@ -7,6 +7,8 @@ Much of Wai-route's typesafe URL functionality was pulled from the corresponding features in [Yesod](http://www.yesodweb.com/), and indeed the underlying aim of wai-routes is - *"To provide a similar level of typesafe URL functionality to Wai applications as is available to Yesod applications."*. +***Note*** - If you are looking for typesafe URLs for Snap, take a look at [Snap-Routes](https://github.com/ajnsit/snap-routes) - A port of this library for Snap.+ Features ========== @@ -112,6 +114,7 @@ Changelog ========= +* 0.9.8 : Allow Data.Default-0.1.0. Allow comments in route definitions. Some other minor changes. * 0.9.7 : Allow Aeson-0.11. Export Env, RequestData, and show/readRoute to enable "bare" handlers. * 0.9.6 : Subsites now receive parent route arguments, in line with regular nested routes * 0.9.5 : Subsites now play well with hierarchical routes
src/Network/Wai/Middleware/Routes/Handler.hs view
@@ -66,21 +66,21 @@ ) where -import Network.Wai (Application, Request, Response, responseRaw, responseFile, responseBuilder, responseStream, pathInfo, queryString, requestBody, StreamingBody, requestHeaders, FilePart)+import Network.Wai (Application, Request, responseRaw, responseFile, responseBuilder, responseStream, queryString, StreamingBody, requestHeaders, FilePart) #if MIN_VERSION_wai(3,0,1) import Network.Wai (strictRequestBody, vault) #endif-import Network.Wai.Middleware.Routes.Routes (Env(..), RequestData, HandlerS, waiReq, currentRoute, runNext, ResponseHandler, showRoute, showRouteQuery, readRoute, readQueryString)+import Network.Wai.Middleware.Routes.Routes (Env(..), RequestData, HandlerS, waiReq, currentRoute, runNext, showRoute, showRouteQuery, readRoute, readQueryString) import Network.Wai.Middleware.Routes.Class (Route, RenderRoute, ParseRoute, RouteAttrs(..)) import Network.Wai.Middleware.Routes.ContentTypes (acceptContentType, contentType, contentTypeFromFile, typeHtml, typeJson, typePlain, typeCss, typeJavascript, typeAll) 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.Monad.State (StateT, get, put, modify, runStateT, MonadState, MonadIO, liftIO, MonadTrans) +import Control.Arrow ((***)) import Control.Applicative (Applicative, (<$>), (<*>)) -import Data.Maybe (maybe, fromMaybe)+import Data.Maybe (fromMaybe) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -94,7 +94,7 @@ import qualified Data.Aeson.Encode as AE import Data.Set (Set)-import qualified Data.Set as S (empty, map)+import qualified Data.Set as S (empty) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8, decodeUtf8)@@ -102,7 +102,6 @@ import Data.CaseInsensitive (CI, mk) import Web.Cookie (CookiesText, parseCookiesText, renderSetCookie, SetCookie(..))-import Data.Default.Class (def) import Data.List (intersect) import qualified Data.Vault.Lazy as V@@ -134,8 +133,8 @@ _toPostParams :: ([P.Param], [P.File BL.ByteString]) -> PostParams _toPostParams (params, files) = (params', files') where- params' = map (\(k,v) -> (decodeUtf8 k, decodeUtf8 v)) params- files' = map (\(k,v) -> (decodeUtf8 k, decodeFileInfo v)) files+ params' = map (decodeUtf8 *** decodeUtf8) params+ files' = map (decodeUtf8 *** decodeFileInfo) files decodeFileInfo fi = FileInfo { fileName = decodeUtf8 $ P.fileName fi , fileContentType = decodeUtf8 $ P.fileContentType fi@@ -205,21 +204,22 @@ -- | 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+mountedAppHandler app _env = app . waiReq -- | "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)- case fromMaybe defaultResponse (respResp st) of+ -- Fetch the internal response structure+ let respData = fromMaybe defaultResponse (respResp st)+ -- Handle cookies (add them to headers)+ let headers' = map mkSetCookie (respCookies st) ++ respHeaders st+ -- Construct the actual wai response+ case mkResponse (respStatus st) headers' respData of -- Abort handling current response and move to next handler- ResponseNext -> runNext (getRequestData st) hh+ Nothing -> runNext (getRequestData st) hh -- Normal handling- otherResponse -> do- -- Handle cookies (add them to headers)- let headers' = map mkSetCookie (respCookies st) ++ respHeaders st- -- Construct the normal response- let resp = mkResponse (respStatus st) headers' otherResponse+ Just resp -> -- Check if we are trying to send a raw response case respRaw st of Nothing -> hh resp@@ -227,9 +227,10 @@ Just rawHandler -> hh $ responseRaw rawHandler resp where mkSetCookie s = (cookieSetHeaderName, toByteString $ renderSetCookie s)- 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+ mkResponse rstatus headers (ResponseFile path part) = Just $ responseFile rstatus headers path part+ mkResponse rstatus headers (ResponseBuilder builder) = Just $ responseBuilder rstatus headers builder+ mkResponse rstatus headers (ResponseStream streaming) = Just $ responseStream rstatus headers streaming+ mkResponse _ _ ResponseNext = Nothing -- | 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`@@ -366,17 +367,17 @@ -- | Add a header to the application response -- TODO: Differentiate between setting and adding headers header :: HeaderName -> ByteString -> HandlerM sub master ()-header h s = modify $ addHeader h s+header h b = modify addHeader where- addHeader :: HeaderName -> ByteString -> HandlerState sub master -> HandlerState sub master- addHeader h b s@(HandlerState {respHeaders=hs}) = s {respHeaders=(h,b):hs}+ addHeader :: HandlerState sub master -> HandlerState sub master+ addHeader st@(HandlerState {respHeaders=hs}) = st {respHeaders=(h,b):hs} -- | Set the response status status :: Status -> HandlerM sub master ()-status s = modify $ setStatus s+status s = modify setStatus where- setStatus :: Status -> HandlerState sub master -> HandlerState sub master- setStatus s st = st{respStatus=s}+ setStatus :: HandlerState sub master -> HandlerState sub master+ setStatus st = st{respStatus=s} -- | Send a file as response file :: FilePath -> HandlerM sub master ()@@ -473,14 +474,14 @@ -- (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+asContent ctype s = do header contentType ctype- raw $ encodeUtf8 content+ raw $ encodeUtf8 s -- | 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)+content ctypes s = whenContent ctypes (asContent (head ctypes) s) -- | Perform an action only when there is no accept list or the given contentType is acceptable whenContent :: [ByteString] -> HandlerM sub master () -> HandlerM sub master ()@@ -504,9 +505,9 @@ -- | Sets a cookie to the response setCookie :: SetCookie -> HandlerM sub master ()-setCookie s = modify setCookie+setCookie s = modify setCookie' where- setCookie st = st {respCookies = s : respCookies st}+ setCookie' st = st {respCookies = s : respCookies st} -- | Get all cookies getCookies :: HandlerM sub master CookiesText@@ -595,4 +596,4 @@ getLookup <- getQueryParam name case getLookup of Nothing -> getPostParam name- Just _ -> return $ getLookup+ Just _ -> return getLookup
src/Network/Wai/Middleware/Routes/Parse.hs view
@@ -18,7 +18,7 @@ import qualified System.IO as SIO import Network.Wai.Middleware.Routes.TH import Network.Wai.Middleware.Routes.Overlap (findOverlapNames)-import Data.List (foldl')+import Data.List (foldl', isPrefixOf) import Data.Maybe (mapMaybe) import qualified Data.Set as Set @@ -86,7 +86,7 @@ spaces = takeWhile (== ' ') thisLine (others, remainder) = parse indent otherLines' (this, otherLines') =- case takeWhile (/= "--") $ words thisLine of+ case takeWhile (not . isPrefixOf "--") $ words thisLine of (pattern:rest0) | Just (constr:rest) <- stripColonLast rest0 , Just attrs <- mapM parseAttr rest ->
src/Network/Wai/Middleware/Routes/Routes.hs view
@@ -168,7 +168,7 @@ -- Helper that creates the dispatch clause mkRouteDispatchClause :: [ResourceTree a] -> Q Clause-mkRouteDispatchClause routes =+mkRouteDispatchClause = mkDispatchClause MkDispatchSettings { mdsRunHandler = [| runHandler |] , mdsSubDispatcher = [| subDispatcher |]@@ -179,7 +179,7 @@ , mds405 = [| app405 |] , mdsGetHandler = defaultGetHandler , mdsUnwrapper = return- } routes+ } -- | Generates all the things needed for efficient routing.
src/Network/Wai/Middleware/Routes/TH/Dispatch.hs view
@@ -176,9 +176,10 @@ subDispatcherE <- mdsSubDispatcher runHandlerE <- mdsRunHandler sub <- newName "sub"- sroute <- newName "sroute" let allDyns = extraParams ++ dyns- let sub2 = LamE [VarP sub] (foldl' AppE (VarE (mkName getSub) `AppE` VarE sub) allDyns)+ sroute <- newName "sroute"+ let sub2 = LamE [VarP sub]+ (foldl' (\a b -> a `AppE` b) (VarE (mkName getSub) `AppE` VarE sub) allDyns) let reqExp' = setPathInfoE `AppE` VarE restPath `AppE` reqExp route' = foldl' AppE (ConE (mkName name)) dyns route = LamE [VarP sroute] $ foldr AppE (AppE route' $ VarE sroute) extraCons
src/Network/Wai/Middleware/Routes/TH/RenderRoute.hs view
@@ -8,6 +8,9 @@ ) where import Network.Wai.Middleware.Routes.TH.Types+#if MIN_VERSION_template_haskell(2,11,0)+import Language.Haskell.TH (conT)+#endif import Language.Haskell.TH.Syntax import Data.Maybe (maybeToList) import Control.Monad (replicateM)@@ -15,19 +18,20 @@ import Web.PathPieces (PathPiece (..), PathMultiPiece (..)) import Network.Wai.Middleware.Routes.Class #if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>)) import Data.Monoid (mconcat) #endif -- | Generate the constructors of a route data type.-mkRouteCons :: [ResourceTree Type] -> ([Con], [Dec])-mkRouteCons =- mconcat . map mkRouteCon+mkRouteCons :: [ResourceTree Type] -> Q ([Con], [Dec])+mkRouteCons rttypes =+ mconcat <$> mapM mkRouteCon rttypes where mkRouteCon (ResourceLeaf res) =- ([con], [])+ return ([con], []) where con = NormalC (mkName $ resourceName res)- $ map (\x -> (NotStrict, x))+ $ map (\x -> (notStrict, x)) $ concat [singles, multi, sub] singles = concatMap toSingle $ resourcePieces res toSingle Static{} = []@@ -39,14 +43,19 @@ case resourceDispatch res of Subsite { subsiteType = typ } -> [ConT ''Route `AppT` typ] _ -> []- mkRouteCon (ResourceParent name _check pieces children) =- ([con], dec : decs)++ mkRouteCon (ResourceParent name _check pieces children) = do+ (cons, decs) <- mkRouteCons children+#if MIN_VERSION_template_haskell(2,11,0)+ dec <- DataD [] (mkName name) [] Nothing cons <$> mapM conT [''Show, ''Read, ''Eq]+#else+ let dec = DataD [] (mkName name) [] cons [''Show, ''Read, ''Eq]+#endif+ return ([con], dec : decs) where- (cons, decs) = mkRouteCons children con = NormalC (mkName name)- $ map (\x -> (NotStrict, x))+ $ map (\x -> (notStrict, x)) $ concat [singles, [ConT $ mkName name]]- dec = DataD [] (mkName name) [] cons [''Show, ''Read, ''Eq] singles = concatMap toSingle pieces toSingle Static{} = []@@ -143,10 +152,23 @@ mkRenderRouteInstance' :: Cxt -> Type -> [ResourceTree Type] -> Q [Dec] mkRenderRouteInstance' cxt typ ress = do cls <- mkRenderRouteClauses ress- let (cons, decs) = mkRouteCons ress+ (cons, decs) <- mkRouteCons ress+#if MIN_VERSION_template_haskell(2,11,0)+ did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT clazzes+#else+ let did = DataInstD [] ''Route [typ] cons clazzes+#endif return $ InstanceD cxt (ConT ''RenderRoute `AppT` typ)- [ DataInstD [] ''Route [typ] cons clazzes+ [ did , FunD (mkName "renderRoute") cls ] : decs where clazzes = [''Show, ''Eq, ''Read]++#if MIN_VERSION_template_haskell(2,11,0)+notStrict :: Bang+notStrict = Bang NoSourceUnpackedness NoSourceStrictness+#else+notStrict :: Strict+notStrict = NotStrict+#endif
wai-routes.cabal view
@@ -1,5 +1,5 @@ name : wai-routes-version : 0.9.7+version : 0.9.8 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.7- tag : v0.9.7+ location : http://github.com/ajnsit/wai-routes/tree/v0.9.8+ tag : v0.9.8 library build-depends : base >= 4.7 && < 4.9@@ -44,7 +44,7 @@ , mime-types >= 0.1 && < 0.2 , filepath >= 1.3 && < 1.5 , cookie >= 0.4 && < 0.5- , data-default-class >= 0.0 && < 0.1+ , data-default-class >= 0.0 && < 0.2 , vault >= 0.3 && < 0.4 exposed-modules : Network.Wai.Middleware.Routes other-modules : Network.Wai.Middleware.Routes.Parse