#6031: Cannot derive instances for empty datatypes defined in other modules
------------------------------+---------------------------------------------
 Reporter:  dreixel           |          Owner:                  
     Type:  bug               |         Status:  new             
 Priority:  normal            |      Component:  Compiler        
  Version:  7.5               |       Keywords:                  
       Os:  Unknown/Multiple  |   Architecture:  Unknown/Multiple
  Failure:  None/Unknown      |       Testcase:                  
Blockedby:                    |       Blocking:                  
  Related:                    |  
------------------------------+---------------------------------------------
 In file A.hs:
 {{{
 module A where

 data Empty
 }}}

 In file B.hs:
 {{{
 {-# LANGUAGE StandaloneDeriving #-}

 module B where

 import A

 deriving instance Show Empty
 }}}

 GHC 7.5.20120421 reports:
 {{{
     Can't make a derived instance of `Show Empty':
       The data constructors of `Empty' are not all in scope
         so you cannot derive an instance for it
     In the stand-alone deriving instance for `Show Empty'
 }}}

 But `Empty` has no constructors, and the problem does not arise if `Empty`
 is declared in `B`.

 I guess the problem is in this part of the code of `TcDeriv`:
 {{{
            ; let hidden_data_cons = not (isWiredInName (tyConName rep_tc))
 &&
                                     (isAbstractTyCon rep_tc ||
                                      any not_in_scope (tyConDataCons
 rep_tc))
                  not_in_scope dc  = null (lookupGRE_Name rdr_env
 (dataConName dc))
            ; unless (isNothing mtheta || not hidden_data_cons)
                     (bale_out (derivingHiddenErr tycon))
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/6031>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler

_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to