The latest official version of the Haskell standard was published in 2010. Since then, GHC, the most popular Haskell compiler, has grown almost 100 extensions which modify the language, sometimes quite drastically. Many of them have proven popular, to the point where it’s rare to find a library on Hackage that doesn’t use any extensions.
This is a problem for students of Haskell since most teaching materials only cover the base standard, leaving learners to fend for themselves in the extension jungle. This guide aims to make the journey a little easier. To that end, I sort GHC’s extensions into four tracks:
- The basic track contains extensions that are generally simple and either commonly used or particularly useful for Haskell beginners. I also consider most of these extensions future-proof, in the sense that a future Haskell standard would probably include them without major changes.
- The advanced track contains extensions that are useful, but either more complex or less popular than the ones in the basic track. This includes a bunch of ‘special interest’ extensions that are only relevant if you want to do particular things with Haskell.
- The questionable track contains extensions that you probably shouldn’t use – either because they are actively unhelpful (badly designed or deprecated), or because they have failed to gain much adoption.
- The miscellaneous track contains extensions that wouldn’t fit in anywhere else.
Each track is subdivided into topics that are mostly independent, so you can pick and choose according to your interests. Which extension belongs into which track is of course a matter of opinion, so take mine with a grain of salt.
For each extension, I provide the following information:
- The GHC version which first introduced the extension. Note that some extensions have been changed considerably in later GHC versions, so there may be surprises lurking if you use extensions with older GHCs. When in doubt, consult the User’s Guide for your GHC version.
- An estimate of how stable the extension is. GHC doesn’t provide formal
stability guarantees for extensions, so this is just my outside view of the
situation. Possible classifications are:
- Stable: the extension is well-established and I don’t expect its design to change much anymore.
- Mostly stable: The extension’s core design is stable, but details are somewhat likely to change.
- Unstable: it is at least possible that the extension will be changed significantly in future GHC versions.
- A link to the relevant section of the GHC User’s Guide. This is your primary reference, but it often contains a bunch of technical details that may obscure the ‘essence’ of an extension.
- Links to external tutorials where available. You should take a look at these before diving into the User’s Guide.
- A brief explanation of what the extension is all about. This is intended as a primer which allows you to determine if the extension is something worth knowing about. It’s not a full tutorial, and certainly not a reference.
Please let me know if I’ve made any mistakes. I don’t know many of these extensions too well myself, so there’s a good chance that some of the explanations are wrong. Also, if you have a suggestion for how to explain things more clearly (structure, choice of examples, etc.), I’d be grateful for that as well.
Of course, I’m not the first to cover the topic of GHC extensions. Some alternative takes:
- Stephen Diehl’s excellent, exhaustive and exhausting collection of knowledge, What I Wish I Knew When Learning Haskell, includes a list of extensions similar in spirit to this guide.
- Doug Beardsley provides a list of extensions sorted by how viable they are in a commercial setting.
- Alexis King’s Opinionated Guide to Haskell in 2018 contains a section with extensions that should be enabled by default.
- Alexander Altman has written a Guide to GHC Extensions for the School of Haskell, providing a mini-tutorial for each extension. For all extensions he covers, I provide a link in the relevant section of this guide.
- Oliver Charles (and guest authors) ran a blog post series on GHC extensions, called 24 Days of GHC Extensions, which I also frequently link to.
Contents
- 1 Language Standards
- 2 Enabling GHC Extensions
- 3 Basic Track
- 4 Advanced Track
- 5 Questionable Track
- 6 Miscellaneous Track
1 Language Standards
There are essentially two versions of the Haskell standard: Haskell98 and Haskell2010. Haskell2010 is a conservative evolution of Haskell98 which just makes the language better, so there’s no reason to limit yourself to Haskell98. Consequently, this guide only covers extensions that aren’t in Haskell2010, and when I say “standard Haskell”, I mean Haskell2010.
Some day, we will hopefully see a new version of the standard that incorporates GHC’s more well-established extensions. Efforts in this direction are underway, but they’re moving so slowly that it’s hard to tell whether they’re moving at all. In the meantime, the pragmatic choice is to treat Haskell as an implementation-defined language and to use a conservative subset of GHC’s extensions.
2 Enabling GHC Extensions
It is good practice to specify exactly which extensions you are using. That way, if someone tries to compile your code with a different compiler (like GHCJS or Eta), the compiler can fail early if it doesn’t support all the extensions you rely on. There are two main ways to enable extensions:
You can enable extensions in a specific source file by adding a
LANGUAGE
pragma at the top of the file:{-# LANGUAGE Extension1, Extension2 #-} module Mod where ...
If the file is part of a Cabal project, you should also add the extensions to your Cabal file’s
other-extensions
field(s). Theother-extensions
field goes in a component block (library
,executable
,test-suite
orbenchmark
) and should list all extensions used by the source files of that component.You can enable an extension globally in your project by adding it to a
default-extensions
field in your Cabal file:library lib default-extensions: Extension1, Extension2 ...
default-extensions
works likeother-extensions
, but the listed extensions are enabled automatically for all source files belonging to the field’s component.
For some discussion on which style to prefer, see here, here and here.
3 Basic Track
3.1 Syntactic Niceties
3.1.1 TupleSections
Since 6.12 | Stable | User’s Guide | School of Haskell
Write (x,,)
instead of \y z -> (x, y, z)
.
3.1.2 LambdaCase
Since 7.6.1 | Stable | User’s Guide | School of Haskell
Instead of
-> case x of
\x 1 -> True
-> False _
write
case
\1 -> True
-> False _
3.1.3 MultiWayIf
Since 7.6.1 | Stable | User’s Guide | School of Haskell
Instead of
if n == m
then x
else if n == k
then y
else z
write
if | n == m -> x
| n == k -> y
| otherwise -> z
3.1.4 BlockArguments
Since 8.6.1 | Unstable | User’s Guide
If you want to apply a function to a do
block, you usually need to use the
$
operator:
= f $ do
main ...
This extension allows you to omit the $
and directly give the do
block
as an argument. This also works with lambdas, case
statements and other
blocks: (f \x -> y)
is now equivalent to (f (\x -> y))
.
3.1.5 TypeOperators
Since 6.8.1 | Stable | User’s Guide
In Haskell2010, expressions like (+)
in a type are parsed as type variables,
which is not very useful. This extension allows you to use operators as names
for type constructors, type synonyms etc.:
type a + b = Either a b
Note that starting with GHC 8.6, using *
as a type operator may lead to
trouble. See StarIsType
.
3.1.6 NumericUnderscores
Since 8.6.1 | Stable | User’s Guide
Write 100_000_001
instead of 100000001
.
3.2 Overloaded Literals
3.2.1 OverloadedStrings
Since 6.8.1 | Stable | User’s Guide | School of Haskell | 24 Days
Overload string literals, similar to numeric literals. This means that
"a string"
has type IsString a => a
, and you can define your own instances
of IsString
. For example, a library for regular expressions might define an
instance IsString Regex
that parses regular expressions, enabling you to write
r :: Regex
= "^x$" r
3.2.2 OverloadedLists
Since 7.8.1 | Mostly stable | User’s Guide
Overload list literals, similar to numeric literals (and string literals with
OverloadedStrings
). This means that [1, 2]
has type
(IsList l, Num (Item l)) => l
. (Item
is an associated type of the IsList
class; see TypeFamilies
.) You can then define instances of
IsList
for list-like types like vectors and sets and write
s :: Set
= [1, 2, 3] s
3.3 Patterns
3.3.1 ViewPatterns
Since 6.10.1 | Stable | User’s Guide | School of Haskell | 24 Days
A view pattern lets you apply a function as part of a pattern, then match against the result of that function. So instead of
toNonEmpty :: Set a -> Maybe (NonEmpty a)
= case toList s of
toNonEmpty s -> Nothing
[] :xs) -> x :| xs (x
write
toNonEmpty :: Set a -> Maybe (NonEmpty a)
-> [] ) = Nothing
toNonEmpty (toList -> (x:xs)) = x :| xs toNonEmpty (toList
3.3.2 PatternSynonyms
Since 7.8.1 | Mostly stable | User’s Guide | School of Haskell | 24 Days
Pattern synonyms allow you to define additional patterns for a type. For example, you can define a pattern that matches on the first two elements of a list:
pattern Head2 x y <- (x:y:_)
firstTwo :: [a] -> Maybe (a, a)
Head2 x y) = Just (x, y)
firstTwo (= Nothing firstTwo _
Pattern synonyms are useful when you want to hide the representation of a
datatype. For example, the containers
package defines a type Seq
representing finite lists. It is implemented as a special sort of tree, but the
implementation is not exposed. Instead, the package defines pattern synonyms
like Empty
and :<|
which allow you to match on a Seq
as if it were a list:
head :: Seq a -> Maybe a
head Empty = Nothing
head (x :<| _) = Just x
3.4 Type System
3.4.1 ExplicitForAll
Since 6.12.1 | Stable | User’s Guide | School of Haskell
The type signature f :: a -> b -> b
means that for all types a
and b
, we
have a function from a
and b
to b
. For example, f
can be used as a
function Int -> Bool -> Bool
, where a := Int
and b := Bool
.
ExplicitForAll
allows us to make this “for all” explicit1
by writing
f :: forall a b. a -> b -> b
This is exactly the same type signature as above. Of course, that’s not very
useful by itself, but the explicit forall
becomes relevant in combination with
the next three extensions.
3.4.2 TypeApplications
Since 8.0.1 | Stable | User’s Guide | Kwang Yul Seo
A polymorphic function like
id :: forall a. a -> a
is really a function with two arguments: One type, a
, and one value of type
a
. TypeApplications
allows you to give the type argument explicitly:
f :: Int -> Int
= id @Int x f x
This is particularly useful when combined with GHCi’s :t
command, which you
can use to view specialised type signatures:
> :t foldr
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
> :t foldr @[] @Int @Bool
foldr @[] @Int @Bool :: (Int -> Bool -> Bool) -> Bool -> [Int] -> Bool
3.4.3 ScopedTypeVariables
Since 6.8.1 | Stable | User’s Guide | 24 Days | School of Haskell
Consider the following slightly-contrived-for-demonstration-purposes
implementation of the minimum
function:
minimum :: forall a. Ord a => [a] -> Maybe a
minimum [] = Nothing
minimum xs = Just $ foldl1' go xs
where
go :: a -> a -> a
= min go
GHC doesn’t accept this (even with ExplicitForAll
) because
from its point of view, the a
in minimum
’s type signature and the a
in
go
’s type signature are different variables that just happen to share the same
name. Therefore, we don’t have a constraint Ord a
in go
, and so we can’t use
min
(a method of Ord
).
With ScopedTypeVariables
, our definition of minimum
is accepted: Both a
s
are now considered the same type variable, and the Ord a
constraint from
minimum
‘trickles down’ to go
.
Caveat: This only works because we quantify over a
explicitly with forall a
.
If we omit the forall a
, we get the same error as before.
3.4.4 RankNTypes
Since 6.8.1 | Stable | User’s Guide | School of Haskell | 24 Days | Gregor Riegler | Chris Done
The ST
monad
can be used to safely run stateful computations. To run an ST
computation, you
use the function runST
, which has type
runST :: forall a. (forall s. ST s a) -> a
This function has one type argument, a
, and one value argument of type forall s. ST s a
. RankNTypes
is required to allow this argument type, because it
contains a forall
– without RankNTypes
, the only place where a forall
may
appear is at the beginning of a type signature.
The meaning of this argument type is that the argument must be polymorphic in
s
, meaning that the argument must have type ST s a
for any s
and some
a
. Contrast this with the different type signature
runST :: forall a s. ST s a -> a
This allows us to pass m :: ST Int Bool
as an argument to runST
, setting a := Bool
and s := Int
. With the correct signature of runST
, on the other
hand, m
cannot be used as an argument because it would have to be of type ST s Bool
for any s
.
RankNTypes
is arguably an advanced extension, but it is required for ST
,
which is in base
.
3.4.5 LiberalTypeSynonyms
Since 6.8.1 | Stable | User’s Guide | School of Haskell
Standard Haskell places a lot of restrictions on type synonyms; for example, you
can’t use forall
in a type synonym. LiberalTypeSynonyms
lifts most of these
restrictions, which can occasionally come in handy.
3.5 Records
3.5.1 NamedFieldPuns
Since 6.10.1 | Stable | User’s Guide | Wikibook
Suppose we have a record storing some configuration:
data Configuration = Configuration
localHost :: String
{ localPort :: Int
,...
, }
To extract only some data out of a Configuration
, we can use record pattern
matching syntax:
localAddr :: Configuration -> String
Configuration { localHost = localHost, localPort = localPort }
localAddr = localHost ++ ":" ++ show localPort
Obviously, writing field = field
gets old quickly. NamedFieldPuns
reduces
the noise:
localAddr :: Configuration -> String
Configuration { localHost , localPort }
localAddr = localHost ++ ":" ++ show localPort
3.5.2 RecordWildCards
Since 6.8.1 | Stable | User’s Guide | 24 Days | Kwang Yul Seo
This extension takes the principle behind NamedFieldPuns
one step further: We can now write (continuing the example):
localAddr :: Configuration -> String
Configuration { .. }
localAddr = localHost ++ ":" ++ show localPort
The { .. }
is equivalent to writing one field pun for every field of
Configuration
.
3.6 Classes
3.6.1 FlexibleInstances
Since 6.8.1 | Stable | User’s Guide
Haskell2010 doesn’t allow you to write instances like
instance C (Maybe Int) where ...
because Maybe
must only be applied to type variables. FlexibleInstances
lifts this restriction. Additionally, it allows you to declare instances for
type synonyms.
3.6.2 FlexibleContexts
Since 6.8.1 | Stable | User’s Guide
Haskell2010 places some restrictions on the superclass constraints that can
appear in a class declaration. FlexibleContexts
lifts these restrictions.
3.6.3 DeriveFunctor
, DeriveFoldable
, DeriveTraversable
Since 7.10.1 | Stable | User’s Guide | 24 Days
This adds Functor
, Foldable
and Traversable
to the list of classes that
GHC can derive for you automatically. So, if you ever need to define your own
list type, you get almost every relevant function for free.
3.6.4 GeneralizedNewtypeDeriving
Since 6.8.1 | Stable | User’s Guide | 24 Days
In Haskell land, we like to introduce lots of newtype
s to prevent errors:
newtype Dollars = Dollars Int
Yet that also forces us to write lots of boilerplate instances:
instance Num Dollars where
Dollars x + Dollars y = Dollars (x + y)
Dollars x * Dollars y = Dollars (x * y)
...
All we do here is wrap and unwrap the Dollar
constructor. With
GeneralizedNewtypeDeriving
, GHC can write these instances for us:
newtype Dollars = Dollars Int
deriving (Num)
and this work for almost every class, not just the built-in Eq
, Ord
etc.
There is an unfortunate interaction between GeneralizedNewtypeDeriving
and
type families; see RoleAnnotations
.
However, that doesn’t need to concern you most of the time.
3.6.5 InstanceSigs
Since 7.6.1 | Stable | User’s Guide
This extension allows you to give type signatures in instances, which can be useful documentation:
data Result a = Success a | Failure
instance Functor Result where
fmap :: (a -> b) -> Result a -> Result b
fmap f (Success x) = Success $ f x
fmap f Failure = Failure
Without InstanceSigs
, the signature for fmap
would be illegal.
3.6.6 ConstrainedClassMethods
Since 6.8.1 | Stable | User’s Guide
Haskell2010 doesn’t allow you to have additional constraints on class methods,
so the following is disallowed (since f
, a class method, has an Eq
constraint):
class Foo a where
f :: Eq a => a -> a
ConstrainedClassMethods
lifts this (quoting the User’s Guide) “pretty stupid”
restriction.
3.6.7 MultiParamTypeClasses
Since 6.8.1 | Stable | User’s Guide | 24 Days | Wikibook | Dennis Gosnell
In standard Haskell, classes can only apply to a single type (here a
):
class Show a where ...
MultiParamTypeClasses
lifts this restriction, allowing us to write classes
that apply to multiple types. For example, the popular
mtl
package defines a class
class MonadReader r m where ...
which denotes monads m
that have access to a value of type r
. (That’s not
quite the whole story – MonadReader
needs an additional functional
dependency.)
Type families provide a better alternative to
MultiParamTypeClasses
in many cases, but the latter are older and still used
by many popular packages.
3.6.8 FunctionalDependencies
Since 6.8.1 | Stable | User’s Guide | 24 Days | Wikibook | Dennis Gosnell
With MultiParamTypeClasses
, you’ll soon encounter situations where some of a
class’s type parameters already determine another type parameter. For example,
with MonadReader
, if m
is Reader Int
, then r
can only be Int
, and this
applies generally: For every m
, there is at most one valid r
.
Functional dependencies let you express precisely this fact:
class MonadReader r m | m -> r where ...
The m -> r
is a functional dependency which tells GHC that for any m
, there
is at most one r
with instance MonadReader m r
(and GHC then won’t allow us
to declare multiple such instances). This is useful because it allows GHC to
infer r
from m
. Without the functional dependency, you would have to give a
lot more type annotations because GHC would frequently fail to infer which r
you mean.
3.6.9 DeriveGeneric
Since 7.2.1 | Mostly stable | User’s Guide | 24 Days | Mark Karpov | Danny Gratzer | Haskell Wiki
DeriveGeneric
enables deriving of the Generic
class, which provides support
for the popular GHC.Generics
flavour of generic programming. ‘Generic’ means
that you can define functions which work for a variety of datatypes, without
having to write separate code for each datatype.
The linked tutorials discuss how to write a library using generic programming,
which is an advanced topic. However, to use these libraries (for example
Aeson) you just need to
put a deriving Generic
next to your datatypes, which is why this extension is
in the basic track.
3.7 Typed Holes
3.7.1 Typed Holes and Type Wildcards
Since 7.8.1 | Mostly stable | User’s Guide | Chris Barrett | Haskell Wiki
Basic typed holes don’t require an extension and are enabled by default. They can occur in terms and in types.
In terms, you can write an underscore, called a hole, and GHC will tell you what type it expects you to fill in instead of the hole. For example, if you write
id :: a -> a
id x = _
then GHC will throw an error saying that it expects something of type a
and
that there is, conveniently, an x :: a
in scope.
In type signatures, you can write an underscore, called a type wildcard, and GHC will tell you what type it inferred. Continuing the example:
id :: a -> _
id x = x
In this case, GHC will throw an error telling you that the _
must stand for
a
. Of course, typed holes and type wildcards are much more interesting with
more complex functions and types.
3.7.2 NamedWildCards
Since 7.10.1 | Mostly stable | User’s Guide | School of Haskell
This extension allows you to add an arbitrary name to a type wildcard, so you can write
id :: _typeofid
id x = x
GHC will use the name in the error message. You can also use the same named wildcard multiple times in a signature, in which case GHC assumes that all its occurrences refer to the same type:
id :: _a -> _a
id x = x
Without this extension, _a
would be interpreted as a regular type variable.
3.7.3 PartialTypeSignatures
Since 7.10.1 | Mostly stable | User’s Guide | School of Haskell
When you use a type wildcard in a signature, you usually get an (informative) error. This extension turns these errors into warnings so you can use partial type signatures in your regular code. This lets you omit the boring parts of a complex type signature.
4 Advanced Track
4.1 Type System
4.1.1 ExistentialQuantification
Since 6.8.1 | Stable | User’s Guide | 24 Days | Wikibook | Arnaud Bailly | Jonathan Fischoff
An existentially quantified type allows you to ‘forget’ the type of a value,
typically remembering only that the type belonged to some class. For example, we
can define a type for any value that can be show
n:
data Showable = forall a. Show a => Showable a
intShowable :: Int -> Showable
= Showable n
intShowable n
stringShowable :: String -> Showable
= Showable s
stringShowable s
showShowable :: Showable -> String
Showable x) = show x showShowable (
As demonstrated by intShowable
and stringShowable
, a Showable
can contain
a value of any type, as long as that type implements the Show
class.
showShowable
demonstrates that we can use this fact to show a Showable
. Note
that we can’t do anything else with a Showable
: the existential type ‘forgets’
everything about the value contained in it except that it can be shown.
Existential types look like an obvious solution to various problems, but it often turns out that these problems are better solved in other ways. Jonathan Fischoff’s article lays out some alternatives to existential quantification.
4.1.2 GADTSyntax
Since 7.2.1 | Stable | User’s Guide | School of Haskell
Constructors can be understood as special functions whose return type is the
datatype to which they belong. For example, the Maybe
type has constructors
Just :: a -> Maybe a
Nothing :: Maybe a
GADTSyntax
provides an alternative syntax for datatype declarations which
reflects this understanding:
data Maybe a where
Just :: a -> Maybe a
Nothing :: Maybe a
GADTSyntax
lets you define exactly those datatypes which you can define
normally, so there’s not much reason to enable this extension, but we need it
for GADTs
.
4.1.3 GADTs
Since 6.8.1 | Stable | User’s Guide | Wikibook | Haskell Wiki | Matt Parsons
When you write a regular datatype in GADTSyntax
, the return
type of all constructors must be the datatype applied to its type variables. In
our example from above, the return type of every constructor is (and must be)
exactly Maybe a
:
data Maybe a where
Just :: a -> Maybe a
Nothing :: Maybe a
GADTs lift this restriction, so different constructors can instantiate the datatype’s type variables differently:
data RestrictedMaybe a where
JustInt :: Int -> RestrictedMaybe Int
JustString :: String -> RestrictedMaybe String
Nothing :: RestrictedMaybe a
A RestrictedMaybe
can contain either an Int
or a String
, but no other
types. This is not particularly useful, but the same principle can be applied to
define a wide variety of interesting types.
4.1.4 TypeFamilies
Since 6.8.1 | Stable | User’s Guide | 24 Days | mchaver | Haskell Wiki | Matt Parsons | Kwang Yul Seo
Type families are the cornerstone of contemporary type-level programming in Haskell, so if you want to write programmes with fancy types (or use certain libraries), you should probably learn about them. The basics are not so hard, though there are a fair few corner cases. A short description couldn’t really do the concept justice, so I just recommend the above tutorials. Matt Parsons in particular gives a concise overview of type-level programming which also covers several other extensions.
4.1.5 TypeFamilyDependencies
Since 8.0.1 | Mostly stable | User’s Guide | Jan Stolarek | Paper (pdf)
Type family dependencies (aka injective type families) are the equivalent of functional dependencies for type families.
4.1.6 AllowAmbiguousTypes
Since 7.8.1 | Mostly stable | User’s Guide
GHC has an ambiguity check which raises an error if a function looks like it
could never be called without leading to an ambiguous constraint. However, the
check is incomplete, meaning that it sometimes rejects functions which can, in
fact, be called. If you’re doing fancy type-level programming, you may therefore
need to disable the check with AllowAmbiguousTypes
(but you probably don’t).
Despite the scary name, this extension does not compromise type safety. If a function call leads to an ambiguous constraint, this is still an error. The only difference is that the error is reported at the function call, not at the function definition.
4.2 Kinds
4.2.1 KindSignatures
Since 6.8.1 | Stable | User’s Guide
This extension allows you specify the kinds of type variables (wherever type variables may occur). This can be used for documentation, and it’s sometimes necessary when working with fancy kinds. An unnecessarily verbose example:
class Functor (f :: * -> *) where
fmap :: forall (a :: *) (b :: *). (a -> b) -> f a -> f b
4.2.2 ConstraintKinds
Since 7.4.1 | Stable | User’s Guide | Kwang Yul Seo | Wolfgang Jeltsch
A constraint is anything that can appear to the left of the =>
arrow in a type
signature (mostly type class constraints like (Ord a, Eq b)
). Constraints are
type-like things which have a special kind, Constraint
. ConstraintKinds
makes this kind available, so you can define, for example, constraint synonyms:
type Serializable a = (Show a, Read a)
roundtrip :: Serializable a => a -> a
= read . show roundtrip
4.2.3 DataKinds
Since 7.4.1 | Mostly stable | User’s Guide | Matt Parsons | Kwang Yul Seo | Christian Marie
With DataKinds
enabled, when you define a data type like
data Nat = Zero | Succ Nat
you also get a kind 'Nat
corresponding to the type Nat
, as well as types
'Zero
and 'Succ
corresponding to the constructors Zero
and Succ
. Hence
-- 'Nat is a kind
'Zero :: 'Nat
'Succ :: 'Nat -> 'Nat
Together with type families, this allows you to compute, for example, natural numbers at the type level, much like you would at the value level.
4.2.4 PolyKinds
Since 7.4.1 | Mostly stable | User’s Guide
This extension enables kind-polymorphic types like the type-level identity
function (which of course requires TypeFamilies
):
type family Id (a :: k) :: k where
Id a = a
We can now apply Id
to types of different kinds:
type IdInt = Id Int -- kind *
type IdMonad = Id Monad -- kind (* -> *)
4.3 Empty Types
4.3.1 EmptyCase
Since 7.8.1 | Stable | User’s Guide
Haskell2010 allows you to define empty data types, which have no constructors.
The only value of such a type is undefined
. EmptyCase
allows you to match on
such values with a case
statement that has zero alternatives, corresponding to
the zero constructors:
data Void
absurd :: Void -> a
= case v of {} absurd v
4.3.2 EmptyDataDeriving
Since 8.4.1 | Mostly stable | User’s Guide
Haskell2010 does not allow you to derive the four standard type classes Eq
,
Ord
, Read
and Show
for empty types. This is a simple oversight, which this
extension fixes.
4.4 Classes
4.4.1 StandaloneDeriving
Since 6.8.1 | Stable | User’s Guide
deriving
clauses must usually be attached to a datatype declaration. This
extension allows you to derive classes ‘after the fact’, even in a different
module. Standalone deriving
clauses are also a little more liberal than
attached deriving
clauses; for example, they support some GADTs.
data Result a = Success a | Failure
deriving instance Eq a => Eq (Result a)
4.4.2 DefaultSignatures
Since 7.2.1 | Stable | User’s Guide | Mark Karpov | Danny Gratzer | Haskell Wiki
When declaring a class, you can give default implementations for some or all of the class methods:
class Eq a where
(==) :: a -> a -> Bool
== b = not (a /= b)
a
(/=) :: a -> a -> Bool
/= b = not (a == b) a
With DefaultSignatures
, you can give type signatures for default methods.
These can be more specific than the implemented method’s signature, so you can
provide a default implementation only if the type in question has instances of
other classes. For example, one could define
class Eq a where
(==) :: a -> a -> Bool
(==) :: Ord a => a -> a -> Bool
default== b = compare a b == EQ
a
instance Eq Int
instance Ord Int where
compare a b = ...
DefaultSignatures
is useful primarily for generic programming with
GHC.Generics
.
4.4.3 DeriveAnyClass
Since 7.10.1 | Stable | User’s Guide
This extensions allows you to write a deriving
clause for any class, and GHC
will simply generate an empty instance declaration (except for those classes
which it knows how to derive). This makes sense if there are default
implementations for all of the class’s methods, which happens frequently when
using GHC.Generics
. For example, we may define a pretty-printing class which
falls back to Show
(using DefaultSignatures
):
class Pretty a where
prettyPrint :: a -> String
prettyPrint :: Show a => a -> String
default= show
prettyPrint
data Stuff = Stuff
deriving (Show, Pretty)
4.4.4 DerivingStrategies
Since 8.2.1 | Mostly stable | User’s Guide | Ryan Scott
With both DeriveAnyClass
and
GeneralizedNewtypeDeriving
enabled, it is
unclear how to process the following declaration:
newtype N = N Int
deriving Num
GHC could either use the DeriveAnyClass
strategy and create an empty instance
declaration, or it could use GeneralizedNewtypeDeriving
. DerivingStrategies
allows you to specify which strategy you want:
newtype N = N Int
deriving newtype Num
4.4.5 DerivingVia
Since 8.6.1 | Unstable | User’s Guide | Paper (pdf)
With this extension, you can write
newtype N = N Int
deriving Semigroup via (Product Int)
Product Int
(from Data.Monoid
) is another newtype for Int
whose
Semigroup
instance uses multiplication. With the deriving via
clause, our
type N
‘inherits’ this Semigroup
instance. Another possible choice would be
deriving Semigroup via (Sum Int)
, in which case we would get a Semigroup
instance that uses addition.
A deriving via
clause requires that the type via which we are deriving
(here Product Int
) and the type whose instance we are deriving (N
) have
the same runtime representation (a machine integer).
4.4.6 QuantifiedConstraints
Since 8.6.1 | Unstable | User’s Guide | Ryan Scott | Paper (pdf)
This extension allows you to universally quantify constraints (i.e. to say that
a constraint C x
must be fulfilled for every x
). Using this feature, the
class of monad transformers, MonadTrans
, could be rewritten like this:
class (forall m. Monad m => Monad (t m)) => MonadTrans t where
...
The forall
-quantified constraint expresses our expectation that applying
the transformer t
to any monad m
should again result in a monad.
4.4.7 UndecidableInstances
Since 6.8.1 | Stable | User’s Guide | Dennis Gosnell
GHC places some restrictions on instance declarations to ensure that it can
always resolve instances in finite time. These restrictions are incomplete,
meaning that they disallow some instance declarations that are perfectly fine.
UndecidableInstances
can therefore be used to disable GHC’s checks. You should
not have to do this often.
4.4.8 UndecidableSuperClasses
Since 8.0.1 | Stable | User’s Guide | Edward Kmett (video)
GHC usually does not allow a class to be a superclass of itself, to ensure that typeclass resolution terminates. It can occasionally be useful to disable this check.
4.4.9 RoleAnnotations
Since 7.8.1 | Mostly stable | User’s Guide | Richard Eisenberg
GHC assigns every type variable (in datatypes, classes, etc.) a role. If a
type variable has the wrong role, GeneralizedNewtypeDeriving
can be used to
break type safety. GHC’s heuristics for role assignment mostly do the right
thing, but it can be necessary to help them out by specifying roles explicitly.
This extension allows you to do that.
Technically, you should think about roles whenever you write a type variable, but I’m not sure anyone actually does that.
4.5 Records
4.5.1 DisambiguateRecordFields
Since 6.8.1 | Stable | User’s Guide
Say you have two records with the same field name,
module M where
data UserPrefs = UserPrefs
user :: Int
{ prefs :: String
,
}
-----------------------------------
module N where
data Profile = Profile
user :: Int
{ profileData :: String
, }
Haskell2010 will only let you use the user
record selector qualified, even
where it’s entirely obvious which of the two record you mean. For example, the
following is not accepted (with M
imported):
updateProfile :: (Int -> Int) -> Profile -> Profile
Profile { user = oldUser, profile = profile }
updateProfile f = Profile { user = f oldUser, profile = profile}
With DisambiguateRecordFields
, GHC accepts this definition (if and only if
UserPrefs
and Profile
are defined in different modules). However, this only
works because both occurrences of user
are under a Profile
constructor.
4.5.2 DuplicateRecordFields
Since 8.0.1 | Stable | User’s Guide
Extending DisambiguateRecordFields
,
DuplicateRecordFields
allows multiple records in the same module to share a
field name.
Moreover, GHC can now sometimes disambiguate uses of record fields based on type
information. (DisambiguateRecordFields
, in contrast, only looks at whether
record fields occur under a constructor.) For example, the following is accepted:
updateProfile :: (Int -> Int) -> Profile -> Profile
= p { user = f $ user (p :: Profile) } updateProfile f p
Exactly when GHC can disambiguate record fields is a little tricky – for
instance, updateProfile
is not accepted without the type annotation on p
.
4.5.3 OverloadedLabels
Since 8.0.1 | Unstable | User’s Guide
With this extension, the new syntactic form #foo
is desugared to fromLabel @foo
, with fromLabel
a class method of
class IsLabel (x :: Symbol) a where
fromLabel :: a
(Symbol
is a type-level string.) GHC by itself defines no instances of
IsLabel
. As I understand it, this mechanism was intended to be used for
properly overloaded record fields, but it seems like there is no satisfying
solution to this problem yet.
4.6 Strictness
4.6.1 BangPatterns
Since 6.8.1 | Stable | User’s Guide | 24 Days | School of Haskell
With this extension, you can prefix a pattern with a bang (!
):
f :: Int -> Bool
!n = True f
When something is matched against the bang pattern, it will be evaluated to
weak head normal form before
the body of f
is evaluated. For example, consider the following programme:
fibonacci :: Int -> Int
0 = 0
fibonacci 1 = 1
fibonacci = fibonacci (n - 1) + fibonacci (n - 2)
fibonacci n
main :: IO ()
= print $ f (fibonacci 100) main
Running main
will take a while because it has to (very inefficiently) compute
fibonacci 100
before f
can return its result. Without the bang pattern, the
programme terminates almost instantly because we don’t actually need the result
of fibonacci 100
.
4.6.2 Strict
, StrictData
Since 8.0.1 | Mostly stable | User’s Guide | Johan Tibell
StrictData
makes all fields of datatypes strict by default. You can then use
~
to make some fields lazy again. For example, with StrictData
active, the
declaration
data D = D Int ~Double
is equivalent to the usual
data D = D !Int Double
Strict
works like StrictData
, but in addition to fields of datatypes, it
also makes most other things (patterns, let
/where
bindings, …) strict by
default.
4.7 Do
Notation
4.7.1 ApplicativeDo
Since 8.0.1 | Mostly stable | User’s Guide | Paper (pdf)
A definition like
= do
f <- mx
x <- my
y return $ g x y
is equivalent to f = g <$> mx <*> my
, which uses only Applicative
combinators.
Despite this, Haskell2010 will require a Monad
constraint – and use the
monadic combinators – as soon as you use do
syntax. ApplicativeDo
changes
this, allowing you to use do
notation with applicatives that aren’t also
monads. Moreover, for some monads, the applicative combinators are more
efficient than the monadic ones, in which case ApplicativeDo
may improve
performance.
4.7.2 RecursiveDo
Since 6.8.1 | Stable | User’s Guide | 24 Days | Roman Cheplyaka | Will Fancher
Some monads (lists, Maybe
, ST
, IO
, …) support a notion of cyclic
computation, in which a data structure is built by using parts of it that have
already been built. This is captured in the
MonadFix
class. RecursiveDo
adds some syntactic sugar so you can more easily write
recursive monadic computations.
4.8 Literals
4.8.1 NegativeLiterals
Since 7.8.1 | Stable | User’s Guide
The literal -1
is usually desugared to negate (fromInteger 1)
. With
NegativeLiterals
, it is instead desugared to fromInteger (-1)
. This should
not make a difference most of the time.
4.8.2 NumDecimals
Since 7.8.1 | Stable | User’s Guide
Floating-point literals like 2.1e6
usually have type Floating a => a
. With
NumDecimals
, floating point literals which denote integers, like 2e6
, have
type Num a => a
instead, so you can use scientific notation for integers.
4.8.3 BinaryLiterals
Since 7.10.1 | Stable | User’s Guide
This extension allows you to write integer literals in binary: 0b10
desugars
to fromInteger 2
.
4.8.4 HexFloatLiterals
Since 8.4.1 | Mostly stable | User’s Guide
This extension allows you to write floating point literals in hexadecimal, which corresponds closely to the underlying binary representation.
4.9 Template Haskell
4.9.1 TemplateHaskell
, TemplateHaskellQuotes
Since 6.0/8.01 | Mostly stable | User’s Guide | 24 Days | Mark Karpov | Matt Parsons | Haskell Wiki
Template Haskell is a major extension that allows you to generate code at compile time. Basically, you write Haskell programmes that generate Haskell code (i.e. abstract syntax trees). GHC then runs your programmes at compile time and combines the generated code with your regular code. This is very powerful because you can generate whatever code you want, but it’s also a bit of a sledgehammer with a bunch of rough edges.
TemplateHaskellQuotes
enables a safer, but also considerably less useful
subset of the TemplateHaskell
functionality.
4.9.2 QuasiQuotes
Since 6.10.1 | Stable | User’s Guide | Edsko de Vries
Quasi-quotes are an extension to Template Haskell which allow you to embed other languages into Haskell. For example:
query :: Query
= [sql| select * from users |] query
sql
is, in effect, a function which parses an SQL query from a user-provided
string at compile time, returning the Haskell type Query
.
4.9.3 DeriveLift
Since 7.2.1 | Stable | User’s Guide
Template Haskell makes use of a Lift
class to convert
expressions into abstract syntax trees. This extension allows you to have your
Lift
instances derived automatically.
4.10 Low-Level Hacking
4.10.1 MagicHash
Since 6.8.1 | Stable | User’s Guide
GHC likes to give its primitives names that end in a hash (#
). Haskell2010
disallows the hash in identifiers, so you have to enable MagicHash
to be able
to refer to these primitives.
4.10.2 UnboxedTuples
Since 6.8.1 | Stable | User’s Guide | Michael Snoyman
An unboxed tuple, written (# Int, Bool #)
, allows you to return multiple
values from a function without the overhead of a regular tuple (heap allocation,
pointer dereferencing, etc.). When you return an unboxed tuple, its contents
will be passed directly via registers or the stack.
4.10.3 UnboxedSums
Since 8.2.1 | Unstable | User’s Guide | Ömer Sinan Ağacan
An unboxed sum, written (# Int | Bool #)
, is like an anonymous sum type with
multiple alternatives. Unlike regular sum types, GHC will try to represent
unboxed sums as compactly as possible.
4.11 Safe Haskell
4.11.1 Safe
, Trustworthy
, Unsafe
Since 7.2.1/7.2.1/7.4.1 | Mostly stable | User’s Guide | Kristen Kozak (video with notes by Joe Nelson) | Edward Z. Yang | Paper (pdf)
Haskell has various features, like
unsafePerformIO
,
which can be (mis)used to circumvent the type system, module abstraction and
other desirable properties. Safe Haskell allows you to control the use of these
features to some degree, but I don’t think it ever really caught on.
4.12 Miscellaneous
4.12.1 CPP
Since forever | Stable | User’s Guide | Aelve
The C preprocessor is (unfortunately) the most common and easiest way to do simple compile-time metaprogramming. A typical use case is supporting different GHC versions, which sometimes requires slightly different code.
CPP is not technically an extension, but it is enabled with a {-# LANGUAGE CPP #-}
pragma (or a GHC flag).
4.12.2 NoImplicitPrelude
Since 6.8.1 | Stable | User’s Guide
The module Prelude
is usually imported implicitly in every module you write.
NoImplicitPrelude
disables this. This is useful if you want to use one of many
alternative preludes developed by the community, whose exported names frequently
clash with those from Prelude
.
4.12.3 RebindableSyntax
Since 7.0.1 | Mostly stable | User’s Guide | 24 Days
Certain syntactic forms desugar to ordinary Haskell functions. For example, do
syntax is desugared into applications of the >>=
and return
combinators;
literals N
are desugared into fromInteger N
; etc. Usually, this desugaring
uses fixed functions, so the fromInteger
is really Prelude.fromInteger
. With
RebindableSyntax
, the desugaring uses whatever functions are in scope, so you
can define your own fromInteger
and GHC will use that.
4.12.4 UnicodeSyntax
Since 6.8.1 | Stable | User’s Guide | Haskell Wiki
This extension allows you to use Unicode symbols for certain keywords, like ∀
instead of forall
. (Even without UnicodeSyntax
, you can use Unicode for
identifiers.)
4.12.5 NoMonomorphismRestriction
Since 6.8.1 | Stable | User’s Guide | Neil Mitchell | Stack Overflow | Haskell Wiki
The monomorphism restriction is a highly technical feature of Haskell’s type
system which sometimes makes GHC infer unexpected types for definitions without
an explicit type signature. Since GHC 7.8.1, it is on by default in compiled
modules, but off by default in GHCi. NoMonomorphismRestriction
allows you to
switch it off even in compiled modules, but there are subtle disadvantages to
this.
4.12.6 PostfixOperators
Since 7.10.1 | Stable | User’s Guide | School of Haskell
The operator section (56 !)
is usually equivalent to \y -> (!) 56 y
. With
PostfixOperators
, it is instead treated as (!) 56
, so you can define and use
postfix operators (though only with ugly parentheses):
(!) :: Int -> Int
!) n = product [1..n]
(
test :: Int
= (56 !) test
4.12.7 PackageImports
Since 6.10.1 | Stable | User’s Guide
With this extension, an import can specify which package to import from:
import "network" Network.Socket
This can be used if two packages you depend on define the same module, though that’s very rare in practice.
5 Questionable Track
5.1 Comprehensions
The extensions in this section aren’t particularly bad; they just have very few
users as far as I can tell, and I don’t give them much of a chance to get in a
future Haskell standard (except maybe ParallelListComp
).
5.1.1 ParallelListComp
Since 6.8.1 | Stable | User’s Guide | 24 Days
This extension extends list comprehension syntax so you can write
* y | x <- xs | y <- ys ] [ x
instead of
* y | (x, y) <- zip xs ys ] [ x
5.1.2 TransformListComp
Since 6.10.1 | Stable | User’s Guide | 24 Days
This extension adds SQL-inspired constructs like group by
and using
to the
list comprehension syntax. I’ve never seen this used in the wild.
5.1.3 MonadComprehensions
Since 7.2.1 | Stable | User’s Guide | 24 Days
As it turns out, list comprehension syntax can be sensibly used with any monad,
not just lists. MonadComprehensions
enables exactly that and includes the
features from ParallelListComp
and
TransformListComp
. I would argue, however, that the
comprehension syntax loses much of its intuitive appeal when used with other
monads.
5.2 Disabling Standard Features
5.2.1 NoTraditionalRecordSyntax
Since 7.4.1 | Stable | User’s Guide
This disables the usual record syntax, like C { f = x }
.
5.2.2 NoPatternGuards
Since 6.8.1 | Stable | User’s Guide
This disables pattern guards, which
are a Haskell2010 feature similar to ViewPatterns
.
5.3 Miscellaneous
5.3.1 Arrows
Since 6.8.1 | Stable | User’s Guide | 24 Days
Arrows
are a generalisation of monads. The Arrows
extension provides a notation for
these constructs, similar to do
notation for monads. Outside of the
Opaleye database library and
certain ‘arrowised’ functional reactive programming libraries, arrows have not
caught on in the community.
5.3.2 StaticPointers
Since 7.10.1 | Mostly stable | User’s Guide | 24 Days
Static Pointers allow you to get a reference to a closure (i.e. a computation, possibly with associated data) which can be serialised and deserialised. The intended use case is distributed programming, where computations can be turned into static pointers and then sent back and forth between nodes. However, as far as I know, the only user of this extension is Cloud Haskell.
5.3.3 ImplicitParams
Since 6.8.1 | Stable | User’s Guide
This extension allows you to have function parameters which are automatically propagated to calling functions. They have never caught on.
5.3.4 ExtendedDefaultRules
Since 6.8.1 | Mostly stable | User’s Guide | Kwang Yul Seo
The type of
show (sum [1..100])
is ambiguous: sum [1..100]
has type (Num a, Enum a) => a
and show
has type Show a => a -> String
– so which a
do we pick? Int
, Integer
and Double
would
all be candidates. For convenience, Haskell has a defaulting mechanism which
kicks in here: a
is defaulted to Integer
based on its constraints. (With
-Wtype-defaults
, GHC warns you about this.) ExtendedDefaultRules
applies
this principle to more classes than standard Haskell. This is intended for GHCi,
where ExtendedDefaultRules
is enabled by default. In normal code, you usually
want less defaulting, not more.
5.3.5 DeriveDataTypeable
Since 6.8.1 | Stable | User’s Guide | Chris Done
This extension allows you to derive instances of the
Data
class automatically. This class supports “Scrap your Boilerplate”-style generic
programming, which seems to have been mostly obsoleted by GHC.Generics
-style
generic programming.
Recent GHCs derive instances of
Typeable
without you even writing a deriving
clause, so you don’t need
DeriveDataTypeable
for that anymore.
5.3.6 NPlusKPatterns
Since 6.12.1 | Stable | User’s Guide
n+k patterns are a misfeature of Haskell98 that has been removed for Haskell2010, so this extension is effectively deprecated.
5.3.7 ImpredicativeTypes
Since 6.10.1 | Unstable | User’s Guide
Impredicative types have been effectively unsupported for a while. The User’s Guide says that “GHC has extremely flaky support for impredicative polymorphism”, which is probably a euphemism.
5.4 Deprecated Extensions
5.4.1 DatatypeContexts
Since 7.0.1 | Stable | User’s Guide
Haskell2010 allows you to put a context on datatype declarations:
data Ord a => Set a = ...
However, due to some weird design choices, this doesn’t work like you’d think and is pretty much useless.
5.4.2 NullaryTypeClasses
Since 7.8.1 | Stable | User’s Guide
A special case of MultiParamTypeClasses
.
5.4.3 OverlappingInstances
, IncoherentInstances
Since 6.8.1 | Mostly stable | User’s Guide
Consider the following situation:
class Foo a where
f :: a -> a
instance Foo a where
= id
f
instance Foo [a] where
= reverse f
The two instances overlap, meaning that if we look, say, for an instance Foo [Int]
, both instances match. This is disallowed by default. With
OverlappingInstances
, it is allowed and the more specific instance (the
second) will be chosen. With IncoherentInstances
, GHC doesn’t complain even if
there is no single most specific instance; it will choose an arbitrary one.
OverlappingInstances
and IncoherentInstances
are deprecated since GHC 7.10.1
because the same functionality is now provided by the OVERLAPPING
,
OVERLAPPABLE
, OVERLAPS
and INCOHERENT
pragmas (also explained in the
linked section of the User’s Guide). These are preferable because they apply to
a single instance, whereas the extensions disable the overlap checks for an
entire module.
5.4.4 TypeInType
Since 8.0.1 | Unstable | User’s Guide
In GHC versions prior to 8.6.1, TypeInType
merges the type and kind languages
of GHC, meaning that types and kinds become the same thing. This implies that
the type *
has kind *
; hence the extension’s name. It also means that
everything we can do at the type level (type synonyms, type families, etc.), we
can also do at the kind level.
Since GHC 8.6.1, TypeInType
is a deprecated alias of
PolyKinds
, DataKinds
and
KindSignatures
. Its functionality has been integrated
into these other extensions.
5.4.5 Rank2Types
Since 6.8.1 | Stable | User’s Guide
A more restricted form of RankNTypes
.
6 Miscellaneous Track
6.1 Extensions That Only Make Sense With Other Extensions
6.1.1 ExplicitNamespaces
Since 7.6.1 | Mostly stable | User’s Guide
With TypeOperators
, you can define the type (++)
. If you
want to export this type while the function (++)
is also in scope, you need to
be able to distinguish the two in the module export list. ExplicitNamespaces
allows you to do so, by writing
module M ((++), type (++)) where ...
The same works when importing from M
. ExplicitNamespaces
also works with
pattern synonyms, which can be prefixed with pattern
. Both
TypeOperators
and PatternSynonyms
imply ExplicitNamespaces
, so you don’t
need to enable it manually.
6.1.2 MonoLocalBinds
Since 6.12.1 | Stable | User’s Guide | Simon Peyton-Jones
Let
and where
bindings without an explicit type signature are usually
generalised as much as possible. With MonoLocalBinds
, they are generalised a
little less. This leads to more predictable type inference when using type
families or GADTs, so these two extensions imply
MonoLocalBinds
.
6.2 Temporary Extensions
6.2.1 MonadFailDesugaring
Since 8.0.1 | Unstable | User’s Guide
When a pattern match fails in a do
block, the Monad
class’s fail
method is
called with an error message. For many monads, fail
is simply error
, which
introduces implicit partiality, which is no good.
As part of the MonadFail
proposal, do
syntax will in future use a subclass of Monad
, MonadFail
, when a do
block
contains a pattern that may fail. MonadFailDesugaring
enables this behaviour.
The extension is temporary because it will eventually become standard.
MonadFailDesugaring
is turned on by default since GHC 8.6.1.
6.2.2 StarIsType
Since 8.6.1 | Unstable | User’s Guide
In standard Haskell, *
is the kind of all types (i.e. Int :: *
, etc). This
is an unfortunate choice of syntax because, among other things, it conflicts
with TypeOperators
: Int * Bool
should probably be the
type operator (*)
applied to Int
and Bool
, rather than Int
applied to
*
and Bool
.
With NoStarIsType
, *
becomes a regular type operator with no special
meaning. (To refer to the kind of all types, use Data.Kind.Type
instead.) As of GHC 8.6.1, StarIsType
is enabled by default, but this default
will change in the future. Note that even with StarIsType
, GHC 8.6.1 removes
some special parsing rules for *
, breaking backwards compatibility. See the
migration plan.
Don’t let anyone tell you that Haskellers are bad at naming.↩︎