Fix order of promoted type tuples in resulting TH

Also add a test illustrating a problem.

Author: avnik

haskell-src-meta/src/Language/Haskell/Meta/Syntax/Translate.hs

@@ -437,7 +437,7 @@ instance ToType (Exts.Type l) where
     Exts.PromotedString _ _ s -> TH.LitT $ TH.StrTyLit s
     Exts.PromotedCon _ _q n -> TH.PromotedT $ toName n
     Exts.PromotedList _ _q ts -> foldr (\t pl -> TH.PromotedConsT `TH.AppT` toType t `TH.AppT` pl) TH.PromotedNilT ts
-    Exts.PromotedTuple _ ts -> foldr (\t pt -> pt `TH.AppT` toType t) (TH.PromotedTupleT $ length ts) ts
+    Exts.PromotedTuple _ ts -> foldl (\pt t -> pt `TH.AppT` toType t) (TH.PromotedTupleT $ length ts) ts
     Exts.PromotedUnit _ -> TH.PromotedT ''()
   toType (Exts.TyEquals _ t1 t2) = TH.EqualityT `TH.AppT` toType t1 `TH.AppT` toType t2
   toType t@Exts.TySplice{} = noTH "toType" t

haskell-src-meta/tests/Main.hs

@@ -7,6 +7,7 @@ import qualified Language.Haskell.Exts           as Exts
 import qualified Language.Haskell.Exts.Extension as Extension
 import qualified Language.Haskell.Exts.Parser    as Parser
 import           Language.Haskell.Meta.Parse
+import           Language.Haskell.Meta.Syntax.Translate
 import qualified Language.Haskell.TH             as TH
 -- import           Test.Framework
 -- import           Test.Framework.Providers.HUnit
@@ -24,12 +25,22 @@ tests = [ derivingClausesTest
 #if MIN_VERSION_template_haskell(2,12,0)
         , typeAppTest
 #endif
+        , orderInTypeTuples
         ]
 
 derivingClausesTest :: Test
 derivingClausesTest = testCase "Deriving clauses preserved" $
     roundTripDecls "data Foo = Foo deriving (A, B, C)"
 
+-- Very ugly test, illustrating incorrect order of promoted type tuples reconstructed into TH
+orderInTypeTuples :: Test
+orderInTypeTuples = testCase "Ensure that type tuples reconstructed in proper order" $ do
+  let Parser.ParseOk parsed = show . toExp <$> Parser.parseExpWithMode mode "getField @'(\"a\", \"b\", \"c\") localVar"
+  parsed @?= expected
+  where
+    mode = Parser.defaultParseMode { Parser.extensions = [Extension.EnableExtension Extension.TypeApplications, Extension.EnableExtension Extension.DataKinds  ] }
+    expected = "(AppE (AppTypeE (VarE getField) (AppT (AppT (AppT (PromotedTupleT 3) (LitT (StrTyLit \"a\"))) (LitT (StrTyLit \"b\"))) (LitT (StrTyLit \"c\")))) (VarE localVar))"
+
 typeAppMode :: Exts.ParseMode
 typeAppMode = Parser.defaultParseMode { Parser.extensions = [Extension.EnableExtension Extension.TypeApplications] }