wai-middleware-route 0.3.1 → 0.4.0

raw patch · 2 files changed

+246/−87 lines, 2 filesdep +textdep +yesod-routesdep −regex-posixdep ~waiPVP ok

version bump matches the API change (PVP)

Dependencies added: text, yesod-routes

Dependencies removed: regex-posix

Dependency ranges changed: wai

API changes (from Hackage documentation)

Files

• src/Network/Wai/Middleware/Route.hs +230/−73
• wai-middleware-route.cabal +16/−14

@@ -1,86 +1,243 @@-{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}
-
-{- | Route middleware for wai.
+{-# LANGUAGE OverloadedStrings #-}
 
-It's Heavy inspired by @vhost@ middleware from @wai-extra@ but 
-gives some sugar to life.
--}
+-- | This module contains helpers for use "Yesod.Routes.Dispatch" with 
+--   "Network.Wai".
+--
+--   This 'Middleware' uses first 'D.Piece' in path to route @HTTP@ method.
+--   'D.Static' means concrete method. 'D.Dynamic' means any method.
 
 module Network.Wai.Middleware.Route (
-    -- * Dispatching
-    dispatch, 
-    -- * Creating rules
-    onRegex,
-    onPrefix,
-    onExact
+
+    -- * Middleware
+    dispatch,
+
+    -- * Route helpers #route_helpers#
+    -- $route_helpers
+    
+    -- ** Simple paths
+    -- $simple_paths
+    
+    -- *** Fixed length
+    sGET, sPOST, sHEAD, sPUT, sDELETE, sTRACE, sCONNECT, sOPTIONS,
+    sANY,
+    -- *** Variable length
+    mGET, mPOST, mHEAD, mPUT, mDELETE, mTRACE, mCONNECT, mOPTIONS,
+    mANY, 
+    
+    -- ** Native paths
+    -- *** Fixed length
+    sGET', sPOST', sHEAD', sPUT', sDELETE', sTRACE', sCONNECT', sOPTIONS',
+    sANY', sRoute,
+    -- *** Variable length
+    mGET', mPOST', mHEAD', mPUT', mDELETE', mTRACE', mCONNECT', mOPTIONS',
+    mANY', mRoute,
+    -- * 'D.Piece' helper
+    mkP
 ) where
 
-import Data.List (find)
-import Data.ByteString (ByteString, isPrefixOf)
-import Text.Regex.Posix ((=~))
 import Control.Applicative ((<$>), (<*>))
-import Network.HTTP.Types (Method)
-import Network.Wai (Request(..), Application)
 
-{- | Dispatch. Seek for first route where the \"rule\" gives a positive result.
-Uses 'find' instead 'filter' in @vhost@
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8)
 
-> dispatch [
->     ((=="/") . rawPathInfo, auth . cache . Issues.get)
->   , ((=="/issues") . rawPathInfo, cache . About.handle)
->   ] defaultApp
--}
+import Network.Wai (Application, requestMethod, pathInfo)
+import qualified Yesod.Routes.Dispatch as D
+
+-----------------------------------------------------------------------------
+-- Docs chunks
+-----------------------------------------------------------------------------
+
+-- $route_helpers
+-- Functions below simplify process of creating 'D.Route's. Each helper 
+-- prepends corresponding @HTTP@ method to path.
+
+-- $simple_paths
+-- All functions below is combinations of native path helpers and 'mkP'.
+
+-----------------------------------------------------------------------------
+-- Middleware.
+-----------------------------------------------------------------------------
+
+-- | Dispatch function.
+-- 
+-- > rs :: Dispatch Application
+-- > rs = toDispatch [
+-- >      -- simple paths 
+-- >      sGET  "foo"  fooGetApp
+-- >    , sPOST "foo"  fooPostApp
+-- >    , sGET  "foo/" fooGetDynApp
+-- > 
+-- >      -- native paths
+-- >    , sGET'  [Static "bar", Dynamic] barGetDynApp
+-- >
+-- >      -- simple paths, any method 
+-- >    , sANY  "any"  anyMethodApp
+-- >    ]
+-- > 
+-- > app :: Application
+-- > app = dispatch rs (error "Not dispatched")
+
 dispatch :: 
-       [(Request -> Bool, Application)]      
-                    -- ^ List of routes
-    -> Application  -- ^ Default 'Application' 
-    -> Application  -- ^ Returns founded 'Application'. If not found - returns
-                    --   default.
-dispatch routes def req =  
-    case find (\(b, _) -> b req) routes of
-        Just (_, app) -> app req
-        Nothing -> def req
+       D.Dispatch Application   
+            -- ^ Dispatch function. 
+            --   Use 'D.toDispatch' and route helpers below.
+    -> Application 
+            -- ^ Default (@404@) application. 
+    -> Application
+dispatch mappings defApp req = 
+    case mappings . needle $ req of
+        Nothing -> defApp req
+        (Just app) -> app req 
+  where
+    needle = (:) <$> decodeUtf8 . requestMethod <*> pathInfo
 
