(issue tracker,) deriving multiple instances

hi, firstly, the "official" syb issue tracker is read-only. My real question is if the code below is not supposed to work, or if there exists a way to make it work. The direct cause of the error is obvious, and I can think of an (ugly) workaround (define different instances in separate modules), but I'd like to know if such usage of Data is considered bad for some reason. code, error and derived instance:
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-}
import Data.Data ( Data )
data Foo f = Foo (f Bool) (f Int)
deriving instance Data (Foo []) deriving instance Data (Foo Maybe)
ghc-7.10.3 error (ghc-8.0.1 shows the same general behaviour, though the internal identifiers are longer):
Main.hs: line 45, column 1: Multiple declarations of ‘$cr2C’ Declared at: Main.hs:44:1 Main.hs:45:1 Main.hs: line 45, column 1: Multiple declarations of ‘$tr2D’ Declared at: Main.hs:44:1 Main.hs:45:1 Main.hs: line 45, column 1: Duplicate type signatures for ‘$tr2D’ at Main.hs:44:1-31 Main.hs:45:1-34 Main.hs: line 45, column 1: Duplicate type signatures for ‘$cr2C’ at Main.hs:44:1-31 Main.hs:45:1-34
ghc -ddump-deriv for a single instance:
Derived instances: instance Data.Data.Data (Main.Foo []) where Data.Data.gfoldl k_a45I z_a45J (Main.Foo a1_a45K a2_a45L) = ((z_a45J Main.Foo `k_a45I` a1_a45K) `k_a45I` a2_a45L) Data.Data.gunfold k_a45M z_a45N _ = k_a45M (k_a45M (z_a45N Main.Foo)) Data.Data.toConstr (Main.Foo _ _) = Main.$cr3ji Data.Data.dataTypeOf _ = Main.$tr3gf
Main.$tr3gf :: Data.Data.DataType Main.$cr3ji :: Data.Data.Constr Main.$tr3gf = Data.Data.mkDataType "Foo" [Main.$cr3ji] Main.$cr3ji = Data.Data.mkConstr Main.$tr3gf "Foo" [] Data.Data.Prefix
participants (1)
-
lennart spitzner