Update Trac ticket URLs to point to GitLab
[ghc.git] / testsuite / tests / indexed-types / should_fail / T4272.hs
1 {-# LANGUAGE TypeFamilies, ScopedTypeVariables, FlexibleContexts #-}
2
3 -- See also #5763 for why we don't really want to see
4 -- an occurs-check error from this program
5
6 module T4272 where
7
8 class Family f where
9 terms :: f a -> a
10
11 class Family (TermFamily a) => TermLike a where
12 type TermFamily a :: * -> *
13
14 laws :: forall a b. TermLike a => TermFamily a a -> b
15 laws t = prune t (terms (undefined :: TermFamily a a))
16
17 prune :: TermLike x => TermFamily x x -> TermFamily x x -> b
18 prune = undefined
19
20 -- terms :: Family f => f a -> a
21 -- Instantiate with f = TermFamily a
22 -- terms :: Family (TermFamily a) => TermFamily a a -> a
23 -- (terms (undefined::TermFamily a a) :: Family (TermFamily a) => a
24 -- So the call to prune forces the equality
25 -- TermFamily a a ~ a
26 -- which triggers an occurs check