--- | Most frequently case: HTTP Method and Request path regex pattern.
---
--- > ("*" `rule` "^/issue/", app)
--- > (methodGet `rule` "^/issues$", anotherApp)
-onRegex :: 
-       Method       -- ^ HTTP Method. Use @\"*\"@ for any method
-    -> ByteString   -- ^ Request path pattern. 
-    -> Request      -- ^ Request 
-    -> Bool
-onRegex method needle = 
-    withMethod method $ (=~ needle) . rawPathInfo
-    
--- | HTTP Method and Request path prefix.
---
--- > ("*" `rule` "^/issue/", app)
--- > (methodGet `rule` "^/issues$", anotherApp)
-onPrefix :: 
-       Method       -- ^ HTTP Method. Use @\"*\"@ for any method
-    -> ByteString   -- ^ Request path prefix. 
-    -> Request      -- ^ Request 
-    -> Bool         -- ^ Routing rule
-onPrefix method needle = 
-    withMethod method $ (needle `isPrefixOf`) . rawPathInfo
+-----------------------------------------------------------------------------
+-- 'D.Route' helpers for simple paths.
+-----------------------------------------------------------------------------
 
--- | HTTP Method and Request path.
+-- | 'D.Route' helpers for concrete @HTTP@ methods with fixed-length 
+--   simple path.
+sGET, sPOST, sHEAD, sPUT, sDELETE, sTRACE, sCONNECT, sOPTIONS :: 
+       T.Text       -- ^ Path
+    -> Application  -- ^ Routable application 
+    -> D.Route Application
+sGET = sGET' . mkP
+sPOST = sPOST' . mkP
+sHEAD = sHEAD' . mkP
+sPUT = sPUT' . mkP
+sDELETE = sDELETE' . mkP
+sTRACE = sTRACE' . mkP
+sCONNECT = sCONNECT' . mkP
+sOPTIONS = sOPTIONS' . mkP
+
+-- | 'D.Route' helper for any @HTTP@ method with fixed-length simple path.
+sANY :: 
+       T.Text       -- ^ Path
+    -> Application  -- ^ Routable application 
+    -> D.Route Application
+sANY = sRoute D.Dynamic . mkP
+
+-- | 'D.Route' helpers for concrete @HTTP@ methods with vary-length 
+--   simple path.
+mGET, mPOST, mHEAD, mPUT, mDELETE, mTRACE, mCONNECT, mOPTIONS :: 
+       T.Text       -- ^ Path
+    -> Application  -- ^ Routable application 
+    -> D.Route Application
+mGET = mGET' . mkP
+mPOST = mPOST' . mkP
+mHEAD = mHEAD' . mkP
+mPUT = mPUT' . mkP
+mDELETE = mDELETE' . mkP
+mTRACE = mTRACE' . mkP
+mCONNECT = mCONNECT' . mkP
+mOPTIONS = mOPTIONS' . mkP
+
+-- | 'D.Route' helper for any @HTTP@ method with vary-length simple path.
+mANY :: 
+       T.Text       -- ^ Path
+    -> Application  -- ^ Routable application 
+    -> D.Route Application
+mANY = mRoute D.Dynamic . mkP
+
+-----------------------------------------------------------------------------
+-- 'D.Route' helpers for native 'D.Piece' paths (Fixed-length)
+-----------------------------------------------------------------------------
+
+-- | 'D.Route' helpers for concrete @HTTP@ methods with fixed-length native 
+--   @yesod-routes@ path.
+sGET', sPOST', sHEAD', sPUT', sDELETE', sTRACE', sCONNECT', sOPTIONS' :: 
+       [D.Piece]        -- ^ Path
+    -> Application      -- ^ Routable application
+    -> D.Route Application
+sGET' = sRoute (D.Static "GET")
+sPOST' = sRoute (D.Static "POST")
+sHEAD' = sRoute (D.Static "HEAD")
+sPUT' = sRoute (D.Static "PUT")
+sDELETE' = sRoute (D.Static "DELETE")
+sTRACE' = sRoute (D.Static "TRACE")
+sCONNECT' = sRoute (D.Static "CONNECT")
+sOPTIONS' = sRoute (D.Static "OPTIONS")
+
+-- | 'D.Route' helper for any @HTTP@ method with fixed-length native 
+--   @yesod-routes@ path.
+sANY' :: 
+       [D.Piece]        -- ^ Path
+    -> Application      -- ^ Routable application
+    -> D.Route Application
+sANY' = sRoute D.Dynamic
+
+-- | Generalized 'D.Route' helper for fixed-length native 
+--   @yesod-routes@ path.
+sRoute ::  
+       D.Piece      -- ^ Method piece. 'D.Dynamic' means any method. 
+    -> [D.Piece]    -- ^ Path pieces
+    -> Application  -- ^ Routed application
+    -> D.Route Application
+sRoute = (`defRoute` False)
+
+-----------------------------------------------------------------------------
+-- Generalized 'D.Route' helpers for native 'D.Piece' paths
+-----------------------------------------------------------------------------
+
+-- | 'D.Route' helpers for concrete @HTTP@ methods with vary-length native 
+--   @yesod-routes@ path.
+mGET', mPOST', mHEAD', mPUT', mDELETE', mTRACE', mCONNECT', mOPTIONS' :: 
+       [D.Piece]        -- ^ Path
+    -> Application      -- ^ Routable application
+    -> D.Route Application
+mGET' = mRoute (D.Static "GET")
+mPOST' = mRoute (D.Static "POST")
+mHEAD' = mRoute (D.Static "HEAD")
+mPUT' = mRoute (D.Static "PUT")
+mDELETE' = mRoute (D.Static "DELETE")
+mTRACE' = mRoute (D.Static "TRACE")
+mCONNECT' = mRoute (D.Static "CONNECT")
+mOPTIONS' = mRoute (D.Static "OPTIONS")
+
+-- | 'D.Route' helper for any @HTTP@ method with fixed-length native 
+--   @yesod-routes@ path.
+mANY' :: 
+       [D.Piece]        -- ^ Path
+    -> Application      -- ^ Routable application
+    -> D.Route Application
+mANY' = sRoute D.Dynamic
+
+-- | Generalized 'D.Route' helper for vary-length native 
+--   @yesod-routes@ path.
+mRoute ::  
+       D.Piece      -- ^ Method piece. 'D.Dynamic' means any method. 
+    -> [D.Piece]    -- ^ Path pieces
+    -> Application  -- ^ Routed application
+    -> D.Route Application
+mRoute = (`defRoute` True)
+
+-----------------------------------------------------------------------------
+-- 'D.Piece' helpers
+-----------------------------------------------------------------------------
+
+-- | Make 'D.Piece's from 'T.Text'. Splits path on slashes. Dual slashes means
+--   'D.Dynamic' 'D.Piece's.
 --
