on develop help sign in
Matching AST against current core client implementation
7556e3bBrendan Hay
gen/src/Gen/AST/Render.hs+3−8
@@ -108,15 +108,10 @@ renderAPI s = do
108 url = name (Text.unpack (urlName s))
108 url = name (Text.unpack (urlName s))
109
109
110 serviceURL = Fun' url (Just (rawHelpText h))
110 serviceURL = Fun' url (Just (rawHelpText h))
111− <$> pp None (urlSig url)
111+ <$> pp None (urlSig url)
112− <*> pp Print d
112+ <*> pp Print (urlDecl s url)
113 where
113 where
114− d | "http://" `Text.isPrefixOf` u = urlDecl url "Http" u 80
115− | otherwise = urlDecl url "Https" u 443
116−
117− u = s ^. dBaseUrl
118−
119− h = sformat ("URL referring to version @" % stext %
114+ h = sformat ("Default request referring to version @" % stext %
120 "@ of the " % stext % ".")
115 "@ of the " % stext % ".")
121 (s ^. dVersion) (s ^. dTitle)
116 (s ^. dVersion) (s ^. dTitle)
122
117
gen/src/Gen/Syntax.hs+14−13
@@ -34,12 +34,15 @@ import Language.Haskell.Exts.SrcLoc
34import Language.Haskell.Exts.Syntax hiding (Alt, Int, Lit)
34import Language.Haskell.Exts.Syntax hiding (Alt, Int, Lit)
35
35
36urlSig :: Name -> Decl
36urlSig :: Name -> Decl
37−urlSig n = TypeSig noLoc [n] (TyCon "BaseUrl")
37+urlSig n = TypeSig noLoc [n] (TyCon "RequestBuilder")
38
38
39−urlDecl :: Name -> String -> Text -> Integer -> Decl
39+urlDecl :: Service a -> Name -> Decl
40−urlDecl n s u p = sfun noLoc n [] (UnGuardedRhs rhs) noBinds
40+urlDecl s n = sfun noLoc n [] (UnGuardedRhs rhs) noBinds
41 where
41 where
42− rhs = appFun (var "BaseUrl") [var (name s), str u, intE p]
42+ rhs = appFun (var "defaultRequest")
43+ [ str (s ^. dRootUrl)
44+ , str (s ^. dServicePath)
45+ ]
43
46
44 -- type API = :<|> ...
47 -- type API = :<|> ...
45apiAlias :: Name -> [Name] -> Decl
48apiAlias :: Name -> [Name] -> Decl
@@ -183,23 +186,21 @@ googleRequestDecl g n assoc alt p api url fields m pat prec =
183 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
186 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
184 [ assoc
187 [ assoc
185 , request
188 , request
186− , requestWithRoute
189+ , requestWith
187 ]
190 ]
188 where
191 where
189− request = funD "request" $
192+ request = funD "request" $ app (var "requestWith") (var url)
190− appFun (var "requestWithRoute") [var "defReq", var url]
191
193
192− requestWithRoute = InsDecl (FunBind [match])
194+ requestWith = InsDecl (FunBind [match])
193 where
195 where
194− match = Match noLoc (name "requestWithRoute") pats Nothing rhs decls
196+ match = Match noLoc (name "requestWith") pats Nothing rhs decls
195
197
196 decls = BDecls
198 decls = BDecls
197 [ patBind noLoc pat $
199 [ patBind noLoc pat $
198− appFun (var "clientWithRoute") $
200+ appFun (var "clientBuild") $
199 [ ExpTypeSig noLoc (var "Proxy") $
201 [ ExpTypeSig noLoc (var "Proxy") $
200 TyApp (TyCon "Proxy") (TyCon (UnQual api))
202 TyApp (TyCon "Proxy") (TyCon (UnQual api))
201− , var "r"
203+ , var "rq"
202− , var "u"
203 ]
204 ]
204 ]
205 ]
205
206
@@ -237,7 +238,7 @@ googleRequestDecl g n assoc alt p api url fields m pat prec =
237 . nub
238 . nub
238 $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m
239 $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m
239
240
240− pats = [pvar "r", pvar "u", prec]
241+ pats = [pvar "rq", prec]
241
242
242authDecl :: Global -> Prefix -> [Local] -> Decl
243authDecl :: Global -> Prefix -> [Local] -> Decl
243authDecl g p fs = InstDecl noLoc Nothing [] [] (unqual "GoogleAuth") [tycon g]
244authDecl g p fs = InstDecl noLoc Nothing [] [] (unqual "GoogleAuth") [tycon g]
gen/src/Gen/Types/Schema.hs+1−1
@@ -434,4 +434,4 @@ instance HasDescription (Service a) a where
434 description = sDescription
434 description = sDescription
435
435
436urlName :: Service a -> Text
436urlName :: Service a -> Text
437−urlName = (<> "URL") . lowerHead . _sCanonicalName
437+urlName = (<> "Request") . lowerHead . _sCanonicalName