[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