Haskell

Table of Contents

Whatever

  • Checkout book "Learn Haskell for the Greater Good"
  • Checkout this paper about the great "Selection Monad", which provides a DSL for selection algorithms.

Features

  • Lazyily evaluated

Running

ghci - interactive

Gives you a nice REPL to work with. It is quite similar to how the scala REPL works:

  • :load to load files (these do not need a main as we do for compiling, again like scala REPL)
  • :r to run the already loaded files

ghc - compiling into binary executable

Works very much like gcc. You can simply type ghc Main.hs or provide output arguments and so on: ghc -o Main.o -c Main.hs.

And like with C, Haskell expects a main function when compiling into a binary.

Basics

import Data.List
addEx = 5 + 4
subEx = 5 - 4
multEx = 5 * 4
divEx = 5 / 4
(addEx, subEx, multEx, divEx)  -- Tuple!

To inspect the type of anything, simply use the :t.

:t truncate

Infix operators

primes = [1, 3, 5]

(elem 1 primes, 1 `elem` primes) -- (regular, infix op)

Lists

  • Elements all need to have same datatype
primeNumbers = [3, 5, 7, 11]  -- a List
morePrime = primeNumbers ++ [13, 17, 19, 23, 29] -- List concatenation

favNums = 2 : 7 : 21 : 66 : []  -- conj operator
favNums

[2,7,21,66]

listTimes2 = [x * 3 | x <- [1..10]]
    listTimes2
listTimes2 = [x * 3 | x <- [1..10], x * 3 <= 20]
    listTimes2
divisBy9 = [x | x <- [1..100], x `mod` 9 == 0]
divisBy9
Indexing
[1, 2, 3] !! 1

Infinite lists

evensUpTo20 = takeWhile (<= 20) [2, 4..]
    evensUpTo20

List comprehension

multTable = [[x * y | y <- [1..5]] | x <- [1..5]]
multTable

Tuples

  • Does not require elements to have same type
randTuple = (1, "Random tuple")
fst randTuple
names = ["Bob", "Mary"]
addresses = ["This road", "Another road"]
zip names addresses

Functions

Functions in Haskell can be defined in multiple ways.

With type declaration

Functions with declarations take the form

-- funcName param1 param2 = operations (return value)
    ""

When we're not in the REPL, we can declare typed functions on multiple lines, as follows:

addMe :: Int -> Int -> Int
addMe x y = x + y

But when we're in the REPL, we need to do both the type declaration and definition of function on the same line:

let addMeTyped :: Int -> Int -> Int; addMeTyped x y = x + y
addMeTyped 3.1 2.2
addMeTyped 3 2
:t addMeTyped

Without type declaration

addMeAny x y = x + y
(addMeAny 4.0 3.5, addMeAny 4 3)

(7.5,7)

:t addMeAny

Using let

let a = 7
let getTriple x = x * 3
getTriple a
let getDouble x = x * y where y = 2
getDouble 3

where ... = syntax has precedence over the arguments, so if you were to write =let getDouble x = x * 2 where x = 3, calling getDouble 1 would actually return 3 * 2 not 1 * 2.

Using do

This is a very convienent way of chaining a bunch of operations.

main = do
 putStrLn "What's your name? "
 name <- getLine
 putStrLn ("Hello " ++ name)

If you were to compile this using ghc -o Name.o -c Name.hs and then run the binary executable, you'll be prompted for your name, woooo!

What is very important about the do syntax is the following:

  • <- extracts the the value from the monad
  • let does not extract the value
f = do
 y <- Just 1    -- 1
 let x = Just 1 -- Just 1
 y

Pattern matching

whatAge :: Int -> String

whatAge 16 = "You can drive"
whatAge 18 = "You can vote"
whatAge 21 = "You're an adult, sort of"
whatAge _ = "I don't know what you are!" -- could be any variable, say `x` and then use `x` inside the function
    ""

Guards

-- guards
isOdd :: Int -> Bool
isOdd n
 | n `mod` 2 == 0 = False
 | otherwise = True
let getListItems :: [Int] -> String;

getListItems [] = "Your list is empty"
getListItems [x] = "Only got one element: " ++ show x -- `show` is just stringifing `x`
getListItems [x, y] = "Got two elems: " ++ show x ++ " and " ++ show y
-- similar to binding the entire match in Scala
getListItems three@[x, y, z] = "Got these three elems " ++ show three 
getListItems (x:xs) = "First is " ++ show x ++ " and the rest is " ++ show xs

