</a>

Introduction

The aim of this tutorial is to help develop a working knowledge of functional programming using Haskell as the vessel language; this turns out to require one to digest a certain number of new ideas, and to get acquainted with the terminology to describe them.

Most of these concepts are intertwined, so perhaps they make little sense if considered in isolation. This has traditionally given Haskell a bad reputation for displaying a steep learning curve and being “too abstract”. We wish to demistify this, by showing how programming with functions is a natural way of expressing computer programs.

Luckily, Haskell comes with an interactive compiler as well (GHCi), and this lets us explore more or less separately the various features of the language.

</a>

The interactive Haskell compiler, GHCi

In the following we will see an example interactive session with GHCi, to familiarize the reader with the notation and some fundamental concepts of the language. Some familiarity with programming concepts and mathematical notation is required, but the tutorial is intended to be as self-contained as possible (All feedback is very welcome!).

The >character at the start of a line indicates the interpreter prompt, whereas :t is the GHCi macro for requesting the type of an expression.

If we input an expression that already has a value associated, GHCi computes and prints the expression value on the next line. If, on the other hand, we ask for the type of an expression x with :t x, the interpreter outputs this after a double colon.

N.B.: In function bodies, parentheses are used to group subexpressions that must be evaluated first (as per convention).

Haskell is case sensitive and often indentation-sensitive too, so watch out :)

Each example builds on the previous one, starting from self-explanatory concepts; the reader is encouraged to install the latest version of the Glasgow Haskell Compiler suite suite and try/modify the examples, in the given order; it’s much more fun and instructive than just reading through!

For those in a hurry, ghc.io provides a “safe” Haskell prompt to e.g. try out one-liners. Longer code can be developed (after a free signup) on FPComplete Haskell Center.


First steps with GHCi

Starting from the very basics :

> 1 + 2
3

> :t 1
1 :: Num a => a

The two interactions above show an evaluation and a type query, respectively. The former, being a constant expression, evaluates directly to its result (no surprises here), whereas the latter could be understood as “What is the type of 1?” “The type of 1 is a, such that a is an instance of a numerical type (i.e. a number).”

The actual letter indicating a type in a signature, like a in the previous example, does not matter; distinct letters correspond to different types.

Why is the type signature of something as simple as a number so verbose? Because many things have number-like properties (can be counted, added, subtracted etc.): potatoes, firemen, structs containing arrays of CSV files, etc.

If a type is an “instance” of a typeclass such as Num, the corresponding functions to operate “numerically”, e.g. sum, product, absolute value etc., can be used on data objects belonging to it. Equivalently, by making it an instance of Num, we have “stapled” additional numerical functionality onto our type. More about this deep idea in the next sections.

Let’s interact some more with the interpreter and see what happens:

> :t pi
pi :: Floating a => a

> pi
3.141592653589793

> exp 1
2.718281828459045

> :t exp
exp :: Floating a => a -> a

The exponential exp is a function of a single parameter (a real number, here represented as a Floating point value): \(y(x) = e ^ x,\; x,y \in \mathbb{R}\)

Why Floating a and not Num a, for instance? Because Num is the most general typeclass of numbers (i.e including fractionals, integers, floats etc.), but transcendental numbers (i.e. having infinite decimal digits) such as pi and exp 1 live in a “smaller” set, that is, require a more specialized definition.

Text characters, tuples, strings and lists

> :t 'a'
'a' :: Char

> :t "potato"
"potato" :: [Char]

Single characters are to be enclosed in single forward quotes whereas text strings require double quotes. Internally, strings are represented as lists of characters, so the above example is rendered internally as ['p','o','t','a','t','o'].

Tuples are constant-size ordered collections of data, not necessarily of the same type, separated by , and enclosed in ( .. ) as in

> :t (132, "potato")
(132, "potato") :: Num t => (t, [Char])

Lists are ordered collections of any one valid type of data, a very versatile tool:

> :t [1,2,3]
[1,2,3] :: Num t => [t]

> [23 .. 28]
[23,24,25,26,27,28]

> ['b' .. 'm']
"bcdefghijklm"

