Implement -fprint-expanded-synonyms

Add a flag to print type-synonyms-expanded versions of types in type
error messages (in addition to old error messages with synonyms)

 * Mailing list discussion: https://mail.haskell.org/pipermail/ghc-devs/2015-June/009247.html
 * Wiki page: https://wiki.haskell.org/Expanding_type_synonyms_in_error_messages_proposal
 * Trac: https://ghc.haskell.org/trac/ghc/ticket/10547

Test Plan:
 * I'll find some examples and add tests.

Reviewers: austin, simonpj, goldfire, bgamari

Reviewed By: austin, simonpj, goldfire, bgamari

Subscribers: rodlogic, thomie, bgamari

Differential Revision: https://phabricator.haskell.org/D1016

GHC Trac Issues: #10547

9 files changed, 100 insertions, 0 deletions

diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.hs b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.hs
new file mode 100644
index 0000000000..7317371e8e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.hs
@@ -0,0 +1,4 @@
+type Foo = Int
+type Bar = Bool
+
+main = print $ (1 :: Foo) == (False :: Bar)
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr
new file mode 100644
index 0000000000..0d5a9109a4
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr
@@ -0,0 +1,11 @@
+ExpandSynsFail1.hs:4:31: error:
+    Couldn't match type ‘Bool’ with ‘Int’
+    Expected type: Foo
+      Actual type: Bar
+    Type synonyms expanded:
+    Expected type: Int
+      Actual type: Bool
+    In the second argument of ‘(==)’, namely ‘(False :: Bar)’
+    In the second argument of ‘($)’, namely
+      ‘(1 :: Foo) == (False :: Bar)’
+    In the expression: print $ (1 :: Foo) == (False :: Bar)
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.hs b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.hs
new file mode 100644
index 0000000000..e9c79c8975
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.hs
@@ -0,0 +1,19 @@
+-- In case of types with nested type synonyms, all synonyms should be expanded
+
+{-# LANGUAGE RankNTypes #-}
+
+import Control.Monad.ST
+
+type Foo = Int
+type Bar = Bool
+
+type MyFooST s = ST s Foo
+type MyBarST s = ST s Bar
+
+fooGen :: forall s . MyFooST s
+fooGen = undefined
+
+barGen :: forall s . MyBarST s
+barGen = undefined
+
+main = print (runST fooGen == runST barGen)
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr
new file mode 100644
index 0000000000..6ded98e0bd
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr
@@ -0,0 +1,9 @@
+ExpandSynsFail2.hs:19:37: error:
+    Couldn't match type ‘Int’ with ‘Bool’
+    Expected type: ST s Foo
+      Actual type: MyBarST s
+    Type synonyms expanded:
+    Expected type: ST s Int
+      Actual type: ST s Bool
+    In the first argument of ‘runST’, namely ‘barGen’
+    In the second argument of ‘(==)’, namely ‘runST barGen’
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.hs b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.hs
new file mode 100644
index 0000000000..31afaf21b9
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.hs
@@ -0,0 +1,23 @@
+-- We test two things here:
+--
+-- 1. We expand only as much as necessary. In this case, we shouldn't expand T.
+-- 2. When we find a difference(T3 and T5 in this case), we do minimal expansion
+--    e.g. we don't expand both of them to T1, instead we expand T5 to T3.
+
+module Main where
+
+type T5 = T4
+type T4 = T3
+type T3 = T2
+type T2 = T1
+type T1 = Int
+
+type T a = Int -> Bool -> a -> String
+
+f :: T (T3, T5, Int) -> Int
+f = undefined
+
+a :: Int
+a = f (undefined :: T (T5, T3, Bool))
+
+main = print a
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr
new file mode 100644
index 0000000000..65d91351f5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr
@@ -0,0 +1,11 @@
+ExpandSynsFail3.hs:21:8: error:
+    Couldn't match type ‘Int’ with ‘Bool’
+    Expected type: T (T3, T5, Int)
+      Actual type: T (T5, T3, Bool)
+    Type synonyms expanded:
+    Expected type: T (T3, T3, Int)
+      Actual type: T (T3, T3, Bool)
+    In the first argument of ‘f’, namely
+      ‘(undefined :: T (T5, T3, Bool))’
+    In the expression: f (undefined :: T (T5, T3, Bool))
+    In an equation for ‘a’: a = f (undefined :: T (T5, T3, Bool))
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.hs b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.hs
new file mode 100644
index 0000000000..1007594920
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.hs
@@ -0,0 +1,11 @@
+-- Synonyms shouldn't be expanded since type error is visible without
+-- expansions. Error message should not have `Type synonyms expanded: ...` part.
+
+module Main where
+
+type T a = [a]
+
+f :: T Int -> String
+f = undefined
+
+main = putStrLn $ f (undefined :: T Bool)
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr
new file mode 100644
index 0000000000..bae53ce104
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr
@@ -0,0 +1,7 @@
+ExpandSynsFail4.hs:11:22: error:
+    Couldn't match type ‘Bool’ with ‘Int’
+    Expected type: T Int
+      Actual type: T Bool
+    In the first argument of ‘f’, namely ‘(undefined :: T Bool)’
+    In the second argument of ‘($)’, namely ‘f (undefined :: T Bool)’
+    In the expression: putStrLn $ f (undefined :: T Bool)
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index a0a98e7e87..d1bf03b37e 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -368,3 +368,8 @@ test('T10351', normal, compile_fail, [''])
 test('T10534', extra_clean(['T10534a.hi', 'T10534a.o']),
      multimod_compile_fail, ['T10534', '-v0'])
 test('T10495', normal, compile_fail, [''])
+
+test('ExpandSynsFail1', normal, compile_fail, ['-fprint-expanded-synonyms'])
+test('ExpandSynsFail2', normal, compile_fail, ['-fprint-expanded-synonyms'])
+test('ExpandSynsFail3', normal, compile_fail, ['-fprint-expanded-synonyms'])
+test('ExpandSynsFail4', normal, compile_fail, ['-fprint-expanded-synonyms'])