wai-middleware-route 0.4.0 → 0.5.0

raw patch · 2 files changed

+142/−192 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Network/Wai/Middleware/Route.hs +141/−191
• wai-middleware-route.cabal +1/−1

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns #-}
 
 -- | This module contains helpers for use "Yesod.Routes.Dispatch" with 
 --   "Network.Wai".
@@ -7,32 +8,14 @@ --   'D.Static' means concrete method. 'D.Dynamic' means any method.
 
 module Network.Wai.Middleware.Route (
-
-    -- * 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, 
+    -- * Routing rules
+    Rule(..),
+    mkRoutes,
+    mkRoutes',
+    mkRoute,
     
-    -- ** 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
+    -- * Middleware
+    dispatch
 ) where
 
 import Control.Applicative ((<$>), (<*>))
@@ -43,17 +26,137 @@ import Network.Wai (Application, requestMethod, pathInfo)
 import qualified Yesod.Routes.Dispatch as D
 
------------------------------------------------------------------------------
--- Docs chunks
------------------------------------------------------------------------------
+-- | Rule for route. Rules without single quotes (@'@) means fixed length
+--   paths. And vice versa, rules with single quotes (@'@) means paths with
+--   variable lengh 
+--
+--   Paths converts to 'D.Piece's by following rules:
+--   
+--   * Paths splits by slashes (@/@).
+--   
+--   * Text between slashes becomes 'D.Static' 'D.Piece'. The same thing 
+--     happens with the text at the ends of paths.
+--
+--   * Double (triple, etc.) slashes means becomes 'D.Dynamic' 'D.Piece's. 
+--     The same thing happens with the slashes at the ends of paths.
+--
+-- > "foo"
+-- > [Static "foo"]
+-- > 
+-- > "foo/bar"
+-- > [Static "foo", Static "bar"]
+-- > 
+-- > "foo//bar"
+-- > [Static "foo", Dynamic, Static "bar"]
+-- > 
+-- > "/foo//bar/baz/"
+-- > [Dynamic, Static "foo", Dynamic, Static "bar", Static "baz", Dynamic]
+-- > 
 
--- $route_helpers
--- Functions below simplify process of creating 'D.Route's. Each helper 
--- prepends corresponding @HTTP@ method to path.
+data Rule = 
+    Get T.Text Application
+        -- ^ @GET@,  fixed length path
+  | Post T.Text Application
+        -- ^ @POST@, fixed length path
+  | Head T.Text Application
+        -- ^ @HEAD@, fixed length path
+  | Put T.Text Application
+        -- ^ @PUT@, fixed length path
+  | Delete T.Text Application
+        -- ^ @DELETE@, fixed length path
+  | Trace T.Text Application
+        -- ^ @TRACE@, fixed length path
+  | Connect T.Text Application
+        -- ^ @CONNECT@, fixed length path
+  | Options T.Text Application
+        -- ^ @OPTIONS@, fixed length path
+  | Any T.Text Application
+        -- ^ Any @HTTP@ method, fixed length path
+  | Get' T.Text Application
+        -- ^ @GET@, variable length path
+  | Post' T.Text Application
+        -- ^ @POST@, variable length path
+  | Head' T.Text Application
+        -- ^ @HEAD@, variable length path
+  | Put' T.Text Application
+        -- ^ @PUT@, variable length path
+  | Delete' T.Text Application
+        -- ^ @DELETE@, variable length path
+  | Trace' T.Text Application
+        -- ^ @TRACE@, variable length path
+  | Connect' T.Text Application
+        -- ^ @CONNECT@, variable length path
+  | Options' T.Text Application
+        -- ^ @OPTIONS@, variable length path
+  | Any' T.Text Application
+        -- ^ Any @HTTP@ method, variable length path
+  | Gen Bool T.Text T.Text Application
+        -- ^ Generic rule with path lenghts flag, @HTTP@ method and path
 
--- $simple_paths
--- All functions below is combinations of native path helpers and 'mkP'.
+-- | Make 'D.Route's from 'Rules'. 
+--   
+--   Equivalent @map mkRoute@ 
+mkRoutes :: 
+       [Rule]
+            -- ^ Routing rules 
+    -> [D.Route Application]
+mkRoutes = map mkRoute
+{-# INLINE mkRoutes #-} 
 
+-- | Make 'D.Dispatch's from 'Rules'. 
+--   
+--   Equivalent @toDispatch . mkRoutes@ 
+mkRoutes' :: [Rule] -> D.Dispatch Application
+mkRoutes' = D.toDispatch . mkRoutes
+
+-- | Make 'D.Route' from 'Rule'. 'D.rhPieces' of 'D.Route' will be
+--   prepended with 'D.Piece' with corresponding @HTTP@ method. 
+--   'D.Static' means concrete method. 'D.Dynamic' means any method.
+--
+-- > mkRoute $ Get "foo/bar" app
+-- > Route [Static "foo", Static "bar"] False (const $ Just app) 
+mkRoute :: Rule -> D.Route Application
+mkRoute (Get p a) = mkGenRoute (D.Static "GET") False p a
+mkRoute (Post p a) = mkGenRoute (D.Static "POST") False p a
+mkRoute (Head p a) = mkGenRoute (D.Static "HEAD") False p a
+mkRoute (Put p a) = mkGenRoute (D.Static "PUT") False p a
+mkRoute (Delete p a) = mkGenRoute (D.Static "DELETE") False p a
+mkRoute (Trace p a) = mkGenRoute (D.Static "TRACE") False p a
+mkRoute (Connect p a) = mkGenRoute (D.Static "CONNECT") False p a
+mkRoute (Options p a) = mkGenRoute (D.Static "OPTIONS") False p a
+mkRoute (Any p a) = mkGenRoute D.Dynamic False p a
+mkRoute (Get' p a) = mkGenRoute (D.Static "GET") True p a
+mkRoute (Post' p a) = mkGenRoute (D.Static "POST") True p a
+mkRoute (Head' p a) = mkGenRoute (D.Static "HEAD") True p a
+mkRoute (Put' p a) = mkGenRoute (D.Static "PUT") True p a
+mkRoute (Delete' p a) = mkGenRoute (D.Static "DELETE") True p a
+mkRoute (Trace' p a) = mkGenRoute (D.Static "TRACE") True p a
+mkRoute (Connect' p a) = mkGenRoute (D.Static "CONNECT") True p a
+mkRoute (Options' p a) = mkGenRoute (D.Static "OPTIONS") True p a
+mkRoute (Any' p a) = mkGenRoute D.Dynamic True p a
+mkRoute (Gen v m p a) = mkGenRoute (D.Static m) v p a
+{-# INLINE mkRoute #-} 
+
+-- | Make generic route
+mkGenRoute :: 
+       D.Piece      -- ^ Method piece. 'D.Dynamic' means any method. 
+    -> Bool         -- ^ 'D.rhHasMulti'
+    -> T.Text         -- ^ Path pieces
+    -> Application  -- ^ Routed application
+    -> D.Route Application
+mkGenRoute m hasMulti pieces = 
+    D.Route (m:mkPieces pieces) hasMulti . const . Just 
+{-# INLINE mkGenRoute #-}
+
+-- | Make Pieces from path
+mkPieces :: T.Text -> [D.Piece]
+mkPieces = 
+    map chunk . T.split (=='/')
+  where
+    chunk "" = D.Dynamic
+    chunk c = D.Static c
+{-# INLINE mkPieces #-}
+
 -----------------------------------------------------------------------------
 -- Middleware.
 -----------------------------------------------------------------------------
@@ -61,17 +164,12 @@ -- | Dispatch function.
 -- 
 -- > rs :: Dispatch Application
--- > rs = toDispatch [
--- >      -- simple paths 
--- >      sGET  "foo"  fooGetApp
--- >    , sPOST "foo"  fooPostApp
--- >    , sGET  "foo/" fooGetDynApp
+-- > rs = toDispatch . mkRoutes [
+-- >      Get  "foo"  fooGetApp
+-- >    , Post "foo"  fooPostApp
+-- >    , Get "foo//bar" fooDynBarApp
 -- > 
--- >      -- native paths
--- >    , sGET'  [Static "bar", Dynamic] barGetDynApp
--- >
--- >      -- simple paths, any method 
--- >    , sANY  "any"  anyMethodApp
+-- >    , Any  "any"  anyMethodApp
 -- >    ]
 -- > 
 -- > app :: Application
@@ -91,153 +189,5 @@   where
     needle = (:) <$> decodeUtf8 . requestMethod <*> pathInfo
 
------------------------------------------------------------------------------
--- 'D.Route' helpers for simple paths.
------------------------------------------------------------------------------
 
--- | '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.
---
--- > 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
-
--------------------------------------------------------------------------------
----- 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,5 +1,5 @@ name:           wai-middleware-route
-version:        0.4.0
+version:        0.5.0
 cabal-version:  >= 1.8
 build-type:     Simple
 synopsis:       Wai dispatch middleware