git.iko.soy/servant
on 0802221 help sign in
servant/test/Servant/API/QQSpec.hs
144 lines 4.8 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE OverlappingInstances #-}
6{-# LANGUAGE QuasiQuotes #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeOperators #-}
9{-# LANGUAGE UndecidableInstances #-}
10module Servant.API.QQSpec where
12import Test.Hspec
14import Servant.API
15{-import Servant.API.QQ-}
17--------------------------------------------------------------------------
18-- Types for testing
19--------------------------------------------------------------------------
21-- Methods ---------------------------------------------------------------
22type SimpleGet = [sitemap|
23GET hello ()
24|]
25type SimpleGet' = "hello" :> Get ()
26type SimpleGet'' = "hello" :> Get Bool
28type SimpleGet2 = [sitemap|
29GET hello Bool
30|]
31type SimpleGet2' = "hello" :> Get Bool
32type SimpleGet2'' = "hello" :> Get Int
34type SimplePost = [sitemap|
35POST hello ()
36|]
37type SimplePost' = "hello" :> Post ()
38type SimplePost'' = "hello" :> Post Bool
40type SimplePost2 = [sitemap|
41POST hello Bool
42|]
43type SimplePost2' = "hello" :> Post Bool
44type SimplePost2'' = "hello" :> Post ()
46type SimplePut = [sitemap|
47PUT hello ()
48|]
49type SimplePut' = "hello" :> Put ()
50type SimplePut'' = "hello" :> Put Bool
52type SimplePut2 = [sitemap|
53PUT hello Bool
54|]
55type SimplePut2' = "hello" :> Put Bool
56type SimplePut2'' = "hello" :> Put ()
58-- Parameters ------------------------------------------------------------
60type SimpleReqBody = [sitemap|
61POST hello () -> Bool
62|]
63type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
64type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
66type SimpleCapture = [sitemap|
67POST hello/p:Int Bool
68|]
69type SimpleCapture' = "hello" :> Capture "p" Int :> Post Bool
70type SimpleCapture'' = "hello" :> Capture "r" Int :> Post Bool
71type SimpleCapture''' = "hello" :> Capture "p" Bool :> Post Bool
73type SimpleQueryParam = [sitemap|
74POST hello/?p:Int Bool
75|]
76type SimpleQueryParam' = "hello" :> QueryParam "p" Int :> Post Bool
77type SimpleQueryParam'' = "hello" :> QueryParam "r" Int :> Post Bool
78type SimpleQueryParam''' = "hello" :> QueryParam "p" Bool :> Post Bool
80-- Combinations ----------------------------------------------------------
82type TwoPaths = [sitemap|
83POST hello Bool
84GET hello Bool
85|]
86type TwoPaths' = ("hello" :> Post Bool) :<|> ("hello" :> Get Bool)
87--------------------------------------------------------------------------
88-- Spec
89--------------------------------------------------------------------------
91spec :: Spec
92spec = do
93 describe "'sitemap' QuasiQuoter" $ do
94 it "Handles simple GET types" $ do
95 (u::SimpleGet) ~= (u::SimpleGet' ) ~> True
96 (u::SimpleGet) ~= (u::SimpleGet'' ) ~> False
97 (u::SimpleGet2) ~= (u::SimpleGet2' ) ~> True
98 (u::SimpleGet2) ~= (u::SimpleGet2'') ~> False
99 it "Handles simple POST types" $ do
100 (u::SimplePost) ~= (u::SimplePost' ) ~> True
101 (u::SimplePost) ~= (u::SimplePost'' ) ~> False
102 (u::SimplePost2) ~= (u::SimplePost2' ) ~> True
103 (u::SimplePost2) ~= (u::SimplePost2'') ~> False
104 it "Handles simple PUT types" $ do
105 (u::SimplePut) ~= (u::SimplePut' ) ~> True
106 (u::SimplePut) ~= (u::SimplePut'' ) ~> False
107 (u::SimplePut2) ~= (u::SimplePut2' ) ~> True
108 (u::SimplePut2) ~= (u::SimplePut2'') ~> False
109 it "Handles simple request body types" $ do
110 (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
111 (u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
112 it "Handles simple captures" $ do
113 (u::SimpleCapture) ~= (u::SimpleCapture' ) ~> True
114 (u::SimpleCapture) ~= (u::SimpleCapture'') ~> False
115 (u::SimpleCapture) ~= (u::SimpleCapture''') ~> False
116 it "Handles simple querystring parameters" $ do
117 (u::SimpleQueryParam) ~= (u::SimpleQueryParam' ) ~> True
118 (u::SimpleQueryParam) ~= (u::SimpleQueryParam'') ~> False
119 (u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False
120 it "Handles multiples paths" $ do
121 (u::TwoPaths) ~= (u::TwoPaths') ~> True
124--------------------------------------------------------------------------
125-- Utilities
126--------------------------------------------------------------------------
127data HTrue
128data HFalse
130-- Kiselyov's Type Equality predicate
131class TypeEq x y b | x y -> b where { areEq :: x -> y -> Bool }
132instance TypeEq x x HTrue where { areEq _ _ = True }
133instance b ~ HFalse => TypeEq x y b where { areEq _ _ = False}
135infix 4 ~=
136(~=) :: TypeEq x y b => x -> y -> Bool
137(~=) = areEq
139u :: a
140u = undefined
142infix 3 ~>
143(~>) :: (Show a, Eq a) => a -> a -> Expectation
144(~>) = shouldBe