Optics in Programming

dev* 2016

@jyrimatti

Polarization, photochromism...

What do these have to do with programming?

- nothing

OK, fine, how about lenses and prisms?

Beware!

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.

Functional reference

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.

The problem, in Java

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.

Actual working example

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

History

Our own Lens. In Haskell.

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
					

Lens as a pair of getter and setter

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!

Composition

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
					

Setter or modifier?

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)

Do we need the getter?

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 }
					

Another definition

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"

Make illegal states unrepresentable

-- 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 } }

					

Digging deeper

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!

Some basic functors

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
						

IO?

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!

Single value ...or more?

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
						

Prism

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.

Composition, again

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})
						

Zoomed in ...or moving?

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...

In (category) theory

That is, in abstract nonsense

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

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

Isomorphisms

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
    				

Profunctors. Never forget.

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"

Tagged

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

Strength

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'
					

Prism

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
						

Traversals

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
    				

IO?

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!
					

Comonadic?

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'
					

The point?

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"})}]}
						

Conclusion

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.

Reading material

Keep your focus on learning new stuff!

Thank you.