Friday, April 25, 2014

Partial Lenses in F#

Partial Lenses in F#

Based on Mauricio's article about Lenses in F#, I recently tried to use lenses in our project, but very soon ran into some fundamental limitations. It turned out be an interesting problem and in the end, we use a modified version of lenses in our project and are happy with the result.

What are lenses

As a quick reminder, lenses are bi-directional transformations which allow you to make a well-behaved copy-and-update operation on (potentially deeply) nested data structures.

They offer two functions get : 'a -> 'b and set : 'b -> 'a -> 'a. The idea is, that you can "zoom in" to a property and perform local transformations that properly propagate through the object graph. Based on those two we can define a function update : '(b -> 'b) -> 'a -> 'a that first applies the get then maps a function over the value and in the end applies set to perform a map somewhere in the object graph.

In particular, lenses can be composed and still behave as one would expect for a copy-and-update operation. For a more detailed introduction, read Mauricio's article.

The Problem

While lenses formulated in the way, as Mauricio presents them are very good for product types like tuples or records, they do not work for sum types like discriminated unions. Consider the following example

1: 
2: 
3: 
4: 
type Shape =
    | Rectangle of width : float * length : float
    | Circle of radius : float
    | Prism of width : float * float * height : float

In this case, we cannot create a lens for say the prism, let alone for the height of prism.

As it turns out, the latter is an important feature, because in F# in general and in our project in particular, we use a lot of discriminated unions. So there was the question, if we could somehow extend the idea of a lens, such that it would work also for sum types as opposed to only product types

Towards partial lenses

The idea, how to make lenses work well with sum types, to consider partial functions instead of total ones: get : 'a -> 'b optionand set : 'b -> 'a -> 'a.

The first point of interest is, that only the get function has a different signature, this is due to the fact, that we may not get a value out of our lens - it is a partial function. When we try to set a value, though, the original object already exists, so if the lens does not trigger, then it just returns the original result instead of changing anything. Our derived update function also keeps its type.

The next question is how do we compose such lenses? It turns out, that it is essentially a monadic bind of the option monad.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
type Lens<'a, 'b> =
    { Get : 'a -> 'b option
      Set : 'b -> 'a -> 'a }
    member l.Update f a =
        match l.Get a with
        | Some x -> l.Set (f x) a
        | None -> a

let compose (l1 : Lens<_, _>) (l2 : Lens<_, _>) =
    { Get = fun a -> Option.bind l1.Get (l2.Get a)
      Set = l1.Set >> l2.Update }

Now we define our partial lenses for discriminated unions thus:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
type MyType =
    | MyCase of string
    | MyOther of int

let myCase =
    { Get = function
        | MyCase value -> Some value
        | _ -> None
      Set = fun newValue -> function
        | MyCase _ -> newValue
        | a -> a }

For normal or total lenses, we can define the get as simply wrapping the Value with Some.

Making sure the lenses are well-behaved

In order to be well-behaved, lenses should fulfil the following lens laws:

  • get-set-law: set (get a) a = a
  • set-get-law: get (set v a) = v
  • set-set-law: set v' (set v a) = set v' a

Now, we cannot immediately fulfil those laws, because our get function is partial, or rather yields an option value. However, we do can show, that the laws hold for the case, where the lense actually yields a value, so this is a conservative extension.

We redefine the get as get' = get >> Option.get, that is, we apply get and immediately unwrap the option. This is now no longer a total function, i.e. it throws for cases, where get returned None, but for the cases, where the original get yielded a Some value, it yields the same value.

By definition, for all total lenses, our partial lens yields the same value, wrapped with Some, so for those cases get' behaves exactly like the original total lens and therefore fulfills the same laws.

And for partial lenses, we only want to show, that the laws hold for the case, where the lens yields a value: Therefore, without loss of generality, assume a = MyCase x for some x and the case MyCase of the lens.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
set (get' a) a
    = set ((get >> Option.get) a) a
    = set (Option.get (get (MyCase x))) a
    = set (Option.get (Some x)) a
    = set x a
    = set x (MyCase x)
    = MyCase x
    = a

get' (set v a)
    = get' (set v (MyCase x))
    = get' (MyCase v)
    = Option.get (Some v)
    = v

set v' (set v a)
    = set v' (set v (MyCase x))
    = set v' (MyCase v)
    = MyCase v'
    = set v' (MyCase x)
    = set v' a

Possible improvement

One possible improvement would be, to distinguish between partial lenses (for sum types) and total lenses (for product types). Whilst I think, it would be possible to properly propagate which lenses are total and which ones are partial (in a static fashion), we did not go down that route, because of two reasons: To get a value, a single pattern match is enough on the caller site and our objects are rarely consisting only of product types. Therefore the more general partial lenses were good enough for our use case.

If one wants to make this distinction properly, one needs 4 overloads of the lens function each: One where both sides are total lenses, one with the first a partial lens, one with the second being partial and one for both sides partial.

type Shape =
  | Rectangle of width: float * length: float
  | Circle of radius: float
  | Prism of width: float * float * height: float

Full name: partiallenses.Shape
union case Shape.Rectangle: width: float * length: float -> Shape
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
union case Shape.Circle: radius: float -> Shape
union case Shape.Prism: width: float * float * height: float -> Shape
type Lens<'a,'b> =
  {Get: 'a -> 'b option;
   Set: 'b -> 'a -> 'a;}
  member Update : f:('b -> 'b) -> a:'a -> 'a

Full name: partiallenses.Lens<_,_>
Lens.Get: 'a -> 'b option
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
Multiple items
Lens.Set: 'b -> 'a -> 'a

--------------------
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>
val l : Lens<'a,'b>
member Lens.Update : f:('b -> 'b) -> a:'a -> 'a

Full name: partiallenses.Lens`2.Update
val f : ('b -> 'b)
val a : 'a
union case Option.Some: Value: 'T -> Option<'T>
val x : 'b
Lens.Set: 'b -> 'a -> 'a
union case Option.None: Option<'T>
val compose : l1:Lens<'a,'b> -> l2:Lens<'c,'a> -> Lens<'c,'b>

Full name: partiallenses.compose
val l1 : Lens<'a,'b>
val l2 : Lens<'c,'a>
val a : 'c
module Option

from Microsoft.FSharp.Core
val bind : binder:('T -> 'U option) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.bind
Lens.Get: 'c -> 'a option
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>
member Lens.Update : f:('b -> 'b) -> a:'a -> 'a
type MyType =
  | MyCase of string
  | MyOther of int

Full name: partiallenses.MyType
union case MyType.MyCase: string -> MyType
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
union case MyType.MyOther: int -> MyType
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val myCase : Lens<MyType,string>

Full name: partiallenses.myCase
val value : string
val newValue : string
val a : MyType
val set : (string -> MyType -> MyType)

Full name: partiallenses.set
val get' : (MyType -> string)

Full name: partiallenses.get'
val get : (MyType -> string option)

Full name: partiallenses.get
val get : option:'T option -> 'T

Full name: Microsoft.FSharp.Core.Option.get

No comments:

Post a Comment