> :t [1 ..]
[1 ..] :: (Num t, Enum t) => [t]

> :t [(1, "one"), (2, "two")]
[(1, "one"), (2, "two")] :: Num t => [(t, [Char])]

Lists can be infinite in length (thus it is more appropriate to describe them as streams). Among the many other library functions, e.g. take, drop and filter let us query or pick out elements from streams.

N.B.: if you actually decide to evaluate an infinite stream such as [1 ..], be prepared to interrupt it! (Control-C terminates the execution of a command in Unix-like systems).

The take function, as the name implies, takes a few sequential elements from an array (i.e. outputs the first n elements of the array, where n is an integer number):

> :t take
take :: Int -> [a] -> [a]

> take 7 [5 ..]
[5,6,7,8,9,10,11]

Function application such as exp 1 and take 7 [5..] is so fundamental that Haskell uses a space to denote it, i.e. considering f x y z, f is the function and x, y and z are its arguments.

Higher order functions, partial application, operator sections

A versatile list-digesting function is filter:

> :t filter
filter :: (a -> Bool) -> [a] -> [a]

> filter (> 2) [-1,3,0,10,9,-4]
[3,10,9]

> filter (/= 'x') "xxxjgxkjg" 
"jgkjg"
 

filter is our first example of higher order function; it requires as arguments a function of type a -> Bool (a predicate, that is, a function that evaluates to True or False) and a list of as and returns the subset of the input list that evaluates to True.

In the previous code block, we also see the first examples of operator section: (> 2) and (/= 'x'), passed as first argument to filter. The ordering relation (>) is a binary operator (since it compares two values and returns True or False), but (> 2) takes only one argument and returns a Boolean. Instead, (/= 'x') compares its only argument to the constant character 'x'.

The following examples should clarify the idea:

:t (+)
(+) :: Num a => a -> a -> a

> :t (==)
(==) :: Eq a => a -> a -> Bool
 
> :t (+ 1)
(+ 1) :: Num a => a -> a

> :t (== 2)
(== 2) :: (Num a, Eq a) => a -> Bool
 

The arithmetic sum (+) and equality comparison (==) functions require two parameters, but fixing the first one to e.g. a constant is equivalent to considering functions of the remaining number of arguments. This is an instance of partial evaluation, ubiquitous in Haskell and very powerful.

Haskell functions are “curried” by default. This means that N-ary functions (functions of N arguments) can be considered as taking arguments in sequence, rather than all at once.

This enables partial evaluation, i.e. creating new functions of fewer arguments by fixing some in the original function.

This fundamental tool has many different uses, for example specializing a general function in a few different ways, by introducing very little additional syntax as we will see in the next sections.

Operator sections are just shorthand for partial application of infix operators; however the usual caveats for non-commutative functions such as arithmetic division / apply; as the following snippet shows for numbers, “.. over two” and “two over ..” have clearly different meanings.

> (/2) 3
1.5

> (2/) 3
0.6666666666666666

Other useful higher-order functions that operate on lists are map and foldr:

> :t map
map :: (a -> b) -> [a] -> [b]

> :t foldr
foldr :: (a -> b -> b) -> b -> [a] -> b
 

map can be interpreted right from its signature: given a function from a to b, and a list of as, it returns a list of bs, obtained by applying the function to every element of the input array.

> map (=='r') "chirp"
[False,False,False,True,False]

> map (* 2) [0,2 .. 8]
[0,4,8,12,16]

foldr is a type of fold that is, an operator which reduces a set of things to a single summary value with a certain policy, i.e. function; it requires a binary function say f, an initial element of type b and a list of as, and recursively applies f to the current first element of the remaining list and an accumulator value, which is returned as result. For example:

> foldr (+) 3 [1,4,10,24]
42

We will see the implementation of map, foldr and of a few other essential library functions in the following.

It is very instructive to have a look at the Haskell Prelude, the core library of the language.

Recap

Whew! In this introductory section we have alread seen quite a few new concepts:

  • types
  • classes of types (a.k.a. typeclasses Num, Floating, Eq, Ord …)
  • higher order functions
  • partial application, operator sections