--- > ("*" `rule` "^/issue/", app)
--- > (methodGet `rule` "^/issues$", anotherApp)
-onExact :: 
-       Method       -- ^ HTTP Method. Use @\"*\"@ for any method
-    -> ByteString   -- ^ Request path. 
-    -> Request      -- ^ Request 
-    -> Bool         -- ^ Routing rule
-onExact method needle = 
-    withMethod method $ (needle ==) . rawPathInfo
+-- > mkP ""             -- []
+-- > mkP "foo/bar"      -- [Static "foo", Static "bar"]
+-- > mkP "foo//bar/"    -- [Static "foo", Dynamic, Static "bar", Dynamic]
+mkP :: T.Text -> [D.Piece]
+mkP = 
+    map chunk . T.split (=='/')
+  where
+    chunk "" = D.Dynamic
+    chunk c = D.Static c
 
-withMethod :: 
-       Method
-    -> (Request -> Bool) 
-    -> Request 
-    -> Bool
-withMethod "*" p = p
-withMethod m p = (&&) <$> (== m) . requestMethod <*> p
+-------------------------------------------------------------------------------
+---- Internal
+-------------------------------------------------------------------------------
+
+defRoute :: 
+       D.Piece      -- ^ Method piece. 'D.Dynamic' means any method. 
+    -> Bool         -- ^ 'D.rhHasMulti'
+    -> [D.Piece]    -- ^ Path pieces
+    -> Application  -- ^ Routed application
+    -> D.Route Application
+defRoute m hasMulti pieces = 
+    D.Route (m:pieces) hasMulti . const . Just 
+

@@ -1,29 +1,31 @@ name:           wai-middleware-route
-version:        0.3.1
+version:        0.4.0
 cabal-version:  >= 1.8
 build-type:     Simple
-synopsis:       Wai routing middleware
+synopsis:       Wai dispatch middleware
 stability:      Experimental
-author:         Alexander Dorofeev
+author:         Alexander Dorofeev <aka.spin@gmail.com>
+maintainer:     Alexander Dorofeev <aka.spin@gmail.com>
 category:       Web
 license:        BSD3
-description:    \"Just enough\" request dispatching Middleware for Wai.
-maintainer:     aka.spin@gmail.com
+description:    \"Just enough\" helpers for use @yesod-routes@ with @WAI@.
 license-file:   LICENSE
 homepage:       https://github.com/akaspin/wai-middleware-route
 
 Source-repository head
-  type:            git
-  location:        git://github.com/akaspin/wai-middleware-route.git
+  type:      git
+  location:  git://github.com/akaspin/wai-middleware-route.git
 
 library
-  hs-source-dirs:  src
-  build-depends:   
+  hs-source-dirs:   src
+  build-depends:    
                    base >= 4 && < 5,
-                   wai >= 1.1,
                    bytestring >= 0.9 && < 0.10,
-                   regex-posix >= 0.94.4,
-                   http-types >= 0.6 && < 0.7
-  ghc-options:     -Wall -rtsopts
-  exposed-modules: Network.Wai.Middleware.Route
+                   http-types >= 0.6 && < 0.7,
+                   text,
+                   wai >= 1.2,
+                   yesod-routes
+  ghc-options:      -Wall -rtsopts
+  exposed-modules:  Network.Wai.Middleware.Route
+