git.iko.soy/gogol
on develop help sign in
Tidying up various generator warnings
62d1891Brendan Hay
gen/script/copy-models+1−1
compare with develop
unifiedsplit
@@ -14,6 +14,6 @@ for dir in $source/*/; do
14 if find $dir -type f -name '*.json' | grep '/v[a-z0-9_\.]*/' 2>&1 > /dev/null; then
14 if find $dir -type f -name '*.json' | grep '/v[a-z0-9_\.]*/' 2>&1 > /dev/null; then
15 name=$(basename $dir)
15 name=$(basename $dir)
16 echo " -> Copy $name"
16 echo " -> Copy $name"
17− cp -rf $dir $target/$name
17+ cp -r $dir $target/$name
18 fi
18 fi
19done
19done
gen/src/Gen/Orphans.hs−1
@@ -12,7 +12,6 @@
12module Gen.Orphans where
12module Gen.Orphans where
13
13
14import Data.Aeson
14import Data.Aeson
15−import Data.Aeson.Types
16import Data.Bifunctor
15import Data.Bifunctor
17import Data.Hashable
16import Data.Hashable
18import qualified Data.HashMap.Strict as Map
17import qualified Data.HashMap.Strict as Map
gen/src/Gen/Syntax.hs+24−24
@@ -15,21 +15,20 @@ module Gen.Syntax where
15import Control.Lens hiding (iso, mapping, op, pre,
15import Control.Lens hiding (iso, mapping, op, pre,
16 strict)
16 strict)
17import Data.Either
17import Data.Either
18−import Data.Foldable (find, foldl', foldr')
18+import Data.Foldable (foldl', foldr')
19−import Data.Hashable
20import qualified Data.HashMap.Strict as Map
19import qualified Data.HashMap.Strict as Map
21import Data.List (delete, nub)
20import Data.List (delete, nub)
22import Data.Maybe
21import Data.Maybe
23import Data.Semigroup ((<>))
22import Data.Semigroup ((<>))
24−import Data.String
25import Data.Text (Text)
23import Data.Text (Text)
26import qualified Data.Text as Text
24import qualified Data.Text as Text
27import Data.Text.Manipulate
25import Data.Text.Manipulate
28−import Debug.Trace
29−import Gen.Orphans
30import Gen.Text
26import Gen.Text
31import Gen.Types
27import Gen.Types
32−import Language.Haskell.Exts.Build
28+import Language.Haskell.Exts.Build (app, appFun, infixApp, lamE,
29+ listE, name, noBinds, paren,
30+ patBind, pvar, sfun, strE, sym,
31+ var)
33import Language.Haskell.Exts.SrcLoc
32import Language.Haskell.Exts.SrcLoc
34import Language.Haskell.Exts.Syntax hiding (Alt, Int, Lit)
33import Language.Haskell.Exts.Syntax hiding (Alt, Int, Lit)
35
34
@@ -174,6 +173,7 @@ httpMethod = TyCon . unqual . Text.unpack . Text.toTitle . _mHttpMethod
174subPaths :: Text -> [Type]
173subPaths :: Text -> [Type]
175subPaths = map sing . filter (not . Text.null) . Text.split (== '/')
174subPaths = map sing . filter (not . Text.null) . Text.split (== '/')
176
175
176+jsonMedia, streamMedia :: Type
177jsonMedia = tylist ["JSON"]
177jsonMedia = tylist ["JSON"]
178streamMedia = tylist ["OctetStream"]
178streamMedia = tylist ["OctetStream"]
179
179
@@ -187,10 +187,12 @@ uploadParam =
187 TyApp (TyApp (TyCon "QueryParam") (sing "uploadType"))
187 TyApp (TyApp (TyCon "QueryParam") (sing "uploadType"))
188 (TyCon "AltMedia")
188 (TyCon "AltMedia")
189
189
190+metadataPat, downloadPat, uploadPat :: Method a -> Pat
190metadataPat = pattern 1
191metadataPat = pattern 1
191downloadPat = pattern 2
192downloadPat = pattern 2
192uploadPat = pattern 3
193uploadPat = pattern 3
193
194
195+pattern :: Integer -> Method a -> Pat
194pattern n m = case (n, down, up) of
196pattern n m = case (n, down, up) of
195 (1, True, True) -> infixOr go (infixOr wild wild)
197 (1, True, True) -> infixOr go (infixOr wild wild)
196 (2, True, True) -> infixOr wild (infixOr go wild)
198 (2, True, True) -> infixOr wild (infixOr go wild)
@@ -219,8 +221,8 @@ downloadDecl :: Global
219 -> [Local]
221 -> [Local]
220 -> Method Solved
222 -> Method Solved
221 -> Decl
223 -> Decl
222−downloadDecl n p api url fs m =
224+downloadDecl n pre api url fs m =
223− googleRequestDecl n ty [rs, ss] [alt] p api url fs m pat prec
225+ googleRequestDecl ty [rs, ss] [alt] pre api url m pat prec
224 where
226 where
225 ty = TyApp (TyCon "MediaDownload") (tycon n)
227 ty = TyApp (TyCon "MediaDownload") (tycon n)
226
228
@@ -243,8 +245,8 @@ uploadDecl :: Global
243 -> [Local]
245 -> [Local]
244 -> Method Solved
246 -> Method Solved
245 -> Decl
247 -> Decl
246−uploadDecl n p api url fs m =
248+uploadDecl n pre api url fs m =
247− googleRequestDecl n ty [rs, ss] extras p api url fs m pat prec
249+ googleRequestDecl ty [rs, ss] extras pre api url m pat prec
248 where
250 where
249 ty = TyApp (TyCon "MediaUpload") (tycon n)
251 ty = TyApp (TyCon "MediaUpload") (tycon n)
250
252
@@ -261,7 +263,7 @@ uploadDecl n p api url fs m =
261 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
263 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
262
264
263 payload
265 payload
264− | isJust (_mRequest m) = [var (fname p "payload")]
266+ | isJust (_mRequest m) = [var (fname pre "payload")]
265 | otherwise = []
267 | otherwise = []
266
268
267 pat = uploadPat m
269 pat = uploadPat m
@@ -280,8 +282,8 @@ requestDecl :: Global
280 -> [Local]
282 -> [Local]
281 -> Method Solved
283 -> Method Solved
282 -> Decl
284 -> Decl
283−requestDecl n p api url fs m =
285+requestDecl n pre api url fs m =
284− googleRequestDecl n (tycon n) [rs, ss] extras p api url fs m pat prec
286+ googleRequestDecl (tycon n) [rs, ss] extras pre api url m pat prec
285 where
287 where
286 rs = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $
288 rs = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $
287 maybe unit_tycon (tycon . ref) (_mResponse m)
289 maybe unit_tycon (tycon . ref) (_mResponse m)
@@ -297,26 +299,24 @@ requestDecl n p api url fs m =
297 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
299 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
298
300
299 payload
301 payload
300− | isJust (_mRequest m) = Just $ var (fname p "payload")
302+ | isJust (_mRequest m) = Just $ var (fname pre "payload")
301 | otherwise = Nothing
303 | otherwise = Nothing
302
304
303 pat = metadataPat m
305 pat = metadataPat m
304
306
305 prec = PRec (UnQual (dname n)) [PFieldWildcard | not (null fs)]
307 prec = PRec (UnQual (dname n)) [PFieldWildcard | not (null fs)]
306
308
307−googleRequestDecl :: Global
309+googleRequestDecl :: Type
308− -> Type
309 -> [InstDecl]
310 -> [InstDecl]
310 -> [Exp]
311 -> [Exp]
311 -> Prefix
312 -> Prefix
312 -> Name
313 -> Name
313 -> Name
314 -> Name
314− -> [Local]
315 -> Method Solved
315 -> Method Solved
316 -> Pat
316 -> Pat
317 -> Pat
317 -> Pat
318 -> Decl
318 -> Decl
319−googleRequestDecl g n assoc extras p api url fields m pat prec =
319+googleRequestDecl n assoc extras pre api url m pat prec =
320 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n] (assoc ++ [request])
320 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [n] (assoc ++ [request])
321 where
321 where
322 request = InsDecl (FunBind [match])
322 request = InsDecl (FunBind [match])
@@ -350,7 +350,7 @@ googleRequestDecl g n assoc extras p api url fields m pat prec =
350 _ -> v l
350 _ -> v l
351
351
352 ps = _mParameters m
352 ps = _mParameters m
353− v = var . fname p
353+ v = var . fname pre
354
354
355 fs = delete "alt"
355 fs = delete "alt"
356 . orderParams id (Map.keys (_mParameters m))
356 . orderParams id (Map.keys (_mParameters m))
@@ -358,9 +358,9 @@ googleRequestDecl g n assoc extras p api url fields m pat prec =
358 $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m
358 $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m
359
359
360jsonDecls :: Global -> Prefix -> Map Local Solved -> [Decl]
360jsonDecls :: Global -> Prefix -> Map Local Solved -> [Decl]
361−jsonDecls g p (Map.toList -> rs) = [from, to]
361+jsonDecls g p (Map.toList -> rs) = [from', to']
362 where
362 where
363− from = InstDecl noLoc Nothing [] [] (unqual "FromJSON") [tycon g]
363+ from' = InstDecl noLoc Nothing [] [] (unqual "FromJSON") [tycon g]
364 [ funD "parseJSON" $
364 [ funD "parseJSON" $
365 app (app (var "withObject") (dstr g)) $
365 app (app (var "withObject") (dstr g)) $
366 lamE noLoc [pvar "o"] $
366 lamE noLoc [pvar "o"] $
@@ -374,7 +374,7 @@ jsonDecls g p (Map.toList -> rs) = [from, to]
374 | monoid s = defJS l (var "mempty")
374 | monoid s = defJS l (var "mempty")
375 | otherwise = optJS l
375 | otherwise = optJS l
376
376
377− to = case rs of
377+ to' = case rs of
378 [(k, v)] | _additional v ->
378 [(k, v)] | _additional v ->
379 InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon g]
379 InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon g]
380 [ funD "toJSON" $
380 [ funD "toJSON" $
@@ -383,14 +383,14 @@ jsonDecls g p (Map.toList -> rs) = [from, to]
383
383
384 _ ->
384 _ ->
385 InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon g]
385 InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon g]
386− [ wildcardD "toJSON" g omit none (map encode rs)
386+ [ wildcardD "toJSON" g omit emptyObj (map encode rs)
387 ]
387 ]
388
388
389 omit = app (var "object")
389 omit = app (var "object")
390 . app (var "catMaybes")
390 . app (var "catMaybes")
391 . listE
391 . listE
392
392
393− none = var "emptyObject"
393+ emptyObj = var "emptyObject"
394
394
395 encode (l, s)
395 encode (l, s)
396 | TMaybe {} <- _type s = infixApp (paren (app n o)) "<$>" a
396 | TMaybe {} <- _type s = infixApp (paren (app n o)) "<$>" a