on develop help sign in
Adding Ss (Scopes) type association and generating Proxy types for all scopes
commit86fdee24d0ca1207d73b1bfe68248157a524000c authorBrendan Hay <brendan.g.hay@gmail.com> dateFri 30 Oct 2015, 14:55 (11 years ago) parentbe05f84
2 files changed+16−8
gen/src/Gen/AST/Render.hs+4−4 gen/src/Gen/Syntax.hs+12−4
gen/src/Gen/AST/Render.hs+4−4
@@ -110,7 +110,7 @@ renderAPI s = do
110110
111111 API alias d rs ms
112112 <$> svc
113− <*> traverse scp (maybe mempty (Map.toList . scopes) (s ^. dAuth))
113+ <*> traverse scope (maybe mempty (Map.toList . scopes) (s ^. dAuth))
114114 where
115115 alias = aname (_sCanonicalName s)
116116
@@ -124,9 +124,9 @@ renderAPI s = do
124124 "@ of the " % stext % ". This contains the host and root path used as a starting point for constructing service requests.")
125125 (s ^. dVersion) (s ^. dTitle)
126126
127− scp (k, h) = Fun' n (Just h)
128− <$> pp None (scopeSig n)
129− <*> pp None (scopeDecl n k)
127+ scope (k, h) = Fun' n (Just h)
128+ <$> pp None (scopeSig n k)
129+ <*> pp None (scopeDecl n)
130130 where
131131 n = name (scopeName s k)
132132
gen/src/Gen/Syntax.hs+12−4
@@ -44,11 +44,13 @@ serviceDecl s n = sfun noLoc n [] (UnGuardedRhs rhs) noBinds
4444 , str . stripSuffix "/" $ stripPrefix "https://" (s ^. dRootUrl)
4545 ]
4646
47−scopeSig :: Name -> Decl
48−scopeSig n = TypeSig noLoc [n] (TyCon "OAuthScope")
47+scopeSig :: Name -> Text -> Decl
48+scopeSig n v = TypeSig noLoc [n] $
49+ TyApp (TyCon "Proxy") $
50+ TyPromoted $ PromotedList True [PromotedString (Text.unpack v)]
4951
50−scopeDecl :: Name -> Text -> Decl
51−scopeDecl n s = sfun noLoc n [] (UnGuardedRhs (str s)) noBinds
52+scopeDecl :: Name -> Decl
53+scopeDecl n = sfun noLoc n [] (UnGuardedRhs (var "Proxy")) noBinds
5254
5355apiAlias :: Name -> [Name] -> Decl
5456apiAlias n ls = TypeDecl noLoc n [] alias
@@ -302,6 +304,7 @@ googleRequestDecl :: Global
302304googleRequestDecl g n assoc extras p api url fields m pat prec =
303305 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
304306 [ assoc
307+ , ss
305308 , request
306309 ]
307310 where
@@ -338,6 +341,11 @@ googleRequestDecl g n assoc extras p api url fields m pat prec =
338341 ps = _mParameters m
339342 v = var . fname p
340343
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+
341349 fs = delete "alt"
342350 . orderParams id (Map.keys (_mParameters m))
343351 . nub