getListItems [1, 2, 3] -- "Got these three elems [1, 2, 3]"
    getListItems [1, 2, 3, 4]    -- "First is 1 and the rest is [2, 3, 4]"

Higher order functions

Simply passing functions to functions.

areStringsEq :: [Char] -> [Char] -> Bool
areStringsEq [] [] = True
areStringsEq (x: xs) (y: ys) = x == y && areStringsEq xs ys
    areStringsEq _ _ = False

Lambdas

-- lambdas
dbl1To10 = map (\x -> x * 2) [1..10]
    dbl1To10

Conditionals

doubleEvenNumber y =
       if y `mod` 2 /= 0
     then y
     else y * 2
getClass :: Int -> String
getClass n = case n of
   5 -> "Go to Kindergarten"
   _ -> "Go home"

Modules

Creating a module
module SampFunctions (getClass, doubleEvenNumbers) where
Importing a module
import SampFunctions

Enumeration

Haskell has something called a DataType, which we can create custom ones for ourselves.

data BaseballPlayer = Pitcher
                    | Catcher
                    | Infielder
                    | Outfield
                    deriving Show

-- Custom stuff
data Customer = Customer String String Double
  deriving Show

tomSmith :: Customer
tomSmith = Customer "Tom Smith" "123 Main" 20.50

getBalance :: Customer -> Double
getBalance (Customer _ _ b) = b

-- "Multitypes" ?
data Shape = Circle Float Float Float | Rectangle Float Float Float Float

area :: Shape -> Float
area (Circle _ _ r) = pi * r ^ 2
-- `$` simply allows us to remove the parenthesis
area (Rectangle x y x2 y2) = (abs $ x2 - x) * (abs (y2 - y))

Dot operator

This is simply function composition.

:t putStrLn
:t show
:t putStrLn . show
putStrLn . show $ 1 + 2

Type classes

I think these are like trait in Rust.

:t (+) -- (+) :: Num a => a -> a -> a
      data Employee = Employee { name :: String,
vv                                                       position :: String,
                                                         idNum :: Int
                               } deriving (Eq, Show)

      samSmith1 = Employee {name = "Sam", position = "1", idNum = 1}
      samSmith2 = Employee {name = "Sam", position = "1", idNum = 1}
      samSmith1 == samSmith2 -- True
data ShirtSize = S | M | L

instance Eq ShirtSize where
  S == S = True
  M == M = True
  L == L = True
  _ == _ = False

S `elem` [S, M, L] -- True
Classes
class MyEq a where
 areEqual :: a -> a -> Bool

instance MyEq ShirtSize where
 areEqual S S = True
 areEqual M M = True
 areEqual L L = True

-- areEqual S S => True

I/O

writeToFile = do
  theFile <- openFile "test.txt" WriteMode
  hPutStrLn theFile ("Random line of text")
  hClose theFile

readFromFile = do
  theFile2 <- openFile "test.txt" ReadMode
  contents <- hGetContets theFile2
  putStr contents
  hClose theFile2

Concepts

Monad

Examples of monads

Maybe x is a way of defining a "box" for some value which can either be a value of type x or Nothing. This is basically the same as Option[T] in Scala. The interesting thing here is that we can define Maybe in a Monadic manner.

:t (=<<)

Book: Learn You a Haskell for Great Good

Making our own Types and Typeclasses

Recursive data structures

data Tree a = EmptyTree | Node a (Tree a) (Tree a)
  deriving (Show, Read, Eq)

-- creates a simple node without any children/subtrees
singleton :: a -> Tree a
singleton x = Node x EmptyTree EmptyTree

-- inserting into the tree
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
  | x == a = Node x left right -- same value => return same tree
  | x < a = Node a (treeInsert x left) right  -- create new tree with `a` inserted in L
  | x > a = Node a left (treeInsert x right)  -- create new tree with `a` inserted in R

-- checking if element exists in `Tree`
treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem x EmptyTree = False
treeElem x (Node a left right)
  | x == a = True
  | x < a = treeElem x left
  | x > a = treeElem x right
-- building the from a `List` tree using `foldr`
let nums = [8,6,4,1,7,3,5]
let tree = foldr treeInsert EmptyTree nums
    tree
(8 `treeElem` tree, treeElem 9999 tree)
(True,False)

