[GHC] #10607: Auto derive from top to bottom
GHC
ghc-devs at haskell.org
Thu Mar 2 19:17:42 UTC 2017
#10607: Auto derive from top to bottom
-------------------------------------+-------------------------------------
Reporter: songzh | Owner: (none)
Type: feature request | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.11
Resolution: | Keywords: deriving,
| typeclass, auto
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: #13324 | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by RyanGlScott):
Ah. For your third problem, I have a suggestion which just might work.
`GHC.Exts` exports a handy type family:
{{{#!hs
type family Any :: k where {}
}}}
which inhabits any kind `k`. You can use `Any` as a handy workaround to
this `isInstance` limitation:
{{{#!hs
{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import GHC.Exts
char :: Q Bool
char = do
char_t <- [t| Char |]
isInstance ''Eq [char_t]
poly_a :: Q Bool
poly_a = do
poly_a_t <- [t| [Any] |]
isInstance ''Eq [poly_a_t]
pair :: Q Bool
pair = do
pair_t <- [t| (Any,Any) |]
isInstance ''Eq [pair_t]
}}}
Then `$(poly_a >>= stringE.show)` and `$(pair >>= stringE.show)` both give
`True`.
Granted, there are still some obscure corner cases for which this wouldn't
work, like if you only had `instance Eq [Int]` but not `instance Eq a =>
Eq [a]`. But for what you're trying to do, which is checking instances of
the form `instance (C a_1, ..., C a_n) => C (T a_1 ... a_n)`, it should
work great!
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10607#comment:20>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list