summaryrefslogtreecommitdiff
path: root/testsuite/tests/polykinds/T14174a.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/polykinds/T14174a.hs')
-rw-r--r--testsuite/tests/polykinds/T14174a.hs7
1 files changed, 4 insertions, 3 deletions
diff --git a/testsuite/tests/polykinds/T14174a.hs b/testsuite/tests/polykinds/T14174a.hs
index 82f418bc9d..bdd3d7ee88 100644
--- a/testsuite/tests/polykinds/T14174a.hs
+++ b/testsuite/tests/polykinds/T14174a.hs
@@ -1,14 +1,15 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module T14174a where
import Data.Kind
-data TyFun :: * -> * -> *
-type a ~> b = TyFun a b -> *
+data TyFun :: Type -> Type -> Type
+type a ~> b = TyFun a b -> Type
infixr 0 ~>
type family Apply (f :: k1 ~> k2) (x :: k1) :: k2