promoted tuples (#62)

Also adds an internal `withPlaceHolders` combinator.

ChangeLog.md

@@ -10,6 +10,7 @@
 
 ## Other Changes
 - Add `kindedVar`.
+- Add `tuplePromotedTy`.
 
 ## 0.3.0.0
 - Add `occNameToStr` and `nameToStr` to convert from the GHC types.

src/GHC/SourceGen/Syntax/Internal.hs

@@ -77,6 +77,9 @@ noExtOrPlaceHolder = noExt
 withPlaceHolder :: a -> a
 withPlaceHolder = id
 
+withPlaceHolders :: a -> a
+withPlaceHolders = id
+
 #else
 
 noExt :: a -> a
@@ -88,6 +91,9 @@ noExtOrPlaceHolder = withPlaceHolder
 withPlaceHolder :: (PlaceHolder -> a) -> a
 withPlaceHolder = ($ PlaceHolder)
 
+withPlaceHolders :: ([PlaceHolder] -> a) -> a
+withPlaceHolders = ($ [])
+
 #endif
 
 builtSpan :: SrcSpan

src/GHC/SourceGen/Type.hs

@@ -12,6 +12,7 @@ module GHC.SourceGen.Type
     , numTy
     , listTy
     , listPromotedTy
+    , tuplePromotedTy
     , (-->)
     , forall'
     , HsTyVarBndr'
@@ -45,6 +46,9 @@ listPromotedTy :: [HsType'] -> HsType'
 -- But for consistency, just always add it.
 listPromotedTy = withPlaceHolder (noExt HsExplicitListTy promoted) . map builtLoc
 
+tuplePromotedTy :: [HsType'] -> HsType'
+tuplePromotedTy = withPlaceHolders (noExt HsExplicitTupleTy) . map builtLoc
+
 -- | A function type.
 --
 -- > a -> b

tests/pprint_test.hs

@@ -99,13 +99,20 @@ typesTest dflags = testGroup "Type"
         , "123" :~ numTy 123
         ]
     , test "unit"
-        [ "()" :~ unit ]
+        [ "()" :~ unit
+        , "(# #)" :~ unboxedTuple []
+        ]
    , test "list"
         [ "[x]" :~ listTy (var "x")
         , "'[]" :~ listPromotedTy []
         , "'[x]" :~ listPromotedTy [var "x"]
         , "'[y, z]" :~ listPromotedTy [var "y", var "z"]
         ]
+    , test "tuple"
+        [ "(a, b)" :~ tuple [(var "a"), (var "b")]
+        , "(# a, b #)" :~ unboxedTuple [(var "a"), (var "b")]
+        , "'(a, b)" :~ tuplePromotedTy [(var "a"), (var "b")]
+        ]
     , test "tyPromotedVar"
         -- For some reason, older GHC pretty-printed an extra space.
         [ ifGhc88 "'Abc" " 'Abc" :~ tyPromotedVar "Abc"