git.iko.soy/servant
on master help sign in
[servant-foreign] Parameterise type classes with a foreign representation type
5188e84Steve Purcell
servant-foreign/servant-foreign.cabal−1
compare with master
unifiedsplit
@@ -65,7 +65,6 @@ test-suite spec
65 build-depends: base
65 build-depends: base
66 , hspec >= 2.1.8
66 , hspec >= 2.1.8
67 , servant-foreign
67 , servant-foreign
68− , text >= 1.2 && < 1.3
69 default-language: Haskell2010
68 default-language: Haskell2010
70 default-extensions: ConstraintKinds
69 default-extensions: ConstraintKinds
71 , DataKinds
70 , DataKinds
servant-foreign/src/Servant/Foreign.hs−3
@@ -10,7 +10,6 @@ module Servant.Foreign
10 , Url(..)
10 , Url(..)
11 -- aliases
11 -- aliases
12 , Path
12 , Path
13− , ForeignType(..)
14 , Arg(..)
13 , Arg(..)
15 , FunctionName(..)
14 , FunctionName(..)
16 , PathSegment(..)
15 , PathSegment(..)
@@ -31,7 +30,6 @@ module Servant.Foreign
31 , headerArg
30 , headerArg
32 -- prisms
31 -- prisms
33 , _PathSegment
32 , _PathSegment
34− , _ForeignType
35 , _HeaderArg
33 , _HeaderArg
36 , _ReplaceHeaderArg
34 , _ReplaceHeaderArg
37 , _Static
35 , _Static
@@ -42,7 +40,6 @@ module Servant.Foreign
42 -- rest of it
40 -- rest of it
43 , HasForeign(..)
41 , HasForeign(..)
44 , HasForeignType(..)
42 , HasForeignType(..)
45− , HasNoForeignType
46 , GenerateList(..)
43 , GenerateList(..)
47 , NoTypes
44 , NoTypes
48 , captureArg
45 , captureArg
servant-foreign/src/Servant/Foreign/Internal.hs+114−122
@@ -27,15 +27,6 @@ newtype FunctionName = FunctionName { unFunctionName :: [Text] }
27
27
28makePrisms ''FunctionName
28makePrisms ''FunctionName
29
29
30−newtype ForeignType f = ForeignType { unForeignType :: f }
31−
32−deriving instance Show f => Show (ForeignType f)
33−deriving instance Eq f => Eq (ForeignType f)
34−deriving instance IsString f => IsString (ForeignType f)
35−deriving instance Monoid f => Monoid (ForeignType f)
36−
37−makePrisms ''ForeignType
38−
39newtype PathSegment = PathSegment { unPathSegment :: Text }
30newtype PathSegment = PathSegment { unPathSegment :: Text }
40 deriving (Show, Eq, IsString, Monoid)
31 deriving (Show, Eq, IsString, Monoid)
41
32
@@ -43,7 +34,7 @@ makePrisms ''PathSegment
43
34
44data Arg f = Arg
35data Arg f = Arg
45 { _argName :: PathSegment
36 { _argName :: PathSegment
46− , _argType :: ForeignType f }
37+ , _argType :: f }
47
38
48deriving instance Eq f => Eq (Arg f)
39deriving instance Eq f => Eq (Arg f)
49deriving instance Show f => Show (Arg f)
40deriving instance Show f => Show (Arg f)
@@ -130,8 +121,8 @@ data Req f = Req
130 { _reqUrl :: Url f
121 { _reqUrl :: Url f
131 , _reqMethod :: HTTP.Method
122 , _reqMethod :: HTTP.Method
132 , _reqHeaders :: [HeaderArg f]
123 , _reqHeaders :: [HeaderArg f]
133− , _reqBody :: Maybe (ForeignType f)
124+ , _reqBody :: Maybe f
134− , _reqReturnType :: ForeignType f
125+ , _reqReturnType :: Maybe f
135 , _reqFuncName :: FunctionName
126 , _reqFuncName :: FunctionName
136 }
127 }
137
128
@@ -140,8 +131,8 @@ deriving instance Show f => Show (Req f)
140
131
141makeLenses ''Req
132makeLenses ''Req
142
133
143−defReq :: Req Text
134+defReq :: Req ftype
144−defReq = Req defUrl "GET" [] Nothing (ForeignType "") (FunctionName [])
135+defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName [])
145
136
146-- | To be used exclusively as a "negative" return type/constraint
137-- | To be used exclusively as a "negative" return type/constraint
147-- by @'Elem`@ type family.
138-- by @'Elem`@ type family.
@@ -154,158 +145,158 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
154
145
155-- | 'HasForeignType' maps Haskell types with types in the target
146-- | 'HasForeignType' maps Haskell types with types in the target
156-- language of your backend. For example, let's say you're
147-- language of your backend. For example, let's say you're
157−-- implementing a backend to some language __X__:
148+-- implementing a backend to some language __X__, and you want
149+-- a Text representation of each input/output type mentioned in the API:
158--
150--
159-- > -- First you need to create a dummy type to parametrize your
151-- > -- First you need to create a dummy type to parametrize your
160-- > -- instances.
152-- > -- instances.
161-- > data LangX
153-- > data LangX
162-- >
154-- >
163-- > -- Otherwise you define instances for the types you need
155-- > -- Otherwise you define instances for the types you need
164−-- > instance HasForeignType LangX Int where
156+-- > instance HasForeignType LangX Text Int where
165−-- > typeFor _ _ = "intX"
157+-- > typeFor _ _ _ = "intX"
166-- >
158-- >
167-- > -- Or for example in case of lists
159-- > -- Or for example in case of lists
168−-- > instance HasForeignType LangX a => HasForeignType LangX [a] where
160+-- > instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where
169−-- > typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
161+-- > typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
170--
162--
171-- Finally to generate list of information about all the endpoints for
163-- Finally to generate list of information about all the endpoints for
172-- an API you create a function of a form:
164-- an API you create a function of a form:
173--
165--
174−-- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api))
166+-- > getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
175−-- > => Proxy api -> [Req]
167+-- > => Proxy api -> [Req Text]
176−-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api
168+-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api
177--
169--
178-- > -- If language __X__ is dynamically typed then you can use
170-- > -- If language __X__ is dynamically typed then you can use
179−-- > -- a predefined NoTypes parameter
171+-- > -- a predefined NoTypes parameter with the () output type:
172+--
180−-- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api))
173+-- > getEndpoints :: (HasForeign NoTypes () api, GenerateList Text (Foreign () api))
181−-- > => Proxy api -> [Req]
174+-- > => Proxy api -> [Req ()]
182−-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api
175+-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) api
183-- >
176-- >
184--
177--
185−class HasForeignType lang a where
178+class HasForeignType lang ftype a where
186− typeFor :: Proxy lang -> Proxy a -> ForeignType Text
179+ typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype
187
180
188data NoTypes
181data NoTypes
189
182
190−instance HasForeignType NoTypes ftype where
183+instance HasForeignType NoTypes () ftype where
191− typeFor _ _ = ForeignType empty
184+ typeFor _ _ _ = ()
192−
193−type HasNoForeignType = HasForeignType NoTypes
194
185
195−class HasForeign lang (layout :: *) where
186+class HasForeign lang ftype (layout :: *) where
196− type Foreign layout :: *
187+ type Foreign ftype layout :: *
197− foreignFor :: Proxy lang -> Proxy layout -> Req Text -> Foreign layout
188+ foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout
198
189
199−instance (HasForeign lang a, HasForeign lang b)
190+instance (HasForeign lang ftype a, HasForeign lang ftype b)
200− => HasForeign lang (a :<|> b) where
191+ => HasForeign lang ftype (a :<|> b) where
201− type Foreign (a :<|> b) = Foreign a :<|> Foreign b
192+ type Foreign ftype (a :<|> b) = Foreign ftype a :<|> Foreign ftype b
202
193
203− foreignFor lang Proxy req =
194+ foreignFor lang ftype Proxy req =
204− foreignFor lang (Proxy :: Proxy a) req
195+ foreignFor lang ftype (Proxy :: Proxy a) req
205− :<|> foreignFor lang (Proxy :: Proxy b) req
196+ :<|> foreignFor lang ftype (Proxy :: Proxy b) req
206
197
207−instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
198+instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout)
208− => HasForeign lang (Capture sym ftype :> sublayout) where
199+ => HasForeign lang ftype (Capture sym t :> sublayout) where
209− type Foreign (Capture sym a :> sublayout) = Foreign sublayout
200+ type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout
210
201
211− foreignFor lang Proxy req =
202+ foreignFor lang Proxy Proxy req =
212− foreignFor lang (Proxy :: Proxy sublayout) $
203+ foreignFor lang Proxy (Proxy :: Proxy sublayout) $
213 req & reqUrl . path <>~ [Segment (Cap arg)]
204 req & reqUrl . path <>~ [Segment (Cap arg)]
214 & reqFuncName . _FunctionName %~ (++ ["by", str])
205 & reqFuncName . _FunctionName %~ (++ ["by", str])
215 where
206 where
216 str = pack . symbolVal $ (Proxy :: Proxy sym)
207 str = pack . symbolVal $ (Proxy :: Proxy sym)
217− ftype = typeFor lang (Proxy :: Proxy ftype)
208+ ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy t)
218 arg = Arg
209 arg = Arg
219 { _argName = PathSegment str
210 { _argName = PathSegment str
220 , _argType = ftype }
211 , _argType = ftype }
221
212
222−instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
213+instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
223− => HasForeign lang (Verb method status list a) where
214+ => HasForeign lang ftype (Verb method status list a) where
224− type Foreign (Verb method status list a) = Req Text
215+ type Foreign ftype (Verb method status list a) = Req ftype
225
216
226− foreignFor lang Proxy req =
217+ foreignFor lang Proxy Proxy req =
227 req & reqFuncName . _FunctionName %~ (methodLC :)
218 req & reqFuncName . _FunctionName %~ (methodLC :)
228 & reqMethod .~ method
219 & reqMethod .~ method
229− & reqReturnType .~ retType
220+ & reqReturnType .~ Just retType
230 where
221 where
231− retType = typeFor lang (Proxy :: Proxy a)
222+ retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a)
232 method = reflectMethod (Proxy :: Proxy method)
223 method = reflectMethod (Proxy :: Proxy method)
233 methodLC = toLower $ decodeUtf8 method
224 methodLC = toLower $ decodeUtf8 method
234
225
235−instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
226+instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
236− => HasForeign lang (Header sym a :> sublayout) where
227+ => HasForeign lang ftype (Header sym a :> sublayout) where
237− type Foreign (Header sym a :> sublayout) = Foreign sublayout
228+ type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout
238
229
239− foreignFor lang Proxy req =
230+ foreignFor lang Proxy Proxy req =
240− foreignFor lang subP $ req & reqHeaders <>~ [HeaderArg arg]
231+ foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
241 where
232 where
242 hname = pack . symbolVal $ (Proxy :: Proxy sym)
233 hname = pack . symbolVal $ (Proxy :: Proxy sym)
243 arg = Arg
234 arg = Arg
244 { _argName = PathSegment hname
235 { _argName = PathSegment hname
245− , _argType = typeFor lang (Proxy :: Proxy a) }
236+ , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
246 subP = Proxy :: Proxy sublayout
237 subP = Proxy :: Proxy sublayout
247
238
248−instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
239+instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
249− => HasForeign lang (QueryParam sym a :> sublayout) where
240+ => HasForeign lang ftype (QueryParam sym a :> sublayout) where
250− type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
241+ type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout
251
242
252− foreignFor lang Proxy req =
243+ foreignFor lang Proxy Proxy req =
253− foreignFor lang (Proxy :: Proxy sublayout) $
244+ foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
254 req & reqUrl.queryStr <>~ [QueryArg arg Normal]
245 req & reqUrl.queryStr <>~ [QueryArg arg Normal]
255 where
246 where
256 str = pack . symbolVal $ (Proxy :: Proxy sym)
247 str = pack . symbolVal $ (Proxy :: Proxy sym)
257 arg = Arg
248 arg = Arg
258 { _argName = PathSegment str
249 { _argName = PathSegment str
259− , _argType = typeFor lang (Proxy :: Proxy a) }
250+ , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
260
251
261instance
252instance
262− (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
253+ (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout)
263− => HasForeign lang (QueryParams sym a :> sublayout) where
254+ => HasForeign lang ftype (QueryParams sym a :> sublayout) where
264− type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
255+ type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout
265− foreignFor lang Proxy req =
256+ foreignFor lang Proxy Proxy req =
266− foreignFor lang (Proxy :: Proxy sublayout) $
257+ foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
267 req & reqUrl.queryStr <>~ [QueryArg arg List]
258 req & reqUrl.queryStr <>~ [QueryArg arg List]
268 where
259 where
269 str = pack . symbolVal $ (Proxy :: Proxy sym)
260 str = pack . symbolVal $ (Proxy :: Proxy sym)
270 arg = Arg
261 arg = Arg
271 { _argName = PathSegment str
262 { _argName = PathSegment str
272− , _argType = typeFor lang (Proxy :: Proxy [a]) }
263+ , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) }
273
264
274instance
265instance
275− (KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
266+ (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout)
276− => HasForeign lang (QueryFlag sym :> sublayout) where
267+ => HasForeign lang ftype (QueryFlag sym :> sublayout) where
277− type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
268+ type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout
278
269
279− foreignFor lang Proxy req =
270+ foreignFor lang ftype Proxy req =
280− foreignFor lang (Proxy :: Proxy sublayout) $
271+ foreignFor lang ftype (Proxy :: Proxy sublayout) $
281 req & reqUrl.queryStr <>~ [QueryArg arg Flag]
272 req & reqUrl.queryStr <>~ [QueryArg arg Flag]
282 where
273 where
283 str = pack . symbolVal $ (Proxy :: Proxy sym)
274 str = pack . symbolVal $ (Proxy :: Proxy sym)
284 arg = Arg
275 arg = Arg
285 { _argName = PathSegment str
276 { _argName = PathSegment str
286− , _argType = typeFor lang (Proxy :: Proxy Bool) }
277+ , _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
287
278
288−instance HasForeign lang Raw where
279+instance HasForeign lang ftype Raw where
289− type Foreign Raw = HTTP.Method -> Req Text
280+ type Foreign ftype Raw = HTTP.Method -> Req ftype
290
281
291− foreignFor _ Proxy req method =
282+ foreignFor _ Proxy Proxy req method =
292 req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
283 req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
293 & reqMethod .~ method
284 & reqMethod .~ method
294
285
295−instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
286+instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
296− => HasForeign lang (ReqBody list a :> sublayout) where
287+ => HasForeign lang ftype (ReqBody list a :> sublayout) where
297− type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
288+ type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout
298
289
299− foreignFor lang Proxy req =
290+ foreignFor lang ftype Proxy req =
300− foreignFor lang (Proxy :: Proxy sublayout) $
291+ foreignFor lang ftype (Proxy :: Proxy sublayout) $
301− req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
292+ req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a))
302
293
303−instance (KnownSymbol path, HasForeign lang sublayout)
294+instance (KnownSymbol path, HasForeign lang ftype sublayout)
304− => HasForeign lang (path :> sublayout) where
295+ => HasForeign lang ftype (path :> sublayout) where
305− type Foreign (path :> sublayout) = Foreign sublayout
296+ type Foreign ftype (path :> sublayout) = Foreign ftype sublayout
306
297
307− foreignFor lang Proxy req =
298+ foreignFor lang ftype Proxy req =
308− foreignFor lang (Proxy :: Proxy sublayout) $
299+ foreignFor lang ftype (Proxy :: Proxy sublayout) $
309 req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
300 req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
310 & reqFuncName . _FunctionName %~ (++ [str])
301 & reqFuncName . _FunctionName %~ (++ [str])
311 where
302 where
@@ -313,58 +304,59 @@ instance (KnownSymbol path, HasForeign lang sublayout)
313 Data.Text.map (\c -> if c == '.' then '_' else c)
304 Data.Text.map (\c -> if c == '.' then '_' else c)
314 . pack . symbolVal $ (Proxy :: Proxy path)
305 . pack . symbolVal $ (Proxy :: Proxy path)
315
306
316−instance HasForeign lang sublayout
307+instance HasForeign lang ftype sublayout
317− => HasForeign lang (RemoteHost :> sublayout) where
308+ => HasForeign lang ftype (RemoteHost :> sublayout) where
318− type Foreign (RemoteHost :> sublayout) = Foreign sublayout
309+ type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout
319
310
320− foreignFor lang Proxy req =
311+ foreignFor lang ftype Proxy req =
321− foreignFor lang (Proxy :: Proxy sublayout) req
312+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
322
313
323−instance HasForeign lang sublayout
314+instance HasForeign lang ftype sublayout
324− => HasForeign lang (IsSecure :> sublayout) where
315+ => HasForeign lang ftype (IsSecure :> sublayout) where
325− type Foreign (IsSecure :> sublayout) = Foreign sublayout
316+ type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout
326
317
327− foreignFor lang Proxy req =
318+ foreignFor lang ftype Proxy req =
328− foreignFor lang (Proxy :: Proxy sublayout) req
319+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
329
320
330−instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
321+instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where
331− type Foreign (Vault :> sublayout) = Foreign sublayout
322+ type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout
332
323
333− foreignFor lang Proxy req =
324+ foreignFor lang ftype Proxy req =
334− foreignFor lang (Proxy :: Proxy sublayout) req
325+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
335
326
336−instance HasForeign lang sublayout =>
327+instance HasForeign lang ftype sublayout =>
337− HasForeign lang (WithNamedContext name context sublayout) where
328+ HasForeign lang ftype (WithNamedContext name context sublayout) where
338
329
339− type Foreign (WithNamedContext name context sublayout) = Foreign sublayout
330+ type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout
340
331
341− foreignFor lang Proxy = foreignFor lang (Proxy :: Proxy sublayout)
332+ foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout)
342
333
343−instance HasForeign lang sublayout
334+instance HasForeign lang ftype sublayout
344− => HasForeign lang (HttpVersion :> sublayout) where
335+ => HasForeign lang ftype (HttpVersion :> sublayout) where
345− type Foreign (HttpVersion :> sublayout) = Foreign sublayout
336+ type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout
346
337
347− foreignFor lang Proxy req =
338+ foreignFor lang ftype Proxy req =
348− foreignFor lang (Proxy :: Proxy sublayout) req
339+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
349
340
350-- | Utility class used by 'listFromAPI' which computes
341-- | Utility class used by 'listFromAPI' which computes
351-- the data needed to generate a function for each endpoint
342-- the data needed to generate a function for each endpoint
352-- and hands it all back in a list.
343-- and hands it all back in a list.
353−class GenerateList reqs where
344+class GenerateList ftype reqs where
354− generateList :: reqs -> [Req Text]
345+ generateList :: reqs -> [Req ftype]
355
346
356−instance GenerateList (Req Text) where
347+instance GenerateList ftype (Req ftype) where
357 generateList r = [r]
348 generateList r = [r]
358
349
359−instance (GenerateList start, GenerateList rest)
350+instance (GenerateList ftype start, GenerateList ftype rest)
360− => GenerateList (start :<|> rest) where
351+ => GenerateList ftype (start :<|> rest) where
361 generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
352 generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
362
353
363-- | Generate the necessary data for codegen as a list, each 'Req'
354-- | Generate the necessary data for codegen as a list, each 'Req'
364-- describing one endpoint from your API type.
355-- describing one endpoint from your API type.
365listFromAPI
356listFromAPI
366− :: (HasForeign lang api, GenerateList (Foreign api))
357+ :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api))
367 => Proxy lang
358 => Proxy lang
359+ -> Proxy ftype
368 -> Proxy api
360 -> Proxy api
369− -> [Req Text]
361+ -> [Req ftype]
370−listFromAPI lang p = generateList (foreignFor lang p defReq)
362+listFromAPI lang ftype p = generateList (foreignFor lang ftype p defReq)
servant-foreign/test/Servant/ForeignSpec.hs+16−17
@@ -6,7 +6,6 @@ module Servant.ForeignSpec where
6import Data.Monoid ((<>))
6import Data.Monoid ((<>))
7import Data.Proxy
7import Data.Proxy
8import Servant.Foreign
8import Servant.Foreign
9−import Data.Text (Text(..))
10
9
11import Test.Hspec
10import Test.Hspec
12
11
@@ -27,20 +26,20 @@ camelCaseSpec = describe "camelCase" $ do
27
26
28data LangX
27data LangX
29
28
30−instance HasForeignType LangX () where
29+instance HasForeignType LangX String () where
31− typeFor _ _ = ForeignType "voidX"
30+ typeFor _ _ _ = "voidX"
32
31
33−instance HasForeignType LangX Int where
32+instance HasForeignType LangX String Int where
34− typeFor _ _ = "intX"
33+ typeFor _ _ _ = "intX"
35
34
36−instance HasForeignType LangX Bool where
35+instance HasForeignType LangX String Bool where
37− typeFor _ _ = "boolX"
36+ typeFor _ _ _ = "boolX"
38
37
39−instance OVERLAPPING_ HasForeignType LangX String where
38+instance OVERLAPPING_ HasForeignType LangX String String where
40− typeFor _ _ = "stringX"
39+ typeFor _ _ _ = "stringX"
41
40
42−instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where
41+instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where
43− typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
42+ typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
44
43
45type TestApi
44type TestApi
46 = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
45 = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
@@ -48,8 +47,8 @@ type TestApi
48 :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
47 :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
49 :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
48 :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
50
49
51−testApi :: [Req Text]
50+testApi :: [Req String]
52−testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
51+testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
53
52
54listFromAPISpec :: Spec
53listFromAPISpec :: Spec
55listFromAPISpec = describe "listFromAPI" $ do
54listFromAPISpec = describe "listFromAPI" $ do
@@ -66,7 +65,7 @@ listFromAPISpec = describe "listFromAPI" $ do
66 , _reqMethod = "GET"
65 , _reqMethod = "GET"
67 , _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"]
66 , _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"]
68 , _reqBody = Nothing
67 , _reqBody = Nothing
69− , _reqReturnType = "intX"
68+ , _reqReturnType = Just "intX"
70 , _reqFuncName = FunctionName ["get", "test"]
69 , _reqFuncName = FunctionName ["get", "test"]
71 }
70 }
72
71
@@ -78,7 +77,7 @@ listFromAPISpec = describe "listFromAPI" $ do
78 , _reqMethod = "POST"
77 , _reqMethod = "POST"
79 , _reqHeaders = []
78 , _reqHeaders = []
80 , _reqBody = Just "listX of stringX"
79 , _reqBody = Just "listX of stringX"
81− , _reqReturnType = "voidX"
80+ , _reqReturnType = Just "voidX"
82 , _reqFuncName = FunctionName ["post", "test"]
81 , _reqFuncName = FunctionName ["post", "test"]
83 }
82 }
84
83
@@ -91,7 +90,7 @@ listFromAPISpec = describe "listFromAPI" $ do
91 , _reqMethod = "PUT"
90 , _reqMethod = "PUT"
92 , _reqHeaders = []
91 , _reqHeaders = []
93 , _reqBody = Just "stringX"
92 , _reqBody = Just "stringX"
94− , _reqReturnType = "voidX"
93+ , _reqReturnType = Just "voidX"
95 , _reqFuncName = FunctionName ["put", "test"]
94 , _reqFuncName = FunctionName ["put", "test"]
96 }
95 }
97
96
@@ -104,6 +103,6 @@ listFromAPISpec = describe "listFromAPI" $ do
104 , _reqMethod = "DELETE"
103 , _reqMethod = "DELETE"
105 , _reqHeaders = []
104 , _reqHeaders = []
106 , _reqBody = Nothing
105 , _reqBody = Nothing
107− , _reqReturnType = "voidX"
106+ , _reqReturnType = Just "voidX"
108 , _reqFuncName = FunctionName ["delete", "test", "by", "id"]
107 , _reqFuncName = FunctionName ["delete", "test", "by", "id"]
109 }
108 }
servant-js/src/Servant/JS.hs+5−5
@@ -128,22 +128,22 @@ import Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
128-- | Generate the data necessary to generate javascript code
128-- | Generate the data necessary to generate javascript code
129-- for all the endpoints of an API, as ':<|>'-separated values
129-- for all the endpoints of an API, as ':<|>'-separated values
130-- of type 'AjaxReq'.
130-- of type 'AjaxReq'.
131−javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
131+javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout
132−javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
132+javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq
133
133
134-- | Directly generate all the javascript functions for your API
134-- | Directly generate all the javascript functions for your API
135-- 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
136-- a file or integrate it in a page, for example.
136-- a file or integrate it in a page, for example.
137−jsForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
137+jsForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))
138 => Proxy api -- ^ proxy for your API type
138 => Proxy api -- ^ proxy for your API type
139 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
139 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
140 -> 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
141−jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) p)
141+jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p)
142
142
143-- | Directly generate all the javascript functions for your API
143-- | Directly generate all the javascript functions for your API
144-- from a 'Proxy' for your API type using the given generator
144-- from a 'Proxy' for your API type using the given generator
145-- 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.
146−writeJSForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
146+writeJSForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))
147 => Proxy api -- ^ proxy for your API type
147 => Proxy api -- ^ proxy for your API type
148 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
148 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
149 -> 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
servant-js/src/Servant/JS/Internal.hs+2−4
@@ -21,7 +21,6 @@ module Servant.JS.Internal
21 , reqHeaders
21 , reqHeaders
22 , HasForeign(..)
22 , HasForeign(..)
23 , HasForeignType(..)
23 , HasForeignType(..)
24− , HasNoForeignType
25 , GenerateList(..)
24 , GenerateList(..)
26 , NoTypes
25 , NoTypes
27 , HeaderArg
26 , HeaderArg
@@ -33,7 +32,6 @@ module Servant.JS.Internal
33 , SegmentType(..)
32 , SegmentType(..)
34 , Url(..)
33 , Url(..)
35 , Path
34 , Path
36− , ForeignType(..)
37 , Arg(..)
35 , Arg(..)
38 , FunctionName(..)
36 , FunctionName(..)
39 , PathSegment(..)
37 , PathSegment(..)
@@ -57,12 +55,12 @@ import qualified Data.Text as T
57import Data.Text (Text)
55import Data.Text (Text)
58import Servant.Foreign
56import Servant.Foreign
59
57
60−type AjaxReq = Req Text
58+type AjaxReq = Req ()
61
59
62-- A 'JavascriptGenerator' just takes the data found in the API type
60-- A 'JavascriptGenerator' just takes the data found in the API type
63-- for each endpoint and generates Javascript code in a Text. Several
61-- for each endpoint and generates Javascript code in a Text. Several
64-- generators are available in this package.
62-- generators are available in this package.
65−type JavaScriptGenerator = [Req Text] -> Text
63+type JavaScriptGenerator = [Req ()] -> Text
66
64
67-- | This structure is used by specific implementations to let you
65-- | This structure is used by specific implementations to let you
68-- customize the output
66-- customize the output
servant-js/test/Servant/JSSpec.hs+2−2
@@ -106,7 +106,7 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
106
106
107axiosSpec :: Spec
107axiosSpec :: Spec
108axiosSpec = describe specLabel $ do
108axiosSpec = describe specLabel $ do
109− let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
109+ let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)
110 it "should add withCredentials when needed" $ do
110 it "should add withCredentials when needed" $ do
111 let jsText = genJS withCredOpts $ reqList
111 let jsText = genJS withCredOpts $ reqList
112 output jsText
112 output jsText
@@ -130,7 +130,7 @@ axiosSpec = describe specLabel $ do
130
130
131angularSpec :: TestNames -> Spec
131angularSpec :: TestNames -> Spec
132angularSpec test = describe specLabel $ do
132angularSpec test = describe specLabel $ do
133− let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
133+ let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)
134 it "should implement a service globally" $ do
134 it "should implement a service globally" $ do
135 let jsText = genJS reqList
135 let jsText = genJS reqList
136 output jsText
136 output jsText
servant-js/test/Servant/JSSpec/CustomHeaders.hs+16−15
@@ -1,4 +1,5 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE PolyKinds #-}
@@ -22,13 +23,13 @@ import Servant.JS.Internal
22-- using -- Basic, Digest, whatever.
23-- using -- Basic, Digest, whatever.
23data Authorization (sym :: Symbol) a
24data Authorization (sym :: Symbol) a
24
25
25−instance (KnownSymbol sym, HasForeign lang sublayout)
26+instance (KnownSymbol sym, HasForeign lang () sublayout)
26− => HasForeign lang (Authorization sym a :> sublayout) where
27+ => HasForeign lang () (Authorization sym a :> sublayout) where
27− type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
28+ type Foreign () (Authorization sym a :> sublayout) = Foreign () sublayout
28
29
29− foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
30+ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
30 req & reqHeaders <>~
31 req & reqHeaders <>~
31− [ ReplaceHeaderArg (Arg "Authorization" "")
32+ [ ReplaceHeaderArg (Arg "Authorization" ())
32 $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
33 $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
33 where
34 where
34 tokenType t = t <> " {Authorization}"
35 tokenType t = t <> " {Authorization}"
@@ -36,23 +37,23 @@ instance (KnownSymbol sym, HasForeign lang sublayout)
36-- | This is a combinator that fetches an X-MyLovelyHorse header.
37-- | This is a combinator that fetches an X-MyLovelyHorse header.
37data MyLovelyHorse a
38data MyLovelyHorse a
38
39
39−instance (HasForeign lang sublayout)
40+instance (HasForeign lang () sublayout)
40− => HasForeign lang (MyLovelyHorse a :> sublayout) where
41+ => HasForeign lang () (MyLovelyHorse a :> sublayout) where
41− type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
42+ type Foreign () (MyLovelyHorse a :> sublayout) = Foreign () sublayout
42
43
43− foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
44+ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
44− req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" "") tpl ]
45+ req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ]
45 where
46 where
46 tpl = "I am good friends with {X-MyLovelyHorse}"
47 tpl = "I am good friends with {X-MyLovelyHorse}"
47
48
48-- | This is a combinator that fetches an X-WhatsForDinner header.
49-- | This is a combinator that fetches an X-WhatsForDinner header.
49data WhatsForDinner a
50data WhatsForDinner a
50
51
51−instance (HasForeign lang sublayout)
52+instance (HasForeign lang () sublayout)
52− => HasForeign lang (WhatsForDinner a :> sublayout) where
53+ => HasForeign lang () (WhatsForDinner a :> sublayout) where
53− type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
54+ type Foreign () (WhatsForDinner a :> sublayout) = Foreign () sublayout
54
55
55− foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
56+ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
56− req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" "") tpl ]
57+ req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ]
57 where
58 where
58 tpl = "I would like {X-WhatsForDinner} with a cherry on top."
59 tpl = "I would like {X-WhatsForDinner} with a cherry on top."