From d071627932f61a20223ff0875ed96452f9e81b34 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Sat, 17 Aug 2019 08:27:35 -0400
Subject: Fix #17067 by making data family type constructors actually injective

`TcTyClsDecls.tcFamDecl1` was using `NotInjective` when creating data
family type constructors, which is just plain wrong. This tweaks it
to use `Injective` instead.

Fixes #17067.
---
 compiler/typecheck/TcTyClsDecls.hs                 |  5 +++--
 testsuite/tests/typecheck/should_compile/T17067.hs | 11 +++++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 3 files changed, 15 insertions(+), 2 deletions(-)
 create mode 100644 testsuite/tests/typecheck/should_compile/T17067.hs

diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index b9e51fa1f5..91536e5d23 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1938,11 +1938,12 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
   ; let (_, final_res_kind) = splitPiTys res_kind
   ; checkDataKindSig DataFamilySort final_res_kind
   ; tc_rep_name <- newTyConRepName tc_name
-  ; let tycon = mkFamilyTyCon tc_name binders
+  ; let inj   = Injective $ replicate (length binders) True
+        tycon = mkFamilyTyCon tc_name binders
                               res_kind
                               (resultVariableName sig)
                               (DataFamilyTyCon tc_rep_name)
-                              parent NotInjective
+                              parent inj
   ; return tycon }
 
   | OpenTypeFamily <- fam_info
diff --git a/testsuite/tests/typecheck/should_compile/T17067.hs b/testsuite/tests/typecheck/should_compile/T17067.hs
new file mode 100644
index 0000000000..2666c4cf2b
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17067.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeFamilies #-}
+module T17067 where
+
+import Data.Kind
+
+data family D1 a
+data family D2 :: Type -> Type
+
+type family F a
+type instance F (D1 a) = a
+type instance F (D2 a) = a
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index e393fe41c7..9a91f4ea9c 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -686,3 +686,4 @@ test('UnliftedNewtypesDifficultUnification', normal, compile, [''])
 test('T16832', normal, ghci_script, ['T16832.script'])
 test('T16946', normal, compile, [''])
 test('T17007', normal, compile, [''])
+test('T17067', normal, compile, [''])
-- 
cgit v1.2.1