on develop help sign in
Ensuring scopes for MediaUpload/Download are proxied through to the underlying type
commit420c6083f412295cdecefe7e4fadd2ee402cabb2 authorBrendan Hay <brendan.g.hay@gmail.com> dateSat 31 Oct 2015, 15:10 (11 years ago) parent4eb0a6b
2 files changed+43−39
gen/src/Gen/Syntax.hs+42−39 gen/template/types.ede+1
gen/src/Gen/Syntax.hs+42−39
@@ -218,11 +218,15 @@ downloadDecl :: Global
218218 -> Method Solved
219219 -> Decl
220220downloadDecl n p api url fs m =
221− googleRequestDecl n ty rs [alt] p api url fs m pat prec
221+ googleRequestDecl n ty [rs, ss] [alt] p api url fs m pat prec
222222 where
223223 ty = TyApp (TyCon "MediaDownload") (tycon n)
224+
224225 rs = InsType noLoc (TyApp (TyCon "Rs") ty) (TyCon "Stream")
225226
227+ ss = InsType noLoc (TyApp (TyCon "Scopes") ty) $
228+ TyApp (TyCon "Scopes") (tycon n)
229+
226230 alt = app (var "Just") (var "AltMedia")
227231 pat = downloadPat m
228232
@@ -238,12 +242,16 @@ uploadDecl :: Global
238242 -> Method Solved
239243 -> Decl
240244uploadDecl n p api url fs m =
241− googleRequestDecl n ty rs extras p api url fs m pat prec
245+ googleRequestDecl n ty [rs, ss] extras p api url fs m pat prec
242246 where
243247 ty = TyApp (TyCon "MediaUpload") (tycon n)
248+
244249 rs = InsType noLoc (TyApp (TyCon "Rs") ty) $
245250 maybe unit_tycon (tycon . ref) (_mResponse m)
246251
252+ ss = InsType noLoc (TyApp (TyCon "Scopes") ty) $
253+ TyApp (TyCon "Scopes") (tycon n)
254+
247255 extras = maybeToList alt ++ [upl] ++ payload ++ [var media]
248256 where
249257 upl = app (var "Just") (var "AltMedia")
@@ -271,11 +279,15 @@ requestDecl :: Global
271279 -> Method Solved
272280 -> Decl
273281requestDecl n p api url fs m =
274− googleRequestDecl n (tycon n) rs extras p api url fs m pat prec
282+ googleRequestDecl n (tycon n) [rs, ss] extras p api url fs m pat prec
275283 where
276284 rs = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $
277285 maybe unit_tycon (tycon . ref) (_mResponse m)
278286
287+ ss = InsType noLoc (TyApp (TyCon "Scopes") (tycon n)) $
288+ TyPromoted $
289+ PromotedList True (map (PromotedString . Text.unpack) (_mScopes m))
290+
279291 extras = catMaybes [alt, payload]
280292 where
281293 alt = app (var "Just") . var . name . Text.unpack . alternate <$>
@@ -291,7 +303,7 @@ requestDecl n p api url fs m =
291303
292304googleRequestDecl :: Global
293305 -> Type
294− -> InstDecl
306+ -> [InstDecl]
295307 -> [Exp]
296308 -> Prefix
297309 -> Name
@@ -302,49 +314,40 @@ googleRequestDecl :: Global
302314 -> Pat
303315 -> Decl
304316googleRequestDecl g n assoc extras p api url fields m pat prec =
305− InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
306− [ assoc
307− , ss
308− , request
309− ]
317+ InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n] (assoc ++ [request])
310318 where
311319 request = InsDecl (FunBind [match])
312− where
313− match = Match noLoc (name "requestClient") [prec] Nothing rhs (Just decls)
314−
315− decls = BDecls
316− [ patBind noLoc pat $
317− appFun (var "buildClient") $
318− [ ExpTypeSig noLoc (var "Proxy") $
319− TyApp (TyCon "Proxy") (TyCon (UnQual api))
320− , var "mempty"
321− ]
322− ]
323320
324− rhs = UnGuardedRhs . appFun (var "go") $ map go fs ++ extras ++ [var url]
325− where
326− go l = case Map.lookup l ps of
327− Just p | _pLocation p == Query
328− , defaulted p
329− , p ^. iRepeated -> v l
321+ match = Match noLoc (name "requestClient") [prec] Nothing rhs (Just decls)
322+
323+ decls = BDecls
324+ [ patBind noLoc pat $
325+ appFun (var "buildClient") $
326+ [ ExpTypeSig noLoc (var "Proxy") $
327+ TyApp (TyCon "Proxy") (TyCon (UnQual api))
328+ , var "mempty"
329+ ]
330+ ]
330331
331− Just p | _pLocation p == Query
332− , not (required p)
333− , p ^. iRepeated -> infixApp (v l) "^." (var "_Default")
332+ rhs = UnGuardedRhs . appFun (var "go") $ map go fs ++ extras ++ [var url]
333+ where
334+ go l = case Map.lookup l ps of
335+ Just p | _pLocation p == Query
336+ , defaulted p
337+ , p ^. iRepeated -> v l
334338
335− Just p | _pLocation p == Query
336− , not (p ^. iRepeated)
337− , parameter p || defaulted p -> app (var "Just") (v l)
339+ Just p | _pLocation p == Query
340+ , not (required p)
341+ , p ^. iRepeated -> infixApp (v l) "^." (var "_Default")
338342
339− _ -> v l
343+ Just p | _pLocation p == Query
344+ , not (p ^. iRepeated)
345+ , parameter p || defaulted p -> app (var "Just") (v l)
340346
341− ps = _mParameters m
342− v = var . fname p
347+ _ -> v l
343348
344− ss = InsType noLoc (TyApp (TyCon "Ss") (tycon g)) $
345− TyPromoted (PromotedList True (map scope (_mScopes m)))
346− where
347− scope = PromotedString . Text.unpack
349+ ps = _mParameters m
350+ v = var . fname p
348351
349352 fs = delete "alt"
350353 . orderParams id (Map.keys (_mParameters m))
gen/template/types.ede+1
@@ -1,4 +1,5 @@
11{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE DeriveGeneric #-}
34{-# LANGUAGE NoImplicitPrelude #-}
45{-# LANGUAGE OverloadedStrings #-}