From 18f8e8d2c26bbae19079beac5419b2a8245fd13c Mon Sep 17 00:00:00 2001
From: Judah Jacobson <judah@users.noreply.github.com>
Date: Fri, 30 Aug 2019 21:32:01 -0700
Subject: [PATCH] Make `tyPromotedVar` pretty-print as `'Abc` not `Abc`. (#44)

Also make it possible for unit tests to change behavior based on the
version of GHC.
---
 src/GHC/SourceGen/Type.hs |  2 +-
 tests/GhcVersion.hs       | 16 ++++++++++++++++
 tests/pprint_test.hs      |  6 ++++++
 3 files changed, 23 insertions(+), 1 deletion(-)
 create mode 100644 tests/GhcVersion.hs

diff --git a/src/GHC/SourceGen/Type.hs b/src/GHC/SourceGen/Type.hs
index 2114348..b1c1144 100644
--- a/src/GHC/SourceGen/Type.hs
+++ b/src/GHC/SourceGen/Type.hs
@@ -28,7 +28,7 @@ import GHC.SourceGen.Type.Internal
 
 -- | A promoted name, for example from the @DataKinds@ extension.
 tyPromotedVar :: RdrNameStr -> HsType'
-tyPromotedVar = noExt HsTyVar notPromoted . typeRdrName
+tyPromotedVar = noExt HsTyVar promoted . typeRdrName
 
 stringTy :: String -> HsType'
 stringTy = noExt HsTyLit . noSourceText HsStrTy . fromString
diff --git a/tests/GhcVersion.hs b/tests/GhcVersion.hs
new file mode 100644
index 0000000..8496c70
--- /dev/null
+++ b/tests/GhcVersion.hs
@@ -0,0 +1,16 @@
+-- A module for changing behavior based on the version of GHC.
+{-# LANGUAGE CPP #-}
+module GhcVersion where
+
+import Data.Version
+import Text.ParserCombinators.ReadP
+
+ghcVersion :: Version
+ghcVersion = case readP_to_S (parseVersion <* eof) VERSION_ghc of
+    [(v,"")] -> v
+    _ -> error $ "Unable to parse GHC version " ++ show VERSION_ghc
+
+ifGhc88 :: a -> a -> a
+ifGhc88 x y = if makeVersion [8,8] <= ghcVersion
+                then x
+                else y
diff --git a/tests/pprint_test.hs b/tests/pprint_test.hs
index 6c0d0a8..9ff6115 100644
--- a/tests/pprint_test.hs
+++ b/tests/pprint_test.hs
@@ -11,6 +11,7 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 import GHC.SourceGen
+import GhcVersion
 
 data TestCase a = String :~ a
 
@@ -98,6 +99,11 @@ typesTest dflags = testGroup "Type"
         , "[x]" :~ listPromotedTy [var "x"]
         , "[y, z]" :~ listPromotedTy [var "y", var "z"]
         ]
+    , test "tyPromotedVar"
+        -- For some reason, older GHC pretty-printed an extra space.
+        [ ifGhc88 "'Abc" " 'Abc" :~ tyPromotedVar "Abc"
+        , ifGhc88 "T 'Abc" "T  'Abc" :~ var "T" @@ tyPromotedVar "Abc"
+        ]
     ]
   where
     test = testTypes dflags