2 people like it.

# Polymorphic lenses

Two encodings of van Laarhoven style lenses allowing polymorphic updates

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: ``` ``````// So called van Laarhoven lenses, named after their discoverer, have a number // of nice properties as explained by Russell O'Connor: // // http://r6.ca/blog/20120623T104901Z.html // // Unfortunately their typing (in Haskell) // // type Lens s t a b = forall f. Functor f => (a -> f b) -> (s -> f t) // // seems to be well outside of what can be achieved in F#. // // Is it possible to encode van Laarhoven lenses in F#? // // The first thing to notice about van Laarhoven lenses is that, while the above // type definition is polymorphic in the functor f, only two concrete functor // instances are actually used, namely // // - Identity, by the over operation, and // - Const, by the view operation. // // We can define a unified functor that simultaneously implements both Identity // and Const: type LensPolyFunctor<'k, 'a> = | Identity of 'a | Const of 'k member t.map a2b = match t with | Identity a -> Identity (a2b a) | Const k -> Const k // The astute reader recognizes that the above is isomorphic to the binary // Choice type. // // This avoids the need to use higher-kinded types. We are left with // higher-rank polymorphism (again in Haskell notation): // // type LensPoly s t a b = // forall k. (a -> LensPolyFunctor k b) -> (s -> LensPolyFunctor k t) // // This can be encoded in F# using an interface or class type with a polymorphic // method: type LensPoly<'s, 't, 'a, 'b> = abstract Apply<'k> : ('a -> LensPolyFunctor<'k, 'b>) -> ('s -> LensPolyFunctor<'k, 't>) // And we can implement the desired operations: module LensPoly = let view (l: LensPoly<'s,'t,'a,'b>) = l.Apply Const >> function Const k -> k | _ -> failwith "Impossible" let over (l: LensPoly<'s,'t,'a,'b>) a2b = l.Apply (a2b >> Identity) >> function Identity b -> b | _ -> failwith "Impossible" let set l b = over l <| fun _ -> b // The astute reader is worried about the partial functions above. If a safe // implementation is desired, the `LensPolyFunctor` type can be made abstract // or private. let lens<'s,'t,'a,'b> (get: 's -> 'a) (set: 'b -> 's -> 't) = {new LensPoly<'s,'t,'a,'b> with override r.Apply f = fun s -> (get s |> f).map(fun x -> set x s)} let (>->) (l1: LensPoly<_,_,_,_>) (l2: LensPoly<_,_,_,_>) = {new LensPoly<'s,'t,'a,'b> with override t.Apply f = l1.Apply (l2.Apply f)} // Everything works up and until this point, but now we run into a difficulty // with the value restriction. If we just try to define lenses for pairs as // let fstL' = lens fst <| fun x (_, y) -> (x, y) // let sndL' = lens snd <| fun y (x, _) -> (x, y) // their types will not be generalized. In F#, a workaround is to use explicit // type parameters: let fstL<'a, 'b, 'c> : LensPoly<'a * 'b, 'c * 'b, 'a, 'c> = lens fst <| fun x (_, y) -> (x, y) let sndL<'a, 'b, 'c> : LensPoly<'a * 'b, 'a * 'c, 'b, 'c> = lens snd <| fun y (x, _) -> (x, y) // to get the desired polymorphic types. (Another workaround would be to add a // dummy unit parameter.) We can now compose lenses to perform polymorphic // updates: do ((1, (2.0, '3')), true) |> over (fstL >-> sndL >-> fstL) (fun x -> x + 3.0 |> string) |> printfn "%A" // The above encoding works, but it is rather heavy. Is there a simpler // encoding? // // One of the things that F# allows us to do is to use effects and those can // often be used to work around lack of higher-rank types. The need to have a // higher-rank type in the above encoding arose from the parameter to the Const // functor and the only use of the Const functor is in the view function. We // can eliminate that parameter by using effects. Here are the simplified // functor and lens types: type LensFunctor<'a> = | Over of 'a | View member t.map a2b = match t with | Over a -> Over (a2b a) | View -> View // The astute reader recognizes the above as isomorphic to the Option type. type Lens<'s,'t,'a,'b> = ('a -> LensFunctor<'b>) -> 's -> LensFunctor<'t> // Now polymorphic lenses are just functions. // // Let's then see the rest of the implementation. module Lens = let view l s = let r = ref Unchecked.defaultof<_> s |> l (fun a -> r := a; View) |> ignore !r // As mentioned, the view function now uses an effect internally. let over l f = l (f >> Over) >> function Over t -> t | _ -> failwith "Impossible" let set l b = over l <| fun _ -> b let (>->) a b = a << b // As seen above, we can now use ordinary function composition to compose // polymorphic lenses. In fact, we could leave `>->` as undefined and just use // `<<`. let lens get set = fun f s -> (get s |> f : LensFunctor<_>).map (fun f -> set f s) // Now that lenses are just functions, we can use eta-expansion to define // polymorphic lenses: let fstL f = lens fst (fun x (_, y) -> (x, y)) f let sndL f = lens snd (fun y (x, _) -> (x, y)) f do ((1, (2.0, '3')), true) |> over (fstL >-> sndL >-> fstL) (fun x -> x + 3.0 |> string) |> printfn "%A" // One potential problem with this approach is that the manipulation of values // of the lens functor type, which is like the Option type, may be expensive, // because F# tends to generate memory allocations when dealing with such types. // The lens functor type can be encoded as a struct type and it might help the // F# compiler to eliminate allocations. But let's leave that for further work. ``````
union case LensPolyFunctor.Identity: 'a -> LensPolyFunctor<'k,'a>
union case LensPolyFunctor.Const: 'k -> LensPolyFunctor<'k,'a>
val t : LensPolyFunctor<'k,'a>
member LensPolyFunctor.map : a2b:('a -> 'a0) -> LensPolyFunctor<'k,'a0>

Full name: Script.LensPolyFunctor`2.map
val a2b : ('a -> 'a0)
val a : 'a
val k : 'k
type LensPoly<'s,'t,'a,'b> =
interface
abstract member Apply : ('a -> LensPolyFunctor<'k,'b>) -> ('s -> LensPolyFunctor<'k,'t>)
end

