Illegal tuple constraint [GHC-77539]

Language extension: ConstraintKinds

Constraints are the part of a signature that defines the type classes that must be implemented for the types used to instantiate the type variables, found to the left of the double arrow (=>). In Haskell 2010, type class constraints are either:

This strict syntax is necessary because type classes do not themselves form types in Haskell 2010. This syntax does not admit nested parentheses or tuples.

With GHC’s ConstraintKinds extension, type classes form types that have kind Constraint, and instead of checking for a specific syntactic form, the type checker ensures that the constraint section of a signature has kind Constraint. Because tuples of types that have kind Constraint themselves have kind Constraint, nested tuples are allowed. This is especially convenient when defining type synonyms that stand for tuples of constraints.

Examples

Use of a tuple constraint

Message

TupleConstraint.hs:4:18: error: [GHC-77539]
    • Illegal tuple constraint: (Read a, Show a)
    • In the type signature:
        addFromString :: ((Read a, Show a), Num a) => String -> a -> String
    Suggested fix: Perhaps you intended to use ConstraintKinds
  |
4 | addFromString :: ((Read a, Show a), Num a) => String -> a -> String
  |                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Explanation

This file is written in Haskell 2010, which does not have ConstraintKinds. This means that a syntactic check is used to ensure that type class constraints form a single-level tuple, and this file does not satisfy that requirement. Either de-nesting the tuple or enabling ConstraintKinds fixes the issue.

TupleConstraint.hs
Before
{-# LANGUAGE Haskell2010 #-}
module TupleConstraint where

addFromString :: ((Read a, Show a), Num a) => String -> a -> String
addFromString x y = show (read x + y)
After
{-# LANGUAGE ConstraintKinds #-}
module TupleConstraint where

addFromString :: ((Read a, Show a), Num a) => String -> a -> String
addFromString x y = show (read x + y)