From 8426a1364ba450fe48fc41a95b2ba76c8d1bb7c8 Mon Sep 17 00:00:00 2001 From: Krzysztof Gogolewski Date: Mon, 24 Aug 2020 16:13:18 +0200 Subject: Add a test for #18585 --- testsuite/tests/typecheck/should_compile/T18585.hs | 48 ++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 49 insertions(+) create mode 100644 testsuite/tests/typecheck/should_compile/T18585.hs diff --git a/testsuite/tests/typecheck/should_compile/T18585.hs b/testsuite/tests/typecheck/should_compile/T18585.hs new file mode 100644 index 0000000000..634675f5f5 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T18585.hs @@ -0,0 +1,48 @@ +{-# Language DataKinds #-} +{-# Language FlexibleContexts #-} +{-# Language PolyKinds #-} +{-# Language StandaloneKindSignatures #-} +{-# Language TypeFamilyDependencies #-} +{-# Language UndecidableInstances #-} +{-# Language UndecidableSuperClasses #-} +module T18585 (Functor(..)) where + +import Data.Kind (Type) +import Prelude hiding (Functor(..)) + +type Cat i = i -> i -> Type + +class + ( Op (Op k) ~ k + , Category (Op k) + ) => Category (k :: Cat i) where + type Op k :: i -> i -> Type + type Op k = Y k + +newtype Y k a b = Y (k b a) + +instance (Category k, Op k ~ Y k) => Category (Y k) where + type Op (Y k) = k + +instance Category (->) + +type SelfDom :: (i -> j) -> Cat i -> Cat i +type family SelfDom (f :: i -> j) (k :: Cat i) :: Cat i where + SelfDom p p = Op p + SelfDom f p = p + +type family DefaultCat (i :: Type) = (res :: Cat i) | res -> i +type instance DefaultCat Type = (->) + +class + ( Category (Dom f) + , Category (Cod f) + ) => Functor (f :: i -> j) where + + type Dom f :: Cat i + type Dom (f :: i -> j) = SelfDom f (DefaultCat i) + + type Cod f :: Cat j + type Cod (f :: i -> j) = DefaultCat j + +instance Functor IO diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index b2dc105b60..9e59160ccf 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -721,4 +721,5 @@ test('T18118', normal, multimod_compile, ['T18118', '-v0']) test('T18412', normal, compile, ['']) test('T18470', normal, compile, ['']) test('T18323', normal, compile, ['']) +test('T18585', normal, compile, ['']) -- cgit v1.2.1