Full name: Script.LensPoly<_,_,_,_>
abstract member LensPoly.Apply : ('a -> LensPolyFunctor<'k,'b>) -> ('s -> LensPolyFunctor<'k,'t>)

Full name: Script.LensPoly`4.Apply
type LensPolyFunctor<'k,'a> =
| Identity of 'a
| Const of 'k
member map : a2b:('a -> 'a0) -> LensPolyFunctor<'k,'a0>

Full name: Script.LensPolyFunctor<_,_>
val view : l:LensPoly<'s,'t,'a,'b> -> ('s -> 'a)

Full name: Script.LensPoly.view
val l : LensPoly<'s,'t,'a,'b>
abstract member LensPoly.Apply : ('a -> LensPolyFunctor<'k,'b>) -> ('s -> LensPolyFunctor<'k,'t>)
val k : 'a
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val over : l:LensPoly<'s,'t,'a,'b> -> a2b:('a -> 'b) -> ('s -> 't)

Full name: Script.LensPoly.over
val a2b : ('a -> 'b)
val b : 't
val set : l:LensPoly<'a,'b,'c,'d> -> b:'d -> ('a -> 'b)

Full name: Script.LensPoly.set
val l : LensPoly<'a,'b,'c,'d>
val b : 'd
val lens : get:('s -> 'a) -> set:('b -> 's -> 't) -> LensPoly<'s,'t,'a,'b>

Full name: Script.LensPoly.lens
val get : ('s -> 'a)
val set : ('b -> 's -> 't)
val r : LensPoly<'s,'t,'a,'b>
val f : ('a -> LensPolyFunctor<'c,'b>)
val s : 's
val x : 'b
val l1 : LensPoly<'s,'t,'a,'b>
val l2 : LensPoly<'a,'b,'a0,'b1>
val t : LensPoly<'s,'t,'a,'b>
val fstL<'a,'b,'c> : LensPoly<('a * 'b),('c * 'b),'a,'c>

Full name: Script.LensPoly.fstL
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val x : 'c
val y : 'b
val sndL<'a,'b,'c> : LensPoly<('a * 'b),('a * 'c),'b,'c>

Full name: Script.LensPoly.sndL
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val y : 'c
val x : 'a
val x : float
Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
type LensFunctor<'a> =
| Over of 'a
| View
member map : a2b:('a -> 'a0) -> LensFunctor<'a0>

Full name: Script.LensFunctor<_>
union case LensFunctor.Over: 'a -> LensFunctor<'a>
union case LensFunctor.View: LensFunctor<'a>
val t : LensFunctor<'a>
member LensFunctor.map : a2b:('a -> 'a0) -> LensFunctor<'a0>

Full name: Script.LensFunctor`1.map
type Lens<'s,'t,'a,'b> = ('a -> LensFunctor<'b>) -> 's -> LensFunctor<'t>

Full name: Script.Lens<_,_,_,_>
Multiple items
module Lens

from Script

--------------------
type Lens<'s,'t,'a,'b> = ('a -> LensFunctor<'b>) -> 's -> LensFunctor<'t>

Full name: Script.Lens<_,_,_,_>
val view : l:(('a -> LensFunctor<'b>) -> 'c -> 'd) -> s:'c -> 'a

Full name: Script.Lens.view
val l : (('a -> LensFunctor<'b>) -> 'c -> 'd)
val s : 'c
val r : 'a ref
Multiple items
val ref : value:'T -> 'T ref

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

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
val over : l:(('a -> LensFunctor<'b>) -> 'c -> LensFunctor<'d>) -> f:('a -> 'b) -> ('c -> 'd)

Full name: Script.Lens.over
val l : (('a -> LensFunctor<'b>) -> 'c -> LensFunctor<'d>)
val f : ('a -> 'b)
val t : 'd
val set : l:(('a -> LensFunctor<'b>) -> 'c -> LensFunctor<'d>) -> b:'b -> ('c -> 'd)

Full name: Script.Lens.set
val b : 'b
val a : ('a -> 'b)
val b : ('c -> 'a)
val lens : get:('a -> 'b) -> set:('c -> 'a -> 'd) -> f:('b -> LensFunctor<'c>) -> s:'a -> LensFunctor<'d>

Full name: Script.Lens.lens
val get : ('a -> 'b)
val set : ('c -> 'a -> 'd)
val f : ('b -> LensFunctor<'c>)
val s : 'a
val f : 'c
val fstL : f:('a -> LensFunctor<'b>) -> ('a * 'c -> LensFunctor<'b * 'c>)

Full name: Script.Lens.fstL
val f : ('a -> LensFunctor<'b>)
val sndL : f:('a -> LensFunctor<'b>) -> ('c * 'a -> LensFunctor<'c * 'b>)

Full name: Script.Lens.sndL