dev* 2016

@jyrimatti

Polarization, photochromism...

What do these have to do with programming?

- nothing

OK, fine, how about lenses and prisms?

I don't mention any laws.

I should.

Maybe some day I will find the time to check if I break any.

There are no new contributions here.

I picked stuff from here and there and put it together.

Imagine if,

we had a way to "zoom in" inside a structure to get a value.

Maybe even modify the value,

producing a modified clone of the structure.

Let's imagine we want to assign salaries to employees.

```
class Department {
Employee _manager;
}
class Employee {
Integer _salary;
}
Department assignSalaries(Department d) {
d._manager._salary = 10000;
}
```

Simple but mutable. Mutability causes lots of problems.

Can we make it immutable?

```
class Department {
final Employee _manager;
Department(Employee manager) { this._manager = manager; }
}
class Employee {
final Integer _salary;
Employee(Integer salary) { this._salary = salary; }
}
Department assignSalaries(Department d} {
return new Department(new Employee(10000));
}
```

Awkward. Doesn't scale.

Unrealistic when objects have more than a few fields.

```
Builder<Employee> eBuilder = Builder.of(Employee_.$Fields(), Employee_.$);
Builder<Department> dBuilder = Builder.of(Department_.$Fields(), Department_.$);
Lens<Employee, Integer> salary = Lens.of(Employee_._salary , eBuilder);
Lens<Department, Employee> manager = Lens.of(Department_._manager, dBuilder);
Lens<Department, Employee> managerSalary = manager.andThen(salary);
Department assignSalaries(Department d} {
return managerSalary.over(d, (s -> 10000));
}
```

With Builders we can copy objects,

with 1st class functions we can reference fields.

Verbose as hell, but scales indefinitely.

This is Lens

Lens is also, more or less, a "Costate Comonad Coalgebra".

You should probably forget that.

**2006:** *The Essence of the Iterator Pattern*. Traversals encode the Iterator pattern.

**2007:** *Haskell State Accessors*. Composable "Accessors" for getting/setting record fields.

**2009:** *CPS based functional references*. Using Functors to get different behaviors.

**2012:** *Polymorphic Update with van Laarhoven Lenses*.

**2012:** *Control.Lens* is released to Hackage.

**2014:** Some pure *profunctor* lenses appear.

**2015:** *Mezzolens* is pushed to Hackage, Purescript gets profunctor lenses.

**2016:** The present. Lenses appear in a number of languages. Profunctor lenses still under research.

**2017:** Maybe **You** figure out something useful?

*mostly from https://github.com/ekmett/lens/wiki/History-of-Lenses*

Following header makes the rest of the code samples compile. (Haskell-for-Mac, GHCi (see GIST))

```
{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}
import Data.Tuple (swap)
import Data.Monoid (First(..), getFirst)
import Data.Time.Clock.POSIX (getPOSIXTime)
import qualified Data.Char as Char
import qualified Data.Profunctor as P
import qualified Data.Tagged as T
import Control.Monad.Identity
import Control.Applicative (Const(..), getConst)
import Control.Category ((>>>))
import qualified Control.Lens as L
import Numeric.Natural
```

```
data MyLens s a = MyLens {
getter :: s -> a
, setter :: a -> s -> s
}
let get :: MyLens s a -> s -> a
get = getter
set :: MyLens s a -> a -> s -> s
set = setter
modify :: MyLens s a -> (a -> a) -> s -> s
modify l f s = (setter l) (f $ getter l s) s
data Employee = Employee { _salary :: Int } deriving Show
let salary = MyLens _salary (\a s -> s { _salary = a } )
get salary (Employee 42)
-- > 42
set salary 42 (Employee 1)
-- > Employee { salary_ = 42 }
modify salary (+1) (Employee 41)
-- > Employee { salary_ = 42 }
```

That's it!

Huge win with lenses is composition:

```
-- Define our own composition operator:
let (@.) :: MyLens a b -> MyLens b c -> MyLens a c
(@.) l@(MyLens g1 s1) r@(MyLens g2 s2) = MyLens (g2 . g1) (\c a -> modify l (\b -> set r c b) a)
data Department = Department { _manager :: Employee } deriving Show
let manager = MyLens _manager (\a s -> s { _manager = a } )
get (manager @. salary) (Department (Employee 42))
-- > 42
```

For modification we must get the value first

-> two traversals inside structure, ugh...

```
-- Let's replace the setter with a modifier:
data MyLens_modifier s a = MyLens_modifier {
getter :: s -> a
, modifier :: (a -> a) -> s -> s
}
-- Now 'modify' == modifier, and 'set' is easy to implement:
let modify :: MyLens_modifier s a -> (a -> a) -> s -> s
modify = modifier
set :: MyLens_modifier s a -> a -> s -> s
set l a = modifier l (const a)
```

How about returning the old value

alongside the new structure?

```
type MyLens_noGetter s a = (a -> a) -> s -> (a, s)
let get :: MyLens_noGetter s a -> s -> a
get l s = fst $ l id s
modify :: MyLens_noGetter s a -> (a -> a) -> s -> s
modify l f s = snd $ l f s
set :: MyLens_noGetter s a -> a -> s -> s
set l a s = snd $ l (const a) s
let salary :: MyLens_noGetter Employee Int = \f s -> let a = _salary s in (a, s { _salary = f a })
get salary (Employee 42)
-- > 42
set salary 42 (Employee 1)
-- > Employee { _salary = 42 }
modify salary (+1) (Employee 41)
-- > Employee { _salary = 42 }
```

```
type MyLens_destructuring s a = s -> (a, a -> s)
let get :: MyLens_destructuring s a -> s -> a
get l s = fst $ l s
modify :: MyLens_destructuring s a -> (a -> a) -> s -> s
modify l f s = let aas = l s in snd aas $ f (fst aas)
set :: MyLens_destructuring s a -> a -> s -> s
set l a s = (snd $ l s) a
let salary :: MyLens_destructuring Employee Int = \s -> (_salary s, \a -> s { _salary = a })
get salary (Employee 42)
-- > 42
set salary 42 (Employee 1)
-- > Employee { _salary = 42 }
modify salary (+1) (Employee 41)
-- > Employee { _salary = 42 }
```

it still works, and now the intuition is

"something that breaks a Structure to a Value

and a new Structure missing a Value"

```
-- Think about: (s -> t) and (a -> b), and s == "source" and t == "target"
data MyLens_typeChanging s t a b = MyLens_typeChanging {
getter :: s -> a
, modifier :: (a -> b) -> s -> t
}
type MyLens_noGetter s a = MyLens_typeChanging s s a a
let get = getter; modify = modifier; set l a = modifier l (const a)
data EmployeeWithoutSalary = EmployeeWithoutSalary { _salaryProposal :: Int } deriving Show
data InvalidDepartment = InvalidDepartment { _imanager :: EmployeeWithoutSalary } deriving Show
-- We know how to make department valid, given a function (f) that can make its manager valid:
let makeDepartmentValid f s@(InvalidDepartment m) = Department { _manager = f m }
-- So we can make a manager Lens which turns an invalid department to a valid one:
let manager :: MyLens_typeChanging InvalidDepartment Department EmployeeWithoutSalary Employee
manager = MyLens_typeChanging _imanager makeDepartmentValid
someInvalidDepartment = InvalidDepartment $ EmployeeWithoutSalary 42
modify manager (Employee . _salaryProposal) someInvalidDepartment
-- > Department { _manager = Employee { _salary = 42 } }
```

Regular functions are boring. What if we change to "monadic" functions, i.e. functions returning a wrapped value?

```
data MyLens_functor s t a b = MyLens_functor {
getter :: s -> a
, modifier :: forall f. Functor f => (a -> f b) -> (s -> f t)
}
let modify :: Functor f => MyLens_functor s t a b -> (a -> f b) -> (s -> f t)
modify = modifier
salary = MyLens_functor _salary (\f s -> fmap (\a -> s { _salary = a }) (f $ _salary s) )
updateSalary = (+1)
```

Needs a functor, so let's use some!

Remember Functors?

