#7459: deriving Generic does not work with TypeLits
--------------------------------------+-------------------------------------
Reporter:  maxtaldykin                |          Owner:                  
    Type:  bug                        |         Status:  new             
Priority:  normal                     |      Component:  Compiler        
 Version:  7.6.1                      |       Keywords:                  
      Os:  Unknown/Multiple           |   Architecture:  Unknown/Multiple
 Failure:  GHC rejects valid program  |      Blockedby:                  
Blocking:                             |        Related:                  
--------------------------------------+-------------------------------------
 {{{
 {-# LANGUAGE DataKinds, KindSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}

 import GHC.TypeLits
 import GHC.Generics

 data F (a :: Symbol)
 data X = X (F "hello") deriving Generic
 }}}

 Trying to derive Generics instance for simple datatype with Symbol inside
 but GHC complains:

 {{{
   Can't make a derived instance of `Generic X':
      X must not have unlifted or polymorphic arguments
    In the data declaration for `X'
 }}}


 I found that this could be fixed by adding single line to isTauTy:

 {{{
 --- a/compiler/typecheck/TcType.lhs
 +++ b/compiler/typecheck/TcType.lhs
 @@ -899,6 +899,7 @@ mkTcEqPred ty1 ty2
  isTauTy :: Type -> Bool
  isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
  isTauTy (TyVarTy _)      = True
 +isTauTy (LitTy _)        = True
  isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
  isTauTy (AppTy a b)      = isTauTy a && isTauTy b
  isTauTy (FunTy a b)      = isTauTy a && isTauTy b
 }}}

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

_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to