Import item suggests constructors/methods [GHC-99623]
Flag: -Wdodgy-imports
Enabled by: -Wextra
When importing identifiers from a module, all in-scope constructors (for a type) or the in-scope methods (for a typeclass) can also be imported with the T(..)
syntax. However, if T
was exported abstractly as only T
- either its constructors/methods are not exported, or it lacks any - then this import item suggests that T has in-scope constructors/methods when it has none.
Examples
Import item suggests constructors/methods
When importing TypeWithoutVisibleCtrs
from module HiddenConstructors
, the import list item in module DodgyImports
suggests that this type has associated in-scope constructor(s). However it does not (the constructors are out of scope). The same is true of TypeWithNoCtrs
; the import item suggests it has constructors whereas it has none (either in or out of scope).
The solution is to import the type abstractly (without (..)
) to match its exporting.
Error Message
DodgyImports.hs:3:1: warning: [-Wdodgy-imports] [GHC-99623]
The import item ‘TypeWithoutVisibleCtrs(..)’ suggests that
‘TypeWithoutVisibleCtrs’ has (in-scope) constructors or class methods,
but it has none
|
3 | import HiddenConstructors ( TypeWithoutVisibleCtrs(..), TypeWithNoCtrs(..) )
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
DodgyImports.hs:3:1: warning: [-Wdodgy-imports] [GHC-99623]
The import item ‘TypeWithNoCtrs(..)’ suggests that
‘TypeWithNoCtrs’ has (in-scope) constructors or class methods,
but it has none
|
3 | import HiddenConstructors ( TypeWithoutVisibleCtrs(..), TypeWithNoCtrs(..) )
DodgyImports.hs
module DodgyImports where
import HiddenConstructors ( TypeWithoutVisibleCtrs(..), TypeWithNoCtrs(..) )
module DodgyImports where
import HiddenConstructors ( TypeWithoutVisibleCtrs, TypeWithNoCtrs )
HiddenConstructors.hs
module HiddenConstructors ( TypeWithoutVisibleCtrs, TypeWithNoCtrs ) where
data TypeWithoutVisibleCtrs = Ctr1 Int | Ctr2 | Ctr3 Bool Bool
data TypeWithNoCtrs
module HiddenConstructors ( TypeWithoutVisibleCtrs, TypeWithNoCtrs ) where
data TypeWithoutVisibleCtrs = Ctr1 Int | Ctr2 | Ctr3 Bool Bool
data TypeWithNoCtrs