Typeclasses 102

Types
defined using the data keyword.
Typeclasses

like interaces. It defines some behavior and then types that can behave in that way are made instances of that typeclass.

Here we define a "behavior" Eq for some type a.

class Eq a where  
    (==) :: a -> a -> Bool  
    (/=) :: a -> a -> Bool  
    x == y = not (x /= y) -- You're probably like "WHAT?! RECURSIVE DEFINITION ALERT!"
    x /= y = not (x == y) -- Just keep readin' bro.

Let's implement this behavior for some custom type TrafficLight.

data TrafficLight = Red | Yellow | Green

instance Eq TraffigLight where
  Red == Red = True           -- here we're just defining the behavior of `==`
  Yellow == Yellow = True
  Green == Green = True
  _ == _ = False

But what about inequality ?! Relax brooo, we have defined (/)= to be the negation of the equality, thus by defining equality we've implicitly defined inequality! Woah! Is it just me or is it the world spinning slightly?

The Functor Typeclass

TLDR: Functor is for things which can be mapped over. Or rather things which implement fmap, allowing us to map functions over this "thing" / "box" or whatever.

fmap (* 2) [2, 3, 4]

The Functor class is implemented as follows:

class Functor f where
  fmap :: (a -> b) -> f a -> f b
  • f is not a concrete type (e.g. Int) but a type constructor that takes one type parameter
  • fmap takes a function from one type to another and a functor applied with one type and returns a functor applied with another type.

An example of a Functor is a list!

instance Functor [] where  
    fmap = map

where map has the following signature

:t map

See? For lists fmap is simply map.

fmap only takes one argument! This means that if we have some constructor f which takes multiple arguments, then we need to partially define it, i.e. replace f with (Whatever a b ... ), and define fmap using, say, pattern matching. Yah feel me?

Types which can acts a "box" can be Functors. For example, Maybe is not a concrete type, but Maybe a is!

instance Functor Maybe where  
    fmap f (Just x) = Just (f x)  
    fmap f Nothing = Nothing  

Let's try doing this for our Tree structure!

data Tree a = EmptyTree | Node a (Tree a) (Tree a)
  deriving (Show, Read, Eq)

-- creates a simple node without any children/subtrees
singleton :: a -> Tree a
singleton x = Node x EmptyTree EmptyTree

-- inserting into the tree
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
  | x == a = Node x left right -- same value => return same tree
  | x < a = Node a (treeInsert x left) right  -- create new tree with `a` inserted in L
  | x > a = Node a left (treeInsert x right)  -- create new tree with `a` inserted in R

-- checking if element exists in `Tree`
treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem x EmptyTree = False
treeElem x (Node a left right)
  | x == a = True
  | x < a = treeElem x left
  | x > a = treeElem x right

instance Functor Tree where
  fmap f EmptyTree = EmptyTree
  fmap f (Node a left right) = Node (f a) (fmap f left) (fmap f right)

Just to remind us what the value of the tree variable is:

let nums = [8,6,4,1,7,3,5]
let tree = foldr insertTree EmptyTree nums
tree
fmap (* 2) tree  -- (+) takes 2 args => (+ 1) defines a partial func taking 1 arg! MAGIC!

Kinds and some type-foo

  • A type has kind *, then it's a concrete type
  • Inspect kinds using :k
:k Int
Int :: *
:k Maybe  -- constructor which takes one concrete type to another concrete type
Maybe :: * -> *

Functors, Applicative Functors and Monoids

Applicative functors

  • Found in Control.Applicative
  • "Beefed up" Functors
class (Functor f) => Applicative f where  
    pure :: a -> f a  
    (<*>) :: f (a -> b) -> f a -> f b  -- it's an infix operator

A better way of thinking about pure would be to say that it takes a value and puts it in some sort of default (or pure) context—a minimal context that still yields that value.

The <*> function is really interesting. It has a type declaration of f (a -> b) -> f a -> f b. Does this remind you of anything? Of course, fmap :: (a -> b) -> f a -> f b. It's a sort of a beefed up fmap. Whereas fmap takes a function and a functor and applies the function inside the functor, <*> takes a functor that has a function in it and another functor and sort of extracts that function from the first functor and then maps it over the second one. When I say extract, I actually sort of mean run and then extract, maybe even sequence.

instance Applicative Maybe where  
    pure = Just  
    Nothing <*> _ = Nothing  
    (Just f) <*> something = fmap f something  

