git.iko.soy/typeable/servant
on master help sign in
Merge pull request #277 from MaxOw/master

Type information in servant-foreign.

commit1bd2d913de6509628277785104d6159f43f857d1 authorDenis Redozubov <denis.redozubov@gmail.com> dateThu 3 Dec 2015, 01:00 (11 years ago) parent6dac6e8721151a
13 files changed+337−153
compare with master
unifiedsplit
servant-foreign/servant-foreign.cabal+2−2 servant-foreign/src/Servant/Foreign.hs+5 servant-foreign/src/Servant/Foreign/Internal.hs+167−79 servant-foreign/test/Servant/ForeignSpec.hs+98−1 servant-js/servant-js.cabal+1−1 servant-js/src/Servant/JS.hs+8−22 servant-js/src/Servant/JS/Angular.hs+7−6 servant-js/src/Servant/JS/Axios.hs+7−6 servant-js/src/Servant/JS/Internal.hs+7−6 servant-js/src/Servant/JS/JQuery.hs+7−6 servant-js/src/Servant/JS/Vanilla.hs+7−6 servant-js/test/Servant/JSSpec.hs+8−6 servant-js/test/Servant/JSSpec/CustomHeaders.hs+13−12
servant-foreign/servant-foreign.cabal+2−2
@@ -11,7 +11,7 @@ description:
1111 <https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md CHANGELOG>
1212license: BSD3
1313license-file: LICENSE
14−author: Denis Redozubov
14+author: Denis Redozubov, Maksymilian Owsianny
1515maintainer: denis.redozubov@gmail.com
1616copyright: 2015 Denis Redozubov, Alp Mestanogullari
1717category: Web
@@ -45,4 +45,4 @@ test-suite spec
4545 build-depends: base
4646 , hspec >= 2.1.8
4747 , servant-foreign
48− default-language: Haskell2010
48+ default-language: Haskell2010
servant-foreign/src/Servant/Foreign.hs+5
@@ -2,6 +2,7 @@
22-- arbitrary programming languages.
33module Servant.Foreign
44 ( HasForeign(..)
5+ , HasForeignType(..)
56 , Segment(..)
67 , SegmentType(..)
78 , FunctionName
@@ -24,8 +25,12 @@ module Servant.Foreign
2425 , reqBody
2526 , reqHeaders
2627 , reqMethod
28+ , reqReturnType
2729 , segment
2830 , queryStr
31+ , listFromAPI
32+ , GenerateList(..)
33+ , NoTypes
2934 -- re-exports
3035 , module Servant.API
3136 ) where
servant-foreign/src/Servant/Foreign/Internal.hs+167−79
@@ -45,7 +45,8 @@ camelCase = camelCase' . Prelude.map (replace "-" "")
4545 capitalize "" = ""
4646 capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
4747
48−type Arg = Text
48+type ForeignType = Text
49+type Arg = (Text, ForeignType)
4950
5051newtype Segment = Segment { _segment :: SegmentType }
5152 deriving (Eq, Show)
@@ -68,10 +69,10 @@ data QueryArg = QueryArg
6869 } deriving (Eq, Show)
6970
7071data HeaderArg = HeaderArg
71− { headerArgName :: Text
72+ { headerArg :: Arg
7273 }
7374 | ReplaceHeaderArg
74− { headerArgName :: Text
75+ { headerArg :: Arg
7576 , headerPattern :: Text
7677 } deriving (Eq, Show)
7778
@@ -88,11 +89,12 @@ type FunctionName = [Text]
8889type Method = Text
8990
9091data Req = Req
91− { _reqUrl :: Url
92− , _reqMethod :: Method
93− , _reqHeaders :: [HeaderArg]
94− , _reqBody :: Bool
95− , _funcName :: FunctionName
92+ { _reqUrl :: Url
93+ , _reqMethod :: Method
94+ , _reqHeaders :: [HeaderArg]
95+ , _reqBody :: Maybe ForeignType
96+ , _reqReturnType :: ForeignType
97+ , _funcName :: FunctionName
9698 } deriving (Eq, Show)
9799
98100makeLenses ''QueryArg
@@ -109,7 +111,7 @@ captureArg (Segment (Cap s)) = s
109111captureArg _ = error "captureArg called on non capture"
110112
111113defReq :: Req
112−defReq = Req defUrl "GET" [] False []
114+defReq = Req defUrl "GET" [] Nothing "" []
113115
114116-- | To be used exclusively as a "negative" return type/constraint
115117-- by @'Elem`@ type family.
@@ -120,142 +122,228 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
120122 Elem a (a ': list) = ()
121123 Elem a (b ': list) = Elem a list
122124
123−class HasForeign (layout :: *) where
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+
163+class HasForeign lang (layout :: *) where
124164 type Foreign layout :: *
125− foreignFor :: Proxy layout -> Req -> Foreign layout
165+ foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
126166
127−instance (HasForeign a, HasForeign b)
128− => HasForeign (a :<|> b) where
167+instance (HasForeign lang a, HasForeign lang b)
168+ => HasForeign lang (a :<|> b) where
129169 type Foreign (a :<|> b) = Foreign a :<|> Foreign b
130170
131− foreignFor Proxy req =
132− foreignFor (Proxy :: Proxy a) req
133− :<|> foreignFor (Proxy :: Proxy b) req
171+ foreignFor lang Proxy req =
172+ foreignFor lang (Proxy :: Proxy a) req
173+ :<|> foreignFor lang (Proxy :: Proxy b) req
134174
135−instance (KnownSymbol sym, HasForeign sublayout)
136− => HasForeign (Capture sym a :> sublayout) where
175+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
176+ => HasForeign lang (Capture sym a :> sublayout) where
137177 type Foreign (Capture sym a :> sublayout) = Foreign sublayout
138178
139− foreignFor Proxy req =
140− foreignFor (Proxy :: Proxy sublayout) $
141− req & reqUrl.path <>~ [Segment (Cap str)]
179+ foreignFor lang Proxy req =
180+ foreignFor lang (Proxy :: Proxy sublayout) $
181+ req & reqUrl.path <>~ [Segment (Cap arg)]
142182 & funcName %~ (++ ["by", str])
143183
144− where str = pack . symbolVal $ (Proxy :: Proxy sym)
184+ where
185+ str = pack . symbolVal $ (Proxy :: Proxy sym)
186+ arg = (str, typeFor lang (Proxy :: Proxy a))
145187
146−instance Elem JSON list => HasForeign (Delete list a) where
188+instance (Elem JSON list, HasForeignType lang a)
189+ => HasForeign lang (Delete list a) where
147190 type Foreign (Delete list a) = Req
148191
149− foreignFor Proxy req =
150− req & funcName %~ ("delete" :)
151− & reqMethod .~ "DELETE"
192+ foreignFor lang Proxy req =
193+ req & funcName %~ ("delete" :)
194+ & reqMethod .~ "DELETE"
195+ & reqReturnType .~ retType
196+ where
197+ retType = typeFor lang (Proxy :: Proxy a)
152198
153−instance Elem JSON list => HasForeign (Get list a) where
199+instance (Elem JSON list, HasForeignType lang a)
200+ => HasForeign lang (Get list a) where
154201 type Foreign (Get list a) = Req
155202
156− foreignFor Proxy req =
203+ foreignFor lang Proxy req =
157204 req & funcName %~ ("get" :)
158205 & reqMethod .~ "GET"
206+ & reqReturnType .~ retType
207+ where
208+ retType = typeFor lang (Proxy :: Proxy a)
159209
160−instance (KnownSymbol sym, HasForeign sublayout)
161− => HasForeign (Header sym a :> sublayout) where
210+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
211+ => HasForeign lang (Header sym a :> sublayout) where
162212 type Foreign (Header sym a :> sublayout) = Foreign sublayout
163213
164− foreignFor Proxy req =
165− foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
214+ foreignFor lang Proxy req =
215+ foreignFor lang subP $ req
216+ & reqHeaders <>~ [HeaderArg arg]
166217
167− where hname = pack . symbolVal $ (Proxy :: Proxy sym)
168− subP = Proxy :: Proxy sublayout
218+ where
219+ hname = pack . symbolVal $ (Proxy :: Proxy sym)
220+ arg = (hname, typeFor lang (Proxy :: Proxy a))
221+ subP = Proxy :: Proxy sublayout
169222
170−instance Elem JSON list => HasForeign (Post list a) where
223+instance (Elem JSON list, HasForeignType lang a)
224+ => HasForeign lang (Post list a) where
171225 type Foreign (Post list a) = Req
172226
173− foreignFor Proxy req =
227+ foreignFor lang Proxy req =
174228 req & funcName %~ ("post" :)
175229 & reqMethod .~ "POST"
230+ & reqReturnType .~ retType
231+ where
232+ retType = typeFor lang (Proxy :: Proxy a)
176233
177−instance Elem JSON list => HasForeign (Put list a) where
234+instance (Elem JSON list, HasForeignType lang a)
235+ => HasForeign lang (Put list a) where
178236 type Foreign (Put list a) = Req
179237
180− foreignFor Proxy req =
238+ foreignFor lang Proxy req =
181239 req & funcName %~ ("put" :)
182240 & reqMethod .~ "PUT"
241+ & reqReturnType .~ retType
242+ where
243+ retType = typeFor lang (Proxy :: Proxy a)
183244
184−instance (KnownSymbol sym, HasForeign sublayout)
185− => HasForeign (QueryParam sym a :> sublayout) where
245+instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
246+ => HasForeign lang (QueryParam sym a :> sublayout) where
186247 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
187248
188− foreignFor Proxy req =
189− foreignFor (Proxy :: Proxy sublayout) $
190− req & reqUrl.queryStr <>~ [QueryArg str Normal]
249+ foreignFor lang Proxy req =
250+ foreignFor lang (Proxy :: Proxy sublayout) $
251+ req & reqUrl.queryStr <>~ [QueryArg arg Normal]
191252
192− where str = pack . symbolVal $ (Proxy :: Proxy sym)
253+ where
254+ str = pack . symbolVal $ (Proxy :: Proxy sym)
255+ arg = (str, typeFor lang (Proxy :: Proxy a))
193256
194−instance (KnownSymbol sym, HasForeign sublayout)
195− => HasForeign (QueryParams sym a :> sublayout) where
257+instance (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
258+ => HasForeign lang (QueryParams sym a :> sublayout) where
196259 type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
197260
198− foreignFor Proxy req =
199− foreignFor (Proxy :: Proxy sublayout) $
200− req & reqUrl.queryStr <>~ [QueryArg str List]
261+ foreignFor lang Proxy req =
262+ foreignFor lang (Proxy :: Proxy sublayout) $
263+ req & reqUrl.queryStr <>~ [QueryArg arg List]
201264
202− where str = pack . symbolVal $ (Proxy :: Proxy sym)
265+ where
266+ str = pack . symbolVal $ (Proxy :: Proxy sym)
267+ arg = (str, typeFor lang (Proxy :: Proxy [a]))
203268
204−instance (KnownSymbol sym, HasForeign sublayout)
205− => HasForeign (QueryFlag sym :> sublayout) where
269+instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout)
270+ => HasForeign lang (QueryFlag sym :> sublayout) where
206271 type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
207272
208− foreignFor Proxy req =
209− foreignFor (Proxy :: Proxy sublayout) $
210− req & reqUrl.queryStr <>~ [QueryArg str Flag]
273+ foreignFor lang Proxy req =
274+ foreignFor lang (Proxy :: Proxy sublayout) $
275+ req & reqUrl.queryStr <>~ [QueryArg arg Flag]
211276
212− where str = pack . symbolVal $ (Proxy :: Proxy sym)
277+ where
278+ str = pack . symbolVal $ (Proxy :: Proxy sym)
279+ arg = (str, typeFor lang (Proxy :: Proxy a))
213280
214−instance HasForeign Raw where
281+instance HasForeign lang Raw where
215282 type Foreign Raw = Method -> Req
216283
217− foreignFor Proxy req method =
284+ foreignFor _ Proxy req method =
218285 req & funcName %~ ((toLower method) :)
219286 & reqMethod .~ method
220287
221−instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
288+instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
289+ => HasForeign lang (ReqBody list a :> sublayout) where
222290 type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
223291
224− foreignFor Proxy req =
225− foreignFor (Proxy :: Proxy sublayout) $
226− req & reqBody .~ True
292+ foreignFor lang Proxy req =
293+ foreignFor lang (Proxy :: Proxy sublayout) $
294+ req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
227295
228−instance (KnownSymbol path, HasForeign sublayout)
229− => HasForeign (path :> sublayout) where
296+instance (KnownSymbol path, HasForeign lang sublayout)
297+ => HasForeign lang (path :> sublayout) where
230298 type Foreign (path :> sublayout) = Foreign sublayout
231299
232− foreignFor Proxy req =
233− foreignFor (Proxy :: Proxy sublayout) $
300+ foreignFor lang Proxy req =
301+ foreignFor lang (Proxy :: Proxy sublayout) $
234302 req & reqUrl.path <>~ [Segment (Static str)]
235303 & funcName %~ (++ [str])
236304
237− where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
305+ where
306+ str = Data.Text.map (\c -> if c == '.' then '_' else c)
307+ . pack . symbolVal $ (Proxy :: Proxy path)
238308
239−instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
309+instance HasForeign lang sublayout => HasForeign lang (RemoteHost :> sublayout) where
240310 type Foreign (RemoteHost :> sublayout) = Foreign sublayout
241311
242− foreignFor Proxy req =
243− foreignFor (Proxy :: Proxy sublayout) req
312+ foreignFor lang Proxy req =
313+ foreignFor lang (Proxy :: Proxy sublayout) req
244314
245−instance HasForeign sublayout => HasForeign (IsSecure :> sublayout) where
315+instance HasForeign lang sublayout => HasForeign lang (IsSecure :> sublayout) where
246316 type Foreign (IsSecure :> sublayout) = Foreign sublayout
247317
248− foreignFor Proxy req =
249− foreignFor (Proxy :: Proxy sublayout) req
318+ foreignFor lang Proxy req =
319+ foreignFor lang (Proxy :: Proxy sublayout) req
250320
251−instance HasForeign sublayout => HasForeign (Vault :> sublayout) where
321+instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
252322 type Foreign (Vault :> sublayout) = Foreign sublayout
253323
254− foreignFor Proxy req =
255− foreignFor (Proxy :: Proxy sublayout) req
324+ foreignFor lang Proxy req =
325+ foreignFor lang (Proxy :: Proxy sublayout) req
256326
257−instance HasForeign sublayout => HasForeign (HttpVersion :> sublayout) where
327+instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where
258328 type Foreign (HttpVersion :> sublayout) = Foreign sublayout
259329
260− foreignFor Proxy req =
261− foreignFor (Proxy :: Proxy sublayout) req
330+ foreignFor lang Proxy 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 @@
11{-# 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
213
314module Servant.ForeignSpec where
415
5−import Servant.Foreign (camelCase)
16+import Data.Monoid ((<>))
17+import Data.Proxy
18+import Servant.Foreign
19+import Servant.Foreign.Internal
620
721import Test.Hspec
822
923spec :: Spec
1024spec = describe "Servant.Foreign" $ do
1125 camelCaseSpec
26+ listFromAPISpec
1227
1328camelCaseSpec :: Spec
1429camelCaseSpec = describe "camelCase" $ do
1530 it "converts FunctionNames to camelCase" $ do
1631 camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
1732 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:
1313 <https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>
1414license: BSD3
1515license-file: LICENSE
16−author: Alp Mestanogullari
16+author: Alp Mestanogullari, Maksymilian Owsianny
1717maintainer: alpmestan@gmail.com
1818copyright: 2014 Alp Mestanogullari
1919category: Web
servant-js/src/Servant/JS.hs+8−22
@@ -2,6 +2,7 @@
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
56-----------------------------------------------------------------------------
67-- |
78-- Module : Servant.JS
@@ -109,6 +110,7 @@ module Servant.JS
109110 , -- * Misc.
110111 listFromAPI
111112 , javascript
113+ , NoTypes
112114 , GenerateList(..)
113115 ) where
114116
@@ -121,46 +123,30 @@ import Servant.JS.Axios
121123import Servant.JS.Internal
122124import Servant.JS.JQuery
123125import Servant.JS.Vanilla
126+import Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
124127
125128-- | Generate the data necessary to generate javascript code
126129-- for all the endpoints of an API, as ':<|>'-separated values
127130-- of type 'AjaxReq'.
128−javascript :: HasForeign layout => Proxy layout -> Foreign layout
129−javascript p = foreignFor p defReq
131+javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
132+javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
130133
131134-- | Directly generate all the javascript functions for your API
132135-- from a 'Proxy' for your API type. You can then write it to
133136-- 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))
135138 => Proxy api -- ^ proxy for your API type
136139 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
137140 -> 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)
139142
140143-- | Directly generate all the javascript functions for your API
141144-- from a 'Proxy' for your API type using the given generator
142145-- 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))
144147 => Proxy api -- ^ proxy for your API type
145148 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
146149 -> FilePath -- ^ path to the file you want to write the resulting javascript code into
147150 -> IO ()
148151writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen)
149152
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 @@
22module Servant.JS.Angular where
33
44import Control.Lens
5+import Data.Maybe (isJust)
56import Data.Monoid
67import qualified Data.Text as T
78import Data.Text (Text)
@@ -74,9 +75,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
7475 where argsStr = T.intercalate ", " args
7576 args = http
7677 ++ captures
77− ++ map (view argName) queryparams
78+ ++ map (view $ argName._1) queryparams
7879 ++ body
79− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
80+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
8081
8182 -- If we want to generate Top Level Function, they must depend on
8283 -- the $http service, if we generate a service, the functions will
@@ -85,7 +86,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
8586 0 -> ["$http"]
8687 _ -> []
8788
88− captures = map captureArg
89+ captures = map (fst . captureArg)
8990 . filter isCapture
9091 $ req ^. reqUrl.path
9192
@@ -93,12 +94,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>
9394
9495 queryparams = req ^.. reqUrl.queryStr.traverse
9596
96− body = if req ^. reqBody
97+ body = if isJust (req ^. reqBody)
9798 then [requestBody opts]
9899 else []
99100
100101 dataBody =
101− if req ^. reqBody
102+ if isJust (req ^. reqBody)
102103 then " , data: JSON.stringify(body)\n" <>
103104 " , contentType: 'application/json'\n"
104105 else ""
@@ -110,7 +111,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
110111
111112 where headersStr = T.intercalate ", " $ map headerStr hs
112113 headerStr header = "\"" <>
113− headerArgName header <>
114+ fst (headerArg header) <>
114115 "\": " <> toJSHeader header
115116
116117 namespace =
servant-js/src/Servant/JS/Axios.hs+7−6
@@ -2,6 +2,7 @@
22module Servant.JS.Axios where
33
44import Control.Lens
5+import Data.Maybe (isJust)
56import Data.Monoid
67import Data.Text (Text)
78import qualified Data.Text as T
@@ -60,11 +61,11 @@ generateAxiosJSWith aopts opts req = "\n" <>
6061
6162 where argsStr = T.intercalate ", " args
6263 args = captures
63− ++ map (view argName) queryparams
64+ ++ map (view $ argName._1) queryparams
6465 ++ body
65− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
66+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
6667
67− captures = map captureArg
68+ captures = map (fst . captureArg)
6869 . filter isCapture
6970 $ req ^. reqUrl.path
7071
@@ -72,12 +73,12 @@ generateAxiosJSWith aopts opts req = "\n" <>
7273
7374 queryparams = req ^.. reqUrl.queryStr.traverse
7475
75− body = if req ^. reqBody
76+ body = if isJust (req ^. reqBody)
7677 then [requestBody opts]
7778 else []
7879
7980 dataBody =
80− if req ^. reqBody
81+ if isJust (req ^. reqBody)
8182 then " , data: body\n" <>
8283 " , responseType: 'json'\n"
8384 else ""
@@ -104,7 +105,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
104105
105106 where headersStr = T.intercalate ", " $ map headerStr hs
106107 headerStr header = "\"" <>
107− headerArgName header <>
108+ fst (headerArg header) <>
108109 "\": " <> toJSHeader header
109110
110111 namespace =
servant-js/src/Servant/JS/Internal.hs+7−6
@@ -18,6 +18,7 @@ module Servant.JS.Internal
1818 , defReq
1919 , reqHeaders
2020 , HasForeign(..)
21+ , HasForeignType(..)
2122 , HeaderArg(..)
2223 , concatCase
2324 , snakeCase
@@ -31,7 +32,7 @@ module Servant.JS.Internal
3132 , Header
3233 ) where
3334
34−import Control.Lens ((^.))
35+import Control.Lens ((^.), _1)
3536import qualified Data.CharSet as Set
3637import qualified Data.CharSet.Unicode.Category as Set
3738import Data.Monoid
@@ -115,7 +116,7 @@ toValidFunctionName t =
115116 ]
116117
117118toJSHeader :: HeaderArg -> Text
118−toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n)
119+toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> fst n)
119120toJSHeader (ReplaceHeaderArg n p)
120121 | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
121122 | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@@ -123,8 +124,8 @@ toJSHeader (ReplaceHeaderArg n p)
123124 <> "\""
124125 | otherwise = p
125126 where
126− pv = toValidFunctionName ("header" <> n)
127− pn = "{" <> n <> "}"
127+ pv = toValidFunctionName ("header" <> fst n)
128+ pn = "{" <> fst n <> "}"
128129 rp = T.replace pn "" p
129130
130131jsSegments :: [Segment] -> Text
@@ -138,7 +139,7 @@ segmentToStr (Segment st) notTheEnd =
138139
139140segmentTypeToStr :: SegmentType -> Text
140141segmentTypeToStr (Static s) = s
141−segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '"
142+segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> fst s <> ") + '"
142143
143144jsGParams :: Text -> [QueryArg] -> Text
144145jsGParams _ [] = ""
@@ -160,4 +161,4 @@ paramToStr qarg notTheEnd =
160161 <> "[]=' + encodeURIComponent("
161162 <> name
162163 <> 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 @@
22module Servant.JS.JQuery where
33
44import Control.Lens
5+import Data.Maybe (isJust)
56import Data.Monoid
67import qualified Data.Text as T
78import Data.Text (Text)
@@ -40,12 +41,12 @@ generateJQueryJSWith opts req = "\n" <>
4041
4142 where argsStr = T.intercalate ", " args
4243 args = captures
43− ++ map (view argName) queryparams
44+ ++ map (view $ argName._1) queryparams
4445 ++ body
45− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
46+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
4647 ++ [onSuccess, onError]
4748
48− captures = map captureArg
49+ captures = map (fst . captureArg)
4950 . filter isCapture
5051 $ req ^. reqUrl.path
5152
@@ -53,7 +54,7 @@ generateJQueryJSWith opts req = "\n" <>
5354
5455 queryparams = req ^.. reqUrl.queryStr.traverse
5556
56− body = if req ^. reqBody
57+ body = if isJust (req ^. reqBody)
5758 then [requestBody opts]
5859 else []
5960
@@ -61,7 +62,7 @@ generateJQueryJSWith opts req = "\n" <>
6162 onError = errorCallback opts
6263
6364 dataBody =
64− if req ^. reqBody
65+ if isJust $ req ^. reqBody
6566 then " , data: JSON.stringify(body)\n" <>
6667 " , contentType: 'application/json'\n"
6768 else ""
@@ -73,7 +74,7 @@ generateJQueryJSWith opts req = "\n" <>
7374
7475 where headersStr = T.intercalate ", " $ map headerStr hs
7576 headerStr header = "\"" <>
76− headerArgName header <>
77+ fst (headerArg header) <>
7778 "\": " <> toJSHeader header
7879
7980 namespace = if (moduleName opts) == ""
servant-js/src/Servant/JS/Vanilla.hs+7−6
@@ -2,6 +2,7 @@
22module Servant.JS.Vanilla where
33
44import Control.Lens
5+import Data.Maybe (isJust)
56import Data.Text (Text)
67import qualified Data.Text as T
78import Data.Monoid
@@ -47,12 +48,12 @@ generateVanillaJSWith opts req = "\n" <>
4748
4849 where argsStr = T.intercalate ", " args
4950 args = captures
50− ++ map (view argName) queryparams
51+ ++ map (view $ argName._1) queryparams
5152 ++ body
52− ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
53+ ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
5354 ++ [onSuccess, onError]
5455
55− captures = map captureArg
56+ captures = map (fst . captureArg)
5657 . filter isCapture
5758 $ req ^. reqUrl.path
5859
@@ -60,7 +61,7 @@ generateVanillaJSWith opts req = "\n" <>
6061
6162 queryparams = req ^.. reqUrl.queryStr.traverse
6263
63− body = if req ^. reqBody
64+ body = if isJust(req ^. reqBody)
6465 then [requestBody opts]
6566 else []
6667
@@ -68,7 +69,7 @@ generateVanillaJSWith opts req = "\n" <>
6869 onError = errorCallback opts
6970
7071 dataBody =
71− if req ^. reqBody
72+ if isJust (req ^. reqBody)
7273 then "JSON.stringify(body)\n"
7374 else "null"
7475
@@ -80,7 +81,7 @@ generateVanillaJSWith opts req = "\n" <>
8081
8182 where headersStr = T.intercalate "\n" $ map headerStr hs
8283 headerStr header = " xhr.setRequestHeader(\"" <>
83− headerArgName header <>
84+ fst (headerArg header) <>
8485 "\", " <> toJSHeader header <> ");"
8586
8687 namespace = if moduleName opts == ""
servant-js/test/Servant/JSSpec.hs+8−6
@@ -98,16 +98,17 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
9898
9999axiosSpec :: Spec
100100axiosSpec = describe specLabel $ do
101+ let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
101102 it "should add withCredentials when needed" $ do
102− let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
103+ let jsText = genJS withCredOpts $ reqList
103104 output jsText
104105 jsText `shouldContain` "withCredentials: true"
105106 it "should add xsrfCookieName when needed" $ do
106− let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
107+ let jsText = genJS cookieOpts $ reqList
107108 output jsText
108109 jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")
109110 it "should add withCredentials when needed" $ do
110− let jsText = genJS headerOpts $ listFromAPI (Proxy :: Proxy TestAPI)
111+ let jsText = genJS headerOpts $ reqList
111112 output jsText
112113 jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")
113114 where
@@ -121,18 +122,19 @@ axiosSpec = describe specLabel $ do
121122
122123angularSpec :: TestNames -> Spec
123124angularSpec test = describe specLabel $ do
125+ let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
124126 it "should implement a service globally" $ do
125− let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
127+ let jsText = genJS reqList
126128 output jsText
127129 jsText `shouldContain` (".service('" <> testName <> "'")
128130
129131 it "should depend on $http service globally" $ do
130− let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
132+ let jsText = genJS reqList
131133 output jsText
132134 jsText `shouldContain` ("('" <> testName <> "', function($http) {")
133135
134136 it "should not depend on $http service in handlers" $ do
135− let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
137+ let jsText = genJS reqList
136138 output jsText
137139 jsText `shouldNotContain` "getsomething($http, "
138140 where
servant-js/test/Servant/JSSpec/CustomHeaders.hs+13−12
@@ -6,6 +6,7 @@
66{-# LANGUAGE TypeFamilies #-}
77{-# LANGUAGE TypeOperators #-}
88{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE MultiParamTypeClasses #-}
910
1011module Servant.JSSpec.CustomHeaders where
1112
@@ -21,12 +22,12 @@ import Servant.JS.Internal
2122-- using -- Basic, Digest, whatever.
2223data Authorization (sym :: Symbol) a
2324
24−instance (KnownSymbol sym, HasForeign sublayout)
25− => HasForeign (Authorization sym a :> sublayout) where
25+instance (KnownSymbol sym, HasForeign lang sublayout)
26+ => HasForeign lang (Authorization sym a :> sublayout) where
2627 type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
2728
28− foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
29− req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
29+ foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
30+ req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $
3031 tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
3132 where
3233 tokenType t = t <> " {Authorization}"
@@ -34,23 +35,23 @@ instance (KnownSymbol sym, HasForeign sublayout)
3435-- | This is a combinator that fetches an X-MyLovelyHorse header.
3536data MyLovelyHorse a
3637
37−instance (HasForeign sublayout)
38− => HasForeign (MyLovelyHorse a :> sublayout) where
38+instance (HasForeign lang sublayout)
39+ => HasForeign lang (MyLovelyHorse a :> sublayout) where
3940 type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
4041
41− foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
42− req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]
42+ foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
43+ req & reqHeaders <>~ [ ReplaceHeaderArg ("X-MyLovelyHorse", "") tpl ]
4344 where
4445 tpl = "I am good friends with {X-MyLovelyHorse}"
4546
4647-- | This is a combinator that fetches an X-WhatsForDinner header.
4748data WhatsForDinner a
4849
49−instance (HasForeign sublayout)
50− => HasForeign (WhatsForDinner a :> sublayout) where
50+instance (HasForeign lang sublayout)
51+ => HasForeign lang (WhatsForDinner a :> sublayout) where
5152 type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
5253
53− foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
54− req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ]
54+ foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
55+ req & reqHeaders <>~ [ ReplaceHeaderArg ("X-WhatsForDinner", "") tpl ]
5556 where
5657 tpl = "I would like {X-WhatsForDinner} with a cherry on top."