]> Git — Sourcephile - haskell/symantic-http.git/blob - symantic-http-test/Hspec/Server/Router.hs
0704a5fd088f6f7424939ea63df674a057449f8f
[haskell/symantic-http.git] / symantic-http-test / Hspec / Server / Router.hs
1 {-# LANGUAGE InstanceSigs #-}
2 {-# LANGUAGE NoMonomorphismRestriction #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# OPTIONS -Wno-missing-signatures #-}
5 {-# OPTIONS -Wno-orphans #-}
6 module Hspec.Server.Router where
7
8 import Control.Monad (unless)
9 import Data.Bool
10 import Data.Char (Char)
11 import Data.Eq (Eq(..))
12 import Data.Int (Int)
13 import Data.String (String)
14 import System.IO (IO, putStrLn)
15 import Text.Show (Show(..))
16 import qualified Control.Monad.Classes as MC
17 import qualified Data.List as List
18 import qualified Data.Map.Strict as Map
19 import qualified Network.Wai.Handler.Warp as Warp
20 import qualified Test.Hspec as Hspec
21
22 import Symantic.HTTP
23 import Symantic.HTTP.Server
24 import Hspec.Utils
25
26 hspec = testSpecs $ describe "Router" $ do
27 it "distributes endpoints through static paths" $ do
28 inp_Endpoint `shouldRouteAs` exp_Endpoint
29 it "distributes nested routes through static paths" $ do
30 inp_Static `shouldRouteAs` exp_Static
31 it "properly reorders permuted static paths" $ do
32 inp_Permute `shouldRouteAs` exp_Permute
33 it "properly reorders permuted static paths in the presence of raw in end" $ do
34 inp_PermuteRawEnd `shouldRouteAs` exp_PermuteRawEnd
35 it "properly reorders permuted static paths in the presence of raw in beginning" $ do
36 inp_PermuteRawBegin `shouldRouteAs` exp_PermuteRawBegin
37 it "properly reorders permuted static paths in the presence of raw in middle" $ do
38 inp_PermuteRawMiddle `shouldRouteAs` exp_PermuteRawMiddle
39 {- NOTE: this is semantically incorrect.
40 it "distributes nested routes through dynamic paths" $ do
41 inp_Dynamic `shouldRouteAs` exp_Dynamic
42 -}
43 it "properly handles mixing static paths at different levels" $ do
44 inp_Level `shouldRouteAs` exp_Level
45
46 -- * Utils
47
48 routerEq ::
49 forall repr a b c d. repr ~ Server =>
50 Router repr a b -> Router repr c d -> Bool
51 routerEq x0 y0 =
52 {-
53 let r = go
54 (Dbg.trace ("eq: x: " <> show x0) x0)
55 (Dbg.trace ("eq: y: " <> show y0) y0) in
56 Dbg.trace ("eq: r: " <> show r) r
57 -}
58 go x0 y0
59 where
60 go :: Router repr a b -> Router repr c d -> Bool
61 go (Router_Seg x) (Router_Seg y) = x == y
62 go (Router_Cat xa xb) (Router_Cat ya yb) = routerEq xa ya && routerEq xb yb
63 go (Router_Alt xl xr) (Router_Alt yl yr) = routerEq xl yl && routerEq xr yr
64 go (Router_Cap xn) (Router_Cap yn) = xn == yn
65 go (Router_Map xs) (Router_Map ys) =
66 let xl = Map.toList xs in
67 let yl = Map.toList ys in
68 (List.length xl == List.length yl &&) $
69 List.and $
70 (\((kx, x),(ky, y)) -> kx==ky && routerEq x y) <$>
71 List.zip xl yl
72 go (Router_Caps xs) (Router_Caps ys) = goCaps xs ys
73 where
74 goCaps :: Captures (Router repr) xs b -> Captures (Router repr) ys d -> Bool
75 goCaps (Captures0 _xa xn xr) (Captures0 _ya yn yr) = xn == yn && routerEq xr yr
76 goCaps (Captures2 xx xy) (Captures2 yx yy) = goCaps xx yx && goCaps xy yy
77 goCaps _ _ = False -- FIXME: may wrongly return False if captures are not in the same order
78 go (Router_Union _u x) y = routerEq x y
79 go x (Router_Union _u y) = routerEq x y
80 go Router_Any{} Router_Any{} = True
81 go _x _y = False
82
83 shouldRouteAs :: Router Server a b -> Router Server c d -> Hspec.Expectation
84 shouldRouteAs inp exp =
85 let inpR = router inp in
86 let expR = router exp in
87 unless (inpR`routerEq`expR) $
88 Hspec.expectationFailure $ "expected:\n" <> show expR <> "\nbut got:\n" <> show inpR
89
90 -- * APIs
91
92 end = get @String @'[PlainText]
93
94 inp_Endpoint = "a" </> end <!> "a" </> end
95 exp_Endpoint = "a" </> (end <!> end)
96
97 inp_Static = "a" </> "b" </> end <!> "a" </> "c" </> end
98 exp_Static = "a" </> ("b" </> end <!> "c" </> end)
99
100 {- FIXME: factorizing should be doable when the captured type is the same
101 inp_Dynamic =
102 "a" </> capture @Int "foo" <.> "b" </> end
103 <!> "a" </> capture @Bool "bar" <.> "c" </> end
104 <!> "a" </> capture @Char "baz" <.> "d" </> end
105 exp_Dynamic =
106 "a" </> captures (Captures2 (Captures2 (Captures0 (Proxy @(Int -> Res)) "foo")
107 (Captures0 (Proxy @(Bool -> Res)) "bar"))
108 (Captures0 (Proxy @(Char -> Res)) "baz"))
109 <.> ("b" </> end <!> "c" </> end <!> "d" </> end)
110 type Res = ResponseArgs (Router Server) String '[PlainText]
111 -}
112
113 inp_Permute =
114 "a" </> "b" </> "c" </> end
115 <!> "b" </> "a" </> "c" </> end
116 <!> "a" </> "c" </> "b" </> end
117 <!> "c" </> "a" </> "b" </> end
118 <!> "b" </> "c" </> "a" </> end
119 <!> "c" </> "b" </> "a" </> end
120 <!> "a" </> "a" </> "b" </> end
121 <!> "a" </> "a" </> "c" </> end
122 exp_Permute =
123 "a" </> ("b" </> "c" </> end
124 <!> "c" </> "b" </> end
125 <!> "a" </> "b" </> end)
126 <!> "b" </> ("a" </> "c" </> end
127 <!> "c" </> "a" </> end)
128 <!> "c" </> ("a" </> "b" </> end
129 <!> "b" </> "a" </> end)
130 <!> "a" </> "a" </> "c" </> end
131
132 inp_PermuteRawEnd =
133 "a" </> "b" </> "c" </> end
134 <!> "b" </> "a" </> "c" </> end
135 <!> "a" </> "c" </> "b" </> end
136 <!> "c" </> "a" </> "b" </> end
137 <!> "b" </> "c" </> "a" </> end
138 <!> "c" </> "b" </> "a" </> end
139 <!> "a" </> "a" </> "b" </> end
140 <!> "a" </> "a" </> "c" </> end
141 <!> raw
142 exp_PermuteRawEnd = exp_Permute <!> raw
143
144 inp_PermuteRawBegin =
145 raw
146 <!> "a" </> "b" </> "c" </> end
147 <!> "b" </> "a" </> "c" </> end
148 <!> "a" </> "c" </> "b" </> end
149 <!> "c" </> "a" </> "b" </> end
150 <!> "b" </> "c" </> "a" </> end
151 <!> "c" </> "b" </> "a" </> end
152 <!> "a" </> "a" </> "b" </> end
153 <!> "a" </> "a" </> "c" </> end
154 exp_PermuteRawBegin = raw <!> exp_Permute
155
156 inp_PermuteRawMiddle =
157 "a" </> "b" </> "c" </> end
158 <!> "b" </> "a" </> "c" </> end
159 <!> "a" </> "c" </> "b" </> end
160 <!> raw
161 <!> "c" </> "a" </> "b" </> end
162 <!> "b" </> "c" </> "a" </> end
163 <!> "c" </> "b" </> "a" </> end
164 exp_PermuteRawMiddle =
165 "a" </> ("b" </> "c" </> end <!>
166 "c" </> "b" </> end)
167 <!> "b" </> "a" </> "c" </> end
168 <!> raw
169 <!> "b" </> "c" </> "a" </> end
170 <!> "c" </> ("a" </> "b" </> end <!>
171 "b" </> "a" </> end)
172
173 inp_Level1 =
174 "a" </> "b" </> end
175 <!> "a" </> end
176 inp_Level2 =
177 "b" </> end
178 <!> "a" </> "c" </> end
179 <!> end
180 inp_Level =
181 inp_Level1 <!>
182 inp_Level2
183 exp_Level =
184 "a" </> ("b" </> end <!> "c" </> end <!> end)
185 <!> "b" </> end
186 <!> end