bmaxa@Branimirs-Air haskell % ghc -O2 dtchk.hs
Loaded package environment from /Users/bmaxa/.ghc/aarch64-darwin-8.10.7/environments/default
[1 of 1] Compiling Main ( dtchk.hs, dtchk.o )
Linking dtchk ...
bmaxa@Branimirs-Air haskell % ./dtchk
dtchk: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
undefined, called at dtchk.hs:10:5 in main:Main
bmaxa@Branimirs-Air haskell % cat dtchk.hs
{-# LANGUAGE FlexibleInstances, KindSignatures,
LiberalTypeSynonyms, StandaloneDeriving,
FlexibleContexts #-}
data Foo sx x = Foo sx x
deriving (Eq,Show)
data Bar (m :: * -> *) = Bar (m Int)
deriving instance Show a => Show (Bar (Foo a))
x :: Bar (Foo (Maybe Int))
x = undefined
deriving instance Eq a => Eq (Bar (Foo a))
main = print x
Greets, Branimir.
{-# LANGUAGE FlexibleInstances, KindSignatures, LiberalTypeSynonyms, StandaloneDeriving #-}
-- This works:
data Foo s x = Foo (s x) x
deriving (Eq)
-- This replacement doesn't:
{-
data Foo' sx x = Foo' sx x
deriving (Eq)
type Foo (s :: * -> *) (x :: *) = Foo' (s x) x
-}
data Bar (m :: * -> *) = Bar (m Int)
-- Neither of these typecheck:
x :: Bar (Foo Maybe)
x = undefined
deriving instance Eq (Bar (Foo Maybe))