
#7021: Tuple (and other exotic predicates) not yet handled in Template Haskell -------------------------+------------------------------------------------- Reporter: | Owner: goldfire | Status: new Type: | Milestone: 7.8.1 feature request | Version: 7.5 Priority: | Keywords: ConstraintKinds normal | TemplateHaskell Component: | Architecture: Unknown/Multiple Template Haskell | Difficulty: Unknown Resolution: | Blocked By: Operating System: | Related Tickets: Unknown/Multiple | Type of failure: | None/Unknown | Test Case: | Blocking: | -------------------------+------------------------------------------------- Comment (by goldfire): The classification of predicates is done by `classifyPredType`, in the Type module. From the definition of that function, any predicate not headed by a class, equality predicate, or tuple is "irreducible". Examples of these include predicates headed by type families or predicates headed by variables. Both of these possibilities require `ConstraintKinds`. Here is a full program that exhibits the problem: {{{ {-# LANGUAGE TemplateHaskell, PolyKinds, ConstraintKinds #-} module Irred where import Language.Haskell.TH data Proxy a = Proxy foo :: a b => Proxy a -> b foo = undefined $( do info <- reify 'foo reportWarning (show info) return [] ) }}} GHC 7.6.3 reports {{{ Can't represent irreducible predicates in Template Haskell: a b }}} Producing this error was admittedly harder than I thought. It turns out that !TcSplice and !DsMeta take rather different routes to translating into the TH syntax. (This is, of course, because !TcSplice is translating from Core while !DsMeta is translating from Haskell.) Only !TcSplice checks the classification of predicates. Using a TH quote with an "irreducible" predicate produces a `ClassP`, even on a type like `foo`'s type, above. I hope this helps! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/7021#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler