# data types

Alexander Konovalov, Compellon Inc

alex.knvl@gmail.com @alexknvl

# The goal

• Briefly go over type isomorphisms and type algebra.
• Show the connection between final tagless, "initial encoding", and recursion schemes.
• Brief introduction to Free monads.
• Show the connection between Free monads, MTL, and Final Tagless.

## Isomorphisms

​A and B are isomorphic when there exist two morphisms,

to: A → B and from: B → A, such that both

from (to a) = a

and

to (from b) = b

## Type Isomorphisms

Can't be faithfully implemented except in Dependently typed languages (Idris, Agda, Coq).

data Iso a b = Iso {
to   :: a -> b
from :: b -> a
fromTo :: (x : a) -> from (to x) = x
toFrom :: (x : b) -> to (from x) = x
}
trait Iso[A, B] {
def to(a: A): B
def from(b: B): A
def fromTo(x: A): (from(to(x))).type =:= x.type
def toFrom(x: B): (to(from(x))).type =:= x.type
}
data Iso a b = Iso {
to   :: a -> b
from :: b -> a
-- make sure that to . from = id
-- and from . to = id
}
trait Iso[A, B] {
def to(a: A): B
def from(b: B): A

// make sure that (to andThen from) == id
// and (from andThen to) == id
}

So let's just manually prove equality.

type A = Either Bool ()
data B = One | Two | Three
type A = Either[Boolean, Unit]
sealed trait B
case object One extends B
case object Two extends B
case object Three extends B

Are these isomorphic?

to :: A -> B
to (Left True)  = One
to (Left False) = Two
to (Right ())   = Three
def to(a: A): B = a match {
case Left(true)  => One
case Left(false) => Two
case Right(())   => Three
}

Yes

type A = Boolean -> Boolean
data B = One | Two | Three | Four
type A = Boolean => Boolean
sealed trait B
case object One   extends B
case object Two   extends B
case object Three extends B
case object Four  extends B

Are these isomorphic?

to f = case (f True, f False) of
(False, False) -> One
(False, True)  -> Two
(True, False)  -> Three
(True, True)   -> Four
def to(f: A): B = (f(true), f(false)) match {
case (false, false) => One
case (false, true)  => Two
case (true, true)   => Three
case (true, true)   => Four
}

Yes.

type A = Bool -> ()
type B = Void -> Int
type C = ()
type A = Boolean => Unit
type B = Nothing => Int
type C = Unit

Are these isomorphic?

to :: A -> B
to f   = absurd
from f = \_ -> ()

to :: B -> C
to f    = ()
from () = absurd
def to(f: Boolean => Unit): Nothing => Int =
(a: Nothing) => a
def from(f: Nothing => Int): Boolean => Unit =
(a: Boolean) => ()

def to(f: Nothing => Int): Unit = ()
def from(f: Unit): Nothing => Int =
(a: Nothing) => a

Maybe...?

## A surprising detour

• When are two things equal?

1729

12³+1

"the first number expressible as a sum of two cubes in two different ways"

• When are two things equal?

http://www.math.harvard.edu/~mazur/preprints/when_is_one.pdf

Gottfried Wilhelm Leibniz, 1646-1716:

For any x and y, if x is identical to y, then x and y have all the same properties.

For any x and y, if x and y have all the same properties, then x is identical to y.

https://plato.stanford.edu/entries/identity-indiscernible/

x = y ⟺ ∀ P. P x ↔ P y

Where P is quantified over all properties of an object.

https://plato.stanford.edu/entries/identity-indiscernible/

x = y ⟺ ∀ P. P x ↔ P y

If 1729 and 12³+1 are expressions, they are different.

data Expr = Lit Int | Pow Int Int | Add Int Int

x = Lit 1729
y = Add (Pow 12 3) 1
sealed trait Expr
case class Lit(i: Int) extends Expr
case class Pow(a: Int, b: Int) extends Expr
case class Add(a: Int, b: Int) extends Expr

val x = Lit(1729)
val y = Add(Pow(12, 3), 1)

x = y ⟺ ∀ P. P x ↔ P y

If 1729 and 12³+1 are integers, they are the same.

type Expr = Int

x = 1729
y = 12^3 + 1
type Expr = Int

val x = 1729
val y = 12 * 12 * 12 + 1

## Type Isomorphisms

type A = Bool -> ()
type B = Void -> Int
to f   = absurd
from f = \_ -> ()
type A = Boolean => Unit
type B = Nothing => Int

def to(f: Boolean => Unit): Nothing => Int =
(a: Nothing) => a
def from(f: Nothing => Int): Boolean => Unit =
(a: Boolean) => ()

Are these isomorphic?

test1 :: (Bool -> ()) -> Bool
test1 f = ???

test1 (\_ -> ())
test1 (\True  -> ()
False -> ())

test2 :: (Void -> Int) -> Bool
test2 f = ???

test2 (\_ -> 1)
test2 (\_ -> 2)
test2 (\x -> absurd x)

What properties of them can we observe?

We can't see the difference of them

as values within a pure functional language.

We can see the difference between

the actual expression trees.

We don't really care about the latter as since it does not affect the semantics.

type A = Bool -> ()
type B = Void -> Int
to f   = absurd
from f = \_ -> ()
type A = Boolean => Unit
type B = Nothing => Int

def to(f: Boolean => Unit): Nothing => Int =
(a: Nothing) => a
def from(f: Nothing => Int): Boolean => Unit =
(a: Boolean) => ()

Are these isomorphic? Yes.

An interesting result:

If A and B are isomorphic,
(a₁: A) and (a₂: A) map to (b₁: A) and (b₂: A) respectively,
then a₁ = a₂ ⟺ b₁ = b₂.

In other words, discernible objects are mapped to discernible objects.

Equal objects are mapped to equal objects.

An interesting result:

If A and B are isomorphic,
(a₁: A) and (a₂: A) map to (b₁: A) and (b₂: A) respectively,
then a₁ = a₂ ⟺ b₁ = b₂.

a₁ = a₂

to a₁ = to a₂

b₁ = b₂

from b₁ = from b₂

## Type Algebra

A few more important isomorphisms:

(a, b) ≈ (b, a)
(a, (b, c)) ≈ ((a, b), c)
(a, Either b c) ≈ Either (a, b) (a, c)
Either a b ≈ Either b a
Either Void a ≈ a
(Unit, a) ≈ a

## Type Algebra

(a, b) ≈ (b, a)
(a, (b, c)) ≈ ((a, b), c)
(a, Either b c) ≈ Either (a, b) (a, c)
Either a b ≈ Either b a
Either Void a ≈ a
(Unit, a) ≈ a

What if we replace Either with +, (,) with *, Unit with 1, and Void with 0?..

## Type Algebra

(a, b) ≈ (b, a)
(a, (b, c)) ≈ ((a, b), c)
(a, Either b c) ≈ Either (a, b) (a, c)
Either a b ≈ Either b a
Either Void a ≈ a
(Unit, a) ≈ a

a * b ≈ b * a
a * (b * c) ≈ (a * b) * c
a * (b + c) ≈ a * b + a * c
a + b ≈ b + a
0 + a ≈ a
1 * a ≈ a

Amusingly, we get something very similar to the regular algebra of natural numbers...

## Type Algebra

(a + b) c ≈ (a c, b c)
a b c ≈ (a, b) c

def curry[A, B, C](f: A => B => C): ((A, B)) => C =
{ case (a, b) => f(a)(b) }

def uncurry[A, B, C](f: ((A, B)) => C): A => B => C =
a => b => f((a, b))

def undiag[A, B, C](f: Either[A, B] => C): (A => C, B => C) =
(a => f(Left(a)), b => f(Right(b)))

def diag[A, B, C](f: (A => C, B => C)): Either[A, B] => C =
{ case Left(a)  => f._1(a)
case Right(b) => f._2(b) }

## Type Algebra

(a + b) c ≈ (a c, b c)
a b c ≈ (a, b) c

c^(a + b) ≈ c^a * c^b
(c^b)^a ≈ c ^ (a * b)

Turns out that similarly to how Either is + and (,) is *, functions correspond to exponentiation:

## Type Algebra

Summing it all up:

Either[a, b] is +

Tuple2[a, b] or (a, b) is A * B

Function1[a, b] or (a → b) is b ^ a

Nothing is 0

Unit is 1

Bool is 2

## Type Algebra

One more thing that we will need.

a ≈ b, then f a ≈ f b for any functor f

Including phantom, covariant, contravariant, or invariant functors.

## Type Algebra

a ≈ b, then f a ≈ f b for any functor f

to' = map to

from' = map from

map to . map from =

map (to . from) = map id = id

## Let's talk recursion

Say we have a data type

data List a = Nil | Cons a (List a)
foldr :: forall a z. z -> (a -> z -> z) -> List a -> z
foldr seed combine = go where
go Nil        = seed
go (Cons h t) = combine h (go t)

and we would like to fold over it

let’s look at the type of foldr more closely

foldr :: forall a z. z -> (a -> z -> z) -> List a -> z
foldr seed combine = go where
go Nil        = seed
go (Cons h t) = combine h (go t)
\forall a~z. z \rightarrow (a \rightarrow z \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. (1 \rightarrow z) \rightarrow ((a, z) \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. ((1 + (a, z)) \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. (1 \rightarrow z, (a, z) \rightarrow z) \rightarrow [a] \rightarrow z
\forall a~z. ((1 + (a, z)) \rightarrow z) \rightarrow [a] \rightarrow z
data ListF a z = NilF | ConsF a z

We can now define a new type, called pattern functor

foldr :: forall a z. (ListF a z -> z) -> List a -> z
foldr alg = go where
go Nil        = alg NilF
go (Cons h t) = alg (ConsF h (go t))

New foldr:

Let's try the same technique with a different type:

data Expr = Lit Int
| Mul Expr Expr

foldExpr :: forall z. (Int -> z) -> (z -> z -> z) -> (z -> z -> z) -> Expr -> z
foldExpr lit add mul = go where
go (Lit i)    = lit i
go (Mul l r)  = mul (go l) (go r) 
\forall z. (Int \rightarrow z) \rightarrow (z \rightarrow z \rightarrow z) \\ ~~~ \rightarrow (z \rightarrow z \rightarrow z) \rightarrow \text{Expr} \rightarrow z
∀ z. (Int \rightarrow z) \rightarrow ((z, z) \rightarrow z) \\ ~~~ \rightarrow ((z, z) \rightarrow z) \rightarrow \text{Expr} \rightarrow z
foldExpr :: forall z. (Int -> z) -> (z -> z -> z) -> (z -> z -> z) -> Expr -> z
foldExpr lit add mul = go where
go (Lit i)    = lit i
go (Mul l r)  = mul (go l) (go r) 
\forall z. ((Int + (z, z) + (z, z)) \rightarrow z) \\ ~~~~~ \rightarrow \text{Expr} \rightarrow z
∀ z. (Int \rightarrow z) \rightarrow ((z, z) \rightarrow z) \\ ~~~ \rightarrow ((z, z) \rightarrow z) \rightarrow \text{Expr} \rightarrow z
data ExprF z = LitF Int | AddF z z | MulF z z


Once again, we introduce a pattern functor

\forall z. (\text{ExprF}~z \rightarrow z) \rightarrow \text{Expr} \rightarrow z
data ExprF z = LitF Int | AddF z z | MulF z z

\forall z. (\text{ExprF}~z \rightarrow z) \rightarrow \text{Expr} \rightarrow z
foldExpr' :: forall z. (ExprF z -> z) -> Expr -> z
foldExpr' alg = go where
go (Lit x)   = alg (LitF x)
go (Mul x y) = alg (MulF (go x) (go y))

Alright, let's go back to our types again

∀ z. (Int \rightarrow z, z \rightarrow z \rightarrow z, z \rightarrow z \rightarrow z) \\ ~~~~~ \rightarrow Expr \rightarrow z
\forall z. (Int \rightarrow z) \rightarrow (z \rightarrow z \rightarrow z) \\ ~~~ \rightarrow (z \rightarrow z \rightarrow z) \rightarrow Expr \rightarrow z
data ExprA z = {
lit :: Int -> z
add :: z -> z -> z
mul :: z -> z -> z
}
∀ z. (Int \rightarrow z, z \rightarrow z \rightarrow z, z \rightarrow z \rightarrow z) \\ ~~~~~ \rightarrow Expr \rightarrow z

Let's define an "algebra"

∀ z. \text{ExprA}~z \rightarrow \text{Expr} \rightarrow z
∀ z. \text{ExprA}~z \rightarrow \text{Expr} \rightarrow z
foldExpr'' :: forall z. ExprA z -> Expr -> z
foldExpr'' alg = go where
go (Lit x)   = alg lit x
go (Add x y) = (alg add) (go x) (go y)
go (Mul x y) = (alg mul) (go x) (go y)

But that's not all!

class ExprC z where
lit :: Int -> z
add :: z -> z -> z
mul :: z -> z -> z
foldExpr''' :: forall z. ExprC z => Expr -> z
foldExpr''' = go where
go (Lit x)   = lit x
go (Add x y) = (go x) add (go y)
go (Mul x y) = (go x) mul (go y)

Let's see all of the derived functions

foldExpr :: forall z. (Int -> z) -> (z -> z -> z) -> (z -> z -> z) -> Expr -> z
foldExpr :: forall z. (ExprF z -> z)                               -> Expr -> z
foldExpr :: forall z.  ExprA z                                     -> Expr -> z
foldExpr :: forall z.  ExprC z                                     => Expr -> z

Huh, recursion schemes and final tagless!

## Let's talk recursion schemes

\begin{aligned} \text{Expr} = &\text{Lit}~\text{Int} \\ | &\text{Add}~\text{Expr}~\text{Expr} \\ | &\text{Mul}~\text{Expr}~\text{Expr} \end{aligned}
\begin{aligned} \text{ExprF} \bullet = &\text{Lit}~\text{Int} \\ | &\text{Add}~\bullet~\bullet \\ | &\text{Mul}~\bullet~\bullet \end{aligned}
project :: Expr -> ExprF Expr
project (Lit i)   = LitF i
project (Mul x y) = MulF x y
embed :: ExprF Expr -> Expr
embed (LitF i)   = Lit i
embed (MulF x y) = Mul x y
data ExprF z = LitF Int | AddF z z | MulF z z
deriving (Functor ExprF)
project :: Expr -> ExprF Expr
project (Lit i)   = LitF i
project (Mul x y) = MulF x y

embed :: ExprF Expr -> Expr
embed (LitF i)   = Lit i
embed (MulF x y) = Mul x y

data ExprF z = LitF Int | AddF z z | MulF z z
deriving (Functor ExprF)
foldExpr :: forall z. (ExprF z -> z) -> Expr -> z
foldExpr alg = go where
go (Lit x)   = alg (LitF x)
go (Mul x y) = alg (MulF (go x) (go y))

foldExpr alg = go where
go x = alg $fmap go$ project x

foldExpr alg = go where
go = alg . fmap go . project
type Algebra f a = f a -> a

foldExpr :: forall z. Algebra ExprF -> Expr -> z

foldExpr alg = go where
go = alg . fmap go . project

cata :: forall z. Algebra ExprF -> Expr -> z
class Functor f => Recursive t f | t -> f where
project :: t -> f t
embed   :: f t -> t
cata    :: Algebra f a -> t -> a

cata alg = go where
go = alg . fmap go . project

Hmm, algebras! Where else have you heard that word?

## Let's talk algebras

What is an algebra?

In mathematics, and more specifically in abstract algebra, an algebraic structure on a set A (called carrier set or underlying set) is a collection of finitary operations on A; the set A with this structure is also called an algebra.

What is an algebra?

In mathematics, specifically in category theory, F-algebras generalize algebraic structure. Rewriting the algebraic laws in terms of morphisms eliminates all references to quantified elements from the axioms, and these algebraic laws may then be glued together in terms of a single functor F, the signature.

## Let's talk algebras

\mathfrak{F} c \rightarrow c ~~~ - ~~~ \text{an }\mathfrak{F}\text{-algebra}
\mathfrak{F} - \text{is called a signature, or pattern functor} \\ c - \text{is called a carrier}
type Algebra f c = f c -> c
type Algebra f c = f c -> c
data ExprF z = LitF Int | AddF z z | MulF z z
deriving (Functor ExprF)

type ExprA' z = Algebra ExprF z

data ExprA z = {
lit :: Int -> z
add :: z -> z -> z
mul :: z -> z -> z
}

class ExprC z where
lit :: Int -> z
add :: z -> z -> z
mul :: z -> z -> z

All of these are algebras!

class ExprC z where
lit :: Int -> z
add :: z -> z -> z
mul :: z -> z -> z

foo :: ExprC z => z
foo = (lit 10 add lit 30) mul lit 10

We can reinterpret the same function in many ways

instance ExprC Int where
lit x = x
add x y = x + y
mul x y = x * y

instance ExprC String where
lit x = show x
add x y = "(" <> show x <> " + " <> show y <> ")"
mul x y = "(" <> show x <> " * " <> show y <> ")"

foo = (lit 10 add lit 30) mul lit 10

boo :: String
boo = foo -- 400

baz :: Int
baz = foo -- "((10 + 30) * 10)"

We can reinterpret the same function in many ways

evalAlg = Algebra ExprF Int
evalAlg = \case (LitF x)   -> x
(AddF x y) -> x + y
(MulF x y) -> x * y

printAlg = Algebra ExprF String
printAlg = \case (LitF x)   -> show x
(AddF x y) -> "(" <> show x <> " + " <> show y <> ")"
(MulF x y) -> "(" <> show x <> " * " <> show y <> ")"

foo = (Lit 10 Add Lit 30) Mul Lit 10

boo :: String
boo = cata evalAlg foo  -- 400

baz :: Int
baz = cata printAlg foo -- "((10 + 30) * 10)"

But the same idea applies to Recursion schemes!

But the same idea applies to final tagless expressed using dictionaries!

evalAlg :: ExprA Int
evalAlg = ExprA {
lit x = x
add x y = x + y
mul x y = x * y
}

printAlg :: ExprA String
printAlg = ExprA {
lit x = show x
add x y = "(" <> show x <> " + " <> show y <> ")"
mul x y = "(" <> show x <> " * " <> show y <> ")"
}

foo = (Lit 10 Add Lit 30) Mul Lit 10

boo :: String
boo = foldExpr evalAlg foo  -- 400

baz :: Int
baz = foldExpr printAlg foo -- "((10 + 30) * 10)"
data Free f a = Pure a | Suspend (f (Free f a))

instance Functor f => Monad (Free f) where
return = Pure
(>>=) :: Free f a -> (a -> Free f b) -> Free f b
(Pure a)      >>= f = f a
(Suspend ffa) >>= f = Suspend $(>>= f) <$> ffa

runFree :: Monad g => (f :~> g) -> Free f a -> g a
runFree (Nat eval) (Pure a)      = return a
runFree (Nat eval) (Suspend ffa) =
(>>= id) $runFree (Nat eval) <$> eval ffa

data ServiceF a = Get Int (Int -> a)
| Set Int Int a
deriving instance (Functor ServiceF)

get :: Int -> Free ServiceF Int
get key = Suspend (Get key return)

set :: Int -> Free ServiceF ()
set key val = Suspend (Set key val (pure ()))

data ServiceF a = Get Int (Int -> a) | Set Int Int a
deriving (Functor ServiceF)

get :: Int -> Free ServiceF Int
get key = Suspend (Get key return)

set :: Int -> Free ServiceF ()
set key val = Suspend (Set key val (pure ()))

#### Recursion

By Alexander Konovalov

• 134