git.iko.soy/typeable/servant
on master help sign in
Merge pull request #351 from purcell/variable-foreign-types

servant-foreign: don't constrain ForeignType to Text

commitf5fe9a060cf2e74c9c94eef59c066e6ac913fbe4 authorDenis Redozubov <denis.redozubov@gmail.com> dateTue 15 Mar 2016, 09:40 (11 years ago) parente34003e5188e84
12 files changed+244−233
compare with master
unifiedsplit
servant-foreign/servant-foreign.cabal+1 servant-foreign/src/Servant/Foreign.hs+5−8 servant-foreign/src/Servant/Foreign/Internal.hs+168−154 servant-foreign/test/Servant/ForeignSpec.hs+16−16 servant-js/src/Servant/JS.hs+5−5 servant-js/src/Servant/JS/Angular.hs+4−4 servant-js/src/Servant/JS/Axios.hs+4−4 servant-js/src/Servant/JS/Internal.hs+15−17 servant-js/src/Servant/JS/JQuery.hs+4−4 servant-js/src/Servant/JS/Vanilla.hs+4−4 servant-js/test/Servant/JSSpec.hs+2−2 servant-js/test/Servant/JSSpec/CustomHeaders.hs+16−15
servant-foreign/servant-foreign.cabal+1
@@ -46,6 +46,7 @@ library
4646 , GeneralizedNewtypeDeriving
4747 , MultiParamTypeClasses
4848 , ScopedTypeVariables
49+ , StandaloneDeriving
4950 , TemplateHaskell
5051 , TypeFamilies
5152 , TypeOperators
servant-foreign/src/Servant/Foreign.hs+5−8
@@ -10,14 +10,13 @@ module Servant.Foreign
1010 , Url(..)
1111 -- aliases
1212 , Path
13− , ForeignType(..)
1413 , Arg(..)
1514 , FunctionName(..)
1615 , PathSegment(..)
1716 -- lenses
18− , aName
19− , aType
20− , aPath
17+ , argName
18+ , argType
19+ , argPath
2120 , reqUrl
2221 , reqMethod
2322 , reqHeaders
@@ -26,12 +25,11 @@ module Servant.Foreign
2625 , reqFuncName
2726 , path
2827 , queryStr
29− , argName
30− , argType
28+ , queryArgName
29+ , queryArgType
3130 , headerArg
3231 -- prisms
3332 , _PathSegment
34− , _ForeignType
3533 , _HeaderArg
3634 , _ReplaceHeaderArg
3735 , _Static
@@ -42,7 +40,6 @@ module Servant.Foreign
4240 -- rest of it
4341 , HasForeign(..)
4442 , HasForeignType(..)
45− , HasNoForeignType
4643 , GenerateList(..)
4744 , NoTypes
4845 , captureArg
servant-foreign/src/Servant/Foreign/Internal.hs+168−154
@@ -27,49 +27,50 @@ newtype FunctionName = FunctionName { unFunctionName :: [Text] }
2727
2828makePrisms ''FunctionName
2929
30−newtype ForeignType = ForeignType { unForeignType :: Text }
31− deriving (Show, Eq, IsString, Monoid)
32−
33−makePrisms ''ForeignType
34−
3530newtype PathSegment = PathSegment { unPathSegment :: Text }
3631 deriving (Show, Eq, IsString, Monoid)
3732
3833makePrisms ''PathSegment
3934
40−data Arg = Arg
41− { _aName :: PathSegment
42− , _aType :: ForeignType }
43− deriving (Show, Eq)
35+data Arg f = Arg
36+ { _argName :: PathSegment
37+ , _argType :: f }
38+
39+deriving instance Eq f => Eq (Arg f)
40+deriving instance Show f => Show (Arg f)
4441
4542makeLenses ''Arg
4643
47−aPath :: Getter Arg Text
48−aPath = aName . _PathSegment
44+argPath :: Getter (Arg f) Text
45+argPath = argName . _PathSegment
4946
50−data SegmentType
47+data SegmentType f
5148 = Static PathSegment
5249 -- ^ a static path segment. like "/foo"
53− | Cap Arg
50+ | Cap (Arg f)
5451 -- ^ a capture. like "/:userid"
55− deriving (Show, Eq)
52+
53+deriving instance Eq f => Eq (SegmentType f)
54+deriving instance Show f => Show (SegmentType f)
5655
5756makePrisms ''SegmentType
5857
59−newtype Segment = Segment { unSegment :: SegmentType }
60− deriving (Eq, Show)
58+newtype Segment f = Segment { unSegment :: SegmentType f }
59+
60+deriving instance Eq f => Eq (Segment f)
61+deriving instance Show f => Show (Segment f)
6162
6263makePrisms ''Segment
6364
64−isCapture :: Segment -> Bool
65+isCapture :: Segment f -> Bool
6566isCapture (Segment (Cap _)) = True
6667isCapture _ = False
6768
68−captureArg :: Segment -> Arg
69+captureArg :: Segment f -> Arg f
6970captureArg (Segment (Cap s)) = s
7071captureArg _ = error "captureArg called on non capture"
7172
72−type Path = [Segment]
73+type Path f = [Segment f]
7374
7475data ArgType
7576 = Normal
@@ -79,47 +80,59 @@ data ArgType
7980
8081makePrisms ''ArgType
8182
82−data QueryArg = QueryArg
83− { _argName :: Arg
84− , _argType :: ArgType
85− } deriving (Eq, Show)
83+data QueryArg f = QueryArg
84+ { _queryArgName :: Arg f
85+ , _queryArgType :: ArgType
86+ }
87+
88+deriving instance Eq f => Eq (QueryArg f)
89+deriving instance Show f => Show (QueryArg f)
8690
8791makeLenses ''QueryArg
8892
89−data HeaderArg = HeaderArg
90− { _headerArg :: Arg }
93+data HeaderArg f = HeaderArg
94+ { _headerArg :: Arg f }
9195 | ReplaceHeaderArg
92− { _headerArg :: Arg
96+ { _headerArg :: Arg f
9397 , _headerPattern :: Text
94− } deriving (Eq, Show)
98+ }
99+
100+deriving instance Eq f => Eq (HeaderArg f)
101+deriving instance Show f => Show (HeaderArg f)
95102
96103makeLenses ''HeaderArg
97104
98105makePrisms ''HeaderArg
99106
100−data Url = Url
101− { _path :: Path
102− , _queryStr :: [QueryArg]
103− } deriving (Eq, Show)
107+data Url f = Url
108+ { _path :: Path f
109+ , _queryStr :: [QueryArg f]
110+ }
111+
112+deriving instance Eq f => Eq (Url f)
113+deriving instance Show f => Show (Url f)
104114
105−defUrl :: Url
115+defUrl :: Url f
106116defUrl = Url [] []
107117
108118makeLenses ''Url
109119
110−data Req = Req
111− { _reqUrl :: Url
120+data Req f = Req
121+ { _reqUrl :: Url f
112122 , _reqMethod :: HTTP.Method
113− , _reqHeaders :: [HeaderArg]
114− , _reqBody :: Maybe ForeignType
115− , _reqReturnType :: ForeignType
123+ , _reqHeaders :: [HeaderArg f]
124+ , _reqBody :: Maybe f
125+ , _reqReturnType :: Maybe f
116126 , _reqFuncName :: FunctionName
117− } deriving (Eq, Show)
127+ }
128+
129+deriving instance Eq f => Eq (Req f)
130+deriving instance Show f => Show (Req f)
118131
119132makeLenses ''Req
120133
121−defReq :: Req
122−defReq = Req defUrl "GET" [] Nothing (ForeignType "") (FunctionName [])
134+defReq :: Req ftype
135+defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName [])
123136
124137-- | To be used exclusively as a "negative" return type/constraint
125138-- by @'Elem`@ type family.
@@ -132,158 +145,158 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
132145
133146-- | 'HasForeignType' maps Haskell types with types in the target
134147-- language of your backend. For example, let's say you're
135−-- 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:
136150--
137151-- > -- First you need to create a dummy type to parametrize your
138152-- > -- instances.
139153-- > data LangX
140154-- >
141155-- > -- Otherwise you define instances for the types you need
142−-- > instance HasForeignType LangX Int where
143−-- > typeFor _ _ = "intX"
156+-- > instance HasForeignType LangX Text Int where
157+-- > typeFor _ _ _ = "intX"
144158-- >
145159-- > -- Or for example in case of lists
146−-- > instance HasForeignType LangX a => HasForeignType LangX [a] where
147−-- > typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
160+-- > instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where
161+-- > typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
148162--
149163-- Finally to generate list of information about all the endpoints for
150164-- an API you create a function of a form:
151165--
152−-- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api))
153−-- > => Proxy api -> [Req]
154−-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api
166+-- > getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
167+-- > => Proxy api -> [Req Text]
168+-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api
155169--
156170-- > -- If language __X__ is dynamically typed then you can use
157−-- > -- a predefined NoTypes parameter
158−-- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api))
159−-- > => Proxy api -> [Req]
160−-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api
171+-- > -- a predefined NoTypes parameter with the () output type:
172+--
173+-- > getEndpoints :: (HasForeign NoTypes () api, GenerateList Text (Foreign () api))
174+-- > => Proxy api -> [Req ()]
175+-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) api
161176-- >
162177--
163−class HasForeignType lang a where
164− typeFor :: Proxy lang -> Proxy a -> ForeignType
178+class HasForeignType lang ftype a where
179+ typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype
165180
166181data NoTypes
167182
168−instance HasForeignType NoTypes ftype where
169− typeFor _ _ = ForeignType empty
170−
171−type HasNoForeignType = HasForeignType NoTypes
183+instance HasForeignType NoTypes () ftype where
184+ typeFor _ _ _ = ()
172185
173−class HasForeign lang (layout :: *) where
174− type Foreign layout :: *
175− foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
186+class HasForeign lang ftype (layout :: *) where
187+ type Foreign ftype layout :: *
188+ foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout
176189
177−instance (HasForeign lang a, HasForeign lang b)
178− => HasForeign lang (a :<|> b) where
179− type Foreign (a :<|> b) = Foreign a :<|> Foreign b
190+instance (HasForeign lang ftype a, HasForeign lang ftype b)
191+ => HasForeign lang ftype (a :<|> b) where
192+ type Foreign ftype (a :<|> b) = Foreign ftype a :<|> Foreign ftype b
180193
181− foreignFor lang Proxy req =
182− foreignFor lang (Proxy :: Proxy a) req
183− :<|> foreignFor lang (Proxy :: Proxy b) req
194+ foreignFor lang ftype Proxy req =
195+ foreignFor lang ftype (Proxy :: Proxy a) req
196+ :<|> foreignFor lang ftype (Proxy :: Proxy b) req
184197
185−instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
186− => HasForeign lang (Capture sym ftype :> sublayout) where
187− type Foreign (Capture sym a :> sublayout) = Foreign sublayout
198+instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout)
199+ => HasForeign lang ftype (Capture sym t :> sublayout) where
200+ type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout
188201
189− foreignFor lang Proxy req =
190− foreignFor lang (Proxy :: Proxy sublayout) $
202+ foreignFor lang Proxy Proxy req =
203+ foreignFor lang Proxy (Proxy :: Proxy sublayout) $
191204 req & reqUrl . path <>~ [Segment (Cap arg)]
192205 & reqFuncName . _FunctionName %~ (++ ["by", str])
193206 where
194207 str = pack . symbolVal $ (Proxy :: Proxy sym)
195− ftype = typeFor lang (Proxy :: Proxy ftype)
208+ ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy t)
196209 arg = Arg
197− { _aName = PathSegment str
198− , _aType = ftype }
210+ { _argName = PathSegment str
211+ , _argType = ftype }
199212
200−instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
201− => HasForeign lang (Verb method status list a) where
202− type Foreign (Verb method status list a) = Req
213+instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
214+ => HasForeign lang ftype (Verb method status list a) where
215+ type Foreign ftype (Verb method status list a) = Req ftype
203216
204− foreignFor lang Proxy req =
217+ foreignFor lang Proxy Proxy req =
205218 req & reqFuncName . _FunctionName %~ (methodLC :)
206219 & reqMethod .~ method
207− & reqReturnType .~ retType
220+ & reqReturnType .~ Just retType
208221 where
209− retType = typeFor lang (Proxy :: Proxy a)
222+ retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a)
210223 method = reflectMethod (Proxy :: Proxy method)
211224 methodLC = toLower $ decodeUtf8 method
212225
213−instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
214− => HasForeign lang (Header sym a :> sublayout) where
215− type Foreign (Header sym a :> sublayout) = Foreign sublayout
226+instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
227+ => HasForeign lang ftype (Header sym a :> sublayout) where
228+ type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout
216229
217− foreignFor lang Proxy req =
218− foreignFor lang subP $ req & reqHeaders <>~ [HeaderArg arg]
230+ foreignFor lang Proxy Proxy req =
231+ foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
219232 where
220233 hname = pack . symbolVal $ (Proxy :: Proxy sym)
221234 arg = Arg
222− { _aName = PathSegment hname
223− , _aType = typeFor lang (Proxy :: Proxy a) }
235+ { _argName = PathSegment hname
236+ , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
224237 subP = Proxy :: Proxy sublayout
225238
226−instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
227− => HasForeign lang (QueryParam sym a :> sublayout) where
228− type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
239+instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
240+ => HasForeign lang ftype (QueryParam sym a :> sublayout) where
241+ type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout
229242
230− foreignFor lang Proxy req =
231− foreignFor lang (Proxy :: Proxy sublayout) $
243+ foreignFor lang Proxy Proxy req =
244+ foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
232245 req & reqUrl.queryStr <>~ [QueryArg arg Normal]
233246 where
234247 str = pack . symbolVal $ (Proxy :: Proxy sym)
235248 arg = Arg
236− { _aName = PathSegment str
237− , _aType = typeFor lang (Proxy :: Proxy a) }
249+ { _argName = PathSegment str
250+ , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
238251
239252instance
240− (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
241− => HasForeign lang (QueryParams sym a :> sublayout) where
242− type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
243− foreignFor lang Proxy req =
244− foreignFor lang (Proxy :: Proxy sublayout) $
253+ (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout)
254+ => HasForeign lang ftype (QueryParams sym a :> sublayout) where
255+ type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout
256+ foreignFor lang Proxy Proxy req =
257+ foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
245258 req & reqUrl.queryStr <>~ [QueryArg arg List]
246259 where
247260 str = pack . symbolVal $ (Proxy :: Proxy sym)
248261 arg = Arg
249− { _aName = PathSegment str
250− , _aType = typeFor lang (Proxy :: Proxy [a]) }
262+ { _argName = PathSegment str
263+ , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) }
251264
252265instance
253− (KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
254− => HasForeign lang (QueryFlag sym :> sublayout) where
255− type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
266+ (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout)
267+ => HasForeign lang ftype (QueryFlag sym :> sublayout) where
268+ type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout
256269
257− foreignFor lang Proxy req =
258− foreignFor lang (Proxy :: Proxy sublayout) $
270+ foreignFor lang ftype Proxy req =
271+ foreignFor lang ftype (Proxy :: Proxy sublayout) $
259272 req & reqUrl.queryStr <>~ [QueryArg arg Flag]
260273 where
261274 str = pack . symbolVal $ (Proxy :: Proxy sym)
262275 arg = Arg
263− { _aName = PathSegment str
264− , _aType = typeFor lang (Proxy :: Proxy Bool) }
276+ { _argName = PathSegment str
277+ , _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
265278
266−instance HasForeign lang Raw where
267− type Foreign Raw = HTTP.Method -> Req
279+instance HasForeign lang ftype Raw where
280+ type Foreign ftype Raw = HTTP.Method -> Req ftype
268281
269− foreignFor _ Proxy req method =
282+ foreignFor _ Proxy Proxy req method =
270283 req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
271284 & reqMethod .~ method
272285
273−instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
274− => HasForeign lang (ReqBody list a :> sublayout) where
275− type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
286+instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
287+ => HasForeign lang ftype (ReqBody list a :> sublayout) where
288+ type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout
276289
277− foreignFor lang Proxy req =
278− foreignFor lang (Proxy :: Proxy sublayout) $
279− req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
290+ foreignFor lang ftype Proxy req =
291+ foreignFor lang ftype (Proxy :: Proxy sublayout) $
292+ req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a))
280293
281−instance (KnownSymbol path, HasForeign lang sublayout)
282− => HasForeign lang (path :> sublayout) where
283− type Foreign (path :> sublayout) = Foreign sublayout
294+instance (KnownSymbol path, HasForeign lang ftype sublayout)
295+ => HasForeign lang ftype (path :> sublayout) where
296+ type Foreign ftype (path :> sublayout) = Foreign ftype sublayout
284297
285− foreignFor lang Proxy req =
286− foreignFor lang (Proxy :: Proxy sublayout) $
298+ foreignFor lang ftype Proxy req =
299+ foreignFor lang ftype (Proxy :: Proxy sublayout) $
287300 req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
288301 & reqFuncName . _FunctionName %~ (++ [str])
289302 where
@@ -291,58 +304,59 @@ instance (KnownSymbol path, HasForeign lang sublayout)
291304 Data.Text.map (\c -> if c == '.' then '_' else c)
292305 . pack . symbolVal $ (Proxy :: Proxy path)
293306
294−instance HasForeign lang sublayout
295− => HasForeign lang (RemoteHost :> sublayout) where
296− type Foreign (RemoteHost :> sublayout) = Foreign sublayout
307+instance HasForeign lang ftype sublayout
308+ => HasForeign lang ftype (RemoteHost :> sublayout) where
309+ type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout
297310
298− foreignFor lang Proxy req =
299− foreignFor lang (Proxy :: Proxy sublayout) req
311+ foreignFor lang ftype Proxy req =
312+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
300313
301−instance HasForeign lang sublayout
302− => HasForeign lang (IsSecure :> sublayout) where
303− type Foreign (IsSecure :> sublayout) = Foreign sublayout
314+instance HasForeign lang ftype sublayout
315+ => HasForeign lang ftype (IsSecure :> sublayout) where
316+ type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout
304317
305− foreignFor lang Proxy req =
306− foreignFor lang (Proxy :: Proxy sublayout) req
318+ foreignFor lang ftype Proxy req =
319+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
307320
308−instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
309− type Foreign (Vault :> sublayout) = Foreign sublayout
321+instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where
322+ type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout
310323
311− foreignFor lang Proxy req =
312− foreignFor lang (Proxy :: Proxy sublayout) req
324+ foreignFor lang ftype Proxy req =
325+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
313326
314−instance HasForeign lang sublayout =>
315− HasForeign lang (WithNamedContext name context sublayout) where
327+instance HasForeign lang ftype sublayout =>
328+ HasForeign lang ftype (WithNamedContext name context sublayout) where
316329
317− type Foreign (WithNamedContext name context sublayout) = Foreign sublayout
330+ type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout
318331
319− foreignFor lang Proxy = foreignFor lang (Proxy :: Proxy sublayout)
332+ foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout)
320333
321−instance HasForeign lang sublayout
322− => HasForeign lang (HttpVersion :> sublayout) where
323− type Foreign (HttpVersion :> sublayout) = Foreign sublayout
334+instance HasForeign lang ftype sublayout
335+ => HasForeign lang ftype (HttpVersion :> sublayout) where
336+ type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout
324337
325− foreignFor lang Proxy req =
326− foreignFor lang (Proxy :: Proxy sublayout) req
338+ foreignFor lang ftype Proxy req =
339+ foreignFor lang ftype (Proxy :: Proxy sublayout) req
327340
328341-- | Utility class used by 'listFromAPI' which computes
329342-- the data needed to generate a function for each endpoint
330343-- and hands it all back in a list.
331−class GenerateList reqs where
332− generateList :: reqs -> [Req]
344+class GenerateList ftype reqs where
345+ generateList :: reqs -> [Req ftype]
333346
334−instance GenerateList Req where
347+instance GenerateList ftype (Req ftype) where
335348 generateList r = [r]
336349
337−instance (GenerateList start, GenerateList rest)
338− => GenerateList (start :<|> rest) where
350+instance (GenerateList ftype start, GenerateList ftype rest)
351+ => GenerateList ftype (start :<|> rest) where
339352 generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
340353
341354-- | Generate the necessary data for codegen as a list, each 'Req'
342355-- describing one endpoint from your API type.
343356listFromAPI
344− :: (HasForeign lang api, GenerateList (Foreign api))
357+ :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api))
345358 => Proxy lang
359+ -> Proxy ftype
346360 -> Proxy api
347− -> [Req]
348−listFromAPI lang p = generateList (foreignFor lang p defReq)
361+ -> [Req ftype]
362+listFromAPI lang ftype p = generateList (foreignFor lang ftype p defReq)
servant-foreign/test/Servant/ForeignSpec.hs+16−16
@@ -26,20 +26,20 @@ camelCaseSpec = describe "camelCase" $ do
2626
2727data LangX
2828
29−instance HasForeignType LangX () where
30− typeFor _ _ = ForeignType "voidX"
29+instance HasForeignType LangX String () where
30+ typeFor _ _ _ = "voidX"
3131
32−instance HasForeignType LangX Int where
33− typeFor _ _ = "intX"
32+instance HasForeignType LangX String Int where
33+ typeFor _ _ _ = "intX"
3434
35−instance HasForeignType LangX Bool where
36− typeFor _ _ = "boolX"
35+instance HasForeignType LangX String Bool where
36+ typeFor _ _ _ = "boolX"
3737
38−instance OVERLAPPING_ HasForeignType LangX String where
39− typeFor _ _ = "stringX"
38+instance OVERLAPPING_ HasForeignType LangX String String where
39+ typeFor _ _ _ = "stringX"
4040
41−instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where
42− typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
41+instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where
42+ typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
4343
4444type TestApi
4545 = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
@@ -47,8 +47,8 @@ type TestApi
4747 :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
4848 :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
4949
50−testApi :: [Req]
51−testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
50+testApi :: [Req String]
51+testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
5252
5353listFromAPISpec :: Spec
5454listFromAPISpec = describe "listFromAPI" $ do
@@ -65,7 +65,7 @@ listFromAPISpec = describe "listFromAPI" $ do
6565 , _reqMethod = "GET"
6666 , _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"]
6767 , _reqBody = Nothing
68− , _reqReturnType = "intX"
68+ , _reqReturnType = Just "intX"
6969 , _reqFuncName = FunctionName ["get", "test"]
7070 }
7171
@@ -77,7 +77,7 @@ listFromAPISpec = describe "listFromAPI" $ do
7777 , _reqMethod = "POST"
7878 , _reqHeaders = []
7979 , _reqBody = Just "listX of stringX"
80− , _reqReturnType = "voidX"
80+ , _reqReturnType = Just "voidX"
8181 , _reqFuncName = FunctionName ["post", "test"]
8282 }
8383
@@ -90,7 +90,7 @@ listFromAPISpec = describe "listFromAPI" $ do
9090 , _reqMethod = "PUT"
9191 , _reqHeaders = []
9292 , _reqBody = Just "stringX"
93− , _reqReturnType = "voidX"
93+ , _reqReturnType = Just "voidX"
9494 , _reqFuncName = FunctionName ["put", "test"]
9595 }
9696
@@ -103,6 +103,6 @@ listFromAPISpec = describe "listFromAPI" $ do
103103 , _reqMethod = "DELETE"
104104 , _reqHeaders = []
105105 , _reqBody = Nothing
106− , _reqReturnType = "voidX"
106+ , _reqReturnType = Just "voidX"
107107 , _reqFuncName = FunctionName ["delete", "test", "by", "id"]
108108 }
servant-js/src/Servant/JS.hs+5−5
@@ -128,22 +128,22 @@ import Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
128128-- | Generate the data necessary to generate javascript code
129129-- for all the endpoints of an API, as ':<|>'-separated values
130130-- of type 'AjaxReq'.
131−javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
132−javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
131+javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout
132+javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq
133133
134134-- | Directly generate all the javascript functions for your API
135135-- from a 'Proxy' for your API type. You can then write it to
136136-- 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))
138138 => Proxy api -- ^ proxy for your API type
139139 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
140140 -> 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)
142142
143143-- | Directly generate all the javascript functions for your API
144144-- from a 'Proxy' for your API type using the given generator
145145-- 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))
147147 => Proxy api -- ^ proxy for your API type
148148 -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
149149 -> FilePath -- ^ path to the file you want to write the resulting javascript code into
servant-js/src/Servant/JS/Angular.hs+4−4
@@ -76,11 +76,11 @@ generateAngularJSWith ngOptions opts req = "\n" <>
7676 where argsStr = T.intercalate ", " args
7777 args = http
7878 ++ captures
79− ++ map (view $ argName . aPath) queryparams
79+ ++ map (view $ queryArgName . argPath) queryparams
8080 ++ body
8181 ++ map ( toValidFunctionName
8282 . (<>) "header"
83− . view (headerArg . aPath)
83+ . view (headerArg . argPath)
8484 ) hs
8585
8686 -- If we want to generate Top Level Function, they must depend on
@@ -90,7 +90,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
9090 0 -> ["$http"]
9191 _ -> []
9292
93− captures = map (view aPath . captureArg)
93+ captures = map (view argPath . captureArg)
9494 . filter isCapture
9595 $ req ^. reqUrl . path
9696
@@ -116,7 +116,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
116116 where
117117 headersStr = T.intercalate ", " $ map headerStr hs
118118 headerStr header = "\"" <>
119− header ^. headerArg . aPath <>
119+ header ^. headerArg . argPath <>
120120 "\": " <> toJSHeader header
121121
122122 namespace =
servant-js/src/Servant/JS/Axios.hs+4−4
@@ -62,14 +62,14 @@ generateAxiosJSWith aopts opts req = "\n" <>
6262
6363 where argsStr = T.intercalate ", " args
6464 args = captures
65− ++ map (view $ argName . aPath) queryparams
65+ ++ map (view $ queryArgName . argPath) queryparams
6666 ++ body
6767 ++ map ( toValidFunctionName
6868 . (<>) "header"
69− . view (headerArg . aPath)
69+ . view (headerArg . argPath)
7070 ) hs
7171
72− captures = map (view aPath . captureArg)
72+ captures = map (view argPath . captureArg)
7373 . filter isCapture
7474 $ req ^. reqUrl.path
7575
@@ -110,7 +110,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
110110 where
111111 headersStr = T.intercalate ", " $ map headerStr hs
112112 headerStr header = "\"" <>
113− header ^. headerArg . aPath <>
113+ header ^. headerArg . argPath <>
114114 "\": " <> toJSHeader header
115115
116116 namespace =
servant-js/src/Servant/JS/Internal.hs+15−17
@@ -21,7 +21,6 @@ module Servant.JS.Internal
2121 , reqHeaders
2222 , HasForeign(..)
2323 , HasForeignType(..)
24− , HasNoForeignType
2524 , GenerateList(..)
2625 , NoTypes
2726 , HeaderArg
@@ -33,7 +32,6 @@ module Servant.JS.Internal
3332 , SegmentType(..)
3433 , Url(..)
3534 , Path
36− , ForeignType(..)
3735 , Arg(..)
3836 , FunctionName(..)
3937 , PathSegment(..)
@@ -57,12 +55,12 @@ import qualified Data.Text as T
5755import Data.Text (Text)
5856import Servant.Foreign
5957
60−type AjaxReq = Req
58+type AjaxReq = Req ()
6159
6260-- A 'JavascriptGenerator' just takes the data found in the API type
6361-- for each endpoint and generates Javascript code in a Text. Several
6462-- generators are available in this package.
65−type JavaScriptGenerator = [Req] -> Text
63+type JavaScriptGenerator = [Req ()] -> Text
6664
6765-- | This structure is used by specific implementations to let you
6866-- customize the output
@@ -139,9 +137,9 @@ toValidFunctionName t =
139137 , Set.connectorPunctuation
140138 ]
141139
142−toJSHeader :: HeaderArg -> Text
140+toJSHeader :: HeaderArg f -> Text
143141toJSHeader (HeaderArg n)
144− = toValidFunctionName ("header" <> n ^. aName . _PathSegment)
142+ = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
145143toJSHeader (ReplaceHeaderArg n p)
146144 | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
147145 | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@@ -149,35 +147,35 @@ toJSHeader (ReplaceHeaderArg n p)
149147 <> "\""
150148 | otherwise = p
151149 where
152− pv = toValidFunctionName ("header" <> n ^. aName . _PathSegment)
153− pn = "{" <> n ^. aName . _PathSegment <> "}"
150+ pv = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
151+ pn = "{" <> n ^. argName . _PathSegment <> "}"
154152 rp = T.replace pn "" p
155153
156−jsSegments :: [Segment] -> Text
154+jsSegments :: [Segment f] -> Text
157155jsSegments [] = ""
158156jsSegments [x] = "/" <> segmentToStr x False
159157jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs
160158
161−segmentToStr :: Segment -> Bool -> Text
159+segmentToStr :: Segment f -> Bool -> Text
162160segmentToStr (Segment st) notTheEnd =
163161 segmentTypeToStr st <> if notTheEnd then "" else "'"
164162
165−segmentTypeToStr :: SegmentType -> Text
163+segmentTypeToStr :: SegmentType f -> Text
166164segmentTypeToStr (Static s) = s ^. _PathSegment
167165segmentTypeToStr (Cap s) =
168− "' + encodeURIComponent(" <> s ^. aName . _PathSegment <> ") + '"
166+ "' + encodeURIComponent(" <> s ^. argName . _PathSegment <> ") + '"
169167
170−jsGParams :: Text -> [QueryArg] -> Text
168+jsGParams :: Text -> [QueryArg f] -> Text
171169jsGParams _ [] = ""
172170jsGParams _ [x] = paramToStr x False
173171jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs
174172
175−jsParams :: [QueryArg] -> Text
173+jsParams :: [QueryArg f] -> Text
176174jsParams = jsGParams "&"
177175
178−paramToStr :: QueryArg -> Bool -> Text
176+paramToStr :: QueryArg f -> Bool -> Text
179177paramToStr qarg notTheEnd =
180− case qarg ^. argType of
178+ case qarg ^. queryArgType of
181179 Normal -> name
182180 <> "=' + encodeURIComponent("
183181 <> name
@@ -187,4 +185,4 @@ paramToStr qarg notTheEnd =
187185 <> "[]=' + encodeURIComponent("
188186 <> name
189187 <> if notTheEnd then ") + '" else ")"
190− where name = qarg ^. argName . aName . _PathSegment
188+ where name = qarg ^. queryArgName . argName . _PathSegment
servant-js/src/Servant/JS/JQuery.hs+4−4
@@ -43,15 +43,15 @@ generateJQueryJSWith opts req = "\n" <>
4343
4444 where argsStr = T.intercalate ", " args
4545 args = captures
46− ++ map (view $ argName . aPath) queryparams
46+ ++ map (view $ queryArgName . argPath) queryparams
4747 ++ body
4848 ++ map (toValidFunctionName
4949 . (<>) "header"
50− . view (headerArg . aPath)
50+ . view (headerArg . argPath)
5151 ) hs
5252 ++ [onSuccess, onError]
5353
54− captures = map (view aPath . captureArg)
54+ captures = map (view argPath . captureArg)
5555 . filter isCapture
5656 $ req ^. reqUrl.path
5757
@@ -80,7 +80,7 @@ generateJQueryJSWith opts req = "\n" <>
8080 where
8181 headersStr = T.intercalate ", " $ map headerStr hs
8282 headerStr header = "\"" <>
83− header ^. headerArg . aPath <>
83+ header ^. headerArg . argPath <>
8484 "\": " <> toJSHeader header
8585
8686 namespace = if (moduleName opts) == ""
servant-js/src/Servant/JS/Vanilla.hs+4−4
@@ -54,15 +54,15 @@ generateVanillaJSWith opts req = "\n" <>
5454
5555 where argsStr = T.intercalate ", " args
5656 args = captures
57− ++ map (view $ argName . aPath) queryparams
57+ ++ map (view $ queryArgName . argPath) queryparams
5858 ++ body
5959 ++ map ( toValidFunctionName
6060 . (<>) "header"
61− . view (headerArg . aPath)
61+ . view (headerArg . argPath)
6262 ) hs
6363 ++ [onSuccess, onError]
6464
65− captures = map (view aPath . captureArg)
65+ captures = map (view argPath . captureArg)
6666 . filter isCapture
6767 $ req ^. reqUrl.path
6868
@@ -91,7 +91,7 @@ generateVanillaJSWith opts req = "\n" <>
9191 where
9292 headersStr = T.intercalate "\n" $ map headerStr hs
9393 headerStr header = " xhr.setRequestHeader(\"" <>
94− header ^. headerArg . aPath <>
94+ header ^. headerArg . argPath <>
9595 "\", " <> toJSHeader header <> ");"
9696
9797 namespace = if moduleName opts == ""
servant-js/test/Servant/JSSpec.hs+2−2
@@ -106,7 +106,7 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
106106
107107axiosSpec :: Spec
108108axiosSpec = 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)
110110 it "should add withCredentials when needed" $ do
111111 let jsText = genJS withCredOpts $ reqList
112112 output jsText
@@ -130,7 +130,7 @@ axiosSpec = describe specLabel $ do
130130
131131angularSpec :: TestNames -> Spec
132132angularSpec 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)
134134 it "should implement a service globally" $ do
135135 let jsText = genJS reqList
136136 output jsText
servant-js/test/Servant/JSSpec/CustomHeaders.hs+16−15
@@ -1,4 +1,5 @@
11{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE KindSignatures #-}
45{-# LANGUAGE PolyKinds #-}
@@ -22,13 +23,13 @@ import Servant.JS.Internal
2223-- using -- Basic, Digest, whatever.
2324data Authorization (sym :: Symbol) a
2425
25−instance (KnownSymbol sym, HasForeign lang sublayout)
26− => HasForeign lang (Authorization sym a :> sublayout) where
27− type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
26+instance (KnownSymbol sym, HasForeign lang () sublayout)
27+ => HasForeign lang () (Authorization sym a :> sublayout) where
28+ type Foreign () (Authorization sym a :> sublayout) = Foreign () sublayout
2829
29− foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
30+ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
3031 req & reqHeaders <>~
31− [ ReplaceHeaderArg (Arg "Authorization" "")
32+ [ ReplaceHeaderArg (Arg "Authorization" ())
3233 $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
3334 where
3435 tokenType t = t <> " {Authorization}"
@@ -36,23 +37,23 @@ instance (KnownSymbol sym, HasForeign lang sublayout)
3637-- | This is a combinator that fetches an X-MyLovelyHorse header.
3738data MyLovelyHorse a
3839
39−instance (HasForeign lang sublayout)
40− => HasForeign lang (MyLovelyHorse a :> sublayout) where
41− type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
40+instance (HasForeign lang () sublayout)
41+ => HasForeign lang () (MyLovelyHorse a :> sublayout) where
42+ type Foreign () (MyLovelyHorse a :> sublayout) = Foreign () sublayout
4243
43− foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
44− req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" "") tpl ]
44+ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
45+ req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ]
4546 where
4647 tpl = "I am good friends with {X-MyLovelyHorse}"
4748
4849-- | This is a combinator that fetches an X-WhatsForDinner header.
4950data WhatsForDinner a
5051
51−instance (HasForeign lang sublayout)
52− => HasForeign lang (WhatsForDinner a :> sublayout) where
53− type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
52+instance (HasForeign lang () sublayout)
53+ => HasForeign lang () (WhatsForDinner a :> sublayout) where
54+ type Foreign () (WhatsForDinner a :> sublayout) = Foreign () sublayout
5455
55− foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $
56− req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" "") tpl ]
56+ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
57+ req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ]
5758 where
5859 tpl = "I would like {X-WhatsForDinner} with a cherry on top."