wai-route 0.4.0 → 1.0.0
raw patch · 11 files changed
+1095/−310 lines, 11 filesdep +containersdep +deepseqdep +doctestdep ~basedep ~unordered-containers
Dependencies added: containers, deepseq, doctest, http-api-data, pattern-trie, text
Dependency ranges changed: base, unordered-containers
Files
- CHANGELOG.md +4/−0
- README.md +4/−2
- doctests.hs +3/−0
- examples/basic.hs +120/−0
- examples/compose.hs +89/−0
- sample/Main.hs +0/−25
- src/Network/Wai/Route.hs +663/−23
- src/Network/Wai/Route/Tree.hs +0/−129
- test/Main.hs +1/−1
- test/Test/Network/Wai/Route.hs +153/−82
- wai-route.cabal +58/−48
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 1.0.0++Major rewrite. Please refer to the package documentation for details.+ ## 0.4.0 * GHC 8.4 compatibility.
README.md view
@@ -1,4 +1,6 @@ wai-route [](https://travis-ci.org/romanb/wai-route)-========+========= -Minimalistic, efficient routing tree for applications using the [WAI](https://github.com/yesodweb/wai). Take a look at the [sample](https://github.com/romanb/wai-route/blob/master/sample/Main.hs).+[WAI](https://github.com/yesodweb/wai) middleware for path-based request routing+with captures.+
+ doctests.hs view
@@ -0,0 +1,3 @@+import Test.DocTest++main = doctest ["src", "examples"]
+ examples/basic.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE+ TypeApplications+ , DataKinds+ , GADTs+ , OverloadedStrings+ , LambdaCase+#-}++module Examples.Basic where++import Data.Binary.Builder (toLazyByteString)+import Data.Text (Text)+import Data.Text.Lazy (fromStrict)+import Data.Text.Lazy.Encoding (encodeUtf8)+import Network.HTTP.Types+import Network.Wai+import Network.Wai.Internal+import Network.Wai.Route+import Prelude++import qualified Data.ByteString.Char8 as C8+import qualified Data.ByteString.Lazy.Char8 as LC8+import qualified Data.Text as Text++-- $setup+-- >>> :set -XOverloadedStrings++-- Routes++routes :: [Route IO]+routes =+ [ defRoute (str "add" ./ var @"x" ./ var @"y" ./ end)+ addHandler++ , defRoute (str "echo" ./ some @Text ./ end)+ echoHandler++ , defRoute (str "reverse" ./ some @Text ./ end) $+ \(t ::: Nil) _rq send ->+ let t' = Text.reverse t+ in send (response200 (encodeUtf8 (fromStrict t')))++ , defRoute (str "upper" ./ some @Text ./ end) $+ \(t ::: Nil) -> byMethod $ \case+ GET -> \_rq send ->+ let t' = Text.toUpper t+ in send (response200 (encodeUtf8 (fromStrict t')))+ _ -> app405+ ]++addHandler :: Params '[Var "x" Int, Var "y" Int] -> App IO+addHandler (x ::: y ::: Nil) _rq send =+ send (response200 (LC8.pack (show (x + y))))++echoHandler :: Params '[Some Text] -> App IO+echoHandler (t ::: Nil) =+ withQuery (qdef @"repeat" @Int 1) appQueryError $+ \(rep ::: Nil) _rq send ->+ let t' = Text.replicate rep t+ in send (response200 (encodeUtf8 (fromStrict t')))++response200 :: LC8.ByteString -> Response+response200 = responseLBS status200 []++-- Fake requests++addReq :: Request+addReq = defaultRequest { pathInfo = ["add","1","2"] }++echoReq :: Request+echoReq = defaultRequest { pathInfo = ["echo","Hello"] }++reverseReq :: Request+reverseReq = defaultRequest { pathInfo = ["reverse","Hello"] }++upperReq :: Request+upperReq = defaultRequest { pathInfo = ["upper","Hello"] }++-- Fake response sending++printResponse :: Response -> IO ResponseReceived+printResponse rs = do+ case rs of+ ResponseBuilder s _ b -> do+ putStr (show (statusCode s))+ putStr " "+ putStr (C8.unpack (statusMessage s))+ putStr ": "+ putStrLn (LC8.unpack (toLazyByteString b))+ _ -> return ()+ return ResponseReceived++-- Application++app :: App IO+app = route (compileRoutes routes) app404++-- $examples+--+-- >>> app addReq printResponse+-- 200 OK: 3+--+-- >>> app echoReq printResponse+-- 200 OK: Hello+--+-- >>> app echoReq { queryString = [("repeat", Just "2")] } printResponse+-- 200 OK: HelloHello+--+-- >>> app echoReq { queryString = [("repeat", Just "a")] } printResponse+-- 400 Bad Request: Invalid parameter [repeat=a]...+--+-- >>> app reverseReq printResponse+-- 200 OK: olleH+--+-- >>> app upperReq printResponse+-- 200 OK: HELLO+--+-- >>> app upperReq { requestMethod = "POST" } printResponse+-- 405 Method Not Allowed:+
+ examples/compose.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE+ TypeApplications+ , DataKinds+ , GADTs+ , OverloadedStrings+#-}++module Examples.Wildcard where++import Data.Binary.Builder (toLazyByteString)+import Data.Text (Text)+import Data.Text.Lazy (fromStrict)+import Data.Text.Lazy.Encoding (encodeUtf8)+import Network.HTTP.Types+import Network.Wai+import Network.Wai.Internal+import Network.Wai.Route+import Prelude++import qualified Data.ByteString.Char8 as C8+import qualified Data.ByteString.Lazy.Char8 as LC8+import qualified Data.Text as Text++-- $setup+-- >>> :set -XOverloadedStrings++-- Routes++prefixRoutes :: [Route IO]+prefixRoutes = [ defRoute (str "files" ./ end) filesHandler ]++otherRoutes :: [Route IO]+otherRoutes = [ defRoute (str "echo" ./ some @Text ./ end) echoHandler ]++filesHandler :: Params '[] -> App IO+filesHandler Nil rq send =+ let path = Text.intercalate "/" (pathInfo rq)+ in send (response200 (encodeUtf8 (fromStrict path)))++echoHandler :: Params '[Some Text] -> App IO+echoHandler (t ::: Nil) _rq send =+ send (response200 (encodeUtf8 (fromStrict t)))++response200 :: LC8.ByteString -> Response+response200 = responseLBS status200 []++-- Fake requests++filesReq :: Request+filesReq = defaultRequest { pathInfo = ["files","foo","bar","baz.jpg"] }++echoReq :: Request+echoReq = defaultRequest { pathInfo = ["echo","Hello"] }++bogusReq :: Request+bogusReq = defaultRequest { pathInfo = ["bogus"] }++-- Fake response sending++printResponse :: Response -> IO ResponseReceived+printResponse rs = do+ case rs of+ ResponseBuilder s _ b -> do+ putStr (show (statusCode s))+ putStr " "+ putStr (C8.unpack (statusMessage s))+ putStr ": "+ putStrLn (LC8.unpack (toLazyByteString b))+ _ -> return ()+ return ResponseReceived++-- Application++app :: App IO+app = routePrefix (compileRoutes prefixRoutes)+ $ route (compileRoutes otherRoutes)+ $ app404++-- $examples+--+-- >>> app filesReq printResponse+-- 200 OK: foo/bar/baz.jpg+--+-- >>> app echoReq printResponse+-- 200 OK: Hello+--+-- >>> app bogusReq printResponse+-- 404 Not Found:+
− sample/Main.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import Network.HTTP.Types-import Network.Wai-import Network.Wai.Handler.Warp-import Network.Wai.Route (route)--import qualified Data.ByteString.Lazy as L--main :: IO ()-main = run 4242 $- route [ ("/foo", fooHandler)- , ("/foo/bar", barHandler)- , ("/foo/:bar/:baz", bazHandler)- ]- where- fooHandler _ _ k = k $ responseLBS status200 [] "foo!"- barHandler _ _ k = k $ responseLBS status200 [] "bar!"- bazHandler p rq k = do- print $ "pathInfo: " ++ show (pathInfo rq)- print $ "captured: " ++ show p- k $ responseLBS status200 []- $ maybe L.empty L.fromStrict (lookup "baz" p)
src/Network/Wai/Route.hs view
@@ -2,37 +2,677 @@ -- License, v. 2.0. If a copy of the MPL was not distributed with this -- file, You can obtain one at http://mozilla.org/MPL/2.0/. -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE+ BangPatterns+ , DataKinds+ , FlexibleContexts+ , GADTs+ , MagicHash+ , OverloadedStrings+ , ScopedTypeVariables+ , StandaloneDeriving+ , StrictData+ , TypeApplications+ , TypeFamilies+ , TypeInType+ , TypeOperators+ , UndecidableInstances+#-} +-- | This module provides a WAI 'Middleware' for routing requests+-- to handlers (i.e. 'Application's) based on the request path,+-- thereby optionally capturing variables.+--+-- The basic functionality is provided by 'route' and 'routePrefix'.+-- The 'RoutingTrie's for the middleware can be constructed directly+-- or by compiling 'Route's via the construction of 'Path's,+-- which offers enhanced type-safety.+--+-- Handlers may furthermore parse parameters from query strings,+-- via the construction of 'Query's. Some additional functions+-- for working with HTTP methods and request headers are also+-- provided.+--+-- The sources contain some+-- <https://github.com/romanb/wai-route/tree/master/examples examples>.+--+-- __Strictness__: This module uses @-XStrictData@. module Network.Wai.Route- ( Handler+ ( -- | The following extensions are used for all inline examples.+ -- $setup++ -- | More extensive examples can be found in the @examples@+ -- directory of the source distribution.++ -- * Middleware+ App+ , Handler+ , RoutingTrie , route+ , routePrefix++ -- * Routes+ , Route (..)+ , defRoute+ , compileRoute+ , compileRoutes++ -- * Parameters+ , Params (..)+ , ParamName+ , InvalidParam (..)++ -- * Paths+ , Path, Vars, Var, Some+ , (=~=)+ , str, var, some, (./), end+ , pathVarsLen+ , pathPattern+ , parsePath+ , PathError (..)+ , SomePath (..)++ -- * Query Strings+ , Query+ , qreq+ , qdef+ , qopt+ , (.&.)+ , withQuery+ , parseQuery+ , QueryError (..)++ -- * Utilities+ , VarsLen+ , knownVarsLen++ -- ** HTTP Methods+ , getMethod+ , byMethod+ , withMethod++ -- ** HTTP Query Parameters+ , getQueryParam+ , getQueryParam'++ -- ** HTTP Headers+ , getHeader+ , InvalidHeader (..)++ -- ** Standard Applications+ , appInvalidParam+ , appMissingParam+ , appQueryError+ , app400+ , app404+ , app405++ -- * Re-exports+ , Trie+ , Pattern+ , Matcher (..)+ , Capture (..)+ , FromHttpApiData ) where +import GHC.Exts (Proxy#, proxy#)+import GHC.TypeLits+ import Data.ByteString (ByteString)-import Network.HTTP.Types+import Data.Kind+import Data.Sequence (Seq (..), (<|))+import Data.Semigroup ((<>))+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8, decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Text.Lazy.Builder (fromString, fromText, toLazyText)+import Data.Trie.Pattern+import Network.HTTP.Types.Header+import Network.HTTP.Types.Method+import Network.HTTP.Types.Status+import Network.HTTP.Types (QueryItem) import Network.Wai-import Network.Wai.Route.Tree-import Prelude hiding (lookup)+import Prelude+import Web.HttpApiData (FromHttpApiData (..)) -import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as C8+import qualified Data.Sequence as Seq+import qualified Data.Text as Text+import qualified Data.Text.Lazy.Encoding as LazyText+import qualified Data.Trie.Pattern as Trie --- | A 'Handler' is a generalized 'Application' that receives the captured--- path parameters as its first argument.-type Handler m = [(ByteString, ByteString)] -- ^ The captured path parameters.- -> Request -- ^ The matched 'Request'.- -> (Response -> m ResponseReceived) -- ^ The continuation.- -> m ResponseReceived+-- $setup+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedStrings+-- >>> :set -XTypeApplications --- | Routes requests to 'Handler's according to a routing table.-route :: Monad m- => [(ByteString, Handler m)]- -> Request- -> (Response -> m ResponseReceived)- -> m ResponseReceived-route rs rq k = case lookup (fromList rs) segs of- Just e -> value e (captured $ captures e) rq k- Nothing -> k notFound+-- | An 'App' is a WAI 'Application' generalised to any type+-- of kind @* -> *@, and thus in particular any monad, i.e.+-- @App IO ~ Application@.+type App m+ = Request+ -> (Response -> m ResponseReceived)+ -> m ResponseReceived++-- | A handler function for a routed request.+type Handler m+ = Seq (Capture Text)+ -> App m++-- | A routing trie for request paths.+type RoutingTrie m = Trie Text (Handler m)++-- | Routes requests to 'Handler's via a routing trie, passing+-- along captured path parameters. The request path must fully match a route in+-- order for the associated handler function to be called. If no route matches+-- the request path, the request is forwarded to the 'App'lication given as+-- second argument.+route :: Monad m => RoutingTrie m -> App m -> App m+route rt app rq k = case Trie.match (pathInfo rq) rt of+ Just (h, cs) -> h cs rq k+ Nothing -> app rq k++-- | Routes requests to 'Handler's via a routing trie, passing along+-- captured path parameters. A prefix of the request path must match a route in+-- order for the associated handler function to be called. Thereby the route+-- for the longest matching prefix is chosen. If no route matches a+-- prefix of the request path, the request is forward to the 'App'lication+-- given as second argument.+--+-- /Note/: With prefix routing, the 'pathInfo' of the 'Request' passed to+-- a handler contains only the (unmatched) suffix of the request path, enabling+-- nested / chained routing with multiple routing tries. An example for+-- the composition of routing tries can be seen+-- <https://github.com/romanb/wai-route/tree/master/examples/compose.hs here>.+routePrefix :: Monad m => RoutingTrie m -> App m -> App m+routePrefix rt app rq k = case Trie.matchPrefix (pathInfo rq) rt of+ Just (h, cs, str') -> h cs (rq { pathInfo = str' }) k+ Nothing -> app rq k++------------------------------------------------------------------------------+-- Routes++-- | A route whose handler is run if the path is a match for a request path.+-- The handler function is thereby given the captured and parsed 'Params'.+data Route m = forall vars. Route+ { routePath :: Path vars+ -- ^ The path that uniquely identifies a route.+ , routeHandler :: Params vars -> App m+ -- ^ Handler for requests matching the route path.+ , routeInvalidParam :: InvalidParam -> App m+ -- ^ Callback for invalid path parameters.+ }++-- | Two routes are equal if they have the same path.+instance Eq (Route m) where+ (Route p1 _ _) == (Route p2 _ _) = p1 =~= p2++-- | Shows the path of the route.+instance Show (Route m) where+ show (Route p _ _) = show p++-- | Define a 'Route' with the given path and handler, using default+-- values for other arguments.+defRoute :: Monad m => Path vars -> (Params vars -> App m) -> Route m+defRoute p h = Route p h appInvalidParam++-- | Compile a list of 'Route's into a 'RoutingTrie'.+compileRoutes :: Monad m => [Route m] -> RoutingTrie m+compileRoutes = Trie.fromAssocList . map compileRoute++-- | Compile a 'Route' into a pair of a 'Pattern' and a 'Handler',+-- suitable for insertion into a 'RoutingTrie'.+compileRoute :: Monad m => Route m -> (Pattern Text, Handler m)+compileRoute (Route p h f) = (pathPattern p, handler) where- segs = segments (rawPathInfo rq)- notFound = responseLBS status404 [] L.empty+ handler cs = case parsePath p cs of+ Right args -> h args+ Left (PathInvalidParam x) -> f x+ Left PathMissingParams ->+ -- Note [Missing path params]+ error "wai-route: incomplete parse: missing captures"++{- Note [Missing path params]+~~~~~~~~~~~~~~~~~~~~~~~~~~+It is a central property of the underlying pattern trie that if @p@ is a pattern+in a trie, then a successful match on that pattern yields exactly @n@ captured+values, where @n@ is the number of captures in the pattern. Since the number of+captures in a pattern is equal to the number of variables in a path by+definition of 'Path' and 'pathPattern', an incomplete parse at this point cannot+happen, given the trie works correctly.+-}++------------------------------------------------------------------------------+-- Paths++-- | The names and types of the variables captured in a 'Path'.+type Vars = [(Symbol,Type)]++-- | A parameter of type @a@ with (type-level) name @s@.+type Var s a = '(s,a)++-- | An unnamed parameter of type @a@.+type Some a = Var "" a++-- | A path of a 'Route', indexed by the names and types of+-- the captured variables.+--+-- Paths are constructed using 'str', 'var', 'some', glued+-- together by './' and terminated by 'end', e.g.+--+-- >>> let p = str "a" ./ var @"b" @Int ./ str "c" ./ some @Text ./ end+-- >>> :t p+-- p :: Path '[Var "b" Int, Some Text]+--+-- Two different paths are /overlapping/ iff their underlying 'Pattern's,+-- as given by 'pathPattern', are overlapping. The preference given to+-- routes based on overlapping paths is given by the preference between+-- the overlapping patterns (see the documentation for 'Pattern's).+data Path :: Vars -> Type where+ Val :: Text+ -> Path vars+ -> Path vars+ Var :: (KnownSymbol s, Eq a, FromHttpApiData a)+ => Proxy# s+ -> Proxy# a+ -> Path vars+ -> Path (Var s a ': vars)+ End :: Path '[]++-- | Equality for paths indexed by the same 'Vars' is subsumed by the+-- structural equality '=~='.+instance Eq (Path vars) where+ p1 == p2 = p1 =~= p2++-- | Shows paths with a leading "/", whereby 'str'ings stand in+-- for themselves, unnamed 'var'iables are represented by a "*"+-- and named variables are represented by a ":" followed by the+-- name of the variable.+--+-- >>> let p = str "a" ./ var @"b" @Int ./ str "c" ./ some @Text ./ end+-- >>> p+-- /a/:b/c/*+instance Show (Path vars) where+ show End = ""+ show (Val s p) = showString "/" . showString (Text.unpack s) . shows p $ ""+ show (Var s _ p) = showString "/" . (+ let s' = symbolVal' s+ in if null s'+ then showString "*"+ else showString ":" . showString s'+ ) . shows p $ ""++-- | Structural equality of paths.+--+-- @p =~= p@ \(\iff\) @'pathPattern' p == pathPattern p@+--+(=~=) :: Path vars -> Path vars' -> Bool+(=~=) End End = True+(=~=) (Val s p) (Val s' p') = s == s' && p =~= p'+(=~=) (Var _ _ p) (Var _ _ p') = p =~= p'+(=~=) _ _ = False++-- | Capture a parameter as a named variable, e.g.+--+-- >>> let p = var @"name" @Text ./ end+-- >>> :t p+-- p :: Path '[Var "name" Text]+--+-- The type-level variable name can serve at least two purposes:+--+-- * It allows to disambiguate multiple parameters of the same type in the+-- path for extra type safety (i.e. against mixing up the order of+-- parameters).+-- * The name is made available at runtime when parsing of a parameter+-- fails in the form of an 'InvalidParam' error, enabling its use in+-- error responses, logs, etc.+--+var :: (KnownSymbol s, Eq a, FromHttpApiData a)+ => Path vars+ -> Path (Var s a ': vars)+var = Var proxy# proxy#++-- | Capture a parameter as an unnamed variable, e.g.+--+-- >>> let p = some @Text ./ end+-- >>> :t p+-- p :: Path '[Some Text]+some :: (Eq a, FromHttpApiData a)+ => Path vars+ -> Path (Some a ': vars)+some = var @""++-- | Match a fixed string, capturing nothing, e.g.+--+-- >>> let p = str "tmp" ./ end+-- >>> :t p+-- p :: Path '[]+str :: Text -> Path vars -> Path vars+str = Val++-- | Right-associative infix operator for constructing 'Path's:+--+-- >>> let p = str "a" ./ some @Int ./ var @"y" @Int ./ end+-- >>> :t p+-- p :: Path '[Some Int, Var "y" Int]+--+(./) :: (Path vars -> Path vars') -> Path vars -> Path vars'+(./) f p = f p+infixr 5 ./++-- | Mark the end of a path.+end :: Path '[]+end = End++-- | The underlying structural 'Pattern' of a 'Path'.+pathPattern :: Path vars -> Pattern Text+pathPattern = go Seq.empty+ where+ go :: Pattern Text -> Path vars -> Pattern Text+ go pat (Val s p) = EqStr s <| go pat p+ go pat (Var _ _ p) = AnyStr <| go pat p+ go pat End = pat++-- | Compute the length of the list of variables in a 'Path', at runtime.+--+-- \(\mathcal{O}(n)\), where @n@ is the total length of the path.+--+-- >>> let p = str "a" ./ some @Text ./ end+-- >>> pathVarsLen p+-- 1+--+-- See also 'knownVarsLen' for lengths known at compile-time.+pathVarsLen :: Path vars -> Int+pathVarsLen = go 0+ where+ go :: Int -> Path vars -> Int+ go !n End = n+ go !n (Var _ _ p) = go (n + 1) p+ go !n (Val _ p) = go n p++-- | An error during parsing of the parameters of a 'Path'.+data PathError+ = PathMissingParams+ -- ^ The path contains more variables than the number of captures given.+ | PathInvalidParam InvalidParam+ -- ^ A parameter failed to parse into the type expected by the+ -- corresponding variable of the path.+ deriving (Eq, Show, Read)++-- | Parse a sequence of captures into a heterogeneous list of 'Params'+-- according to the 'Vars' in the given 'Path'. The number of captures+-- given must be at least as large as the number of variables in the path,+-- in order for the parse to succeed.+parsePath :: Path vars -> Seq (Capture Text) -> Either PathError (Params vars)+parsePath End _ = Right Nil+parsePath (Val _ p) cs = parsePath p cs+parsePath _ Empty = Left PathMissingParams+parsePath (Var s (_ :: Proxy# a) p) (Capture c :<| cs) =+ case parseUrlPiece @a c of+ Right a -> (a :::) <$> parsePath p cs+ Left e -> Left $! PathInvalidParam (InvalidParam (symbolVal' s) c e)++------------------------------------------------------------------------------+-- SomePath++-- | A path with existentially quantified variables.+data SomePath = forall vars. SomePath (Path vars)++deriving instance Show SomePath++instance Eq SomePath where+ (SomePath p1) == (SomePath p2) = p1 =~= p2++------------------------------------------------------------------------------+-- Query++-- | A query string with heterogeneously typed variables.+data Query :: Vars -> Type where+ QDef :: (Eq a, KnownSymbol s, FromHttpApiData a)+ => Proxy# s+ -> Proxy# a+ -> a+ -> Query '[Var s a]+ QOpt :: (Eq a, KnownSymbol s, FromHttpApiData a)+ => Proxy# s+ -> Proxy# a+ -> Query '[Var s (Maybe a)]+ QReq :: (Eq a, KnownSymbol s, FromHttpApiData a)+ => Proxy# s+ -> Proxy# a+ -> Query '[Var s a]+ QAnd :: (Eq a, KnownSymbol s, FromHttpApiData a)+ => Query '[Var s a]+ -> Query (Var s' a' ': vars)+ -> Query (Var s a ': Var s' a' ': vars)++-- | A required query parameter.+qreq :: (KnownSymbol s, FromHttpApiData a, Eq a) => Query '[Var s a]+qreq = QReq proxy# proxy#++-- | A query parameter with a default value. The default only applies+-- when the parameter is absent or has no value, not if there is a+-- value that fails to parse.+qdef :: (KnownSymbol s, FromHttpApiData a, Eq a) => a -> Query '[Var s a]+qdef = QDef proxy# proxy#++-- | An optional query parameter. The parameter value is 'Nothing' only if+-- the parameter is absent or has no value, not if there is a value+-- that fails to parse.+qopt :: (KnownSymbol s, FromHttpApiData a, Eq a) => Query '[Var s (Maybe a)]+qopt = QOpt proxy# proxy#++-- | Combine a query parameter with one or more other query parameters.+(.&.) :: (Eq a, KnownSymbol s, FromHttpApiData a)+ => Query '[Var s a]+ -> Query (Var s' a' ': vars)+ -> Query (Var s a ': Var s' a' ': vars)+(.&.) = QAnd+infixr 5 .&.++instance Show (Query vars) where+ showsPrec _ (QReq s _ ) = showString (symbolVal' s) . showString "=?[req]"+ showsPrec _ (QDef s _ _) = showString (symbolVal' s) . showString "=?[def]"+ showsPrec _ (QOpt s _ ) = showString (symbolVal' s) . showString "=?[opt]"+ showsPrec _ (QAnd q qs) = shows q . showString "&" . shows qs++-- | An error during parsing of the parameters for a 'Query'.+data QueryError+ = QueryMissingParam ParamName+ -- ^ A query parameter is missing.+ | QueryInvalidParam InvalidParam+ -- ^ A query parameter failed to parse correctly.+ deriving (Eq, Show, Read)++-- | Parse the variables of a 'Query' for the given list of values+-- into 'Params'.+parseQuery :: Query vars -> [QueryItem] -> Either QueryError (Params vars)+parseQuery qry items = case qry of+ q@QReq{} -> (::: Nil) <$> parseQ q+ q@QDef{} -> (::: Nil) <$> parseQ q+ q@QOpt{} -> (::: Nil) <$> parseQ q+ QAnd q qs -> (:::) <$> parseQ q <*> parseQuery qs items+ where+ parseQ :: Query '[Var s a] -> Either QueryError a+ parseQ q = case q of+ QReq s (_ :: Proxy# a) ->+ parse s (parseQParam @a) (Left . QueryMissingParam)+ QDef s (_ :: Proxy# a) def ->+ parse s (parseQParam @a) (const (Right def))+ QOpt s (_ :: Proxy# a) ->+ parse s (\n -> fmap Just . parseQParam @a n) (const (Right Nothing))++ parse :: KnownSymbol s+ => Proxy# s+ -> (ParamName -> ByteString -> Either InvalidParam a)+ -> (ParamName -> Either QueryError a)+ -> Either QueryError a+ parse s f g = let name = symbolVal' s in+ case Prelude.lookup (C8.pack name) items of+ Just (Just val) -> case f name val of+ Left e -> Left $! QueryInvalidParam e+ Right a -> Right a+ _ -> g name++-- | Run an 'App' after parsing the parameters for the given 'Query'+-- from the request.+withQuery+ :: Query vars+ -- ^ The query to parse.+ -> (QueryError -> App m)+ -- ^ The application to run when the query failed to parse.+ -> (Params vars -> App m)+ -- ^ The application to run with the parsed query parameters.+ -> App m+withQuery q onE onP rq = case parseQuery q (queryString rq) of+ Left e -> onE e rq+ Right p -> onP p rq++parseQParam :: forall a. FromHttpApiData a+ => ParamName+ -> ByteString+ -> Either InvalidParam a+parseQParam name val =+ let val' = decodeUtf8With lenientDecode val+ in case parseQueryParam @a val' of+ Right a -> Right a+ Left e -> Left $! InvalidParam name val' e++------------------------------------------------------------------------------+-- Parameters++type ParamName = String++-- | A heterogenous list of parameters.+data Params :: Vars -> Type where+ Nil :: Params '[]+ (:::) :: Eq a => a -> Params vars -> Params (Var s a ': vars)++infixr 5 :::+deriving instance Eq (Params vars)++-- | A parameter could not be parsed correctly.+data InvalidParam = InvalidParam+ { invalidParamName :: ParamName+ , invalidParamValue :: Text+ , invalidParamMsg :: Text+ } deriving (Eq, Show, Read)++------------------------------------------------------------------------------+-- Utilities++-- | Compute the length of 'Vars'.+type family VarsLen vars :: Nat where+ VarsLen '[] = 0+ VarsLen (_ ': vars) = 1 + VarsLen vars++-- | Get the length of a 'Vars' list for a 'Path' or 'Params',+-- computed at compile-time.+--+-- >>> knownVarsLen (1 ::: "a" ::: 3.14 ::: Nil)+-- 3+--+-- >>> knownVarsLen (str "a" ./ some @Int ./ var @"x" @Text ./ str "b" ./ end)+-- 2+knownVarsLen :: forall proxy vars. KnownNat (VarsLen vars) => proxy vars -> Integer+knownVarsLen _ = natVal' (proxy# :: Proxy# (VarsLen vars))++-- | Get and parse the request method as a 'StdMethod'.+getMethod :: Request -> Either ByteString StdMethod+getMethod = parseMethod . requestMethod++-- | Dispatch a request to an application based on the standardised+-- HTTP request methods (verbs). If the request method is not a+-- standard method, 'app405' is called.+byMethod :: (StdMethod -> App m) -> App m+byMethod f rq k = case getMethod rq of+ Left _ -> app405 rq k+ Right m -> f m rq k++-- | Run an 'App' only if the request method matches, otherwise run 'app405'.+withMethod :: Monad m => StdMethod -> App m -> App m+withMethod m app = byMethod $ \m' ->+ if m == m' then app+ else app405++-- | Get and parse a query parameter by its name, assuming UTF-8+-- encoding of the value. If the query parameter is not present in the+-- request or has an empty value, 'Nothing' is returned.+--+-- If the parameter name is known to contain only ASCII characters (the most+-- common case), this function is more efficient than 'getQueryParam\'', since+-- query parameter names are plain 'ByteString's in the WAI.+getQueryParam :: FromHttpApiData a => Request -> ByteString -> Maybe (Either InvalidParam a)+getQueryParam rq key = case Prelude.lookup key (queryString rq) of+ Nothing -> Nothing -- key not present+ Just Nothing -> Nothing -- empty value+ Just (Just bs) -> Just $! parseQParam (C8.unpack key) bs++-- | Like 'getQueryParam' but supports UTF-8 encoded names of query parameters.+getQueryParam' :: FromHttpApiData a => Request -> Text -> Maybe (Either InvalidParam a)+getQueryParam' rq = getQueryParam rq . encodeUtf8++-- | A header that failed to parse.+data InvalidHeader = InvalidHeader+ { invalidHeaderName :: HeaderName+ , invalidHeaderValue :: ByteString+ , invalidHeaderMsg :: Text+ } deriving (Eq, Show, Read)++-- | Get an parse the value of an HTTP header.+getHeader :: FromHttpApiData a => Request -> HeaderName -> Maybe (Either InvalidHeader a)+getHeader rq h = case Prelude.lookup h (requestHeaders rq) of+ Nothing -> Nothing+ Just bs -> case parseHeader bs of+ Right a -> Just (Right a)+ Left e -> Just (Left (InvalidHeader h bs e))++-- | An application that always yields a 400 Bad Request+-- plaintext response for an invalid parameter.+appInvalidParam :: InvalidParam -> App m+appInvalidParam (InvalidParam n v e) _rq k =+ k $ responseLBS code hdrs body+ where+ code = status400+ hdrs = [(hContentType, "text/plain; charset=utf-8")]+ body = LazyText.encodeUtf8 . toLazyText $+ fromString "Invalid parameter "+ <> fromString "["+ <> (if not (null n)+ then fromString n <> fromString "="+ else mempty)+ <> fromText v+ <> fromString "], "+ <> fromText e++-- | An application that always yields a 400 Bad Request+-- plaintext response for a missing parameter.+appMissingParam :: ParamName -> App m+appMissingParam name _rq k =+ k $ responseLBS code hdrs body+ where+ code = status400+ hdrs = [(hContentType, "text/plain; charset=utf-8")]+ body = LazyText.encodeUtf8 . toLazyText $+ fromString "Missing parameter "+ <> fromString "["+ <> fromString name+ <> fromString "]"++-- | An application that always yields a 400 Bad Request+-- plaintext response for an invalid or missing query parameter.+appQueryError :: QueryError -> App m+appQueryError (QueryInvalidParam e) = appInvalidParam e+appQueryError (QueryMissingParam n) = appMissingParam n++-- | An application that always yields an empty 404 Not Found response.+app404 :: App m+app404 _rq k = k $ responseLBS status404 [] mempty++-- | An application that always yields an empty 405 Method Not Allowed response.+app405 :: App m+app405 _rq k = k $ responseLBS status405 [] mempty++-- | An application that always yields an empty 400 Bad Request response.+app400 :: App m+app400 _rq k = k $ responseLBS status400 [] mempty
− src/Network/Wai/Route/Tree.hs
@@ -1,129 +0,0 @@--- This Source Code Form is subject to the terms of the Mozilla Public--- License, v. 2.0. If a copy of the MPL was not distributed with this--- file, You can obtain one at http://mozilla.org/MPL/2.0/.--module Network.Wai.Route.Tree- ( -- * Routing Tree- Tree- , fromList- , lookup- , foldTree- , mapTree- , toList- , segments-- -- ** Tree leaf payload- , Payload- , value- , path- , captures-- -- ** Captures- , Captures- , captured- , captureParams- , captureValues- ) where--import Control.Applicative-import Data.ByteString (ByteString)-import Data.List (foldl')-import Data.HashMap.Strict (HashMap)-import Data.Maybe (fromMaybe)-import Data.Semigroup-import Data.Word-import Network.HTTP.Types (urlDecode, urlEncode)-import Prelude hiding (lookup)--import qualified Data.ByteString as B-import qualified Data.HashMap.Strict as M--data Tree a = Tree- { subtree :: HashMap ByteString (Tree a)- , capture :: Maybe (Tree a)- , payload :: Maybe (Payload a)- } deriving (Eq, Show)--data Payload a = Payload- { path :: !ByteString- , value :: !a- , captures :: !Captures- } deriving (Eq, Show)--data Captures = Captures- { params :: [ByteString]- , values :: [ByteString]- } deriving (Eq, Show)--instance Semigroup (Tree a) where- a <> b = Tree (subtree a <> subtree b)- (capture a <> capture b)- (payload a <|> payload b)--instance Monoid (Tree a) where- mempty = Tree mempty Nothing Nothing- mappend = (<>)--captureParams :: Captures -> [ByteString]-captureParams = params--captureValues :: Captures -> [ByteString]-captureValues = values--captured :: Captures -> [(ByteString, ByteString)]-captured (Captures a b) = zip a b--fromList :: [(ByteString, a)] -> Tree a-fromList = foldl' addRoute mempty- where- addRoute t (p,a) = go t (segments p) []- where- go n [] cs =- let pa = Payload p a (Captures cs [])- in n { payload = Just pa }-- go n (c:ps) cs | B.head c == colon =- let b = fromMaybe mempty $ capture n- in n { capture = Just $! go b ps (B.tail c : cs) }-- go n (d:ps) cs =- let d' = urlEncode False d- b = fromMaybe mempty $ M.lookup d' (subtree n)- in n { subtree = M.insert d' (go b ps cs) (subtree n) }--lookup :: Tree a -> [ByteString] -> Maybe (Payload a)-lookup t p = go p [] t- where- go [] cvs n =- let f e = e { captures = Captures (params (captures e)) cvs }- in f <$> payload n-- go (s:ss) cvs n =- maybe (capture n >>= go ss (urlDecode False s : cvs))- (go ss cvs)- (M.lookup s $ subtree n)--foldTree :: (Payload a -> b -> b) -> b -> Tree a -> b-foldTree f z (Tree sub cap pay) =- let a = M.foldl' (foldTree f) z sub- b = maybe a (foldTree f a) cap- c = maybe b (flip f b) pay- in c--mapTree :: (Payload a -> Payload b) -> Tree a -> Tree b-mapTree f t = foldTree apply mempty t- where- apply x tr = tr { payload = Just (f x) }--toList :: Tree a -> [Payload a]-toList = foldTree (:) []--segments :: ByteString -> [ByteString]-segments = filter (not . B.null) . B.split slash--slash, colon :: Word8-slash = 0x2F-colon = 0x3A-{-# INLINE slash #-}-{-# INLINE colon #-}-
test/Main.hs view
@@ -8,4 +8,4 @@ import qualified Test.Network.Wai.Route as Route main :: IO ()-main = defaultMain $ testGroup "Tests" [ Route.tests ]+main = defaultMain Route.tests
test/Test/Network/Wai/Route.hs view
@@ -2,132 +2,203 @@ -- License, v. 2.0. If a copy of the MPL was not distributed with this -- file, You can obtain one at http://mozilla.org/MPL/2.0/. -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE+ OverloadedStrings+ , TypeApplications+#-} module Test.Network.Wai.Route (tests) where +import Control.DeepSeq import Control.Monad.State.Strict-import Data.ByteString (ByteString)-import Data.Semigroup+import Data.Foldable (toList)+import Data.Sequence (Seq (..), (<|))+import Data.Semigroup ((<>))+import Data.Text (Text) import Network.HTTP.Types import Network.Wai import Network.Wai.Internal (ResponseReceived (..)) import Network.Wai.Route-import Network.Wai.Route.Tree (Tree) import Test.Tasty import Test.Tasty.QuickCheck -import qualified Data.ByteString.Char8 as C-import qualified Network.Wai.Route.Tree as Tree+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.Text as Text+import qualified Data.Trie.Pattern as Trie tests :: TestTree tests = testGroup "Network.Wai.Route" [ testProperty "route" checkRouting- , testGroup "Network.Wai.Route.Tree"- [ testProperty "identity" checkMonoidId- , testProperty "associativity" checkMonoidAssoc- ]+ , testProperty "parsePath (1/2)" checkParsePath1+ , testProperty "parsePath (2/2)" checkParsePath2+ , testProperty "compileRoutes" checkCompileRoutes+ , testProperty "path equivalence (=~=)" checkPathEquiv ] checkRouting :: Property-checkRouting = forAll genRoutes check+checkRouting = forAll genTestRoutes check where- check routes =- let f = route $ map (fmap unHandler) routes+ check rs =+ let f = route $ Trie.fromAssocList (map unTestRoute rs) k = const $ return ResponseReceived- in conjoin . flip map routes $ \(p, h) ->- forAll (genReq p) $ \(params, rq) ->- let s = execState (f rq k) (-1, [])- in s == (handlerId h, params)+ in conjoin . flip map rs $ \(TestRoute (p, _)) ->+ forAll (genRequest p) $ \(params, rq) ->+ let s = execState (f noRoute rq k) (Seq.empty, Seq.empty)+ in s == (p, params) -checkMonoidId :: Property-checkMonoidId = forAll genTree $ \t ->- t <> mempty == t && mempty <> t == t+ noRoute _rq k = k $ responseLBS status404 [] mempty -checkMonoidAssoc :: Property-checkMonoidAssoc = forAll (replicateM 3 genTree) $ \[t1,t2,t3] ->- (t1 <> t2) <> t3 == t1 <> (t2 <> t3)+checkParsePath1 :: Property+checkParsePath1 = forAll (genPath Nothing) $ \(SomePath p) ->+ let captures = Seq.replicate (pathVarsLen p) joker+ in case parsePath p captures of+ Left e -> counterexample (show e) False+ Right _ -> property True +checkParsePath2 :: Property+checkParsePath2 = forAll ((,) <$> genText <*> arbitrary) $ \(t, i) ->+ let+ p0 = str t ./ end+ p1 = str t ./ some @Int ./ end+ c = Seq.singleton (Capture (Text.pack (show i)))+ c' = Seq.singleton (Capture "NaN")+ in+ parsePath p0 c == Right Nil &&+ parsePath p0 Seq.empty == Right Nil &&+ parsePath p1 c == Right (i ::: Nil) &&+ parsePath p1 Seq.empty == Left PathMissingParams &&+ case parsePath p1 c' of+ Left (PathInvalidParam e) -> invalidParamValue e == "NaN"+ _ -> False++-- | Compile a list of (non-overlapping) routes into a routing+-- trie and check that all routes have been preserved by running+-- all handlers.+checkCompileRoutes :: Property+checkCompileRoutes = forAll genRoutes $ \rs ->+ let maxLen = maximum (map (Seq.length . routePattern) rs)+ captures = Seq.replicate maxLen joker+ rt = force $ run captures <$> compileRoutes rs+ in Set.fromList (map Trie.matchOrd (toList rt))+ ==+ Set.fromList (map (Trie.matchOrd . routePattern) rs)+ where+ routePattern Route{routePath = p} = pathPattern p++ run captures h =+ let k = const $ return ResponseReceived+ s = h captures defaultRequest k+ in execState s Seq.empty++checkPathEquiv :: Property+checkPathEquiv = forAll ((,) <$> genPath Nothing <*> genPath Nothing) $+ \(SomePath p, SomePath p') ->+ let pp = pathPattern p+ pp' = pathPattern p'+ in p =~= p' ==> pp == pp'+ &&+ pp == pp' ==> p =~= p'+ ------------------------------------------------------------------------------- -- Generators & helpers -type Params = [(ByteString, ByteString)]+type TestState = State (Pattern Text, Seq (Capture Text)) -data TestHandler = TestHandler- { handlerId :: !Int- , unHandler :: Handler (State (Int, Params))- }+-- | An (untyped) test route.+newtype TestRoute = TestRoute+ { unTestRoute :: (Pattern Text, Handler TestState) } -instance Eq TestHandler where- h1 == h2 = handlerId h1 == handlerId h2+instance Show TestRoute where+ show (TestRoute (p, _)) = "<test-route; " ++ show p ++ ">" -instance Show TestHandler where- show h = "<test-handler-" ++ show (handlerId h) ++ ">"+-- Generate a matcher for a pattern. All 'EqStr' matchers are prefixed+-- with a @0@ character, to avoid accidental clashes with generated+-- capture values (see 'genRequest').+genMatcher :: Gen (Matcher Text)+genMatcher = oneof [genStr, genVar]+ where+ genStr = EqStr . ("0" <>) <$> genText+ genVar = pure AnyStr -handler :: Int -> TestHandler-handler i = TestHandler i $ \p _ k -> do- put (i, p)- k $ responseLBS status200 [] mempty+genPattern :: Gen (Pattern Text)+genPattern = do+ n <- choose (1, 10)+ Seq.fromList <$> vectorOf n genMatcher --- Generate a name for a capture segment in a route.-genCapture :: Gen ByteString-genCapture = (":"<>) . C.pack <$> listOf1 arbitraryASCIIChar `suchThat` f- where- f d = '/' `notElem` d+genPath :: Maybe Text -> Gen SomePath+genPath prefix = oneof+ [ return (SomePath (maybe id str prefix $ end))+ , do SomePath p <- genPath prefix+ SomePath <$> (str <$> genText <*> pure p)+ , do SomePath p <- genPath prefix+ b <- elements [True,False]+ return $ if b+ then SomePath (some @Text p)+ else SomePath (some @Int p)+ ] --- Generate a name for a static segment in a route. These are disambiguated from--- generated parameter values by a fixed prefix, namely '_'. See 'genParam'.-genDir :: Gen ByteString-genDir = C.pack . ('_':) <$> listOf1 arbitraryASCIIChar `suchThat` f- where- f d = head d /= ':' && '/' `notElem` d+-- | A capture value that is valid for all types in a path+-- generated by 'genPath'.+joker :: Capture Text+joker = Capture "42" --- Generate a parameter value for a capture segment to be used in a request.--- These are disambiguated from static segments by a fixed prefix, namely 'p',--- in order not to generate values that accidentily match a static segment of--- some other route.-genParam :: Gen ByteString-genParam = C.pack . ('p':) <$> listOf1 arbitraryASCIIChar+genTestRoute :: Gen TestRoute+genTestRoute = do+ p <- genPattern+ return $ TestRoute (p, \params _ k -> do+ put (p, params)+ k $ responseLBS status200 [] mempty) -genRoute :: ByteString -> Gen ByteString+genTestRoutes :: Gen [TestRoute]+genTestRoutes = do+ n <- choose (0, 100)+ replicateM n genTestRoute++genRoute :: Maybe Text -> Gen (Route (State (Pattern Text))) genRoute prefix = do- n <- choose (1, 10)- s <- vectorOf n (oneof [genDir, genCapture])- return $ prefix <> C.intercalate "/" s+ SomePath p <- genPath prefix+ return $ defRoute p $ \_params _rq k -> do+ put (pathPattern p)+ k $ responseLBS status200 [] mempty --- Generates routing tables without ambiguous routes (by giving every route a--- prefix that is unique in this routing table).-genRoutes :: Gen [(ByteString, TestHandler)]+-- | Generate 1-100 non-overlapping routes.+genRoutes :: Gen [Route (State (Pattern Text))] genRoutes = do- n <- choose (0, 100)- r <- mapM (genRoute . C.pack . show) [1..n]- return $ r `zip` map handler [1..n]--genTree :: Gen (Tree TestHandler)-genTree = Tree.fromList <$> genRoutes+ n <- choose (0 :: Int, 100)+ mapM (genRoute . Just . Text.pack . show) [1..n] --- Generate a request with a path matching the given route,--- replacing captures with actual parameter values.-genReq :: ByteString -> Gen (Params, Request)-genReq r = do+-- Generate a request with a path matching the given pattern,+-- generating capture values for capture segments. Returns the+-- generated captures and request.+genRequest :: Pattern Text -> Gen (Seq (Capture Text), Request)+genRequest pat = do -- Pair each segment of the route with a potential parameter value. -- Those values which are paired with a capture are the actual parameters.- let segs = C.split '/' r- values <- vectorOf (length segs) genParam- let segs' = segs `zip` values- return (mkParams segs', mkReq segs')+ values <- vectorOf (Seq.length pat) genValue+ let segs = toList pat `zip` values+ return (mkParams segs, mkReq segs) where mkReq segs = defaultRequest- { rawPathInfo = C.intercalate "/" (map mkSeg segs)+ { pathInfo = map mkSeg segs } - mkSeg (seg, val)- | C.head seg == ':' = urlEncode False val- | otherwise = urlEncode False seg+ mkSeg (AnyStr, val) = val+ mkSeg (EqStr s, _) = s - mkParams = reverse . foldr go []+ mkParams = foldr go Seq.empty where- go (seg, val) params- | C.head seg == ':' = (C.tail seg, val) : params- | otherwise = params+ go (AnyStr, val) ps = Capture val <| ps+ go (EqStr _, _) ps = ps++-- Generate a value for a capture. All values are prefixed with+-- a '1' character, to avoid accidentally generating a value that is+-- an exact match for an 'EqStr' matcher in another pattern. If that+-- were to happen for all matchers of a path (unlikely but possible),+-- it would result in a spurious test failure.+genValue :: Gen Text+genValue = ("1" <>) <$> genText++genText :: Gen Text+genText = Text.pack <$> listOf arbitrary
wai-route.cabal view
@@ -1,78 +1,88 @@-name: wai-route-version: 0.4.0-synopsis: Minimalistic, efficient routing for WAI.+name: wai-route+version: 1.0.0+synopsis: WAI middleware for path-based request routing with captures.+category: Web description:- .- Simple routing for applications using the WAI, based on an- efficient tree structure. Routes are defined as string literals- whereby path segments beginning with a ':' indicate captures.- .- A sample is available at: <https://github.com/romanb/wai-route/blob/master/sample/Main.hs>.+ WAI middleware for path-based request routing with captures,+ including further utilities for processing query strings and+ request headers. -license: MPL-2.0-license-file: LICENSE-author: Roman S. Borschel-maintainer: Roman S. Borschel <roman@pkaboo.org>-copyright: 2014 Roman S. Borschel-category: Web-build-type: Simple-extra-source-files: README.md, sample/*.hs, CHANGELOG.md-cabal-version: >=1.10+license: MPL-2.0+license-file: LICENSE+author: Roman S. Borschel+maintainer: Roman S. Borschel <roman@pkaboo.org>+copyright: 2018 Roman S. Borschel -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+build-type: Simple+cabal-version: 1.18 +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.2++extra-source-files:+ README.md, CHANGELOG.md, examples/*.hs+ source-repository head type: git location: git@github.com:romanb/wai-route.git library default-language: Haskell2010- hs-source-dirs: src+ hs-source-dirs: src exposed-modules: Network.Wai.Route- , Network.Wai.Route.Tree + default-extensions:+ NoImplicitPrelude+ build-depends:- base == 4.*- , wai >= 3.0.2 && < 3.3- , unordered-containers >= 0.2- , http-types >= 0.8+ base >= 4.9 && < 5 , bytestring >= 0.10+ , containers >= 0.5.7+ , deepseq >= 1.4.3+ , http-api-data >= 0.3+ , http-types >= 0.8+ , pattern-trie >= 0.1+ , text+ , unordered-containers >= 0.2+ , wai >= 3.0.2 && < 3.3 ghc-options: -Wall -fwarn-tabs- -O2 test-suite wai-route-test- type: exitcode-stdio-1.0 default-language: Haskell2010- hs-source-dirs: test- main-is: Main.hs- ghc-options:- -Wall- -fwarn-tabs- -threaded- other-modules: Test.Network.Wai.Route+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs++ other-modules:+ Test.Network.Wai.Route+ build-depends:- base == 4.*+ base == 4.* , bytestring+ , containers+ , deepseq , http-types- , mtl >= 2.1- , QuickCheck >= 2.10- , tasty >= 0.11+ , mtl >= 2.1+ , pattern-trie+ , QuickCheck >= 2.10+ , tasty >= 0.11 , tasty-quickcheck >= 0.9+ , text+ , unordered-containers , wai , wai-route --- executable wai-route-sample--- hs-source-dirs: sample--- main-is: Main.hs--- build-depends:--- base--- , bytestring--- , http-types--- , wai--- , wai-route--- , warp+ ghc-options:+ -Wall+ -fwarn-tabs+ -threaded++test-suite doctests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ build-depends: base, doctest >= 0.16