reroute 0.2.0.1 → 0.2.1.0

raw patch · 5 files changed

+48/−20 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• reroute.cabal +2/−1
• src/Web/Routing/AbstractRouter.hs +12/−0
• src/Web/Routing/SafeRouting.hs +15/−7
• src/Web/Routing/TextRouting.hs +14/−7
• test/Web/Routing/SafeRoutingSpec.hs +5/−5

@@ -1,5 +1,5 @@ name:                reroute-version:             0.2.0.1+version:             0.2.1.0 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@@ -31,6 +31,7 @@                        graph-core >=0.2 && <0.3   hs-source-dirs:      src   default-language:    Haskell2010+  ghc-options: -Wall -fno-warn-orphans   test-suite reroute-test

@@ -21,6 +21,7 @@     emptyRegistry :: Registry r     rootPath :: RoutePath r '[]     defRoute :: RoutePath r as -> RouteAction r as -> Registry r -> Registry r+    fallbackRoute :: ([T.Text] -> RouteAppliedAction r) -> Registry r -> Registry r     matchRoute :: Registry r -> [T.Text] -> [(ParamMap, RouteAppliedAction r)]  type ParamMap = HM.HashMap CaptureVar T.Text@@ -42,6 +43,17 @@    = RegistryState    { rs_registry :: HM.HashMap reqTypes (Registry r)    }++hookAny :: (Monad m, AbstractRouter r, Eq reqTypes, Hashable reqTypes)+        => reqTypes+        -> ([T.Text] -> RouteAppliedAction r)+        -> RegistryT r middleware reqTypes m ()+hookAny reqType action =+    modify $ \rs ->+        rs { rs_registry =+                 let reg = fromMaybe emptyRegistry (HM.lookup reqType (rs_registry rs))+                 in HM.insert reqType (fallbackRoute action reg) (rs_registry rs)+           }  hookRoute :: (Monad m, AbstractRouter r, Eq reqTypes, Hashable reqTypes)           => reqTypes

@@ -30,21 +30,29 @@ data SafeRouter (m :: * -> *) a = SafeRouter  instance AbstractRouter (SafeRouter m a) where-    newtype Registry (SafeRouter m a) = SafeRouterReg (PathMap (m a))+    newtype Registry (SafeRouter m a) = SafeRouterReg (PathMap (m a), [[T.Text] -> m a])     newtype RoutePath (SafeRouter m a) xs = SafeRouterPath (Path xs)     type RouteAction (SafeRouter m a) = HVectElim' (m a)     type RouteAppliedAction (SafeRouter m a) = m a     subcompCombine (SafeRouterPath p1) (SafeRouterPath p2) =         SafeRouterPath $         p1 </> p2-    emptyRegistry = SafeRouterReg emptyPathMap+    emptyRegistry = SafeRouterReg (emptyPathMap, [])     rootPath = SafeRouterPath Empty-    defRoute (SafeRouterPath path) action (SafeRouterReg m) =-        SafeRouterReg $-        insertPathMap (RouteHandle path (flipHVectElim action)) m-    matchRoute (SafeRouterReg m) pathPieces =+    defRoute (SafeRouterPath path) action (SafeRouterReg (m, cAll)) =+        SafeRouterReg+        ( insertPathMap (RouteHandle path (flipHVectElim action)) m+        , cAll+        )+    fallbackRoute routeDef (SafeRouterReg (m, cAll)) =+        SafeRouterReg (m, cAll ++ [routeDef])+    matchRoute (SafeRouterReg (m, cAll)) pathPieces =         let matches = match m pathPieces-        in zip (replicate (length matches) HM.empty) matches+            matches' =+                if null matches+                then matches ++ (map (\f -> f pathPieces) cAll)+                else matches+        in zip (replicate (length matches') HM.empty) matches'   data Path (as :: [*]) where

@@ -51,19 +51,26 @@ data TextRouter (m :: * -> *) a = TextRouter  instance AbstractRouter (TextRouter m a) where-    newtype Registry (TextRouter m a) = TextRouterRegistry (RoutingTree (m a))+    newtype Registry (TextRouter m a) = TextRouterRegistry (RoutingTree (m a), [[T.Text] -> m a])     newtype RoutePath (TextRouter m a) xs = TextRouterPath T.Text     type RouteAction (TextRouter m a) = TAction m a     type RouteAppliedAction (TextRouter m a) = m a     subcompCombine (TextRouterPath p1) (TextRouterPath p2) =         TextRouterPath $ combineRoute p1 p2-    emptyRegistry = TextRouterRegistry emptyRoutingTree+    emptyRegistry = TextRouterRegistry (emptyRoutingTree, [])     rootPath = TextRouterPath "/"-    defRoute (TextRouterPath p) (TAction a) (TextRouterRegistry tree) =-        TextRouterRegistry $-        addToRoutingTree p a tree-    matchRoute (TextRouterRegistry tree) path =-        matchRoute' path tree+    defRoute (TextRouterPath p) (TAction a) (TextRouterRegistry (tree, cAll)) =+        TextRouterRegistry+        ( addToRoutingTree p a tree+        , cAll+        )+    fallbackRoute routeDef (TextRouterRegistry (m, cAll)) =+        TextRouterRegistry (m, cAll ++ [routeDef])+    matchRoute (TextRouterRegistry (tree, cAll)) path =+        let matches = matchRoute' path tree+        in if null matches+           then matches ++ ((zip (replicate (length cAll) HM.empty) $ map (\f -> f path) cAll))+           else matches  data RegexWrapper    = RegexWrapper

@@ -24,16 +24,12 @@ 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]]@@ -61,10 +57,13 @@              check "/plus/forty/two/forty/two" (42+42)              check "/mult/forty/two/3" (42*3)              check "/plus/5/89" 94+       it "should have a catch all route" $+          do checkRoute "/aslkdjk/asdaskl/aslkjd" [StrVar "aslkdjk/asdaskl/aslkjd"]+             checkRoute "/zuiasf/zuiasf" [StrVar "zuiasf/zuiasf"]     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)@@ -93,3 +92,4 @@              defR ("bar" </> "bingo") $ return (StrVar "bar/bingo")              defR ("bar" </> var) $ (return . StrVar . T.pack)              defR ("entry" </> var </> "audit") (return . IntVar)+             hookAny True (return . StrVar . T.intercalate "/")