Conflicting definitions [GHC-10498]
GHC does not allow the same entity to have more than one definition. In some contexts it can figure out which one is supposed to shadow another: local definitions take priority over global definitions, etc. Shadowing is just a warning, GHC-63397. However, if the definitions are on the same level it becomes a fatal error.
Examples
Duplicate function arguments
Lib.hs:4:14: error: [GHC-10498]
• Conflicting definitions for ‘x’
Bound at: Lib.hs:4:14
Lib.hs:4:16
• In an equation for ‘areDifferent’
|
4 | areDifferent x x = Nothing
|
Advanced topic: somewhat surprisingly, you are allowed to duplicate arguments of type-level functions as in
{-# LANGUAGE DataKinds, TypeFamilies #-}
type family IsElem x xs where
IsElem _ '[] = 'False
IsElem x (x ': xs) = 'True
IsElem x (_ ': xs) = IsElem x xs
Lib.hs
Before
module Lib where
areDifferent :: a -> a -> Maybe (a, a)
areDifferent x x = Nothing
areDifferent x y = Just (x, y)
After
module Lib where
areDifferent :: Eq a => a -> a -> Maybe (a, a)
areDifferent x y
| x == y = Nothing
areDifferent x y = Just (x, y)
Duplicate datatype parameters
Lib.hs:3:11: error: [GHC-10498]
Conflicting definitions for ‘a’
Bound at: Lib.hs:3:11
Lib.hs:3:13
|
3 | data Pair a a = Pair a a
|
Lib.hs
Before
module Lib where
data Pair a a = Pair a a
After
module Lib where
data Pair a = Pair a a
Just a typo
Lib.hs:7:1: error: [GHC-29916]
Multiple declarations of ‘function’
Declared at: Lib.hs:4:1
Lib.hs:7:1
|
7 | function _ = 4
|
Because of a typo (functlon
instead of function
)
GHC parses the third equation as a definition of
functlon
(without a type signature), while the fourth
equation becomes a separate, conflicting definition of function
.
Lib.hs
Before
module Lib where
function :: Int -> Int
function 1 = 1
function 2 = 2
functlon 3 = 3
function _ = 4
After
module Lib where
function :: Int -> Int
function 1 = 1
function 2 = 2
function 3 = 3
function _ = 4
Implicit duplication because of `RecordWildCards`
Lib.hs:8:9: error: [GHC-10498]
• Conflicting definitions for ‘x’
Bound at: Lib.hs:8:9-10
Lib.hs:8:13
• In an equation for ‘foo’
|
8 | foo Foo{..} x = x + y
|
Consider using NamedFieldPuns
to be more explicit
about which variables are bound where.
Lib.hs
Before
{-# LANGUAGE RecordWildCards #-}
module Lib where
data Foo = Foo { x :: Int, y :: Int }
foo :: Foo -> Int -> Int
foo Foo{..} x = x + y
After
{-# LANGUAGE NamedFieldPuns #-}
module Lib where
data Foo = Foo { x :: Int, y :: Int }
foo :: Foo -> Int -> Int
foo Foo{y} x = x + y