In the following sections we will expand on and give examples for all the terms introduced so far (and a few more ..), and in a few pages the reader will be able to produce her first working programs !



</a>

Notation for functional programs

Anonymous expressions (often called “lambda” functions) let us define what a function does, and to separate this from what we choose to call it.

They often are used as single-use functions, if a certain functionality is too specific to be given a name; the pattern is \ x -> f x, in which what lies to the left of the arrow is the set of free variables (separated by spaces if more than one), and what lies to the right is an arbitrarily complex function of these and other variables (this might be read “for any given x, give me the result of function f applied on x”, or \(\forall x, f(x)\)

The actual syntax to be used in the free variable declaration is a backslash, but it is often pretty-printed (e.g. in Computer Science and Logic textbooks) as a Greek lambda character, as a reminder of its origins in Church’s Lambda Calculus.

Two elementary examples of lambda expressions could be:

> :t \ x -> 2 * x
\ x -> 2 * x :: Num a => a -> a

> :t \ x y -> x + y
\ x y -> x + y :: Num a => a -> a -> a

We should note that, in the snippet above, the Num constraint is introduced by (*) and (+).

In the following, we will implement a few useful functions using only lambda expressions, to demonstrate their versatility and to introduce some key concepts.

The Identity function

This one is pretty self explanatory:

> :t \ x -> x
\ x -> x :: a -> a

> :t id
id :: a -> a
 

Function application

If the body of the lambda expression contains function application syntax, we can easily re-create higher order functions, as shown below:

> :t \ f x -> f x
\ f x -> f x :: (a -> b) -> a -> b

> :t ($)
($) :: (a -> b) -> a -> b
 

The library function ($) captures the function application pattern shown in the definition above it.

As the first example above shows, some function arguments are inferred to be functions by how they are used in the body of the (anonymous) function.

Functions as “first class values” (i.e. that can be used and passed around just like regular values) are one of the defining features of functional programming languages, and it is fundamental to absorb this concept early.

As an example, we can apply the ``squared’’ function to an arbitrary value:

> ($) (\ x -> x^2) 0.98
0.9603999999999999

Function composition

What does it mean to “compose functions”? If we think of a function as a machine on a factory floor, feeding the output of one (g, say) into the input of the next (which we can call f) is a form of composition. This of course only works if the f is designed to work on the outputs of g (you wouldn’t want to plug a grinder to an Easter egg packaging machine, for example).

The composition of f and g, written f . g in Haskell and \(f \circ g\) in mathematical literature, is itself a function, taking g’s input type and returning f’s result type. It’s as if we welded the two machines together, and obtained a new, more complex machine as a result. (However the Haskell compiler, when types are aligned, does a great job of simplifying out the “seam”).

Here is a nested function application pattern, and below it the type signature of the corresponding library function (.):

> :t \ f g x -> f (g x)
\ f g x-> f (g x) :: (b -> c) -> (a -> b) -> a -> c

> :t (.)
(.) :: (b -> c) -> (a -> b) -> a -> c

When given two single-argument functions of the right types as inputs, as in f . g or (.) f g (the infix and prefix ways to write application of a binary operator, respectively), the result will be a new unary function of type a -> c obtained by chaining the outputs of g to f: seamless.

The Haskell Prelude and the other built-in libraries come with a rich library of synonyms, such as (.) and ($) shown above, and lets us define and use our own, as soon as the need for abstraction arises.

Partial evaluation

When calling functions in Haskell, you don’t have to “fill all the slots”, i.e. supply all the arguments; this is called partial evaluation (or application).

As explained briefly in the first section, the result of this is a new function, having a smaller number of arguments than the original one.

In the following we will see a few more examples of this from a slightly abstract point of view, in order not to lose sight of the pattern amid the implementation details.

> let f1 = \ f g x y -> f (g x) (g y)

> :t f1
f1 :: (b -> b -> c) -> (a -> b) -> a -> a -> c

In the example above we first define a function f1 of four arguments; in the next lines we specialize f1 to use the sum or ordering relation (<) as “external” functions f. The “internal” function g is instead meant to be separately applied on the operands x and y:

> :t f1 (+)
f1 (+) :: Num b => (a -> b) -> a -> a -> b

> :t f1 (+) (^2) 
f1 (+) (^2) :: Num a => a -> a -> a

> :t f1 (<)
f1 (<) :: Ord b => (a -> b) -> a -> a -> Bool

> :t f1 (<) cos
f1 (<) cos :: (Ord t1, Floating t1) => t1 -> t1 -> Bool

The expressions f1 (+), f1 (<) and f1 (<) exp are examples of partial application; the resulting expression is itself a function with a reduced number of arguments than the original one.

The higher-order function f2 accepts three arguments, the first of which is a binary function; if we only supply this, the result will itself be a binary function:

> let f2 g x y = g y x 

> :t f2
f2 :: (a -> b -> c) -> b -> a -> c
 
> :t flip
flip :: (a -> b -> c) -> (b -> a -> c)

(my parentheses on the right hand side of flip). Both f2 and the library function flip return the input binary function but with exchanged order of arguments:

> let pow = (^)

> :t pow
pow :: (Num a, Integral b) => b -> a -> a
 
> pow 2 3
9

> let wop = flip pow

> :t wop
wop :: (Num a, Integral b) => a -> b -> a
 
> wop 2 3
8

Eta-conversion

Dropping or adding an abstraction over a variable to an expression are termed “eta-reduction” and “eta-abstraction”, respectively. The following two expressions are identical, in this sense; the latter being the eta-reduced version of the former.

> :t \ x -> 2 * x
\ x -> 2 * x :: Num a => a -> a

> :t (2 *)
(2 *) :: Num a => a -> a

Examples

Let’s try together a few of the things we’ve see so far: partial application, function composition, the higher order function map :: (a -> b) -> [a] -> [b], and operate on a list-of-lists for the first time:

> let testData = [[1,2],[23452,24,515,0],[2351661]]

> let listShorterThan m = (m >) . length 

> :t listShorterThan
listShorterThan :: Int -> [a] -> Bool

> map (listShorterThan 4) testData
[True,False,True]

Recall how (.) works: from right to left. The rightmost function in the chain is the “innermost”, and the first to be applied. Our listShorterThan may be a bit contrived, but shows one advantage of this compositional approach: we are not interested in the actual length of the list, but only to know whether it’s shorter than m.

Another interesting, albeit a bit more abstract, little example is the following:

> :t map . map
map . map :: (a -> b) -> [[a]] -> [[b]] 

A composition of maps is equivalent to lifting an (a -> b) function to work onto lists of lists. Neat! We can easily prove this, by considering the composition operator (.) in infix position and plugging in the definitions;

> :t (.) map
(.) map :: (x -> y -> z) -> x -> [y] -> [z]

and, since map is a binary function accepting a function and a list, we can identify equal terms. In the line above, if we partially apply (.) map on map, x is identified with a function and y has to be a list, resulting in the initial type identity.

Let’s recycle testData from the example before to try it out:

> (map . map) (\s -> if s > 100 then '+' else '-') testData
["--","+-+-","+"]

“Wow, if-then-else like a normal language !”

Jokes aside, the above example is meant to reinforce the point that in Haskell whole subprograms can be passed around, either as arguments or as return types to appropriate higher-order functions. Such is the nature of “purely functional” languages.



Defining new symbols, functions and modules

When in the interactive mode (or, equivalently, while we are working within the IO monad, more details in the following), we need the let construct, which behaves very much like its mathematical counterpart:

> let a = pi / 2

> a
1.5707963267948966

> let f x = if x=='o' then 'i' else x

> :t f
f :: Char -> Char

> map f "potatoes"
"pitaties"
 

In bulk code, there is no need for let for declaring a new entity; if we write the following in a blank text file named, say, TestModule.hs :

-- If the prompt is not present, we assume to be working in a `.hs` text file, 
-- to be loaded in GHCi.

{- 
The `--` token at the start of a line specifies a comment: 
the line as a whole is not interpreted as Haskell code. 
Multiple-line comments are enclosed in a `{-`,  `-}` pair.
-}
module TestModule where

f1 = (^2)

v = [2,3,4]

main = do
  putStrLn $ map f1 v

and load it with GHCi (from command line: ghci TestModule.hs), calling main will print [4,9,16] to screen.

In the previous code snippet we start to see one of Haskell’s strength points: a clean separation of input-output (“IO”) and purely functional code. The first line is a function, the second a piece of data, and the main function runs the example (in this case mapping the squaring function over the data) and displays on-screen the results as a newline-terminated string with putStrLn.

The main function effectively “coordinates” the execution of the purely functional parts; its body is a do block, to signify that it is to be executed top-to-bottom. However the intermediate results are only effectively computed when requested (this is the non-strict, or lazy evaluation logic of Haskell). In the code above, f1 is mapped over v only when putStrLn is run.

We will return on how to write do blocks (the “imperative” part of Haskell) shortly. At this point we still need to see a few general features of the language syntax.



</a>

Pattern matching

Recursive functions

Haskell allows multiple declarations of any function, that are applied according to the arguments; this of course can hold only if the type signatures match and the declarations are mutually exclusive and complementary.

As an example, this is the implementation of map:

map f [] = []
map f (x:xs) = f x : map f xs

The above code recursively consumes the list supplied as second argument by applying f to its first element and appending the result (with (:)) to the output array. The first declaration is used if the supplied list is empty (this decision is called pattern matching), which also holds at the base case of the recursion.


A brief digression on lists

Lists (“streams”) are better thought of in recursive terms: a list can either be the empty list, or a concatenation of an element to a preexisting list (including the empty one). The signatures of [] and (:) represent exactly this, and in the following lines we see their use as “list constructors”:

> :t []
[] :: [a]

> :t (:)
(:) :: a -> [a] -> [a]

> 2 : []
[2]

> 4 : [3, 2]
[4,3,2]

It seems like [] and (:) are intimately connected: both are necessary to build a non-trivial list. Having a “neutral element” and an (associative) “appending” operation is the characteristic of a much more general algebraic class called a Monoid (to which lists naturally belong), but discussing the details would distract us at this point.

For now, it suffices to say that [] and (:) are the constructor (methods) of the empty and nontrivial list respectively, and as such can be “pattern matched against” in function declarations (left hand side of the =), or used for constructing a list from its elements in a function body (right hand side).

The notation (x:xs) in the calling sequence of map, foldr etc. is one such example of “pattern matching on the constructor of the input data”. x and xs, interpreted as an element of type a and list containing elements of the same type, [a], respectively, will be used in the body of the function as usual.


Let us now return to recursive functions that take apart their arguments by pattern matching.

A fold operation is to obtain a “summary” value from a set of values. The right-associative fold (foldr) is defined recursively as:

foldr f z []     = z
foldr f z (x:xs) = f x (foldr f z xs)

One of the most famous examples of Haskell conciseness is this implementation of the QuickSort algorithm:

qsort [] = []
qsort (x:xs) = qsort l ++ [x] ++ qsort r where
   l = filter (< x) xs
   r = filter (> x) xs

The first element of the unsorted list is chosen as pivot (This choice of pivoting means that this naive version of QuickSort will be suboptimal for partially sorted inputs.) and the remaining elements are filtered (cost O (N)) and passed to the next level of recursive call.

The three examples above all use pattern matching on the constructor of the input data, i.e. if the input is the empty list, the base case is computed, otherwise (list with at least one element x) the algorithm takes the induction branch.

We can apply the same reasoning to user-made types (which will be explained in the following Section):

data Pop a = Z | P a
data Pip a = W | Q a

woop Z = W
woop (P x) = Q r where
  r = 2 * x

and, after loading the above code in GHCi:

Above we have used two algebraic, polymorphic types Pop a and Pip a and a function that pattern matches on each constructor of the input data type.

> :t woop
woop :: Num a => Pop a -> Pip a

Pattern guards

One form of conditional branching statement is the pattern guard |. Let’s see a posible implementation of filter:

filter' _ [] = []
filter' p (x:xs) | p x       = x : filter' p xs
                 | otherwise = filter' p xs

If p x evaluates to True, the first branch is taken;

The options (expressions after |) are evaluated in top-to-bottom order, and the last one is only evaluated if none of the previous ones evaluates to True.

oddness x
   | odd x = sx ++ " is odd"
   | otherwise = sx ++ " is even"
       where
         sx = show x

buzz x 
   | f || g  = 0             -- (||) is the logical OR operation
   | even x = 1
   | otherwise = 2 
       where
         f = x `mod` 7 == 0
         g = x < 20

Pattern guards are convenient syntax for deciding which conditional branch to take according to the truth value computed from one or more of the input variables. Note that the functions acting as pattern guards (e.g. odd x, f || g) have to return a Boolean, and only after the = sign do we specify the return value for each branch.

Quiz: what are the type signatures of oddness and buzz and why ?



</a>

Datatypes

Record notation, constructor as a function

We can specify datatypes (which remind of structs in C) with the data keyword, as shown in the following examples. (Also newtype can be used in the same fashion as data, for datastructures that have a single constuctor, but the difference between the two keywords is a bit technical and will not be discussed here.)

> data TypeA = MakeA { unA :: Int } deriving Show

> :t MakeA
MakeA :: Int -> TypeA

> :t unA
unA :: TypeA -> Int

The constructor (MakeA, in this case) is a function; we build a data “object” by passing the appropriate arguments to it and whenever we need the values stored inside, we just call the appropriate accessor method (unA, in the example), using the data object as its argument :

> let test1 = MakeA 597

> test1
MakeA {unA = 597}

> :t test1
test1 :: TypeA

> unA test1
597

Within the curly brackets we can specify a number of “records” to hold values; however these are not simple data fields but also declare the accessor functions to retrieve them.

Haskell provides the machinery to augment our datatypes, by making them “instances” of standard classes such as Show above. If a datatype is an instance of one or more classes, it “inherits” the functionality of that class, so in the present example making TypeA an instance of Show lets us print TypeA objects on screen.

N.B.: if we hadn’t made TypeA an instance of Show, the evaluation of test1 would have returned a “No instance for (Show TypeA) … “ error, instead.

Let’s declare a slightly larger datatype constructor and try out its accessor functions:

> data Test = Tee { h1 :: [(Bool, String)], h2 :: Char }

> :t Tee
Tee :: [(Bool, String)] -> Char -> Test


> let test2 = Tee [(True, "boop")] 'x'

> (snd . head . h1) test2
"boop"

> h2 test2
'x'

In the above example, we have declared a Test datatype with constructor Tee and two records, the first of which is of a composite type, and created a test2 object of this type.

Next, we access an internal field in a purely functional style, by composition of elementary functions. This idea of functional manipulation of “getter”/”setter” methods for nested datastructure is called lensing, and it is implemented (and greatly expanded) in a few packages such as lens, which however is beyond the scope of this tutorial.

What happens if we supply an integer to the Tee constructor, instead of the expected list of (Bool, String) tuples? Our first type error! <3

> :t Tee 2

<interactive>:1:5:
   No instance for (Num [(Bool, String)]) arising from the literal '2'
   In the first argument of 'Tee', namely '2'
   In the expression: Tee 2

The second line, “In the first argument of ‘Tee’”, is the hint!

Type synonyms

The keyword type is reserved to declare transparent type synonyms (i.e. that are internally re-written into their elementary types at compile time). Let’s see a few examples:

> type Name = String

> type Address = (String, Int)

> type Contact = (Name, Address)

> type Directory = [Contact]

Type synonyms let us describe the problem domain more accurately, and enforce consistency among the functions using them.

A worked example

We now show a slightly longer example, a sketch of customer database application with query functions. The code captures the situation of having an array of structured data and having to take a decision based on some computation performed on each entry. Here we aim to display together a few of the syntactic elements shown so far, in a not-too-contrived setting.

type NameStr = String
type AddrStr = String
type AddrN = Int
data Address = A {addressStr :: AddrStr,
                  houseNo :: AddrN} deriving (Show, Eq)
                                                   
data Name = N {nameStr :: NameStr} deriving (Show, Eq)

data Contact = C {name :: Name,
                  addr :: Address} deriving (Show, Eq)

houseNoContact = houseNo . addr
nameContact = nameStr . name
addressContact = addressStr . addr

A query method deliver : if the house number is within range, return True

deliver nMax nMin c
  | inRange (houseNoContact c) = True
  | otherwise = False where
       inRange m = abs (nMax - nMin) > abs (m - nMin)

or, more concisely:

deliver' nMax nMin c = abs (nMax - nMin) > abs (houseNoContact c - nMin)

Quiz: what is the type signature of deliver' and why?

Partial application of both deliver and filter :

todaysDeliveries n1 n2 = filter (deliver n1 n2)

We can now load the previous code snippet in GHCi and see the signature of today’s delivery list, mapping from two house numbers and a list of contacts to the subset of the original contact list whose house number lies within the range.

> :t todaysDeliveries
todaysDeliveries :: AddrN -> AddrN -> [Contact] -> [Contact]

Haskell uses a decidable type system (the Hindley-Milner system) which allows the type-checking algorithm to always terminate without the user having to supply type annotations; in the above example we see the utility of this: using partial application wisely, we can achieve the desired signature function very concisely.

Concise code has very far-reaching implications, besides just “looking clever”: it greatly simplifies reasoning, checking for correctness, refactoring and knowledge propagation. This is one of the many examples in which Haskell’s theoretical foundations have very practical advantages.

For instance, imagine having one day to update the matching criterion, i.e. the function deliver in our case; it’s a single line change, and as long as the types match, the whole code will still be correct.

An example data entry for the delivery example above:

name1 = N "John Doe"
addr1 = A "Potato St." 42
contact1 = C name1 addr1

> :t contact1
contact1 :: Contact

Algebraic types

We have already seen an instance of an algebraic datatype (ADT): Bool can have two mutually exclusive values.

> data Bool = True | False

> data PS = Tri | Cir | Sqr | Crs

Polymorphic types

Polymorphic types can be thought of as a labeled scaffolding for more elementary types; in the following example we show how the constructor Pt a a can be specialized to cater for various needs:

> data Point a = Pt a a

> :t Pt 2 3 
Pt 2 3 :: Num a => Point a

> :t Pt 'c' 'd'
Pt 'c' 'd' :: Point Char

> let inside p1 p2 = let normP (Pt x y) = x^2 + y^2 in normP p1 < normP p2 

> :t inside
inside :: (Ord a, Num a) => Point a -> Point a -> Bool

Quiz: why do theOrd and Num constraints arise, in the definition of inside ?

A simple polymorphic datatype to represent a computation that can fail is Maybe a:

> data Maybe a = Nothing | Just a

For example, we can implement a simple “safe division”, as follows

safeDiv a b
  | b /= 0 = Just ( a/b )
  | otherwise = Nothing 

> :t safeDiv
safeDiv :: (Eq a, Fractional a) => a -> a -> Maybe a

The Maybe a type is a simple way to treat errors as values, and to perform further computation on them, rather than letting the program fail and stop.

Recursive types

We have been using a recursive data structure all along, the humble list:

> data [] a = [] | a : [a] 	-- Defined in ‘GHC.Types’

Next, we introduce a handy binary tree type Tree a, which can be either a “leaf” L carrying a type a, i.e. L a, or a “branch” B carrying two Tree a’s.

> data Tree a = L a | B (Tree a) (Tree a) deriving Show

> :t L
L :: a -> Tree a

> :t B
B :: Tree a -> Tree a -> Tree a

> let leaf1 = L 15
 
> let leaf2 = L 27
 
> B leaf1 leaf2
B (L 15) (L 27)

> let b0 = B leaf1 leaf2

> :t b0
b0 :: Num a => Tree a         

Trees have very convenient asymptotic performance for search and sorting operations, and they are naturally suited to be traversed with recursive logic in Haskell.