No orphan warning for data instances
Consider three + one modules:
{-# LANGUAGE TypeFamilies #-}
module DF where
data family DF a
{-# LANGUAGE TypeFamilies #-}
module DI_A where
import DF
data instance DF [a] = DF_A a
{-# LANGUAGE TypeFamilies #-}
module DI_B where
import DF
data instance DF [a] = DF_B a
module Main where
import DF
import DI_A
import DI_B
main :: IO ()
main = print 'x'
When compiling or interpreting this, I get:
% ghci-9.2.0.20210422 -Wall Main.hs
GHCi, version 9.2.0.20210422: https://www.haskell.org/ghc/ :? for help
[1 of 4] Compiling DF ( DF.hs, interpreted )
[2 of 4] Compiling DI_A ( DI_A.hs, interpreted )
[3 of 4] Compiling DI_B ( DI_B.hs, interpreted )
[4 of 4] Compiling Main ( Main.hs, interpreted )
DI_A.hs:5:15: error:
Conflicting family instance declarations:
DF [a] -- Defined at DI_A.hs:5:15
DF [a] -- Defined at DI_B.hs:5:15
|
5 | data instance DF [a] = DF_A a
| ^^
Failed, three modules loaded.
Note: DI_A
was checked without any warnings.
Then (potentially a lot later) the conflict is found and reported.
The explanation is probably because type family
ies use the same check, and there defining instances with the same RHS in the different modules is fine, as there is no conflict (thought in that case warning would still make sense!). However with data family
ies that will never be the case, the conflict is guaranteed.
I expect some orphan warning already for the new datatype defined.
We get orphan warnings for the instances if we do data instance DF [a] = DF_A a deriving Show
, as neither Show
nor DF
is defined in that module, but we can argue that DF [a] = DF_A
is defined in this module, but the data-instance itself is orphan!