wai-middleware-route 0.5.1 → 0.6.0

raw patch · 3 files changed

+122/−82 lines, 3 filesdep +wai-middleware-routedep +wai-testdep ~http-typesdep ~waiPVP ok

version bump matches the API change (PVP)

Dependencies added: wai-middleware-route, wai-test

Dependency ranges changed: http-types, wai

API changes (from Hackage documentation)

Files

• src/Network/Wai/Middleware/Route.hs +54/−77
• test/Main.hs +61/−2
• wai-middleware-route.cabal +7/−3

@@ -37,61 +37,35 @@ --   * 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.
+--   * Hashes (@#@) inside slashes becomes 'D.Dynamic' 'D.Piece's.
 --
+--   * To make route with variable length just add asterisk (@\*@) after last
+--     slash.
+--
 -- > "foo"
--- > [Static "foo"]
+-- > [Static "foo"] Fixed
 -- > 
 -- > "foo/bar"
--- > [Static "foo", Static "bar"]
--- > 
--- > "foo//bar"
--- > [Static "foo", Dynamic, Static "bar"]
+-- > [Static "foo", Static "bar"] Fixed
 -- > 
--- > "/foo//bar/baz/"
--- > [Dynamic, Static "foo", Dynamic, Static "bar", Static "baz", Dynamic]
+-- > "foo/#/bar"
+-- > [Static "foo", Dynamic, Static "bar"] Fixed
 -- > 
+-- > "foo/#/bar/baz/*"
+-- > [Dynamic, Static "foo", Dynamic, Static "bar", Static "baz"] Variable
 
 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
+    Get T.Text Application          -- ^ @GET@ method
+  | Post T.Text Application         -- ^ @POST@ method
+  | Head T.Text Application         -- ^ @HEAD@ method
+  | Put T.Text Application          -- ^ @PUT@ method
+  | Delete T.Text Application       -- ^ @DELETE@ method
+  | Trace T.Text Application        -- ^ @TRACE@ method
+  | Connect T.Text Application      -- ^ @CONNECT@ method
+  | Options T.Text Application      -- ^ @OPTIONS@ method
+  | Any T.Text Application          -- ^ Any @HTTP@ method
+  | Gen T.Text T.Text Application
+        -- ^ Generic rule with @HTTP@ method and path
 
 -- | Make 'D.Route's from 'Rules'. 
 --   
@@ -116,48 +90,51 @@ -- > 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
+mkRoute (Get p a) = mkGenRoute (D.Static "GET") p a
+mkRoute (Post p a) = mkGenRoute (D.Static "POST") p a
+mkRoute (Head p a) = mkGenRoute (D.Static "HEAD") p a
+mkRoute (Put p a) = mkGenRoute (D.Static "PUT") p a
+mkRoute (Delete p a) = mkGenRoute (D.Static "DELETE") p a
+mkRoute (Trace p a) = mkGenRoute (D.Static "TRACE") p a
+mkRoute (Connect p a) = mkGenRoute (D.Static "CONNECT") p a
+mkRoute (Options p a) = mkGenRoute (D.Static "OPTIONS") p a
+mkRoute (Any p a) = mkGenRoute D.Dynamic p a
+mkRoute (Gen m p a) = mkGenRoute (D.Static m) 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 
+mkGenRoute m path =
+    let (!pieces, !hasMulti) = mkPieces path in
+    D.Route (m:pieces) hasMulti . const . Just 
 {-# INLINE mkGenRoute #-}
 
--- | Make Pieces from path
-mkPieces :: T.Text -> [D.Piece]
-mkPieces = 
-    map chunk . protPath . T.split (=='/')
+-- | Parse 'T.Text' and make tuple with 'D.Piece's and 'D.hasMulti'. 
+--   
+-- > ""         -- ([], False)
+-- > "*"        -- ([], True)
+-- > "foo/#"    -- ([Static "foo", Dynamic], False)  
+-- > "foo/#/*"  -- ([Static "foo", Dynamic], True)  
+mkPieces :: 
+       T.Text               -- ^ Path to parse 
+    -> ([D.Piece], Bool)    -- ^ list of 'D.Piece's and 'D.hasMulti'
+mkPieces "" = ([], False) 
+mkPieces !t = 
+    if T.last t == '*' 
+        then (prep . T.init $ t, True)
+        else (prep t, False)
   where
-    protPath [""] = []
-    protPath p = p
-    chunk "" = D.Dynamic
+    prep = map chunk . filter (/="") . T.split (=='/')
+    {-# INLINE prep #-} 
+    -- | Convert chunk
+    chunk "#" = D.Dynamic
     chunk c = D.Static c
-{-# INLINE mkPieces #-}
+    {-# INLINE chunk #-} 
+{-# INLINE mkPieces #-} 
 
 -----------------------------------------------------------------------------
 -- Middleware.

@@ -6,11 +6,20 @@ import Test.Framework.Providers.HUnit (testCase)
 import Test.HUnit (Assertion, (@=?))
 
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL 
 import qualified Data.Text as T 
 
+import Network.Wai (Application, responseLBS, Request(..))
+import Network.Wai.Test
+import qualified Network.HTTP.Types as H
+
+import Network.Wai.Middleware.Route
+
 main :: IO ()
 main = defaultMain [
-        testCase "Split Text" caseSplitText
+      testCase "Split Text" caseSplitText
+    , testCase "Route"      caseRoute
     ]
 
 caseSplitText :: Assertion
@@ -20,4 +29,54 @@     ["", "a"] @=? sp "/a"
     ["", "a", "", "b", ""] @=? sp "/a//b/"
   where
-    sp = T.split (=='/')+    sp = T.split (=='/')
+
+caseRoute :: Assertion
+caseRoute = flip runSession routedApp $ do
+    -- unhappy, setRawPathInfo has error. it producing 'pathInfo' as @[\"\"]@
+    rRoot <- request defaultRequest
+    assertBody "" rRoot
+
+    testOne "foo"                   "foo"
+    testOne "foo/bar"               "foo/bar"
+    testOne "foo/baz"               "foo/#"
+    testOne "foo/bar/baz"           "#/#/#"
+    testOne "foo/bar/bast"          "#/#/bast"
+    testOne "last/bar/baz"          "#/#/#"
+    testOne "will/never/be/routed"  "noroute"
+    
+    -- test @POST@
+    rPost <- request $ setRawPathInfo 
+            defaultRequest {requestMethod="POST"} "foo/bar" 
+    assertBody "post foo/bar" rPost
+  where
+    testOne url answer = do
+        resp <- mkRequest url
+        assertStatus 200 resp
+        assertBody answer resp
+
+-- | Routed application
+routedApp :: Application
+routedApp = 
+    dispatch mappings $ testApp "noroute"
+  where
+    mappings = mkRoutes' [
+          Get ""            $ testApp ""
+        , Get "foo"         $ testApp "foo"
+        , Get "foo/bar"     $ testApp "foo/bar"
+        , Get "foo/#"       $ testApp "foo/#"
+        , Get "#/#/bast"    $ testApp "#/#/bast"
+        , Get "#/#/#"       $ testApp "#/#/#"
+        , Get "last/*"      $ testApp "#/*"
+        , Post "foo/bar"      $ testApp "post foo/bar"
+        ]
+
+-- | Simple test application
+testApp :: BL.ByteString -> Application
+testApp answer _req = 
+    return $ responseLBS H.ok200 [] answer
+
+-- | Default request
+mkRequest :: B.ByteString -> Session SResponse
+mkRequest = request . setRawPathInfo defaultRequest 
+

@@ -1,5 +1,5 @@ name:           wai-middleware-route
-version:        0.5.1
+version:        0.6.0
 cabal-version:  >= 1.8
 build-type:     Simple
 synopsis:       Wai dispatch middleware
@@ -37,8 +37,12 @@                    test-framework >= 0.4.1,
                    test-framework-quickcheck2,
                    test-framework-hunit,
-
-                   text
+                   bytestring >= 0.9 && < 0.10,
+                   http-types,
+                   text,
+                   wai,
+                   wai-test,
+                   wai-middleware-route
   ghc-options:     -Wall -rtsopts
   hs-source-dirs:  test
   main-is:         Main.hs