https://lahteenmaki.net/dev_*14/```
runIdentity $ modify salary (Identity . updateSalary) (Employee 41)
-- > Employee { _salary = 42 }
```

This looks like the previous modification!

In Control.Lens, 'over' does exactly this wrapping and unwrapping Identity.

```
getConst $ modify salary (Const . updateSalary) (Employee 41)
-- > 42
```

This looks like the regular get!

In Control.Lens, 'view' does exactly this wrapping and unwrapping Const.

Let's use a bit more interesting functor, like... I don't know...

```
let debugging f oldValue = do
putStrLn $ "Old value: " ++ show oldValue
started <- getPOSIXTime
let newVal = f oldValue
finished <- getPOSIXTime
putStrLn $ "New value: " ++ show newVal ++ ". Execution took " ++ show (finished-started) ++ " ms"
return newVal
modify salary (debugging updateSalary) $ Employee 41
-- > IO (Employee { _salary = 42 })
-- and outputs a debugging string when executed!
```

Who says purity prevents us from doing stuff!

Lens "zooms in" to a single value inside a structure.

What if we want to "zoom in" to multiple values?

Basic trick:

replace Functors with **Applicatives** and see what happens

(remember? https://lahteenmaki.net/dev_*14/)

```
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
type Traversal' s a = Traversal s s a a
```

Traversal can read and update multiple fields.

What if we want to "zoom in" to a part that may not be there?

```
type MyPrism s a = forall p f. (L.Choice p, Applicative f) => p a (f a) -> p s (f s)
let myPrism :: (a -> s) -> (s -> Maybe a) -> MyPrism s a
myPrism as sma = P.dimap (\s -> maybe (Left s) Right (sma s)) (either pure (fmap as)) . L.right'
review r = runIdentity . T.unTagged . r . T.Tagged . Identity
preview l = getFirst . L.foldMapOf l (First . Just)
-- conditional constructor to create a department with a suitable manager
let newDepartment emp | _salary emp > 5000 = Just $ Department emp
newDepartment _ = Nothing
-- prism breaking down the construction of a Department to
-- the "missing" value and the function taking the missing value
department :: MyPrism Employee Department
department = myPrism _manager newDepartment
review department $ Department (Employee 42)
-- > Employee {_salary = 42}
preview department $ Employee 42
-- > Nothing
preview department $ Employee 5042
-- > Just (Department {_manager = Employee {_salary = 5042})
```

So, we can test if the function accepts the given argument.

I guess all this would be utterly useless if it didn't compose:

```
-- Only allow an Employee with a positive salary
let newEmployee sal = if sal > 0 then Just $ Employee sal else Nothing
employee = myPrism _salary newEmployee
L.has employee $ 42
-- > True
L.has employee $ -42
-- > False
review employee $ Employee 42
-- > 42
preview employee $ -42
-- > Nothing
preview employee $ 42
-- > Just (Employee {_salary = 42})
-- prism for a valid department, that is, a department with an employee (manager) with salary >= 5000
let validDepartment = employee . department
L.has validDepartment $ 42
-- > False
L.has validDepartment $ 5042
-- > True
preview validDepartment $ 42
-- > Nothing
preview validDepartment $ 5042
-- > Just (Department {_manager = Employee {_salary = 5042})
```

With prisms we can build structures functionally with

"validation in constructors"

What if we are zoomed in to a part inside a huge structure, and want to observe the neighborhood?

Zooming again and again not acceptable performance-wise.

a Zipper can move inside a structure.

forwards/backwards in a list, up or down a binary tree...

Maybe some other year about zippers...

That is, in *abstract nonsense*

Let's define an 'Optic' as something that

goes from 's' to 't' and from 'a' to 'b'.

Or something that "zooms in" to an 'a' inside an 's' and

can transform them to 'b' and 't' respectively:

```
type Optic p s t a b = p a b -> p s t
```

'p' is something that can wrap this whole mess.

Isomorphism is something that can go "there and back again".

A transformation that preserves information.

Remember Profunctor? https://lahteenmaki.net/dev_*15/

A Bifunctor where the first argument is contravariant ("input") and the second is covariant ("output")

```
class Profunctor p where
dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
-- We get an isomorphism as an Optic with a profunctor wrapper:
type Iso s t a b = forall p. Profunctor p => Optic p s t a b
-- create an isomorphism
let iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso = dimap
let charAsInt :: Iso Int Int Char Char
charAsInt = iso toEnum fromEnum
charOptic :: Profunctor p => Optic p Int Int Char Char
charOptic = charAsInt
```

If we "Forget" the output transformation 'g'...

```
newtype Forget r a b = Forget { runForget :: a -> r }
instance Profunctor (Forget r) where
dimap f _ (Forget k) = Forget (k . f)
let view :: Optic (Forget a) s t a b -> s -> a
view o = runForget $ o $ Forget id
view charOptic 120
-- > 'x'
```

...we get a view to what an optic is "zoomed in to"

If we "Tag in" a final value 'b'...

```
newtype Tagged s b = Tagged { unTagged :: b }
instance Profunctor Tagged where
dimap _ g (Tagged b) = Tagged (g b)
let review :: Optic Tagged s t a b -> b -> t
review o = unTagged . o . Tagged
review charOptic 'x'
-- > 120
```

...we get back "its source"

With Forget and Tagged, an isomorphism can be inverted

```
let from :: Iso s t a b -> Iso b a t s
from i = iso (review i) (view i)
view charOptic 120
-- > 'x'
view (from charOptic) 'x'
-- > 120
```

If we use regular function for the Optic...

```
instance Profunctor (->) where
dimap ab cd bc = cd . bc . ab
let over :: Optic (->) s t a b -> (a -> b) -> (s -> t)
over = id
set :: Optic (->) s t a b -> b -> s -> t
set o = over o . const
over charOptic (Char.toUpper) 120
-- > 88 (== 'X')
set charOptic 'X' 120
-- > 88
```

...we get modifier and setter

```
class Profunctor p => Strong p where
first' :: p a b -> p (a, c) (b, c)
first' = dimap swap swap . second'
second' :: p a b -> p (c, a) (c, b)
second' = dimap swap swap . first'
instance Strong (->) where
first' ab ~(a, c) = (ab a, c)
instance Strong (Forget r) where
first' (Forget k) = Forget (k . fst)
```

If we use Strength to "Pass through values",

we get Lens

```
type Lens s t a b = forall p. Strong p => Optic p s t a b
let lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens f g = dimap (f &&& id) (uncurry $ flip g) . first'
where
(***) :: (b -> c) -> (b' -> c') -> (b,b') -> (c,c')
f *** g = first' f >>> swap >>> first' g >>> swap
(&&&) :: (b -> c) -> (b -> c') -> b -> (c,c')
f &&& g = (\b -> (b,b)) >>> f *** g
let charLens :: Lens Int Int Char Char
charLens = lens toEnum (\s b -> fromEnum b)
salary :: Lens Employee Employee Int Int
salary = lens _salary (\s b -> s { _salary = b })
view charLens 120
-- > 'x'
set charLens 'x' 42
-- > 120
over charLens (Char.toUpper) 120
-- > 88 (== 'X')
```

Lens composition:

```
let toUpperLens = lens Char.toUpper $ \s -> Char.toLower
view (charLens . toUpperLens) 120
-- > 'X'
```

By using Choice as the wrapper...

```
class Profunctor p => Choice p where
left' = dimap (either Right Left) (either Right Left) . right'
right' = dimap (either Right Left) (either Right Left) . left'
instance Choice Tagged where
left' (Tagged b) = Tagged (Left b)
instance Monoid r => Choice (Forget r) where
left' (Forget k) = Forget (either k (const mempty))
type Prism s t a b = forall p. Choice p => Optic p s t a b
let prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism f g = dimap g (either id f) . right'
preview :: Prism s t a b -> s -> (Maybe a)
preview l = getFirst . (runForget . l . Forget $ First . pure)
let charPrism :: Prism Int Int Char Char
charPrism = prism fromEnum (\s -> if s > 0 then Right (toEnum s) else Left s)
review charPrism 'x'
-- > 120
preview charPrism 120
-- > Just 'x'
preview charPrism (-120)
-- > Nothing
```

... we get Prism

```
instance Choice (->) where
left' ab (Left a) = Left (ab a)
left' _ (Right c) = Right c
class (Strong p, Choice p) => Wander p where
wander :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t
instance Wander (->) where
wander t f = runIdentity . t (Identity . f)
type Traversal s t a b = forall p. Wander p => Optic p s t a b
let traversed :: forall t a b. (Traversable t) => Traversal (t a) (t b) a b
traversed = wander traverse
```

If instead of a regular function we use a "monadic function",

that is, a function of the form "a -> m b"

wrapped inside a data type (Kleisli),

we get IO etc.

```
data Kleisli m a b = Kleisli { runKleisli :: a -> m b }
instance Functor f => Profunctor (Kleisli f) where
dimap f g (Kleisli h) = Kleisli (fmap g . h . f)
instance Applicative f => Choice (Kleisli f) where
right' (Kleisli f) = Kleisli foo
where foo (Left c) = pure $ Left c
foo (Right a) = sequenceA $ Right (f a)
instance Functor f => Strong (Kleisli f) where
second' (Kleisli h) = Kleisli $ \(x,y) -> (,) x <$> (h y)
let modifyM :: Optic (Kleisli f) s t a b -> (a -> f b) -> s -> f t
modifyM l = runKleisli . l . Kleisli
modifyM charLens (\c -> do putStrLn "You see me!"; return $ Char.toUpper c) 120
-- > IO 88
-- and outputs "You see me!" when executed!
```

Similarly, we can wrap a "comonadic function"

to a CoKleisli type to be able to use

comonadic (w a -> b) instead of monadic functions:

```
data CoKleisli w a b = CoKleisli { runCoKleisli :: w a -> b }
instance Functor f => Profunctor (CoKleisli f) where
dimap f g (CoKleisli h) = CoKleisli (g . h . fmap f)
let modifyW :: Optic (CoKleisli f) s t a b -> (f a -> b) -> f s -> t
modifyW l = runCoKleisli . l . CoKleisli
data MyEnv v = MyEnv Int v
instance Functor MyEnv where
fmap f (MyEnv e v) = MyEnv e $ f v
let getEnv (MyEnv e v) = e
getValue (MyEnv e v) = v
let someComonadicFunction :: MyEnv Char -> Char
someComonadicFunction env = Char.toUpper $ toEnum $ fromEnum (getValue env) + getEnv env
view charOptic $ modifyW charOptic someComonadicFunction (MyEnv 1 120)
-- > 'Y'
```

We can finally reference "things" inside complex hierarchies:

```
data Money = Money { _amount :: Natural, _currency :: String } deriving Show
data Employee = Employee { _salary :: Maybe Money } deriving Show
data Department = Department { _employees :: [Employee] } deriving Show
let employees :: Lens Department Department [Employee] [Employee]
employees = lens _employees (\d es -> d { _employees = es })
salary :: Lens Employee Employee (Maybe Money) (Maybe Money)
salary = lens _salary (\e s -> e { _salary = s })
amount :: Lens Money Money Natural Natural
amount = lens _amount (\m a -> m { _amount = a })
just :: Prism (Maybe a) (Maybe b) a b
just = prism Just $ maybe (Left Nothing) Right
someDepartment = Department [Employee (Just $ Money 42 "Euro")]
let nilled = set (employees.traversed.salary) Nothing someDepartment
-- > Department {_employees = [Employee {_salary = Nothing}]}
over (employees.traversed.salary.just.amount) (+1) nilled
-- > Department {_employees = [Employee {_salary = Nothing}]}
over (employees.traversed.salary.just.amount) (+1) someDepartment
-- > Department {_employees = [Employee {_salary = Just (Money {_amount = 43, _currency = "Euro"})}]}
```

Like object-oriented dot-notation but better!

Optics are useful, in any language striving for immutability.

Multiple libraries and languages provide Optics.

In 10-20 years we will all be using Optics

in everyday programming.

Implementing Optics with Profunctors

is an active research topic.

The code:

https://gist.github.com/jyrimatti/02722d1422534016170219ab3a8086e2

Excellent tutorial for a passionate mind:

https://artyom.me/#lens-over-tea

Nice QA:

https://www.schoolofhaskell.com/user/tel/a-little-lens-starter-tutorial

More lens stuff:

https://github.com/ekmett/lens/wiki/FAQ#q-where-can-i-learn-more-about-lenses-in-general

Mezzolens:

https://hackage.haskell.org/package/mezzolens

Mainline Profunctor Heirarchy for Optics:

http://r6research.livejournal.com/27476.html

Profunctor lenses for Purescript:

https://github.com/purescript-contrib/purescript-profunctor-lenses/

Keep your focus on learning new stuff!

Thank you.

link to this presentation: https://lahteenmaki.net/dev_*16/