git.iko.soy/gogol
on develop help sign in
Adding defaulting to matrix query parameters
ab17b84Brendan Hay
gen/src/Gen/AST/Solve.hs+5−1
compare with develop
unifiedsplit
@@ -92,11 +92,15 @@ getType g = loc "getType" g $ memo typed g go
92 SAny {} -> may (TType "JSONValue")
92 SAny {} -> may (TType "JSONValue")
93 SRef _ r -> unmay <$> getType (ref r)
93 SRef _ r -> unmay <$> getType (ref r)
94 --- FIXME: add natural/numeric manipulations
94 --- FIXME: add natural/numeric manipulations
95− SLit _ l -> may (TLit l)
95+ SLit i l -> may (lit i l)
96 SEnm {} -> may (TType g)
96 SEnm {} -> may (TType g)
97 SArr _ (Arr e) -> (TList <$> (getType e)) >>= may
97 SArr _ (Arr e) -> (TList <$> (getType e)) >>= may
98 SObj {} -> may (TType g)
98 SObj {} -> may (TType g)
99 where
99 where
100+ lit i l
101+ | i ^. iRepeated = TList (TLit l)
102+ | otherwise = TLit l
103+
100 may | required s = pure
104 may | required s = pure
101 | defaulted s = pure
105 | defaulted s = pure
102 | otherwise = pure . TMaybe
106 | otherwise = pure . TMaybe
gen/src/Gen/Syntax.hs+32−17
@@ -124,13 +124,17 @@ downloadDecl :: Global
124 -> Method Solved
124 -> Method Solved
125 -> Decl
125 -> Decl
126downloadDecl n p api url fs m =
126downloadDecl n p api url fs m =
127− googleRequestDecl n (tycon n) rs alt p api url fs m
127+ googleRequestDecl n ty rs alt p api url fs m pat prec
128 where
128 where
129+ ty = TyApp (TyCon "Download") (tycon n)
129− rs = InsType noLoc
130+ rs = InsType noLoc (TyApp (TyCon "Rs") ty) (TyCon "Body")
130− (TyApp (TyCon "Rs") (TyApp (TyCon "Download") (tycon n)))
131− (TyCon "Body")
132
131
133− alt = Just (var "Media")
132+ alt = Just (var "AltMedia")
133+
134+ pat | _mSupportsMediaDownload m = PInfixApp PWildCard (UnQual (sym ":<|>")) (pvar "go")
135+ | otherwise = pvar "go"
136+
137+ prec = PApp (UnQual "Download") [PRec (UnQual (dname n)) [PFieldWildcard]]
134
138
135requestDecl :: Global
139requestDecl :: Global
136 -> Prefix
140 -> Prefix
@@ -140,7 +144,7 @@ requestDecl :: Global
140 -> Method Solved
144 -> Method Solved
141 -> Decl
145 -> Decl
142requestDecl n p api url fs m =
146requestDecl n p api url fs m =
143− googleRequestDecl n (tycon n) rs alt p api url fs m
147+ googleRequestDecl n (tycon n) rs alt p api url fs m pat prec
144 where
148 where
145 rs = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $
149 rs = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $
146 maybe unit_tycon (tycon . ref) (_mResponse m)
150 maybe unit_tycon (tycon . ref) (_mResponse m)
@@ -148,6 +152,11 @@ requestDecl n p api url fs m =
148 alt = var . name . Text.unpack . alternate <$>
152 alt = var . name . Text.unpack . alternate <$>
149 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
153 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
150
154
155+ pat | _mSupportsMediaDownload m = PInfixApp (pvar "go") (UnQual (sym ":<|>")) PWildCard
156+ | otherwise = pvar "go"
157+
158+ prec = PRec (UnQual (dname n)) [PFieldWildcard]
159+
151googleRequestDecl :: Global
160googleRequestDecl :: Global
152 -> Type
161 -> Type
153 -> InstDecl
162 -> InstDecl
@@ -157,8 +166,10 @@ googleRequestDecl :: Global
157 -> Name
166 -> Name
158 -> [Local]
167 -> [Local]
159 -> Method Solved
168 -> Method Solved
169+ -> Pat
170+ -> Pat
160 -> Decl
171 -> Decl
161−googleRequestDecl g n assoc alt p api url fields m =
172+googleRequestDecl g n assoc alt p api url fields m pat prec =
162 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
173 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n]
163 [ assoc
174 [ assoc
164 , request
175 , request
@@ -181,18 +192,20 @@ googleRequestDecl g n assoc alt p api url fields m =
181 , var "u"
192 , var "u"
182 ]
193 ]
183 ]
194 ]
184− where
185− pat | _mSupportsMediaDownload m = PInfixApp (pvar "go") (UnQual (sym ":<|>")) PWildCard
186− | otherwise = pvar "go"
187
195
188 rhs = UnGuardedRhs . appFun (var "go") $ map go fs'
196 rhs = UnGuardedRhs . appFun (var "go") $ map go fs'
189 ++ maybeToList (app (var "Just") <$> alt)
197 ++ maybeToList (app (var "Just") <$> alt)
190 ++ maybeToList (go <$> rq)
198 ++ maybeToList (go <$> rq)
199+ ++ maybeToList (go <$> pay)
191 where
200 where
192− go l | Just p <- Map.lookup l ps
201+ go l = case Map.lookup l ps of
202+ Just p | _pLocation p == Query
203+ , p ^. iRepeated -> infixApp (v l) "^." (var "_Default")
204+
193− , _pLocation p == Query
205+ Just p | _pLocation p == Query
194− , parameter p || defaulted p = app (var "Just") (v l)
206+ , parameter p || defaulted p -> app (var "Just") (v l)
195− | otherwise = v l
207+
208+ _ -> v l
196
209
197 ps = _mParameters m
210 ps = _mParameters m
198 v = var . fname p
211 v = var . fname p
@@ -200,13 +213,15 @@ googleRequestDecl g n assoc alt p api url fields m =
200 (fs', rq) | Just _ <- _mRequest m = (delete "payload" fs, Just "payload")
213 (fs', rq) | Just _ <- _mRequest m = (delete "payload" fs, Just "payload")
201 | otherwise = (fs, Nothing)
214 | otherwise = (fs, Nothing)
202
215
216+ pay | _mSupportsMediaUpload m = Just "media"
217+ | otherwise = Nothing
218+
203 fs = delete "alt"
219 fs = delete "alt"
204 . orderParams id (Map.keys (_mParameters m))
220 . orderParams id (Map.keys (_mParameters m))
205 . nub
221 . nub
206 $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m
222 $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m
207
223
208 pats = [pvar "r", pvar "u", prec]
224 pats = [pvar "r", pvar "u", prec]
209− prec = PRec (UnQual (dname g)) [PFieldWildcard]
210
225
211authDecl :: Global -> Prefix -> [Local] -> Decl
226authDecl :: Global -> Prefix -> [Local] -> Decl
212authDecl g p fs = InstDecl noLoc Nothing [] [] (unqual "GoogleAuth") [tycon g]
227authDecl g p fs = InstDecl noLoc Nothing [] [] (unqual "GoogleAuth") [tycon g]
@@ -374,8 +389,8 @@ def s
374terminalType :: TType -> Type
389terminalType :: TType -> Type
375terminalType = internalType . go
390terminalType = internalType . go
376 where
391 where
377− go (TMaybe x) = x
392+ go (TMaybe x) = go x
378− go (TList x) = x
393+ go (TList x) = go x
379 go x = x
394 go x = x
380
395
381externalType :: TType -> Type
396externalType :: TType -> Type
gen/template/action.ede+1
@@ -1,6 +1,7 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}