[Haskell-cafe] question about GADT and deriving automatically a Show instance

TP paratribulations at free.fr
Fri May 17 16:32:44 CEST 2013


Hi everybody,

I have a question about deriving automatically a Show instance when using 
GADT.
It works in this situation:

----------------------------
{-# LANGUAGE GADTs #-}

data Male
data Female

data Person gender where
    Dead :: Person gender
    Alive :: { name :: String
              , weight :: Float
              , father :: Person gender } -> Person gender
     deriving Show

main = do

let a = Alive "Joe" 60 Dead :: Person Male
let b = Alive "Jim" 70 a :: Person Male

print a
print b
----------------------------

Indeed:

$ runghc test_show.hs 
Alive {name = "Joe", weight = 60.0, father = Dead}
Alive {name = "Jim", weight = 70.0, father = Alive {name = "Joe", weight = 
60.0, father = Dead}}


But when I replace "father :: Person gender" by "father :: Person gender2" 
in the code (this is one of the advantages of GADT: with a classical 
algebraic data type declaration, gender2 would have to be a type variable 
for the data type), I obtain:

Can't make a derived instance of `Show (Person gender)':
      Constructor `Alive' must have a Haskell-98 type
      Possible fix: use a standalone deriving declaration instead
    In the data declaration for `Person'

So I modify my code by removing "deriving Show", and adding the line:
----------------------------
instance Show (Person gender)
----------------------------

But now, I obtain:

$ runghc test_show.hs 
GHC stack-space overflow: current limit is 536870912 bytes.
Use the `-K<size>' option to increase it.

Why (I imagine this is because there is an infinite loop in the construction 
of the show function)? Is there any workaround?

Thanks,

TP




More information about the Haskell-Cafe mailing list