From 8a083ab94ed63d1b4183cf89c69b27f612f202ec Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Tue, 17 Jan 2023 13:45:20 +1000 Subject: [PATCH] gen: Sort waiters, error checks, and lenses in generated output Same output as https://github.com/brendanhay/amazonka/pull/862, but sticks to `HashMap` internally to avoid triggering https://github.com/brendanhay/amazonka/issue/888 A couple of enums change value in a strange way, because the generator cannot handle enums-of-numeric values. See https://github.com/brendanhay/amazonka/issues/889 --- gen/src/Gen/AST.hs | 10 +++--- gen/src/Gen/AST/Data/Field.hs | 6 ++-- gen/src/Gen/AST/Data/Syntax.hs | 61 +++++++++++++++++----------------- gen/src/Gen/Types/Config.hs | 2 +- gen/src/Gen/Types/Data.hs | 8 ++--- lib/amazonka/CHANGELOG.md | 2 ++ 6 files changed, 47 insertions(+), 42 deletions(-) diff --git a/gen/src/Gen/AST.hs b/gen/src/Gen/AST.hs index c858ffcd59a..5474985bfa2 100644 --- a/gen/src/Gen/AST.hs +++ b/gen/src/Gen/AST.hs @@ -189,17 +189,17 @@ solve :: Config -> t (Shape Prefixed) -> t (Shape Solved) -solve cfg ss = State.evalState (go ss) (replaced typeOf cfg) +solve cfg ss = State.evalState (go ss) types where go = traverse (annotate Solved id (pure . typeOf)) - replaced :: (Replace -> a) -> Config -> HashMap Id a - replaced f = + types :: HashMap Id TType + types = HashMap.fromList - . map (_replaceName &&& f) + . map (_replaceName &&& typeOf) . HashMap.elems . vMapMaybe _replacedBy - . _typeOverrides + $ _typeOverrides cfg type MemoS a = StateT (HashMap Id a) (Either String) diff --git a/gen/src/Gen/AST/Data/Field.hs b/gen/src/Gen/AST/Data/Field.hs index e4d53ec6e05..3369615dee9 100644 --- a/gen/src/Gen/AST/Data/Field.hs +++ b/gen/src/Gen/AST/Data/Field.hs @@ -77,8 +77,10 @@ mkFields :: StructF (Shape Solved) -> [Field] mkFields (Lens.view metadata -> m) s st = - sortFields rs $ - zipWith mk [1 ..] $ HashMap.toList (st ^. members) + sortFields rs + . zipWith mk [1 ..] + . List.sortOn fst + $ HashMap.toList (st ^. members) where mk :: Int -> (Id, Ref) -> Field mk i (k, v) = diff --git a/gen/src/Gen/AST/Data/Syntax.hs b/gen/src/Gen/AST/Data/Syntax.hs index 01e0234c393..cbe48204a20 100644 --- a/gen/src/Gen/AST/Data/Syntax.hs +++ b/gen/src/Gen/AST/Data/Syntax.hs @@ -7,7 +7,7 @@ import qualified Control.Lens as Lens import qualified Data.Char as Char import qualified Data.Foldable as Fold import qualified Data.HashMap.Strict as HashMap -import Data.List (find) +import Data.List (find, sortOn) import qualified Data.List.NonEmpty as NE import qualified Data.Text as Text import Gen.AST.Data.Field @@ -227,7 +227,8 @@ serviceD m r = Exts.patBindWhere (pvar n) rhs bs chk = Exts.sfun (ident "check") [ident "e"] . Exts.GuardedRhss () $ - mapMaybe policy (r ^.. retryPolicies . kvTraversal) ++ [otherE nothingE] + mapMaybe policy (sortOn fst . HashMap.toList $ r ^. retryPolicies) + ++ [otherE nothingE] where policy (k, v) = (`guardE` Exts.app justE (str k)) <$> policyE v @@ -275,8 +276,8 @@ pagerD n p = -- Next ks t -> Exts.GuardedRhss () $ - stop (notationE (_tokenOutput t)) : - map (stop . notationE) (Fold.toList ks) + stop (notationE (_tokenOutput t)) + : map (stop . notationE) (Fold.toList ks) ++ [other [t]] -- Many k (t :| ts) -> @@ -344,8 +345,8 @@ notationE' withLensIso = \case accessors f | not withLensIso = var (fieldLens f) | otherwise = - foldl' (\a b -> Exts.infixApp a "Prelude.." b) (var (fieldLens f)) $ - lensIso (typeOf f) + foldl' (\a b -> Exts.infixApp a "Prelude.." b) (var (fieldLens f)) $ + lensIso (typeOf f) lensIso = \case TList1 x -> Exts.app (var "Lens.to") (var "Prelude.toList") : lensIso x @@ -407,16 +408,16 @@ responseE p r fs = Exts.app (responseF p r fs) bdy parseOne :: Field -> Exp parseOne f | fieldLit f = - if fieldIsParam f - then Exts.app (var "Prelude.pure") (var "x") - else -- Coerce is inserted here to handle newtypes such as Sensitive. - - Exts.app (var "Prelude.pure") - . Exts.paren - . Exts.app justE - . Exts.paren - . Exts.app (var "Prelude.coerce") - $ var "x" + if fieldIsParam f + then Exts.app (var "Prelude.pure") (var "x") + else -- Coerce is inserted here to handle newtypes such as Sensitive. + + Exts.app (var "Prelude.pure") + . Exts.paren + . Exts.app justE + . Exts.paren + . Exts.app (var "Prelude.coerce") + $ var "x" -- This ensures anything which is set as a payload, -- but is a primitive type is just consumed as a bytestring. | otherwise = parseAll @@ -461,8 +462,8 @@ hashableD n fs = rhs | null fs = hashWithSaltE (Exts.var "_salt") (Exts.tuple []) | otherwise = - foldl' hashWithSaltE (Exts.var "_salt") $ - var . fieldAccessor <$> fs + foldl' hashWithSaltE (Exts.var "_salt") $ + var . fieldAccessor <$> fs hashWithSaltE l r = Exts.infixApp l "`Prelude.hashWithSalt`" r @@ -626,11 +627,11 @@ parseXMLE p f = case outputNames p f of wrapSensitive | sensitive = - Exts.app - ( Exts.app - (var "Prelude.fmap") - (Exts.app (var "Prelude.fmap") (var "Data.Sensitive")) - ) + Exts.app + ( Exts.app + (var "Prelude.fmap") + (Exts.app (var "Prelude.fmap") (var "Data.Sensitive")) + ) | otherwise = id wrapMay @@ -716,14 +717,14 @@ toGenericE :: Protocol -> QOp -> Text -> Exp -> Exp -> Field -> Exp toGenericE p toO toF toM toL f = case inputNames p f of NMap mn e k v | fieldMaybe f -> - flatE mn toO . Exts.app (var toF) $ Exts.appFun toM [str e, str k, str v, var "Prelude.<$>", a] + flatE mn toO . Exts.app (var toF) $ Exts.appFun toM [str e, str k, str v, var "Prelude.<$>", a] | otherwise -> - flatE mn toO $ Exts.appFun toM [str e, str k, str v, a] + flatE mn toO $ Exts.appFun toM [str e, str k, str v, a] NList mn i | fieldMaybe f -> - flatE mn toO . Exts.app (var toF) $ Exts.appFun toL [str i, var "Prelude.<$>", a] + flatE mn toO . Exts.app (var toF) $ Exts.appFun toL [str i, var "Prelude.<$>", a] | otherwise -> - flatE mn toO $ Exts.appFun toL [str i, a] + flatE mn toO $ Exts.appFun toL [str i, a] NName n -> encodeE n toO a where @@ -821,11 +822,11 @@ requestF c meta h r is = _ | p == Query, m == POST -> - Just "Query" + Just "Query" _ | p == EC2, m == POST -> - Just "Query" + Just "Query" _ -> Nothing m = h ^. method @@ -939,7 +940,7 @@ directed i m d (typeOf -> t) = case t of Just Output -> "Data.ResponseBody" -- Response stream. Just Input | m ^. signatureVersion == S3 -> - "Data.RequestBody" -- If the signer supports chunked encoding, both body types are accepted. + "Data.RequestBody" -- If the signer supports chunked encoding, both body types are accepted. | otherwise -> "Data.HashedBody" -- Otherwise only a pre-hashed body is accepted. mapping :: TType -> Exp -> Exp diff --git a/gen/src/Gen/Types/Config.hs b/gen/src/Gen/Types/Config.hs index d7a08b05372..8f428c4f6b5 100644 --- a/gen/src/Gen/Types/Config.hs +++ b/gen/src/Gen/Types/Config.hs @@ -172,7 +172,7 @@ instance ToJSON Library where "operations" .= List.sortOn _opName (l ^.. operations . Lens.each), "shapes" .= List.sort (l ^.. shapes . Lens.each), - "waiters" .= (l ^.. waiters . Lens.each) + "waiters" .= List.sortOn _waitName (l ^.. waiters . Lens.each) ] -- FIXME: Remove explicit construction of getters, just use functions. diff --git a/gen/src/Gen/Types/Data.hs b/gen/src/Gen/Types/Data.hs index ed23ae6aba2..26f11f6e216 100644 --- a/gen/src/Gen/Types/Data.hs +++ b/gen/src/Gen/Types/Data.hs @@ -6,7 +6,7 @@ import qualified Control.Lens as Lens import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Types (Pair) -import qualified Data.Function as Function +import Data.Ord (comparing) import qualified Data.Set as Set import qualified Data.Text as Text import Gen.Prelude @@ -113,9 +113,9 @@ data SData instance Ord SData where compare a b = case (a, b) of - (Prod _ x _, Prod _ y _) -> Function.on compare _prodName x y - (Sum _ x _, Sum _ y _) -> Function.on compare _sumName x y - (Fun _, Fun _) -> EQ + (Prod _ x _, Prod _ y _) -> comparing _prodName x y + (Sum _ x _, Sum _ y _) -> comparing _sumName x y + (Fun x, Fun y) -> comparing _funName x y (Prod {}, _) -> GT (_, Prod {}) -> LT (Sum {}, _) -> GT diff --git a/lib/amazonka/CHANGELOG.md b/lib/amazonka/CHANGELOG.md index c871d69bd34..86a289fcaa4 100644 --- a/lib/amazonka/CHANGELOG.md +++ b/lib/amazonka/CHANGELOG.md @@ -109,6 +109,8 @@ Released: **?**, Compare: [2.0.0-rc1](https://github.com/brendanhay/amazonka/com ### Changed +- `gen` / `amazonka-*`: Sort generated code so that outputs are stable across regenerations. +[\#890](https://github.com/brendanhay/amazonka/pull/890) - `amazonka-core`/`amazonka`: Various time-related data types and the `_Time` `Iso'` are re-exported by `Amazonka.Core` and therefore `Amazonka`. [\#884](https://github.com/brendanhay/amazonka/pull/884) - `amazonka-core`: service error matchers are now `AsError a => Fold a ServiceError` instead of `AsError a => Getting (First ServiceError) a ServiceError`. This makes them more flexible (e.g., usable with `Control.Lens.has`), but existing uses should be unaffected.