3 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

More information

Link:http://fssnip.net/7Pk
Posted:7 years ago
Author:Vesa Karvonen
Tags: haskell , lens