@@ -9,16 +9,12 @@ import Prelude.Compat
99
1010import Data.Function
1111 (on)
12−import Data.List
13− (nub)
1412import Data.Map
1513 (Map)
1614import qualified Data.Map as M
1715import Data.Text
1816 (Text)
1917import qualified Data.Text as T
20−import Data.Typeable
21− (TypeRep)
2218import Network.Wai
2319 (Response, pathInfo)
2420import Servant.Server.Internal.ErrorFormatter
@@ -28,18 +24,6 @@ import Servant.Server.Internal.ServerError
2824
2925type Router env = Router' env RoutingApplication
3026
31−data CaptureHint = CaptureHint
32− { captureName :: Text
33− , captureType :: TypeRep
34− }
35− deriving (Show, Eq)
36−
37−toCaptureTag :: CaptureHint -> Text
38−toCaptureTag hint = captureName hint <> "::" <> (T.pack . show) (captureType hint)
39−
40−toCaptureTags :: [CaptureHint] -> Text
41−toCaptureTags hints = "<" <> T.intercalate "|" (map toCaptureTag hints) <> ">"
42−
4327-- | Internal representation of a router.
4428--
4529-- The first argument describes an environment type that is
@@ -52,10 +36,10 @@ data Router' env a =
5236 -- ^ the map contains routers for subpaths (first path component used
5337 -- for lookup and removed afterwards), the list contains handlers
5438 -- for the empty path, to be tried in order
55− | CaptureRouter [CaptureHint] (Router' (Text, env) a)
39+ | CaptureRouter (Router' (Text, env) a)
5640 -- ^ first path component is passed to the child router in its
5741 -- environment and removed afterwards
58− | CaptureAllRouter [CaptureHint] (Router' ([Text], env) a)
42+ | CaptureAllRouter (Router' ([Text], env) a)
5943 -- ^ all path components are passed to the child router in its
6044 -- environment and are removed afterwards
6145 | RawRouter (env -> a)
@@ -85,8 +69,8 @@ leafRouter l = StaticRouter M.empty [l]
8569choice :: Router' env a -> Router' env a -> Router' env a
8670choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =
8771 StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)
88−choice (CaptureRouter hints1 router1) (CaptureRouter hints2 router2) =
89− CaptureRouter (nub $ hints1 ++ hints2) (choice router1 router2)
72+choice (CaptureRouter router1) (CaptureRouter router2) =
73+ CaptureRouter (choice router1 router2)
9074choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3
9175choice router1 router2 = Choice router1 router2
9276
@@ -100,7 +84,7 @@ choice router1 router2 = Choice router1 router2
10084--
10185data RouterStructure =
10286 StaticRouterStructure (Map Text RouterStructure) Int
103− | CaptureRouterStructure [CaptureHint] RouterStructure
87+ | CaptureRouterStructure RouterStructure
10488 | RawRouterStructure
10589 | ChoiceStructure RouterStructure RouterStructure
10690 deriving (Eq, Show)
@@ -114,11 +98,11 @@ data RouterStructure =
11498routerStructure :: Router' env a -> RouterStructure
11599routerStructure (StaticRouter m ls) =
116100 StaticRouterStructure (fmap routerStructure m) (length ls)
117−routerStructure (CaptureRouter hints router) =
118− CaptureRouterStructure hints $
101+routerStructure (CaptureRouter router) =
102+ CaptureRouterStructure $
119103 routerStructure router
120−routerStructure (CaptureAllRouter hints router) =
121− CaptureRouterStructure hints $
104+routerStructure (CaptureAllRouter router) =
105+ CaptureRouterStructure $
122106 routerStructure router
123107routerStructure (RawRouter _) =
124108 RawRouterStructure
@@ -130,8 +114,8 @@ routerStructure (Choice r1 r2) =
130114-- | Compare the structure of two routers.
131115--
132116sameStructure :: Router' env a -> Router' env b -> Bool
133−sameStructure router1 router2 =
134− routerStructure router1 == routerStructure router2
117+sameStructure r1 r2 =
118+ routerStructure r1 == routerStructure r2
135119
136120-- | Provide a textual representation of the
137121-- structure of a router.
@@ -142,8 +126,7 @@ routerLayout router =
142126 where
143127 mkRouterLayout :: Bool -> RouterStructure -> [Text]
144128 mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n
145− mkRouterLayout c (CaptureRouterStructure hints r) =
146− mkSubTree c (toCaptureTags hints) (mkRouterLayout False r)
129+ mkRouterLayout c (CaptureRouterStructure r) = mkSubTree c "<capture>" (mkRouterLayout False r)
147130 mkRouterLayout c RawRouterStructure =
148131 if c then ["├─ <raw>"] else ["└─ <raw>"]
149132 mkRouterLayout c (ChoiceStructure r1 r2) =
@@ -186,7 +169,7 @@ runRouterEnv fmt router env request respond =
186169 -> let request' = request { pathInfo = rest }
187170 in runRouterEnv fmt router' env request' respond
188171 _ -> respond $ Fail $ fmt request
189− CaptureRouter _ router' ->
172+ CaptureRouter router' ->
190173 case pathInfo request of
191174 [] -> respond $ Fail $ fmt request
192175 -- This case is to handle trailing slashes.
@@ -194,7 +177,7 @@ runRouterEnv fmt router env request respond =
194177 first : rest
195178 -> let request' = request { pathInfo = rest }
196179 in runRouterEnv fmt router' (first, env) request' respond
197− CaptureAllRouter _ router' ->
180+ CaptureAllRouter router' ->
198181 let segments = pathInfo request
199182 request' = request { pathInfo = [] }
200183 in runRouterEnv fmt router' (segments, env) request' respond