git.iko.soy/typeable/servant
on master help sign in
Merge pull request #277 from MaxOw/master
1bd2d91Denis Redozubov
servant-foreign/servant-foreign.cabal+2−2
compare with master
unifiedsplit
@@ -11,7 +11,7 @@ description:
11 <https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md CHANGELOG>
11 <https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md CHANGELOG>
12license: BSD3
12license: BSD3
13license-file: LICENSE
13license-file: LICENSE
14−author: Denis Redozubov
14+author: Denis Redozubov, Maksymilian Owsianny
15maintainer: denis.redozubov@gmail.com
15maintainer: denis.redozubov@gmail.com
16copyright: 2015 Denis Redozubov, Alp Mestanogullari
16copyright: 2015 Denis Redozubov, Alp Mestanogullari
17category: Web
17category: Web
@@ -45,4 +45,4 @@ test-suite spec
45 build-depends: base
45 build-depends: base
46 , hspec >= 2.1.8
46 , hspec >= 2.1.8
47 , servant-foreign
47 , servant-foreign
48− default-language: Haskell2010
48+ default-language: Haskell2010
servant-foreign/src/Servant/Foreign.hs+5
@@ -2,6 +2,7 @@
2-- arbitrary programming languages.
2-- arbitrary programming languages.
3module Servant.Foreign
3module Servant.Foreign
4 ( HasForeign(..)
4 ( HasForeign(..)
5+ , HasForeignType(..)
5 , Segment(..)
6 , Segment(..)
6 , SegmentType(..)
7 , SegmentType(..)
7 , FunctionName
8 , FunctionName
@@ -24,8 +25,12 @@ module Servant.Foreign
24 , reqBody
25 , reqBody
25 , reqHeaders
26 , reqHeaders
26 , reqMethod
27 , reqMethod
28+ , reqReturnType
27 , segment
29 , segment
28 , queryStr
30 , queryStr
31+ , listFromAPI
32+ , GenerateList(..)
33+ , NoTypes
29 -- re-exports
34 -- re-exports
30 , module Servant.API
35 , module Servant.API
31 ) where
36 ) where
servant-foreign/src/Servant/Foreign/Internal.hs+167−79
@@ -45,7 +45,8 @@ camelCase = camelCase' . Prelude.map (replace "-" "")
45 capitalize "" = ""
45 capitalize "" = ""
46 capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
46 capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
47
47
48+type ForeignType = Text
48−type Arg = Text
49+type Arg = (Text, ForeignType)
49
50
50newtype Segment = Segment { _segment :: SegmentType }
51newtype Segment = Segment { _segment :: SegmentType }
51 deriving (Eq, Show)
52 deriving (Eq, Show)
@@ -68,10 +69,10 @@ data QueryArg = QueryArg
68 } deriving (Eq, Show)
69 } deriving (Eq, Show)
69
70
70data HeaderArg = HeaderArg
71data HeaderArg = HeaderArg
71− { headerArgName :: Text
72+ { headerArg :: Arg
72 }
73 }
73 | ReplaceHeaderArg
74 | ReplaceHeaderArg
74− { headerArgName :: Text
75+ { headerArg :: Arg
75 , headerPattern :: Text
76 , headerPattern :: Text
76 } deriving (Eq, Show)
77 } deriving (Eq, Show)
77
78
@@ -88,11 +89,12 @@ type FunctionName = [Text]
88type Method = Text
89type Method = Text
89
90
90data Req = Req
91data Req = Req
91− { _reqUrl :: Url
92+ { _reqUrl :: Url
92− , _reqMethod :: Method
93+ , _reqMethod :: Method
93− , _reqHeaders :: [HeaderArg]
94+ , _reqHeaders :: [HeaderArg]
94− , _reqBody :: Bool
95+ , _reqBody :: Maybe ForeignType
96+ , _reqReturnType :: ForeignType
95− , _funcName :: FunctionName
97+ , _funcName :: FunctionName
96 } deriving (Eq, Show)
98 } deriving (Eq, Show)
97
99
98makeLenses ''QueryArg
100makeLenses ''QueryArg
@@ -109,7 +111,7 @@ captureArg (Segment (Cap s)) = s
109captureArg _ = error "captureArg called on non capture"
111captureArg _ = error "captureArg called on non capture"
110
112
111defReq :: Req
113defReq :: Req
112−defReq = Req defUrl "GET" [] False []
114+defReq = Req defUrl "GET" [] Nothing "" []
113
115
114-- | To be used exclusively as a "negative" return type/constraint
116-- | To be used exclusively as a "negative" return type/constraint
115-- by @'Elem`@ type family.
117-- by @'Elem`@ type family.
@@ -120,142 +122,228 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
120 Elem a (a ': list) = ()
122 Elem a (a ': list) = ()
121 Elem a (b ': list) = Elem a list
123 Elem a (b ': list) = Elem a list
122
124
125+-- | 'HasForeignType' maps Haskell types with types in the target
126+-- language of your backend. For example, let's say you're
127+-- implementing a backend to some language __X__:
128+--
129+-- > -- First you need to create a dummy type to parametrize your
130+-- > -- instances.
131+-- > data LangX
132+-- >
133+-- > -- Otherwise you define instances for the types you need
134+-- > instance HasForeignType LangX Int where
135+-- > typeFor _ _ = "intX"
136+-- >
137+-- > -- Or for example in case of lists
138+-- > instance HasForeignType LangX a => HasForeignType LangX [a] where
139+-- > typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
140+--
141+-- Finally to generate list of information about all the endpoints for
142+-- an API you create a function of a form:
143+--
144+-- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api))
145+-- > => Proxy api -> [Req]
146+-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api
147+--
148+-- > -- If language __X__ is dynamically typed then you can use
149+-- > -- a predefined NoTypes parameter
150+-- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api))
151+-- > => Proxy api -> [Req]
152+-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api
153+-- >
154+--
155+class HasForeignType lang a where
156+ typeFor :: Proxy lang -> Proxy a -> ForeignType
157+
158+data NoTypes
159+
160+instance HasForeignType NoTypes a where
161+ typeFor _ _ = empty
162+
123−class HasForeign (layout :: *) where
163+class HasForeign lang (layout :: *) where
124 type Foreign layout :: *
164 type Foreign layout :: *
125− foreignFor :: Proxy layout -> Req -> Foreign layout
165+ foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
126
166
127−instance (HasForeign a, HasForeign b)
167+instance (HasForeign lang a, HasForeign lang b)
128− => HasForeign (a :<|> b) where
168+ => HasForeign lang (a :<|> b) where
129 type Foreign (a :<|> b) = Foreign a :<|> Foreign b
169 type Foreign (a :<|> b) = Foreign a :<|> Foreign b
130
170
131− foreignFor Proxy req =
171+ foreignFor lang Proxy req =
132− foreignFor (Proxy :: Proxy a) req
172+ foreignFor lang (Proxy :: Proxy a) req
133− :<|> foreignFor (Proxy :: Proxy b) req
173+ :<|> foreignFor lang (Proxy :: Proxy b) req
134
174
135−instance (KnownSymbol sym, HasForeign sublayout)
175+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
136− => HasForeign (Capture sym a :> sublayout) where
176+ => HasForeign lang (Capture sym a :> sublayout) where
137 type Foreign (Capture sym a :> sublayout) = Foreign sublayout
177 type Foreign (Capture sym a :> sublayout) = Foreign sublayout
138
178
139− foreignFor Proxy req =
179+ foreignFor lang Proxy req =
140− foreignFor (Proxy :: Proxy sublayout) $
180+ foreignFor lang (Proxy :: Proxy sublayout) $
141− req & reqUrl.path <>~ [Segment (Cap str)]
181+ req & reqUrl.path <>~ [Segment (Cap arg)]
142 & funcName %~ (++ ["by", str])
182 & funcName %~ (++ ["by", str])
143
183
184+ where
144− where str = pack . symbolVal $ (Proxy :: Proxy sym)
185+ str = pack . symbolVal $ (Proxy :: Proxy sym)
186+ arg = (str, typeFor lang (Proxy :: Proxy a))
145
187
188+instance (Elem JSON list, HasForeignType lang a)
146−instance Elem JSON list => HasForeign (Delete list a) where
189+ => HasForeign lang (Delete list a) where
147 type Foreign (Delete list a) = Req
190 type Foreign (Delete list a) = Req
148
191
149− foreignFor Proxy req =
192+ foreignFor lang Proxy req =
150− req & funcName %~ ("delete" :)
193+ req & funcName %~ ("delete" :)
151− & reqMethod .~ "DELETE"
194+ & reqMethod .~ "DELETE"
195+ & reqReturnType .~ retType
196+ where
197+ retType = typeFor lang (Proxy :: Proxy a)
152
198
199+instance (Elem JSON list, HasForeignType lang a)
153−instance Elem JSON list => HasForeign (Get list a) where
200+ => HasForeign lang (Get list a) where
154 type Foreign (Get list a) = Req
201 type Foreign (Get list a) = Req
155
202
156− foreignFor Proxy req =
203+ foreignFor lang Proxy req =
157 req & funcName %~ ("get" :)
204 req & funcName %~ ("get" :)
158 & reqMethod .~ "GET"
205 & reqMethod .~ "GET"
206+ & reqReturnType .~ retType
207+ where
208+ retType = typeFor lang (Proxy :: Proxy a)
159
209
160−instance (KnownSymbol sym, HasForeign sublayout)
210+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
161− => HasForeign (Header sym a :> sublayout) where
211+ => HasForeign lang (Header sym a :> sublayout) where
162 type Foreign (Header sym a :> sublayout) = Foreign sublayout
212 type Foreign (Header sym a :> sublayout) = Foreign sublayout
163
213
164− foreignFor Proxy req =
214+ foreignFor lang Proxy req =
215+ foreignFor lang subP $ req
165− foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
216+ & reqHeaders <>~ [HeaderArg arg]
166
217
218+ where
167− where hname = pack . symbolVal $ (Proxy :: Proxy sym)
219+ hname = pack . symbolVal $ (Proxy :: Proxy sym)
220+ arg = (hname, typeFor lang (Proxy :: Proxy a))
168− subP = Proxy :: Proxy sublayout
221+ subP = Proxy :: Proxy sublayout
169
222
223+instance (Elem JSON list, HasForeignType lang a)
170−instance Elem JSON list => HasForeign (Post list a) where
224+ => HasForeign lang (Post list a) where
171 type Foreign (Post list a) = Req
225 type Foreign (Post list a) = Req
172
226
173− foreignFor Proxy req =
227+ foreignFor lang Proxy req =
174 req & funcName %~ ("post" :)
228 req & funcName %~ ("post" :)
175 & reqMethod .~ "POST"
229 & reqMethod .~ "POST"
230+ & reqReturnType .~ retType
231+ where
232+ retType = typeFor lang (Proxy :: Proxy a)
176
233
234+instance (Elem JSON list, HasForeignType lang a)
177−instance Elem JSON list => HasForeign (Put list a) where
235+ => HasForeign lang (Put list a) where
178 type Foreign (Put list a) = Req
236 type Foreign (Put list a) = Req
179
237
180− foreignFor Proxy req =
238+ foreignFor lang Proxy req =
181 req & funcName %~ ("put" :)
239 req & funcName %~ ("put" :)
182 & reqMethod .~ "PUT"
240 & reqMethod .~ "PUT"
241+ & reqReturnType .~ retType
242+ where
243+ retType = typeFor lang (Proxy :: Proxy a)
183
244
184−instance (KnownSymbol sym, HasForeign sublayout)
245+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
185− => HasForeign (QueryParam sym a :> sublayout) where
246+ => HasForeign lang (QueryParam sym a :> sublayout) where
186 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
247 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
187
248
188− foreignFor Proxy req =
249+ foreignFor lang Proxy req =
189− foreignFor (Proxy :: Proxy sublayout) $
250+ foreignFor lang (Proxy :: Proxy sublayout) $
190− req & reqUrl.queryStr <>~ [QueryArg str Normal]
251+ req & reqUrl.queryStr <>~ [QueryArg arg Normal]
191
252
253+ where
192− where str = pack . symbolVal $ (Proxy :: Proxy sym)
254+ str = pack . symbolVal $ (Proxy :: Proxy sym)
255+ arg = (str, typeFor lang (Proxy :: Proxy a))
193
256
194−instance (KnownSymbol sym, HasForeign sublayout)
257+instance (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
195− => HasForeign (QueryParams sym a :> sublayout) where
258+ => HasForeign lang (QueryParams sym a :> sublayout) where
196 type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
259 type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
197
260
198− foreignFor Proxy req =
261+ foreignFor lang Proxy req =
199− foreignFor (Proxy :: Proxy sublayout) $
262+ foreignFor lang (Proxy :: Proxy sublayout) $
200− req & reqUrl.queryStr <>~ [QueryArg str List]
263+ req & reqUrl.queryStr <>~ [QueryArg arg List]
201
264
265+ where
202− where str = pack . symbolVal $ (Proxy :: Proxy sym)
266+ str = pack . symbolVal $ (Proxy :: Proxy sym)
267+ arg = (str, typeFor lang (Proxy :: Proxy [a]))
203
268
204−instance (KnownSymbol sym, HasForeign sublayout)
269+instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout)
205− => HasForeign (QueryFlag sym :> sublayout) where
270+ => HasForeign lang (QueryFlag sym :> sublayout) where
206 type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
271 type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
207
272
208− foreignFor Proxy req =
273+ foreignFor lang Proxy req =
209− foreignFor (Proxy :: Proxy sublayout) $
274+ foreignFor lang (Proxy :: Proxy sublayout) $
210− req & reqUrl.queryStr <>~ [QueryArg str Flag]
275+ req & reqUrl.queryStr <>~ [QueryArg arg Flag]
211
276
277+ where
212− where str = pack . symbolVal $ (Proxy :: Proxy sym)
278+ str = pack . symbolVal $ (Proxy :: Proxy sym)
279+ arg = (str, typeFor lang (Proxy :: Proxy a))
213
280
214−instance HasForeign Raw where
281+instance HasForeign lang Raw where
215 type Foreign Raw = Method -> Req
282 type Foreign Raw = Method -> Req
216
283
217− foreignFor Proxy req method =
284+ foreignFor _ Proxy req method =
218 req & funcName %~ ((toLower method) :)
285 req & funcName %~ ((toLower method) :)
219 & reqMethod .~ method
286 & reqMethod .~ method
220
287
288+instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
221−instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
289+ => HasForeign lang (ReqBody list a :> sublayout) where
222 type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
290 type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
223
291
224− foreignFor Proxy req =
292+ foreignFor lang Proxy req =
225− foreignFor (Proxy :: Proxy sublayout) $
293+ foreignFor lang (Proxy :: Proxy sublayout) $
226− req & reqBody .~ True
294+ req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
227
295
228−instance (KnownSymbol path, HasForeign sublayout)
296+instance (KnownSymbol path, HasForeign lang sublayout)
229− => HasForeign (path :> sublayout) where
297+ => HasForeign lang (path :> sublayout) where
230 type Foreign (path :> sublayout) = Foreign sublayout
298 type Foreign (path :> sublayout) = Foreign sublayout
231
299
232− foreignFor Proxy req =
300+ foreignFor lang Proxy req =
233− foreignFor (Proxy :: Proxy sublayout) $
301+ foreignFor lang (Proxy :: Proxy sublayout) $
234 req & reqUrl.path <>~ [Segment (Static str)]
302 req & reqUrl.path <>~ [Segment (Static str)]
235 & funcName %~ (++ [str])
303 & funcName %~ (++ [str])
236
304
305+ where
237− where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
306+ str = Data.Text.map (\c -> if c == '.' then '_' else c)
307+ . pack . symbolVal $ (Proxy :: Proxy path)
238
308
239−instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
309+instance HasForeign lang sublayout => HasForeign lang (RemoteHost :> sublayout) where
240 type Foreign (RemoteHost :> sublayout) = Foreign sublayout
310 type Foreign (RemoteHost :> sublayout) = Foreign sublayout
241
311
242− foreignFor Proxy req =
312+ foreignFor lang Proxy req =
243− foreignFor (Proxy :: Proxy sublayout) req
313+ foreignFor lang (Proxy :: Proxy sublayout) req
244
314
245−instance HasForeign sublayout => HasForeign (IsSecure :> sublayout) where
315+instance HasForeign lang sublayout => HasForeign lang (IsSecure :> sublayout) where
246 type Foreign (IsSecure :> sublayout) = Foreign sublayout
316 type Foreign (IsSecure :> sublayout) = Foreign sublayout
247
317
248− foreignFor Proxy req =
318+ foreignFor lang Proxy req =
249− foreignFor (Proxy :: Proxy sublayout) req
319+ foreignFor lang (Proxy :: Proxy sublayout) req
250
320
251−instance HasForeign sublayout => HasForeign (Vault :> sublayout) where
321+instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
252 type Foreign (Vault :> sublayout) = Foreign sublayout
322 type Foreign (Vault :> sublayout) = Foreign sublayout
253
323
254− foreignFor Proxy req =
324+ foreignFor lang Proxy req =
255− foreignFor (Proxy :: Proxy sublayout) req
325+ foreignFor lang (Proxy :: Proxy sublayout) req
256
326
257−instance HasForeign sublayout => HasForeign (HttpVersion :> sublayout) where
327+instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where
258 type Foreign (HttpVersion :> sublayout) = Foreign sublayout
328 type Foreign (HttpVersion :> sublayout) = Foreign sublayout
259
329
260− foreignFor Proxy req =
330+ foreignFor lang Proxy req =
261− foreignFor (Proxy :: Proxy sublayout) req
331+ foreignFor lang (Proxy :: Proxy sublayout) req
332+
333+-- | Utility class used by 'listFromAPI' which computes
334+-- the data needed to generate a function for each endpoint
335+-- and hands it all back in a list.
336+class GenerateList reqs where
337+ generateList :: reqs -> [Req]
338+
339+instance GenerateList Req where
340+ generateList r = [r]
341+
342+instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where
343+ generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
344+
345+-- | Generate the necessary data for codegen as a list, each 'Req'
346+-- describing one endpoint from your API type.
347+listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]
348+listFromAPI lang p = generateList (foreignFor lang p defReq)
349+
servant-foreign/test/Servant/ForeignSpec.hs+98−1
@@ -1,17 +1,114 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TypeOperators #-}
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE FlexibleContexts #-}
6+{-# LANGUAGE FlexibleInstances #-}
7+{-# LANGUAGE TypeSynonymInstances #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
9+{-# LANGUAGE CPP #-}
10+#if __GLASGOW_HASKELL__ < 710
11+{-# LANGUAGE OverlappingInstances #-}
12+#endif
2
13
3module Servant.ForeignSpec where
14module Servant.ForeignSpec where
4
15
16+import Data.Monoid ((<>))
17+import Data.Proxy
5−import Servant.Foreign (camelCase)
18+import Servant.Foreign
19+import Servant.Foreign.Internal
6
20
7import Test.Hspec
21import Test.Hspec
8
22
9spec :: Spec
23spec :: Spec
10spec = describe "Servant.Foreign" $ do
24spec = describe "Servant.Foreign" $ do
11 camelCaseSpec
25 camelCaseSpec
26+ listFromAPISpec
12
27
13camelCaseSpec :: Spec
28camelCaseSpec :: Spec
14camelCaseSpec = describe "camelCase" $ do
29camelCaseSpec = describe "camelCase" $ do
15 it "converts FunctionNames to camelCase" $ do
30 it "converts FunctionNames to camelCase" $ do
16 camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
31 camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
17 camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
32 camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
33+
34+----------------------------------------------------------------------
35+
36+data LangX
37+
38+instance HasForeignType LangX () where
39+ typeFor _ _ = "voidX"
40+instance HasForeignType LangX Int where
41+ typeFor _ _ = "intX"
42+instance HasForeignType LangX Bool where
43+ typeFor _ _ = "boolX"
44+instance {-# Overlapping #-} HasForeignType LangX String where
45+ typeFor _ _ = "stringX"
46+instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where
47+ typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
48+
49+type TestApi
50+ = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
51+ :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] ()
52+ :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
53+ :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
54+
55+testApi :: [Req]
56+testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
57+
58+listFromAPISpec :: Spec
59+listFromAPISpec = describe "listFromAPI" $ do
60+ it "generates 4 endpoints for TestApi" $ do
61+ length testApi `shouldBe` 4
62+
63+ let [getReq, postReq, putReq, deleteReq] = testApi
64+
65+ it "collects all info for get request" $ do
66+ shouldBe getReq $ defReq
67+ { _reqUrl = Url
68+ [ Segment $ Static "test" ]
69+ [ QueryArg ("flag", "boolX") Flag ]
70+ , _reqMethod = "GET"
71+ , _reqHeaders = [HeaderArg ("header", "listX of stringX")]
72+ , _reqBody = Nothing
73+ , _reqReturnType = "intX"
74+ , _funcName = ["get", "test"]
75+ }
76+
77+ it "collects all info for post request" $ do
78+ shouldBe postReq $ defReq
79+ { _reqUrl = Url
80+ [ Segment $ Static "test" ]
81+ [ QueryArg ("param", "intX") Normal ]
82+ , _reqMethod = "POST"
83+ , _reqHeaders = []
84+ , _reqBody = Just "listX of stringX"
85+ , _reqReturnType = "voidX"
86+ , _funcName = ["post", "test"]
87+ }
88+
89+ it "collects all info for put request" $ do
90+ shouldBe putReq $ defReq
91+ { _reqUrl = Url
92+ [ Segment $ Static "test" ]
93+ -- Shoud this be |intX| or |listX of intX| ?
94+ [ QueryArg ("params", "listX of intX") List ]
95+ , _reqMethod = "PUT"
96+ , _reqHeaders = []
97+ , _reqBody = Just "stringX"
98+ , _reqReturnType = "voidX"
99+ , _funcName = ["put", "test"]
100+ }
101+
102+ it "collects all info for delete request" $ do
103+ shouldBe deleteReq $ defReq
104+ { _reqUrl = Url
105+ [ Segment $ Static "test"
106+ , Segment $ Cap ("id", "intX") ]
107+ []
108+ , _reqMethod = "DELETE"
109+ , _reqHeaders = []
110+ , _reqBody = Nothing
111+ , _reqReturnType = "voidX"
112+ , _funcName = ["delete", "test", "by", "id"]
113+ }
114+
servant-js/servant-js.cabal+1−1
@@ -13,7 +13,7 @@ description:
13 <https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>
13 <https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>
14license: BSD3
14license: BSD3
15license-file: LICENSE
15license-file: LICENSE
16−author: Alp Mestanogullari
16+author: Alp Mestanogullari, Maksymilian Owsianny
17maintainer: alpmestan@gmail.com
17maintainer: alpmestan@gmail.com
18copyright: 2014 Alp Mestanogullari
18copyright: 2014 Alp Mestanogullari
19category: Web
19category: Web
servant-js/src/Servant/JS.hs+8−22
@@ -2,6 +2,7 @@
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
5-----------------------------------------------------------------------------
6-----------------------------------------------------------------------------
6-- |
7-- |
7-- Module : Servant.JS
8-- Module : Servant.JS
@@ -109,6 +110,7 @@ module Servant.JS
109 , -- * Misc.
110 , -- * Misc.
110 listFromAPI
111 listFromAPI
111 , javascript
112 , javascript
113+ , NoTypes
112 , GenerateList(..)
114 , GenerateList(..)
113 ) where
115 ) where
114
116
@@ -121,46 +123,30 @@ import Servant.JS.Axios
121import Servant.JS.Internal
123import Servant.JS.Internal
122import Servant.JS.JQuery
124import Servant.JS.JQuery
123import Servant.JS.Vanilla
125import Servant.JS.Vanilla
126+import Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
124
127
125-- | Generate the data necessary to generate javascript code
128-- | Generate the data necessary to generate javascript code
126-- for all the endpoints of an API, as ':<|>'-separated values
129-- for all the endpoints of an API, as ':<|>'-separated values
127-- of type 'AjaxReq'.
130-- of type 'AjaxReq'.
128−javascript :: HasForeign layout => Proxy layout -> Foreign layout
131+javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
129−javascript p = foreignFor p defReq
132+javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
130
133
131-- | Directly generate all the javascript functions for your API
134-- | Directly generate all the javascript functions for your API
132-- from a 'Proxy' for your API type. You can then write it to
135-- from a 'Proxy' for your API type. You can then write it to
133-- a file or integrate it in a page, for example.
136-- a file or integrate it in a page, for example.
134−jsForAPI :: (HasForeign api, GenerateList (Foreign api))
137+jsForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
135 => Proxy api -- ^ proxy for your API type
138 => Proxy api -- ^ proxy for your API type
136 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
139 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
137 -> Text -- ^ a text that you can embed in your pages or write to a file
140 -> Text -- ^ a text that you can embed in your pages or write to a file
138−jsForAPI p gen = gen (listFromAPI p)
141+jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) p)
139
142
140-- | Directly generate all the javascript functions for your API
143-- | Directly generate all the javascript functions for your API
141-- from a 'Proxy' for your API type using the given generator
144-- from a 'Proxy' for your API type using the given generator
142-- and write the resulting code to a file at the given path.
145-- and write the resulting code to a file at the given path.
143−writeJSForAPI :: (HasForeign api, GenerateList (Foreign api))
146+writeJSForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
144 => Proxy api -- ^ proxy for your API type
147 => Proxy api -- ^ proxy for your API type
145 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
148 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
146 -> FilePath -- ^ path to the file you want to write the resulting javascript code into
149 -> FilePath -- ^ path to the file you want to write the resulting javascript code into
147 -> IO ()
150 -> IO ()
148writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen)
151writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen)
149
152
150−-- | Utility class used by 'jsForAPI' which computes
151−-- the data needed to generate a function for each endpoint
152−-- and hands it all back in a list.
153−class GenerateList reqs where
154− generateList :: reqs -> [AjaxReq]
155−
156−instance GenerateList AjaxReq where
157− generateList r = [r]
158−
159−instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where
160− generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
161−
162−-- | Generate the necessary data for JS codegen as a list, each 'AjaxReq'
163−-- describing one endpoint from your API type.
164−listFromAPI :: (HasForeign api, GenerateList (Foreign api)) => Proxy api -> [AjaxReq]
165−listFromAPI p = generateList (javascript p)
166−
servant-js/src/Servant/JS/Angular.hs+7−6
@@ -2,6 +2,7 @@
2module Servant.JS.Angular where
2module Servant.JS.Angular where
3
3
4import Control.Lens
4import Control.Lens
5+import Data.Maybe (isJust)
5import Data.Monoid
6import Data.Monoid
6import qualified Data.Text as T
7import qualified Data.Text as T
7import Data.Text (Text)
8import Data.Text (Text)
@@ -74,9 +75,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
74 where argsStr = T.intercalate ", " args
75 where argsStr = T.intercalate ", " args
75 args = http
76 args = http
76 ++ captures
77 ++ captures
77− ++ map (view argName) queryparams
78+ ++ map (view $ argName._1) queryparams
78 ++ body
79 ++ body
79− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
80+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
80
81
81 -- If we want to generate Top Level Function, they must depend on
82 -- If we want to generate Top Level Function, they must depend on
82 -- the $http service, if we generate a service, the functions will
83 -- the $http service, if we generate a service, the functions will
@@ -85,7 +86,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
85 0 -> ["$http"]
86 0 -> ["$http"]
86 _ -> []
87 _ -> []
87
88
88− captures = map captureArg
89+ captures = map (fst . captureArg)
89 . filter isCapture
90 . filter isCapture
90 $ req ^. reqUrl.path
91 $ req ^. reqUrl.path
91
92
@@ -93,12 +94,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>
93
94
94 queryparams = req ^.. reqUrl.queryStr.traverse
95 queryparams = req ^.. reqUrl.queryStr.traverse
95
96
96− body = if req ^. reqBody
97+ body = if isJust (req ^. reqBody)
97 then [requestBody opts]
98 then [requestBody opts]
98 else []
99 else []
99
100
100 dataBody =
101 dataBody =
101− if req ^. reqBody
102+ if isJust (req ^. reqBody)
102 then " , data: JSON.stringify(body)\n" <>
103 then " , data: JSON.stringify(body)\n" <>
103 " , contentType: 'application/json'\n"
104 " , contentType: 'application/json'\n"
104 else ""
105 else ""
@@ -110,7 +111,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
110
111
111 where headersStr = T.intercalate ", " $ map headerStr hs
112 where headersStr = T.intercalate ", " $ map headerStr hs
112 headerStr header = "\"" <>
113 headerStr header = "\"" <>
113− headerArgName header <>
114+ fst (headerArg header) <>
114 "\": " <> toJSHeader header
115 "\": " <> toJSHeader header
115
116
116 namespace =
117 namespace =
servant-js/src/Servant/JS/Axios.hs+7−6
@@ -2,6 +2,7 @@
2module Servant.JS.Axios where
2module Servant.JS.Axios where
3
3
4import Control.Lens
4import Control.Lens
5+import Data.Maybe (isJust)
5import Data.Monoid
6import Data.Monoid
6import Data.Text (Text)
7import Data.Text (Text)
7import qualified Data.Text as T
8import qualified Data.Text as T
@@ -60,11 +61,11 @@ generateAxiosJSWith aopts opts req = "\n" <>
60
61
61 where argsStr = T.intercalate ", " args
62 where argsStr = T.intercalate ", " args
62 args = captures
63 args = captures
63− ++ map (view argName) queryparams
64+ ++ map (view $ argName._1) queryparams
64 ++ body
65 ++ body
65− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
66+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
66
67
67− captures = map captureArg
68+ captures = map (fst . captureArg)
68 . filter isCapture
69 . filter isCapture
69 $ req ^. reqUrl.path
70 $ req ^. reqUrl.path
70
71
@@ -72,12 +73,12 @@ generateAxiosJSWith aopts opts req = "\n" <>
72
73
73 queryparams = req ^.. reqUrl.queryStr.traverse
74 queryparams = req ^.. reqUrl.queryStr.traverse
74
75
75− body = if req ^. reqBody
76+ body = if isJust (req ^. reqBody)
76 then [requestBody opts]
77 then [requestBody opts]
77 else []
78 else []
78
79
79 dataBody =
80 dataBody =
80− if req ^. reqBody
81+ if isJust (req ^. reqBody)
81 then " , data: body\n" <>
82 then " , data: body\n" <>
82 " , responseType: 'json'\n"
83 " , responseType: 'json'\n"
83 else ""
84 else ""
@@ -104,7 +105,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
104
105
105 where headersStr = T.intercalate ", " $ map headerStr hs
106 where headersStr = T.intercalate ", " $ map headerStr hs
106 headerStr header = "\"" <>
107 headerStr header = "\"" <>
107− headerArgName header <>
108+ fst (headerArg header) <>
108 "\": " <> toJSHeader header
109 "\": " <> toJSHeader header
109
110
110 namespace =
111 namespace =
servant-js/src/Servant/JS/Internal.hs+7−6
@@ -18,6 +18,7 @@ module Servant.JS.Internal
18 , defReq
18 , defReq
19 , reqHeaders
19 , reqHeaders
20 , HasForeign(..)
20 , HasForeign(..)
21+ , HasForeignType(..)
21 , HeaderArg(..)
22 , HeaderArg(..)
22 , concatCase
23 , concatCase
23 , snakeCase
24 , snakeCase
@@ -31,7 +32,7 @@ module Servant.JS.Internal
31 , Header
32 , Header
32 ) where
33 ) where
33
34
34−import Control.Lens ((^.))
35+import Control.Lens ((^.), _1)
35import qualified Data.CharSet as Set
36import qualified Data.CharSet as Set
36import qualified Data.CharSet.Unicode.Category as Set
37import qualified Data.CharSet.Unicode.Category as Set
37import Data.Monoid
38import Data.Monoid
@@ -115,7 +116,7 @@ toValidFunctionName t =
115 ]
116 ]
116
117
117toJSHeader :: HeaderArg -> Text
118toJSHeader :: HeaderArg -> Text
118−toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)
119+toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> fst n)
119toJSHeader (ReplaceHeaderArg n p)
120toJSHeader (ReplaceHeaderArg n p)
120 | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
121 | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
121 | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
122 | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@@ -123,8 +124,8 @@ toJSHeader (ReplaceHeaderArg n p)
123 <> "\""
124 <> "\""
124 | otherwise = p
125 | otherwise = p
125 where
126 where
126− pv = toValidFunctionName ("header" <> n)
127+ pv = toValidFunctionName ("header" <> fst n)
127− pn = "{" <> n <> "}"
128+ pn = "{" <> fst n <> "}"
128 rp = T.replace pn "" p
129 rp = T.replace pn "" p
129
130
130jsSegments :: [Segment] -> Text
131jsSegments :: [Segment] -> Text
@@ -138,7 +139,7 @@ segmentToStr (Segment st) notTheEnd =
138
139
139segmentTypeToStr :: SegmentType -> Text
140segmentTypeToStr :: SegmentType -> Text
140segmentTypeToStr (Static s) = s
141segmentTypeToStr (Static s) = s
141−segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '"
142+segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> fst s <> ") + '"
142
143
143jsGParams :: Text -> [QueryArg] -> Text
144jsGParams :: Text -> [QueryArg] -> Text
144jsGParams _ [] = ""
145jsGParams _ [] = ""
@@ -160,4 +161,4 @@ paramToStr qarg notTheEnd =
160 <> "[]=' + encodeURIComponent("
161 <> "[]=' + encodeURIComponent("
161 <> name
162 <> name
162 <> if notTheEnd then ") + '" else ")"
163 <> if notTheEnd then ") + '" else ")"
163− where name = qarg ^. argName
164+ where name = qarg ^. argName . _1
servant-js/src/Servant/JS/JQuery.hs+7−6
@@ -2,6 +2,7 @@
2module Servant.JS.JQuery where
2module Servant.JS.JQuery where
3
3
4import Control.Lens
4import Control.Lens
5+import Data.Maybe (isJust)
5import Data.Monoid
6import Data.Monoid
6import qualified Data.Text as T
7import qualified Data.Text as T
7import Data.Text (Text)
8import Data.Text (Text)
@@ -40,12 +41,12 @@ generateJQueryJSWith opts req = "\n" <>
40
41
41 where argsStr = T.intercalate ", " args
42 where argsStr = T.intercalate ", " args
42 args = captures
43 args = captures
43− ++ map (view argName) queryparams
44+ ++ map (view $ argName._1) queryparams
44 ++ body
45 ++ body
45− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
46+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
46 ++ [onSuccess, onError]
47 ++ [onSuccess, onError]
47
48
48− captures = map captureArg
49+ captures = map (fst . captureArg)
49 . filter isCapture
50 . filter isCapture
50 $ req ^. reqUrl.path
51 $ req ^. reqUrl.path
51
52
@@ -53,7 +54,7 @@ generateJQueryJSWith opts req = "\n" <>
53
54
54 queryparams = req ^.. reqUrl.queryStr.traverse
55 queryparams = req ^.. reqUrl.queryStr.traverse
55
56
56− body = if req ^. reqBody
57+ body = if isJust (req ^. reqBody)
57 then [requestBody opts]
58 then [requestBody opts]
58 else []
59 else []
59
60
@@ -61,7 +62,7 @@ generateJQueryJSWith opts req = "\n" <>
61 onError = errorCallback opts
62 onError = errorCallback opts
62
63
63 dataBody =
64 dataBody =
64− if req ^. reqBody
65+ if isJust $ req ^. reqBody
65 then " , data: JSON.stringify(body)\n" <>
66 then " , data: JSON.stringify(body)\n" <>
66 " , contentType: 'application/json'\n"
67 " , contentType: 'application/json'\n"
67 else ""
68 else ""
@@ -73,7 +74,7 @@ generateJQueryJSWith opts req = "\n" <>
73
74
74 where headersStr = T.intercalate ", " $ map headerStr hs
75 where headersStr = T.intercalate ", " $ map headerStr hs
75 headerStr header = "\"" <>
76 headerStr header = "\"" <>
76− headerArgName header <>
77+ fst (headerArg header) <>
77 "\": " <> toJSHeader header
78 "\": " <> toJSHeader header
78
79
79 namespace = if (moduleName opts) == ""
80 namespace = if (moduleName opts) == ""
servant-js/src/Servant/JS/Vanilla.hs+7−6
@@ -2,6 +2,7 @@
2module Servant.JS.Vanilla where
2module Servant.JS.Vanilla where
3
3
4import Control.Lens
4import Control.Lens
5+import Data.Maybe (isJust)
5import Data.Text (Text)
6import Data.Text (Text)
6import qualified Data.Text as T
7import qualified Data.Text as T
7import Data.Monoid
8import Data.Monoid
@@ -47,12 +48,12 @@ generateVanillaJSWith opts req = "\n" <>
47
48
48 where argsStr = T.intercalate ", " args
49 where argsStr = T.intercalate ", " args
49 args = captures
50 args = captures
50− ++ map (view argName) queryparams
51+ ++ map (view $ argName._1) queryparams
51 ++ body
52 ++ body
52− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
53+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
53 ++ [onSuccess, onError]
54 ++ [onSuccess, onError]
54
55
55− captures = map captureArg
56+ captures = map (fst . captureArg)
56 . filter isCapture
57 . filter isCapture
57 $ req ^. reqUrl.path
58 $ req ^. reqUrl.path
58
59
@@ -60,7 +61,7 @@ generateVanillaJSWith opts req = "\n" <>
60
61
61 queryparams = req ^.. reqUrl.queryStr.traverse
62 queryparams = req ^.. reqUrl.queryStr.traverse
62
63
63− body = if req ^. reqBody
64+ body = if isJust(req ^. reqBody)
64 then [requestBody opts]
65 then [requestBody opts]
65 else []
66 else []
66
67
@@ -68,7 +69,7 @@ generateVanillaJSWith opts req = "\n" <>
68 onError = errorCallback opts
69 onError = errorCallback opts
69
70
70 dataBody =
71 dataBody =
71− if req ^. reqBody
72+ if isJust (req ^. reqBody)
72 then "JSON.stringify(body)\n"
73 then "JSON.stringify(body)\n"
73 else "null"
74 else "null"
74
75
@@ -80,7 +81,7 @@ generateVanillaJSWith opts req = "\n" <>
80
81
81 where headersStr = T.intercalate "\n" $ map headerStr hs
82 where headersStr = T.intercalate "\n" $ map headerStr hs
82 headerStr header = " xhr.setRequestHeader(\"" <>
83 headerStr header = " xhr.setRequestHeader(\"" <>
83− headerArgName header <>
84+ fst (headerArg header) <>
84 "\", " <> toJSHeader header <> ");"
85 "\", " <> toJSHeader header <> ");"
85
86
86 namespace = if moduleName opts == ""
87 namespace = if moduleName opts == ""
servant-js/test/Servant/JSSpec.hs+8−6
@@ -98,16 +98,17 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
98
98
99axiosSpec :: Spec
99axiosSpec :: Spec
100axiosSpec = describe specLabel $ do
100axiosSpec = describe specLabel $ do
101+ let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
101 it "should add withCredentials when needed" $ do
102 it "should add withCredentials when needed" $ do
102− let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
103+ let jsText = genJS withCredOpts $ reqList
103 output jsText
104 output jsText
104 jsText `shouldContain` "withCredentials: true"
105 jsText `shouldContain` "withCredentials: true"
105 it "should add xsrfCookieName when needed" $ do
106 it "should add xsrfCookieName when needed" $ do
106− let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
107+ let jsText = genJS cookieOpts $ reqList
107 output jsText
108 output jsText
108 jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")
109 jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")
109 it "should add withCredentials when needed" $ do
110 it "should add withCredentials when needed" $ do
110− let jsText = genJS headerOpts $ listFromAPI (Proxy :: Proxy TestAPI)
111+ let jsText = genJS headerOpts $ reqList
111 output jsText
112 output jsText
112 jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")
113 jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")
113 where
114 where
@@ -121,18 +122,19 @@ axiosSpec = describe specLabel $ do
121
122
122angularSpec :: TestNames -> Spec
123angularSpec :: TestNames -> Spec
123angularSpec test = describe specLabel $ do
124angularSpec test = describe specLabel $ do
125+ let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
124 it "should implement a service globally" $ do
126 it "should implement a service globally" $ do
125− let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
127+ let jsText = genJS reqList
126 output jsText
128 output jsText
127 jsText `shouldContain` (".service('" <> testName <> "'")
129 jsText `shouldContain` (".service('" <> testName <> "'")
128
130
129 it "should depend on $http service globally" $ do
131 it "should depend on $http service globally" $ do
130− let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
132+ let jsText = genJS reqList
131 output jsText
133 output jsText
132 jsText `shouldContain` ("('" <> testName <> "', function($http) {")
134 jsText `shouldContain` ("('" <> testName <> "', function($http) {")
133
135
134 it "should not depend on $http service in handlers" $ do
136 it "should not depend on $http service in handlers" $ do
135− let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
137+ let jsText = genJS reqList
136 output jsText
138 output jsText
137 jsText `shouldNotContain` "getsomething($http, "
139 jsText `shouldNotContain` "getsomething($http, "
138 where
140 where
servant-js/test/Servant/JSSpec/CustomHeaders.hs+13−12
@@ -6,6 +6,7 @@
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE MultiParamTypeClasses #-}
9
10
10module Servant.JSSpec.CustomHeaders where
11module Servant.JSSpec.CustomHeaders where
11
12
@@ -21,12 +22,12 @@ import Servant.JS.Internal
21-- using -- Basic, Digest, whatever.
22-- using -- Basic, Digest, whatever.
22data Authorization (sym :: Symbol) a
23data Authorization (sym :: Symbol) a
23
24
24−instance (KnownSymbol sym, HasForeign sublayout)
25+instance (KnownSymbol sym, HasForeign lang sublayout)
25− => HasForeign (Authorization sym a :> sublayout) where
26+ => HasForeign lang (Authorization sym a :> sublayout) where
26 type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
27 type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
27
28
28− foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
29+ foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
29− req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
30+ req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $
30 tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
31 tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
31 where
32 where
32 tokenType t = t <> " {Authorization}"
33 tokenType t = t <> " {Authorization}"
@@ -34,23 +35,23 @@ instance (KnownSymbol sym, HasForeign sublayout)
34-- | This is a combinator that fetches an X-MyLovelyHorse header.
35-- | This is a combinator that fetches an X-MyLovelyHorse header.
35data MyLovelyHorse a
36data MyLovelyHorse a
36
37
37−instance (HasForeign sublayout)
38+instance (HasForeign lang sublayout)
38− => HasForeign (MyLovelyHorse a :> sublayout) where
39+ => HasForeign lang (MyLovelyHorse a :> sublayout) where
39 type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
40 type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
40
41
41− foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
42+ foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
42− req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]
43+ req & reqHeaders <>~ [ ReplaceHeaderArg ("X-MyLovelyHorse", "") tpl ]
43 where
44 where
44 tpl = "I am good friends with {X-MyLovelyHorse}"
45 tpl = "I am good friends with {X-MyLovelyHorse}"
45
46
46-- | This is a combinator that fetches an X-WhatsForDinner header.
47-- | This is a combinator that fetches an X-WhatsForDinner header.
47data WhatsForDinner a
48data WhatsForDinner a
48
49
49−instance (HasForeign sublayout)
50+instance (HasForeign lang sublayout)
50− => HasForeign (WhatsForDinner a :> sublayout) where
51+ => HasForeign lang (WhatsForDinner a :> sublayout) where
51 type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
52 type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
52
53
53− foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
54+ foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
54− req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ]
55+ req & reqHeaders <>~ [ ReplaceHeaderArg ("X-WhatsForDinner", "") tpl ]
55 where
56 where
56 tpl = "I would like {X-WhatsForDinner} with a cherry on top."
57 tpl = "I would like {X-WhatsForDinner} with a cherry on top."