git.iko.soy/gogol
on develop help sign in
Oh lord.
20c45baBrendan Hay
gen/src/Gen/AST/Flatten.hs+1−1
compare with develop
unifiedsplit
@@ -88,7 +88,7 @@ globalParam l p = ($ p) $ case l of
88 "oauth_token" -> overrideParam l OAuthToken
88 "oauth_token" -> overrideParam l OAuthToken
89 _ -> localParam "" l
89 _ -> localParam "" l
90 where
90 where
91− alt = Text.toUpper (fromMaybe "JSON" (p ^. iDefault))
91+ alt = alternate $ fromMaybe "JSON" (p ^. iDefault)
92
92
93overrideParam :: Local -> Lit -> Param (Fix Schema) -> AST (Param Global)
93overrideParam :: Local -> Lit -> Param (Fix Schema) -> AST (Param Global)
94overrideParam l v p =
94overrideParam l v p =
gen/src/Gen/AST/Solve.hs+16−13
@@ -87,19 +87,22 @@ getSchema g = do
87getType :: Global -> AST TType
87getType :: Global -> AST TType
88getType g = loc "getType" g $ memo typed g go
88getType g = loc "getType" g $ memo typed g go
89 where
89 where
90− go s = fmap (may s) $
91− case s of
90+ go s = case s of
92− SAny {} -> pure (TType "JSONValue")
91+ SAny {} -> may (TType "JSONValue")
93− SRef _ r -> getType (ref r)
92+ SRef _ r -> unmay <$> getType (ref r)
94− --- FIXME: add natural/numeric manipulations
93+ --- FIXME: add natural/numeric manipulations
95− SLit _ l -> pure (TLit l)
94+ SLit _ l -> may (TLit l)
96− SEnm {} -> pure (TType g)
95+ SEnm {} -> may (TType g)
97− SArr _ (Arr e) -> TList <$> getType e
96+ SArr _ (Arr e) -> (TList <$> (getType e)) >>= may
98− SObj {} -> pure (TType g)
97+ SObj {} -> may (TType g)
99−
98+ where
100− may s | required s = id
99+ may | required s = pure
101− | defaulted s = id
100+ | defaulted s = pure
102− | otherwise = TMaybe
101+ | otherwise = pure . TMaybe
102+
103+ unmay (TMaybe x)
104+ | required s = x
105+ unmay x = x
103
106
104getDerive :: Global -> AST [Derive]
107getDerive :: Global -> AST [Derive]
105getDerive g = loc "getDerive" g $ memo derived g go
108getDerive g = loc "getDerive" g $ memo derived g go
gen/src/Gen/Syntax.hs+19−10
@@ -17,6 +17,7 @@ import Control.Lens hiding (iso, mapping, op, pre,
17import Data.Foldable (find, foldl', foldr')
17import Data.Foldable (find, foldl', foldr')
18import Data.Hashable
18import Data.Hashable
19import qualified Data.HashMap.Strict as Map
19import qualified Data.HashMap.Strict as Map
20+import Data.List (delete)
20import Data.Maybe
21import Data.Maybe
21import Data.Maybe
22import Data.Maybe
22import Data.Semigroup ((<>))
23import Data.Semigroup ((<>))
@@ -93,20 +94,19 @@ verbAlias n m
93 media | Just b <- _mRequest m =
94 media | Just b <- _mRequest m =
94 let g = ref b
95 let g = ref b
95 in if _mSupportsMediaUpload m
96 in if _mSupportsMediaUpload m
96− then [TyApp (TyApp (TyCon "Multipart") json) (parts g)]
97+ then [TyApp (TyApp (TyApp (TyCon "MultipartRelated") json)
98+ (tycon g))
99+ (TyCon "Body")]
97− else [TyApp (TyApp (TyCon "ReqBody") json) (tycon g)]
100+ else [TyApp (TyApp (TyCon "ReqBody") json) (tycon g)]
98 | otherwise = []
101 | otherwise = []
99− where
100− parts g = TyCon . UnQual . name . Text.unpack $
101− "'[" <> global g <> ", Body]"
102
102
103 verb = TyApp (TyApp meth json) $
103 verb = TyApp (TyApp meth json) $
104 maybe (TyCon "()") (tycon . ref) (_mResponse m)
104 maybe (TyCon "()") (tycon . ref) (_mResponse m)
105
105
106 meth = TyCon . unqual . Text.unpack $ Text.toTitle (_mHttpMethod m)
106 meth = TyCon . unqual . Text.unpack $ Text.toTitle (_mHttpMethod m)
107
107
108− octet = TyCon "'[OctetStream]"
108+ octet = tylist ["OctetStream"]
109− json = TyCon "'[JSON]"
109+ json = tylist ["JSON"]
110
110
111 alt = TyApp (TyApp (TyCon "QueryParam") (sing "alt")) (TyCon "Media")
111 alt = TyApp (TyApp (TyCon "QueryParam") (sing "alt")) (TyCon "Media")
112
112
@@ -141,7 +141,7 @@ requestDecl n p api url fs m =
141 rs = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $
141 rs = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $
142 maybe unit_tycon (tycon . ref) (_mResponse m)
142 maybe unit_tycon (tycon . ref) (_mResponse m)
143
143
144− alt = var . name . Text.unpack . Text.toUpper <$>
144+ alt = var . name . Text.unpack . alternate <$>
145 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
145 (Map.lookup "alt" (_mParameters m) >>= view iDefault)
146
146
147googleRequestDecl :: Global
147googleRequestDecl :: Global
@@ -181,7 +181,9 @@ googleRequestDecl g n assoc alt p api url fs m =
181 pat | _mSupportsMediaDownload m = PInfixApp (pvar "go") (UnQual (sym ":<|>")) PWildCard
181 pat | _mSupportsMediaDownload m = PInfixApp (pvar "go") (UnQual (sym ":<|>")) PWildCard
182 | otherwise = pvar "go"
182 | otherwise = pvar "go"
183
183
184− rhs = UnGuardedRhs $ appFun (var "go") (map go fs ++ maybeToList alt)
184+ rhs = UnGuardedRhs . appFun (var "go") $ map go fs'
185+ ++ maybeToList (app (var "Just") <$> alt)
186+ ++ maybeToList (go <$> rq)
185 where
187 where
186 go l | Just p <- Map.lookup l ps
188 go l | Just p <- Map.lookup l ps
187 , _pLocation p == Query
189 , _pLocation p == Query
@@ -191,6 +193,9 @@ googleRequestDecl g n assoc alt p api url fs m =
191 ps = _mParameters m
193 ps = _mParameters m
192 v = var . fname p
194 v = var . fname p
193
195
196+ (fs', rq) | Just r <- _mRequest m = let x = localise (ref r) in (delete x fs, Just x)
197+ | otherwise = (fs, Nothing)
198+
194 pats = [pvar "r", pvar "u", prec]
199 pats = [pvar "r", pvar "u", prec]
195 prec = PRec (UnQual (dname g)) [PFieldWildcard]
200 prec = PRec (UnQual (dname g)) [PFieldWildcard]
196
201
@@ -201,7 +206,7 @@ authDecl g p fs = InstDecl noLoc Nothing [] [] (unqual "GoogleAuth") [tycon g]
201 ]
206 ]
202 where
207 where
203 method l f
208 method l f
204− | f `elem` fs = funD l (var (lname p f))
209+ | f `elem` fs = funD l (infixApp (var (lname p f)) "." (var "_Just"))
205 | otherwise = funD l (app (var "const") (var "pure"))
210 | otherwise = funD l (app (var "const") (var "pure"))
206
211
207jsonDecls :: Global -> Prefix -> Map Local Solved -> [Decl]
212jsonDecls :: Global -> Prefix -> Map Local Solved -> [Decl]
@@ -444,6 +449,10 @@ strict = TyBang BangedTy . \case
444sing :: Text -> Type
449sing :: Text -> Type
445sing = TyCon . unqual . Text.unpack . flip mappend "\"" . mappend "\""
450sing = TyCon . unqual . Text.unpack . flip mappend "\"" . mappend "\""
446
451
452+tylist :: [Text] -> Type
453+tylist xs = TyCon . UnQual . name . Text.unpack $
454+ "'[" <> Text.intercalate ", " xs <> "]"
455+
447tycon :: Global -> Type
456tycon :: Global -> Type
448tycon = TyCon . UnQual . dname
457tycon = TyCon . UnQual . dname
449
458
gen/src/Gen/Types/Schema.hs+4−1
@@ -93,6 +93,9 @@ defaulted = isJust . view iDefault
93required = view iRequired
93required = view iRequired
94parameter s = required s && not (defaulted s)
94parameter s = required s && not (defaulted s)
95
95
96+alternate :: Text -> Text
97+alternate = mappend "Alt" . Text.toUpper
98+
96emptyInfo :: Info
99emptyInfo :: Info
97emptyInfo = Info
100emptyInfo = Info
98 { _iId = Nothing
101 { _iId = Nothing
@@ -107,7 +110,7 @@ emptyInfo = Info
107 }
110 }
108
111
109requiredInfo :: Info
112requiredInfo :: Info
110−requiredInfo = emptyInfo & iRequired .~ True
113+requiredInfo = setRequired emptyInfo
111
114
112setRequired :: HasInfo a => a -> a
115setRequired :: HasInfo a => a -> a
113setRequired = iRequired .~ True
116setRequired = iRequired .~ True