Applicative functors and the applicative style of doing pure f <*> x <*> y <*> ... allow us to take a function that expects parameters that aren't necessarily wrapped in functors and use that function to operate on several values that are in functor contexts. The function can take as many parameters as we want, because it's always partially applied step by step between occurences of <*>.

Lists (actually the list type constructor, []) are applicative functors. What a suprise! Here's how [] is an instance of Applicative:

instance Applicative [] where  
    pure x = [x]  
    fs <*> xs = [f x | f <- fs, x <- xs]  
Examples
[(* 2)] <*> [1, 2, 3]
(* 2) <$> [1, 2, 3]

Appendix A: Files

import Data.List
import System.IO

-- Pattern matching
whatAge :: Int -> String

whatAge 16 = "You can drive"
whatAge 18 = "You can vote"
whatAge 21 = "You're an adult, sort of"
whatAge _ = "I don't know what you are!"

-- factorial
factorial :: Int -> Int

factorial 0 = 1
factorial n = n * factorial(n - 1)

-- Function guards
isOdd :: Int -> Bool
isOdd n
  | n `mod` 2 == 0 = False
  | otherwise = True

isEven n = n `mod` 2 == 0

-- another guard example
batAvgRating :: Double -> Double -> String

batAvgRating hits atBats
  | avg <= 0.200 = "Terrible"
  | avg <= 0.280 = "OK"
  | otherwise = "Good"
  where avg = hits / atBats

-- pattern matching over a list
getListItems :: [Int] -> String

getListItems [] = "Your list is empty"
getListItems [x] = "Only got one element: " ++ show x -- `x.toString()`
getListItems [x, y] = "Got two elems: " ++ show x ++ " and " ++ show y
getListItems three@[x, y, z] = "Got these three elems " ++ show three -- similar to binding the entire match in Scala
getListItems (x:xs) = "First is " ++ show x ++ " and the rest is " ++ show xs


-- Higher order functions
times4 :: Int -> Int
times4 x = 4 * x

listTimes4 xs = map times4 xs


multBy4 :: [Int] -> [Int] -- will do exactly the same as `listTimes4`

multBy4 [] = []
multBy4 (x:xs) = times4 x : multBy4 xs -- one by one call `times4`

-- really neat recursion example
areStringsEq :: [Char] -> [Char] -> Bool
areStringsEq [] [] = True
areStringsEq (x: xs) (y: ys) = x == y && areStringsEq xs ys
areStringsEq _ _ = False

-- passing function to function
doMult :: (Int -> Int) -> Int
doMult func = func 3

num3times4 = doMult times4


-- lambdas
dbl1To10 = map (\x -> x * 2) [1..10]


-- conditionals
doubleEvenNumber y =
  if y `mod` 2 /= 0
     then y
     else y * 2


getClass :: Int -> String
getClass n = case n of
  5 -> "Go to Kindergarten"
  _ -> "Go home"


-- Enums
data BaseballPlayer = Pitcher
                    | Catcher
                    | Infielder
                    | Outfield
                    deriving Show

barryBonds :: BaseballPlayer -> Bool
barryBonds Outfield = True


-- Custom stuff
data Customer = Customer String String Double
  deriving Show

tomSmith :: Customer
tomSmith = Customer "Tom Smith" "123 Main" 20.50

getBalance :: Customer -> Double
getBalance (Customer _ _ b) = b

-- "Multitypes" ?
data Shape = Circle Float Float Float | Rectangle Float Float Float Float

area :: Shape -> Float

area (Circle _ _ r) = pi * r ^ 2
area (Rectangle x y x2 y2) = (abs $ x2 - x) * (abs (y2 - y)) -- `$` simply allows us to remove the parenthesis


data Employee = Employee { name :: String,
                           position :: String,
                           idNum :: Int
                         } deriving (Eq, Show)

samSmith1 = Employee {name = "Sam", position = "1", idNum = 1}
samSmith2 = Employee {name = "Sam", position = "1", idNum = 1}


data ShirtSize = S | M | L

instance Eq ShirtSize where
  S == S = True
  M == M = True
  L == L = True
  _ == _ = False

-- Classes
class MyEq a where
  areEqual :: a -> a -> Bool

instance MyEq ShirtSize where
  areEqual S S = True
  areEqual M M = True
  areEqual L L = True