on develop help sign in
Adding Ss (Scopes) type association and generating Proxy types for all scopes
86fdee2Brendan Hay
gen/src/Gen/AST/Render.hs+4−4
@@ -110,7 +110,7 @@ renderAPI s = do
110
110
111 API alias d rs ms
111 API alias d rs ms
112 <$> svc
112 <$> svc
113− <*> traverse scp (maybe mempty (Map.toList . scopes) (s ^. dAuth))
113+ <*> traverse scope (maybe mempty (Map.toList . scopes) (s ^. dAuth))
114 where
114 where
115 alias = aname (_sCanonicalName s)
115 alias = aname (_sCanonicalName s)
116
116
@@ -124,9 +124,9 @@ renderAPI s = do
124 "@ of the " % stext % ". This contains the host and root path used as a starting point for constructing service requests.")
124 "@ of the " % stext % ". This contains the host and root path used as a starting point for constructing service requests.")
125 (s ^. dVersion) (s ^. dTitle)
125 (s ^. dVersion) (s ^. dTitle)
126
126
127− scp (k, h) = Fun' n (Just h)
127+ scope (k, h) = Fun' n (Just h)
128− <$> pp None (scopeSig n)
128+ <$> pp None (scopeSig n k)
129− <*> pp None (scopeDecl n k)
129+ <*> pp None (scopeDecl n)
130 where
130 where
131 n = name (scopeName s k)
131 n = name (scopeName s k)
132
132
gen/src/Gen/Syntax.hs+12−4
@@ -44,11 +44,13 @@ serviceDecl s n = sfun noLoc n [] (UnGuardedRhs rhs) noBinds
44 , str . stripSuffix "/" $ stripPrefix "https://" (s ^. dRootUrl)
44 , str . stripSuffix "/" $ stripPrefix "https://" (s ^. dRootUrl)
45 ]
45 ]
46
46
47−scopeSig :: Name -> Decl
47+scopeSig :: Name -> Text -> Decl
48−scopeSig n = TypeSig noLoc [n] (TyCon "OAuthScope")
48+scopeSig n v = TypeSig noLoc [n] $
49+ TyApp (TyCon "Proxy") $
50+ TyPromoted $ PromotedList True [PromotedString (Text.unpack v)]
49
51
50−scopeDecl :: Name -> Text -> Decl
52+scopeDecl :: Name -> Decl
51−scopeDecl n s = sfun noLoc n [] (UnGuardedRhs (str s)) noBinds
53+scopeDecl n = sfun noLoc n [] (UnGuardedRhs (var "Proxy")) noBinds
52
54
53apiAlias :: Name -> [Name] -> Decl
55apiAlias :: Name -> [Name] -> Decl
54apiAlias n ls = TypeDecl noLoc n [] alias
56apiAlias n ls = TypeDecl noLoc n [] alias
@@ -302,6 +304,7 @@ googleRequestDecl :: Global
302googleRequestDecl g n assoc extras p api url fields m pat prec =
304googleRequestDecl g n assoc extras p api url fields m pat prec =
303 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
305 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
304 [ assoc
306 [ assoc
307+ , ss
305 , request
308 , request
306 ]
309 ]
307 where
310 where
@@ -338,6 +341,11 @@ googleRequestDecl g n assoc extras p api url fields m pat prec =
338 ps = _mParameters m
341 ps = _mParameters m
339 v = var . fname p
342 v = var . fname p
340
343
344+ ss = InsType noLoc (TyApp (TyCon "Ss") (tycon g)) $
345+ TyPromoted (PromotedList True (map scope (_mScopes m)))
346+ where
347+ scope = PromotedString . Text.unpack
348+
341 fs = delete "alt"
349 fs = delete "alt"
342 . orderParams id (Map.keys (_mParameters m))
350 . orderParams id (Map.keys (_mParameters m))
343 . nub
351 . nub