reroute 0.2.0.0 → 0.2.0.1

raw patch · 8 files changed

+283/−197 lines, 8 filesdep +criteriondep +randomdep +reroutedep ~basedep ~deepseqdep ~graph-corePVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: criterion, random, reroute

Dependency ranges changed: base, deepseq, graph-core, hashable, mtl, path-pieces, regex-compat, text, unordered-containers, vector

API changes (from Hackage documentation)

Files

• benchmarks/Benchmarks.hs +75/−0
• reroute.cabal +31/−8
• src/Web/Routing/Specs/Main.hs +0/−10
• src/Web/Routing/Specs/SafeRoutingSpec.hs +0/−98
• src/Web/Routing/Specs/TextRoutingSpec.hs +0/−81
• test/Spec.hs +1/−0
• test/Web/Routing/SafeRoutingSpec.hs +95/−0
• test/Web/Routing/TextRoutingSpec.hs +81/−0

@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++module Main where++import Web.Routing.TextRouting+import Web.Routing.SafeRouting++import Criterion.Main+import qualified Data.Text as T+import Data.List (permutations, foldl')+import System.Random (mkStdGen, randomRs)+import Data.Maybe (listToMaybe, fromMaybe)+import Data.Monoid (Monoid (..))+++buildRoutingTree :: [([T.Text], a)] -> RoutingTree a+buildRoutingTree =+  foldl' (\t (route, val) -> addToRoutingTree (joinSegs route) val t)+         emptyRoutingTree+  where joinSegs = T.intercalate "/"++lookupRoutingTreeM :: [[T.Text]] -> RoutingTree Int -> Int+lookupRoutingTreeM routes tree =+  foldl' (\z route -> maybe z snd (listToMaybe $ matchRoute' route tree)) 0 routes++buildPath :: [T.Text] -> Path '[]+buildPath = static . T.unpack . T.intercalate "/"++buildPathMap :: [([T.Text], a)] -> PathMap a+buildPathMap =+  foldl' (\t (route, val) -> insertPathMap' (buildPath route) (const val) t) mempty++lookupPathMapM :: [[T.Text]] -> PathMap Int -> Int+lookupPathMapM rs m =+  foldl' (\z route -> fromMaybe z (listToMaybe $ match m route)) 0 rs++benchmarks :: [Benchmark]+benchmarks =+  [ env setupTextMap $ \ ~(routingTree, routes') ->+    bgroup "TextRouting"+    [ bench "static-lookup" $ whnf (lookupRoutingTreeM routes') routingTree+    ]+  , env setupSafeMap $ \ ~(safeMap, routes') ->+    bgroup "SafeRouting"+    [ bench "static-lookup" $ whnf (lookupPathMapM routes') safeMap+    ]+  ]+  where+    strlen = 10+    seglen = 5+    num = 10+    routes = rndRoutes strlen seglen num+    routesList = zip routes [1..]+    setupTextMap = return (buildRoutingTree routesList, routes)+    setupSafeMap = return (buildPathMap routesList, routes)++main :: IO ()+main = defaultMain benchmarks++chunks :: Int -> [a] -> [[a]]+chunks n xs =+  let (ys, xs') = splitAt n xs+  in ys : chunks n xs'++-- | Generate a number of paths consisting of a fixed number of fixed length+-- strings ("path segments") where the content of the segments are letters in+-- random order. Contains all permutations with the path.+rndRoutes ::+     Int -- ^ Length of each string+  -> Int -- ^ Number of segments+  -> Int -- ^ Number of routes+  -> [[T.Text]]+rndRoutes strlen seglen num =+  take num $ concatMap permutations $ chunks seglen $ map T.pack $+    chunks strlen $ randomRs ('a', 'z') $ mkStdGen 1234

@@ -1,5 +1,5 @@ name:                reroute-version:             0.2.0.0+version:             0.2.0.1 synopsis:            abstract implementation of typed and untyped web routing description:         abstraction over how urls with/without parameters are mapped to their corresponding handlers homepage:            http://github.com/agrafix/reroute@@ -13,8 +13,11 @@ cabal-version:       >=1.10  library-  exposed-modules:     Data.HVect, Web.Routing.AbstractRouter, Web.Routing.SafeRouting, Web.Routing.TextRouting-  other-modules:       Data.PolyMap+  exposed-modules:     Data.HVect,+                       Data.PolyMap,+                       Web.Routing.AbstractRouter,+                       Web.Routing.SafeRouting,+                       Web.Routing.TextRouting   build-depends:       base >=4.6 && <4.8,                        transformers >=0.3 && <0.5,                        text >= 0.11.3.1 && <1.3,@@ -23,7 +26,6 @@                        hashable >=1.2 && <1.3,                        mtl >=2.1 && <2.3,                        path-pieces >=0.1 && <0.2,-                       hspec2 >=0.4 && <0.5,                        vector >=0.10 && <0.11,                        deepseq >= 1.1.0.2 && < 1.4,                        graph-core >=0.2 && <0.3@@ -31,12 +33,13 @@   default-language:    Haskell2010  -test-suite reroutetest+test-suite reroute-test   type:                exitcode-stdio-1.0-  hs-source-dirs:      src-  main-is:             Web/Routing/Specs/Main.hs-  other-modules:       Web.Routing.Specs.SafeRoutingSpec, Web.Routing.Specs.TextRoutingSpec+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Web.Routing.SafeRoutingSpec, Web.Routing.TextRoutingSpec   build-depends:       base >=4.6 && <4.8,+                       reroute,                        transformers >=0.3 && <0.5,                        text >= 0.11.3.1 && <1.3,                        unordered-containers ==0.2.*,@@ -50,6 +53,26 @@                        graph-core >=0.2 && <0.3   default-language:    Haskell2010   ghc-options: -Wall -fno-warn-orphans++benchmark reroute-benchmarks+  type:             exitcode-stdio-1.0+  ghc-options:      -Wall -O2+  hs-source-dirs:   src benchmarks+  default-language: Haskell2010+  main-is:          Benchmarks.hs+  build-depends:+    base,+    criterion,+    text,+    mtl,+    unordered-containers,+    vector,+    hashable,+    regex-compat,+    random,+    deepseq,+    path-pieces,+    graph-core  source-repository head   type:     git

@@ -1,10 +0,0 @@-import qualified Web.Routing.Specs.TextRoutingSpec-import qualified Web.Routing.Specs.SafeRoutingSpec--import Test.Hspec--main :: IO ()-main =-    hspec $-    do Web.Routing.Specs.TextRoutingSpec.spec-       Web.Routing.Specs.SafeRoutingSpec.spec

@@ -1,98 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverloadedStrings #-}-#if MIN_VERSION_base(4,7,0)-{-# LANGUAGE AllowAmbiguousTypes #-}-#endif-module Web.Routing.Specs.SafeRoutingSpec where--import Test.Hspec-import Data.HVect--import Control.Monad.Identity-import Web.Routing.SafeRouting-import Web.Routing.AbstractRouter-import Data.Monoid (mconcat)-import Control.Applicative (Applicative (..))-import qualified Data.Text as T--data ReturnVar-   = IntVar Int-   | StrVar T.Text-   | BoolVar Bool-   | ListVar [ReturnVar]-   deriving (Show, Eq, Read)--defR :: (Monad m, HVectElim ts (m ReturnVar) ~ HVectElim ts x) => Path ts -> HVectElim ts x -> RegistryT (SafeRouter m ReturnVar) middleware Bool m ()-defR path action = hookRoute True (SafeRouterPath path) (HVectElim' action)---spec :: Spec-spec =-    describe "SafeRouting Spec" $-    do it "should match known routes" $-          do checkRoute "" [StrVar "root"]-             checkRoute "/bar" [StrVar "bar"]-       it "shoudn't match unknown routes" $-          do checkRoute "/random" []-             checkRoute "/baz" []-       it "should capture variables in routes" $-          do checkRoute "/bar/23/baz" [IntVar 23]-             checkRoute "/bar/23/baz/100" [ListVar [IntVar 23, IntVar 100]]-             checkRoute "/bar/23/100" [ListVar [IntVar 23, IntVar 100]]-             checkRoute "/entry/344/2014-20-14T12:23" [ListVar [IntVar 344, StrVar "2014-20-14T12:23"]]-             checkRoute "/entry/bytags/344/2014-20-14T12:23" [ListVar [IntVar 344, StrVar "2014-20-14T12:23"]]-             checkRoute "/entry/2/rel/3"  [ListVar [IntVar 2, IntVar 3]]-       it "should handle multiple possible matches correctly" $-          do checkRoute "/bar/5" [IntVar 5, StrVar "5"]-             checkRoute "/bar/bingo" [StrVar "bar/bingo", StrVar "bingo"]-             checkRoute "/entry/1/audit" [IntVar 1,ListVar [IntVar 1,StrVar "audit"]]-       it "should provide an Applicative interface" $-          do let numbers =-                   mconcat-                   [ singleton var id-                   , singleton ("forty" </> "two") (42 :: Int)-                   ]-                 operators =-                   mconcat-                   [ singleton "plus" ((+) :: Int -> Int -> Int)-                   , singleton "mult" (*)-                   ]-                 routes = operators <*> numbers <*> numbers-                 check path val = match routes (pieces path) `shouldBe` [val]-             check "/plus/forty/two/forty/two" (42+42)-             check "/mult/forty/two/3" (42*3)-             check "/plus/5/89" 94-    where-      pieces :: T.Text -> [T.Text]-      pieces = filter (not . T.null) . T.splitOn "/"-      -      checkRoute :: T.Text -> [ReturnVar] -> Expectation-      checkRoute r x =-          let matches = handleFun (pieces r)-          in (map (runIdentity . snd) matches) `shouldBe` x--      handleFun :: [T.Text] -> [(ParamMap, Identity ReturnVar)]-      handleFun = handleFun' True-      (_, handleFun', _) =-          runIdentity (runRegistry SafeRouter handleDefs)--      handleDefs =-          do defR root $ return (StrVar "root")-             defR "bar" $ return (StrVar "bar")-             defR ("bar" </> var) (return . IntVar)-             defR ("bar" </> var </> "baz") (return . IntVar)-             defR ("bar" </> var </> "baz" </> var) $ \i i2 ->-                 return (ListVar [IntVar i, IntVar i2])-             defR ("bar" </> var </> var) $ \i i2 ->-                 return (ListVar [IntVar i, IntVar i2])-             defR ("entry" </> var </> var) $ \i st ->-                 return (ListVar [IntVar i, StrVar st])-             defR ("entry/bytags" </> var </> var) $ \i st ->-                 return (ListVar [IntVar i, StrVar st])-             defR ("entry" </> var </> "rel" </> var) $ \i i2 ->-                 return (ListVar [IntVar i, IntVar i2])-             defR ("bar" </> "bingo") $ return (StrVar "bar/bingo")-             defR ("bar" </> var) $ (return . StrVar . T.pack)-             defR ("entry" </> var </> "audit") (return . IntVar)

@@ -1,81 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Web.Routing.Specs.TextRoutingSpec (spec) where--import Test.Hspec--import Web.Routing.TextRouting-import qualified Web.Routing.AbstractRouter as R-import qualified Data.HashMap.Strict as HM--spec :: Spec-spec =-    do matchNodeDesc-       matchRouteDesc-       parseRouteNodeDesc--matchNodeDesc :: Spec-matchNodeDesc =-    describe "matchNode" $-    do it "shouldn't match to root node" $-          matchNode "foo" RouteNodeRoot `shouldBe` (False, Nothing)-       it "should capture basic variables" $-          matchNode "123" (RouteNodeCapture (R.CaptureVar "x")) `shouldBe` (True, Just (R.CaptureVar "x", "123"))-       it "should work with regex" $-          matchNode "123" (RouteNodeRegex (R.CaptureVar "x") (buildRegex "^[0-9]+$")) `shouldBe` (True, Just (R.CaptureVar "x", "123"))--matchRouteDesc :: Spec-matchRouteDesc =-    describe "matchRoute" $-    do it "shouldn't match unknown routes" $-          do matchRoute "random" routingTree `shouldBe` noMatches-             matchRoute "/baz" routingTree `shouldBe` noMatches-       it "should match known routes" $-          do matchRoute "/" routingTree `shouldBe` oneMatch emptyParamMap [1]-             matchRoute "/bar" routingTree `shouldBe` oneMatch emptyParamMap [2]-       it "should capture variables in routes" $-          do matchRoute "/bar/5" routingTree `shouldBe` oneMatch (vMap [("baz", "5")]) [3]-             matchRoute "/bar/23/baz" routingTree `shouldBe` oneMatch (vMap [("baz", "23")]) [4]-             matchRoute "/bar/23/baz/100" routingTree `shouldBe` oneMatch (vMap [("baz", "23"), ("bim", "100")]) [4]-             matchRoute "/ba/23/100" routingTree `shouldBe` oneMatch (vMap [("baz", "23"), ("bim", "100")]) [4]-             matchRoute "/entry/344/2014-20-14T12:23" routingTree `shouldBe` oneMatch (vMap [("cid", "344"), ("since", "2014-20-14T12:23")]) [6]-             matchRoute "/entry/bytags/344/2014-20-14T12:23" routingTree `shouldBe` oneMatch (vMap [("cid", "344"), ("since", "2014-20-14T12:23")]) [7]-             matchRoute "/entry/2/rel/3" routingTree `shouldBe` oneMatch (vMap [("eid", "2"), ("cid", "3")]) [9]-       it "should handle multiple possibile matches correctly" $-          do matchRoute "/bar/bingo" routingTree `shouldBe` multiMatch-             matchRoute "/entry/1/audit" routingTree `shouldBe` multiMatch'-    where-      vMap kv =-          HM.fromList $ map (\(k, v) -> (R.CaptureVar k, v)) kv-      multiMatch =-          ((oneMatch emptyParamMap [5])-            ++ oneMatch (vMap [("baz", "bingo")]) [3])-      multiMatch' =-          ((oneMatch (vMap [("eid", "1")]) [8])-           ++ (oneMatch (vMap [("since", "audit"), ("cid", "1")]) [6]))-      noMatches = []-      oneMatch pm m = [(pm, m)]-      routingTree =-          foldl (\tree (route, action) -> addToRoutingTree route action tree) emptyRoutingTree routes-      routes =-          [ ("/", [1])-          , ("/bar", [2 :: Int])-          , ("/bar/:baz", [3])-          , ("/bar/bingo", [5])-          , ("/bar/:baz/baz", [4])-          , ("/bar/:baz/baz/:bim", [4])-          , ("/ba/:baz/:bim", [4])-          , ("/entry/:cid/:since", [6])-          , ("/entry/bytags/:cid/:since", [7])-          , ("/entry/:eid/audit", [8])-          , ("/entry/:eid/rel/:cid", [9])-          ]--parseRouteNodeDesc :: Spec-parseRouteNodeDesc =-    describe "parseRouteNode" $-    do it "parses text nodes correctly" $-          parseRouteNode "foo" `shouldBe` RouteNodeText "foo"-       it "parses capture variables" $-          parseRouteNode ":bar" `shouldBe` RouteNodeCapture (R.CaptureVar "bar")-       it "parses regex capture variables" $-          parseRouteNode "{bar:^[0-9]$}" `shouldBe` RouteNodeRegex (R.CaptureVar "bar") (buildRegex "^[0-9]$")

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,95 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+module Web.Routing.SafeRoutingSpec where++import Test.Hspec+import Data.HVect++import Control.Monad.Identity+import Web.Routing.SafeRouting+import Web.Routing.AbstractRouter+import Data.Monoid (mconcat)+import Control.Applicative (Applicative (..))+import qualified Data.Text as T++data ReturnVar+   = IntVar Int+   | StrVar T.Text+   | BoolVar Bool+   | ListVar [ReturnVar]+   deriving (Show, Eq, Read)++defR :: (Monad m, m ReturnVar ~ x) => Path ts -> HVectElim ts x -> RegistryT (SafeRouter m ReturnVar) middleware Bool m ()+defR path action = hookRoute True (SafeRouterPath path) (HVectElim' action)+++spec :: Spec+spec =+    describe "SafeRouting Spec" $+    do it "should match known routes" $+          do checkRoute "" [StrVar "root"]+             checkRoute "/bar" [StrVar "bar"]+       it "shoudn't match unknown routes" $+          do checkRoute "/random" []+             checkRoute "/baz" []+       it "should capture variables in routes" $+          do checkRoute "/bar/23/baz" [IntVar 23]+             checkRoute "/bar/23/baz/100" [ListVar [IntVar 23, IntVar 100]]+             checkRoute "/bar/23/100" [ListVar [IntVar 23, IntVar 100]]+             checkRoute "/entry/344/2014-20-14T12:23" [ListVar [IntVar 344, StrVar "2014-20-14T12:23"]]+             checkRoute "/entry/bytags/344/2014-20-14T12:23" [ListVar [IntVar 344, StrVar "2014-20-14T12:23"]]+             checkRoute "/entry/2/rel/3"  [ListVar [IntVar 2, IntVar 3]]+       it "should handle multiple possible matches correctly" $+          do checkRoute "/bar/5" [IntVar 5, StrVar "5"]+             checkRoute "/bar/bingo" [StrVar "bar/bingo", StrVar "bingo"]+             checkRoute "/entry/1/audit" [IntVar 1,ListVar [IntVar 1,StrVar "audit"]]+       it "should provide an Applicative interface" $+          do let numbers =+                   mconcat+                   [ singleton var id+                   , singleton ("forty" </> "two") (42 :: Int)+                   ]+                 operators =+                   mconcat+                   [ singleton "plus" ((+) :: Int -> Int -> Int)+                   , singleton "mult" (*)+                   ]+                 routes = operators <*> numbers <*> numbers+                 check path val = match routes (pieces path) `shouldBe` [val]+             check "/plus/forty/two/forty/two" (42+42)+             check "/mult/forty/two/3" (42*3)+             check "/plus/5/89" 94+    where+      pieces :: T.Text -> [T.Text]+      pieces = filter (not . T.null) . T.splitOn "/"+      +      checkRoute :: T.Text -> [ReturnVar] -> Expectation+      checkRoute r x =+          let matches = handleFun (pieces r)+          in (map (runIdentity . snd) matches) `shouldBe` x++      handleFun :: [T.Text] -> [(ParamMap, Identity ReturnVar)]+      handleFun = handleFun' True+      (_, handleFun', _) =+          runIdentity (runRegistry SafeRouter handleDefs)++      handleDefs =+          do defR root $ return (StrVar "root")+             defR "bar" $ return (StrVar "bar")+             defR ("bar" </> var) (return . IntVar)+             defR ("bar" </> var </> "baz") (return . IntVar)+             defR ("bar" </> var </> "baz" </> var) $ \i i2 ->+                 return (ListVar [IntVar i, IntVar i2])+             defR ("bar" </> var </> var) $ \i i2 ->+                 return (ListVar [IntVar i, IntVar i2])+             defR ("entry" </> var </> var) $ \i st ->+                 return (ListVar [IntVar i, StrVar st])+             defR ("entry/bytags" </> var </> var) $ \i st ->+                 return (ListVar [IntVar i, StrVar st])+             defR ("entry" </> var </> "rel" </> var) $ \i i2 ->+                 return (ListVar [IntVar i, IntVar i2])+             defR ("bar" </> "bingo") $ return (StrVar "bar/bingo")+             defR ("bar" </> var) $ (return . StrVar . T.pack)+             defR ("entry" </> var </> "audit") (return . IntVar)

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+module Web.Routing.TextRoutingSpec (spec) where++import Test.Hspec++import Web.Routing.TextRouting+import qualified Web.Routing.AbstractRouter as R+import qualified Data.HashMap.Strict as HM++spec :: Spec+spec =+    do matchNodeDesc+       matchRouteDesc+       parseRouteNodeDesc++matchNodeDesc :: Spec+matchNodeDesc =+    describe "matchNode" $+    do it "shouldn't match to root node" $+          matchNode "foo" RouteNodeRoot `shouldBe` (False, Nothing)+       it "should capture basic variables" $+          matchNode "123" (RouteNodeCapture (R.CaptureVar "x")) `shouldBe` (True, Just (R.CaptureVar "x", "123"))+       it "should work with regex" $+          matchNode "123" (RouteNodeRegex (R.CaptureVar "x") (buildRegex "^[0-9]+$")) `shouldBe` (True, Just (R.CaptureVar "x", "123"))++matchRouteDesc :: Spec+matchRouteDesc =+    describe "matchRoute" $+    do it "shouldn't match unknown routes" $+          do matchRoute "random" routingTree `shouldBe` noMatches+             matchRoute "/baz" routingTree `shouldBe` noMatches+       it "should match known routes" $+          do matchRoute "/" routingTree `shouldBe` oneMatch emptyParamMap [1]+             matchRoute "/bar" routingTree `shouldBe` oneMatch emptyParamMap [2]+       it "should capture variables in routes" $+          do matchRoute "/bar/5" routingTree `shouldBe` oneMatch (vMap [("baz", "5")]) [3]+             matchRoute "/bar/23/baz" routingTree `shouldBe` oneMatch (vMap [("baz", "23")]) [4]+             matchRoute "/bar/23/baz/100" routingTree `shouldBe` oneMatch (vMap [("baz", "23"), ("bim", "100")]) [4]+             matchRoute "/ba/23/100" routingTree `shouldBe` oneMatch (vMap [("baz", "23"), ("bim", "100")]) [4]+             matchRoute "/entry/344/2014-20-14T12:23" routingTree `shouldBe` oneMatch (vMap [("cid", "344"), ("since", "2014-20-14T12:23")]) [6]+             matchRoute "/entry/bytags/344/2014-20-14T12:23" routingTree `shouldBe` oneMatch (vMap [("cid", "344"), ("since", "2014-20-14T12:23")]) [7]+             matchRoute "/entry/2/rel/3" routingTree `shouldBe` oneMatch (vMap [("eid", "2"), ("cid", "3")]) [9]+       it "should handle multiple possibile matches correctly" $+          do matchRoute "/bar/bingo" routingTree `shouldBe` multiMatch+             matchRoute "/entry/1/audit" routingTree `shouldBe` multiMatch'+    where+      vMap kv =+          HM.fromList $ map (\(k, v) -> (R.CaptureVar k, v)) kv+      multiMatch =+          ((oneMatch emptyParamMap [5])+            ++ oneMatch (vMap [("baz", "bingo")]) [3])+      multiMatch' =+          ((oneMatch (vMap [("eid", "1")]) [8])+           ++ (oneMatch (vMap [("since", "audit"), ("cid", "1")]) [6]))+      noMatches = []+      oneMatch pm m = [(pm, m)]+      routingTree =+          foldl (\tree (route, action) -> addToRoutingTree route action tree) emptyRoutingTree routes+      routes =+          [ ("/", [1])+          , ("/bar", [2 :: Int])+          , ("/bar/:baz", [3])+          , ("/bar/bingo", [5])+          , ("/bar/:baz/baz", [4])+          , ("/bar/:baz/baz/:bim", [4])+          , ("/ba/:baz/:bim", [4])+          , ("/entry/:cid/:since", [6])+          , ("/entry/bytags/:cid/:since", [7])+          , ("/entry/:eid/audit", [8])+          , ("/entry/:eid/rel/:cid", [9])+          ]++parseRouteNodeDesc :: Spec+parseRouteNodeDesc =+    describe "parseRouteNode" $+    do it "parses text nodes correctly" $+          parseRouteNode "foo" `shouldBe` RouteNodeText "foo"+       it "parses capture variables" $+          parseRouteNode ":bar" `shouldBe` RouteNodeCapture (R.CaptureVar "bar")+       it "parses regex capture variables" $+          parseRouteNode "{bar:^[0-9]$}" `shouldBe` RouteNodeRegex (R.CaptureVar "bar") (buildRegex "^[0-9]$")