/
ForeignSpec.hs
149 lines (123 loc) · 4.89 KB
/
ForeignSpec.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW__HASKELL < 709
{-# OPTIONS_GHC -fcontext-stack=41 #-}
#endif
#include "overlapping-compat.h"
module Servant.ForeignSpec where
import Data.Monoid ((<>))
import Data.Proxy
import Servant.Foreign
import Servant.API.Internal.Test.ComprehensiveAPI
import Test.Hspec
spec :: Spec
spec = describe "Servant.Foreign" $ do
camelCaseSpec
listFromAPISpec
camelCaseSpec :: Spec
camelCaseSpec = describe "camelCase" $ do
it "converts FunctionNames to camelCase" $ do
camelCase (FunctionName ["post", "counter", "inc"])
`shouldBe` "postCounterInc"
camelCase (FunctionName ["get", "hyphen-ated", "counter"])
`shouldBe` "getHyphen-atedCounter"
----------------------------------------------------------------------
-- This declaration simply checks that all instances are in place.
_ = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) comprehensiveAPIWithoutRaw
----------------------------------------------------------------------
data LangX
instance HasForeignType LangX String NoContent where
typeFor _ _ _ = "voidX"
instance HasForeignType LangX String (Headers ctyps NoContent) where
typeFor _ _ _ = "voidX"
instance HasForeignType LangX String Int where
typeFor _ _ _ = "intX"
instance HasForeignType LangX String Bool where
typeFor _ _ _ = "boolX"
instance OVERLAPPING_ HasForeignType LangX String String where
typeFor _ _ _ = "stringX"
instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where
typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
instance (HasForeignType LangX String a) => HasForeignType LangX String (Maybe a) where
typeFor lang ftype _ = "maybe " <> typeFor lang ftype (Proxy :: Proxy a)
type TestApi
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
:<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
:<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
:<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]
:<|> "test" :> EmptyAPI
testApi :: [Req String]
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
listFromAPISpec :: Spec
listFromAPISpec = describe "listFromAPI" $ do
it "generates 5 endpoints for TestApi" $ do
length testApi `shouldBe` 5
let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi
it "collects all info for get request" $ do
shouldBe getReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test" ]
[ QueryArg (Arg "flag" "boolX") Flag ]
, _reqMethod = "GET"
, _reqHeaders = [HeaderArg $ Arg "header" "maybe listX of stringX"]
, _reqBody = Nothing
, _reqReturnType = Just "intX"
, _reqFuncName = FunctionName ["get", "test"]
}
it "collects all info for post request" $ do
shouldBe postReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test" ]
[ QueryArg (Arg "param" "maybe intX") Normal ]
, _reqMethod = "POST"
, _reqHeaders = []
, _reqBody = Just "listX of stringX"
, _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["post", "test"]
}
it "collects all info for put request" $ do
shouldBe putReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test" ]
-- Shoud this be |intX| or |listX of intX| ?
[ QueryArg (Arg "params" "listX of intX") List ]
, _reqMethod = "PUT"
, _reqHeaders = []
, _reqBody = Just "stringX"
, _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["put", "test"]
}
it "collects all info for delete request" $ do
shouldBe deleteReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test"
, Segment $ Cap (Arg "id" "intX") ]
[]
, _reqMethod = "DELETE"
, _reqHeaders = []
, _reqBody = Nothing
, _reqReturnType = Just "voidX"
, _reqFuncName = FunctionName ["delete", "test", "by", "id"]
}
it "collects all info for capture all request" $ do
shouldBe captureAllReq $ defReq
{ _reqUrl = Url
[ Segment $ Static "test"
, Segment $ Cap (Arg "ids" "listX of intX") ]
[]
, _reqMethod = "GET"
, _reqHeaders = []
, _reqBody = Nothing
, _reqReturnType = Just "listX of intX"
, _reqFuncName = FunctionName ["get", "test", "by", "ids"]
}