Lenses and Prisms in OCaml

2026-09-25 · 24 min

An optic is a first-class value that gets at one part of a structure and puts it back; Haskell has them in lens. This post builds them for OCaml: a small library where the kind of an optic lives in its type, a ppx that derives lenses from records and prisms from variants, and two extensions that turn a field path and a pattern into optics.

This post assumes the basics from ppx in Practice: what a deriver is, and how ppxlib registers one.

§ 01

Where this ends up

A save file for a small RPG. Every type derives optics.

type item =
  | Sword of { name : string; damage : int }
  | Potion of int
  | Gold of int
  | Key of string
[@@deriving optics]
 
type stats = { hp : int; max_hp : int; level : int } [@@deriving optics]
 
type role = Fighter | Wizard | Thief [@@deriving optics]
 
type hero = { name : string; role : role; stats : stats; bag : item list }
[@@deriving optics]
 
type party = { heroes : hero list; camp : string } [@@deriving optics]

Optics compose with %, into paths through the whole party. [%lens hero.stats.hp] is a lens written as a field path; filtered keeps only the heroes a predicate accepts.

let heroes = party_heroes % each
let items = heroes % hero_bag % each
let gold = items % item_gold
let hp = heroes % [%lens hero.stats.hp]
let named n = heroes % filtered (fun (h : hero) -> h.name = n)
let damage = items % item_sword % snd
let fighters = heroes % filtered (has (hero_role % role_fighter))

Each edit, and each query, is one expression.

over (heroes % hero_stats) (fun s -> { s with hp = s.max_hp }) p
over damage (fun d -> d + 3) p
over (named "Quill" % [%lens hero.stats.level]) succ p
over (fighters % hero_bag) (fun bag -> Potion 5 :: bag) p
fold gold ( + ) 0 p

What running it prints, first and last.

Arriving at camp:
  Ada    lv3  hp  4/18  gold  40  potions 1  swords 
  Brom   lv4  hp 21/30  gold  12  potions 0  swords Rustfang+6
  Quill  lv2  hp  9/14  gold 253  potions 1  swords Nick+2
 
total gold: 305, lowest hp: 4
...
Gold is pooled into Ada's bag:
  Ada    lv3  hp 18/18  gold 305  potions 1  swords 
  Brom   lv4  hp 30/30  gold   0  potions 1  swords Rustfang+9
  Quill  lv3  hp 14/14  gold   0  potions 1  swords Nick+5
 
Ada's first potion heals 5; the camp is Mossy Ruins.

§ 02

One record for every optic

Haskell's lens library encodes an optic as a function polymorphic over a functor, forall f. Functor f => (a -> f a) -> s -> f s. That encoding composes with plain function composition, and it needs higher-kinded polymorphism over f, which OCaml only has through functors. So the optics here are a record, with one field per thing an optic can do.

Three capabilities. fold visits every focus, over rewrites every focus, and review builds a whole from a part if the optic can.

type ('s, 'a, +'k) t = {
  fold : 'r. ('r -> 'a -> 'r) -> 'r -> 's -> 'r;
  over : ('a -> 'a) -> 's -> 's;
  review : ('a -> 's) option;
}

fold is a left fold with its own polymorphic accumulator type 'r, which is why it is a record field and not a type parameter: one optic has to be folded into an int by length and into a list by to_list. A lens has exactly one focus, a prism zero or one, a traversal any number, and all three fit this shape. The third type parameter, 'k, appears in no field and records which of them a value is.

The constructors. Each one states its kind in its return type, and review is filled in exactly for the kinds that can go backwards.

let iso get build =
  {
    fold = (fun f acc s -> f acc (get s));
    over = (fun f s -> build (f (get s)));
    review = Some build;
  }
 
let lens get set =
  {
    fold = (fun f acc s -> f acc (get s));
    over = (fun f s -> set (f (get s)) s);
    review = None;
  }
 
let prism match_ build =
  {
    fold =
      (fun f acc s -> match match_ s with Some a -> f acc a | None -> acc);
    over = (fun f s -> match match_ s with Some a -> build (f a) | None -> s);
    review = Some build;
  }
 
let affine match_ set =
  {
    fold =
      (fun f acc s -> match match_ s with Some a -> f acc a | None -> acc);
    over =
      (fun f s -> match match_ s with Some a -> set (f a) s | None -> s);
    review = None;
  }
 
let traversal to_list over =
  {
    fold = (fun f acc s -> List.fold_left f acc (to_list s));
    over;
    review = None;
  }

§ 03

Kinds as a phantom polymorphic variant

Optics form a small lattice. An iso is both a lens and a prism. A lens composed with a prism is neither: it has at most one focus, like a prism, and cannot build a whole from a part, like a lens. That composite is usually called an affine traversal. Anything composed with a traversal is a traversal.

The kinds, as the types spell them. A kind lists what the optic might be, never what it certainly is.

iso        'k                               any kind at all
lens       [> `Lens ]
prism      [> `Prism ]
affine     [> `Lens | `Prism ]             a lens into a prism
traversal  [> `Traversal ]

The phantom parameter is an open polymorphic variant, and composition does nothing to it except require both sides to agree. Unifying [> `Lens ] with [> `Prism ] gives [> `Lens | `Prism ], the least upper bound.

Composition. Both arguments share one kind variable, and the result has it too.

let ( % ) o1 o2 =
  {
    fold = (fun f acc s -> o1.fold (fun acc a -> o2.fold f acc a) acc s);
    over = (fun f -> o1.over (o2.over f));
    review =
      (match (o1.review, o2.review) with
      | Some r1, Some r2 -> Some (fun b -> r1 (r2 b))
      | _ -> None);
  }

The shared 'k in the interface's type for % is what makes this work, and the first version left it out. Without it, the record literal says nothing about 'k, so the inferred type gives each argument and the result a kind of its own.

What ocamlc -i infers for an unannotated %. Composing a lens with a prism would then produce an optic of any kind at all, an iso included, and view would accept it.

val ( % ) : ('a, 'b, 'c) t -> ('b, 'd, 'e) t -> ('a, 'd, 'f) t

The eliminators go the other way. Each one takes a closed upper bound, the set of tags it tolerates. view needs exactly one focus, so it takes [< `Lens ]: an iso fits, since its kind is a free variable, and so does a lens. An affine traversal does not, because its kind mentions `Prism. review takes [< `Prism ], and anything that tolerates everything, like over, takes _.

The interface, which is where the kinds are enforced.

val ( % ) : ('s, 'a, 'k) t -> ('a, 'b, 'k) t -> ('s, 'b, 'k) t
 
(** {1 Eliminators} *)
 
val view : ('s, 'a, [< `Lens ]) t -> 's -> 'a
val preview : ('s, 'a, [< `Lens | `Prism ]) t -> 's -> 'a option
val first : ('s, 'a, _) t -> 's -> 'a option
(** The first focus of anything, traversals included. [preview] is the same
    function at a narrower type, one that promises there is at most one. *)
 
val review : ('s, 'a, [< `Prism ]) t -> 'a -> 's
val over : ('s, 'a, _) t -> ('a -> 'a) -> 's -> 's
val set : ('s, 'a, _) t -> 'a -> 's -> 's
val to_list : ('s, 'a, _) t -> 's -> 'a list
val fold : ('s, 'a, _) t -> ('r -> 'a -> 'r) -> 'r -> 's -> 'r
val length : ('s, 'a, _) t -> 's -> int
val has : ('s, 'a, _) t -> 's -> bool

Asking for the one focus of a prism.

File "view_prism.ml", line 3, characters 25-37:
3 | let radius = Optics.view shape_circle (Circle 1.)
                             ^^^^^^^^^^^^
Error: This expression has type (shape, float, [> `Prism ]) Optics.t
       but an expression was expected of type
         (shape, float, [< `Lens ]) Optics.t
       The second variant type does not allow tag(s) `Prism

Building a person from a name.

File "review_lens.ml", line 3, characters 27-38:
3 | let nobody = Optics.review person_name "Ada"
                               ^^^^^^^^^^^
Error: This expression has type (person, string, [> `Lens ]) Optics.t
       but an expression was expected of type
         (person, string, [< `Prism ]) Optics.t
       The second variant type does not allow tag(s) `Lens

A lens into an option field, composed with some, is affine: it cannot promise a port is there.

File "view_affine.ml", line 3, characters 31-49:
3 | let port = Optics.view Optics.(config_port % some) { port = Some 8080 }
                                   ^^^^^^^^^^^^^^^^^^
Error: This expression has type (config, int, [> `Prism ]) Optics.t
       but an expression was expected of type
         (config, int, [< `Lens ]) Optics.t
       The second variant type does not allow tag(s) `Prism

And preview on a traversal, which can have many foci.

File "preview_traversal.ml", line 1, characters 33-73:
1 | let first_even = Optics.(preview (each % filtered (fun n -> n mod 2 = 0))) [ 1; 2; 3; 4 ]
                                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This expression has type (int list, int, [> `Traversal ]) Optics.t
       but an expression was expected of type
         (int list, int, [< `Lens | `Prism ]) Optics.t
       The second variant type does not allow tag(s) `Traversal

The +'k in the type definition matters as well. A composed optic like let items = heroes % hero_bag % each is the result of an application, and the value restriction would normally make its kind a weak variable, fixed at its first use. OCaml's relaxed value restriction generalizes type variables that only appear covariantly, and a phantom parameter can be declared covariant because nothing constrains it. So % results stay polymorphic in their kind. Their source and focus types do not, for a reason §06 comes back to.

§ 04

Eliminators

Everything is a fold. first stops at the first focus by raising a local exception, whose type mentions the locally abstract type a.

let first (type a) o s =
  let exception Found of a in
  match o.fold (fun () a -> raise_notrace (Found a)) () s with
  | () -> None
  | exception Found a -> Some a
 
let preview = first
 
(* The kind [< `Lens] only admits isos and lenses, both of which
   have exactly one focus, so [preview] cannot come back empty. *)
let view o s =
  match preview o s with Some a -> a | None -> assert false
 
(* Likewise [< `Prism] only admits isos and prisms, and both
   constructors fill in [review]. *)
let review o a = match o.review with Some r -> r a | None -> assert false
let over o f s = o.over f s
let set o a s = o.over (fun _ -> a) s
let fold o f acc s = o.fold f acc s
let to_list o s = List.rev (o.fold (fun acc a -> a :: acc) [] s)
let length o s = o.fold (fun n _ -> n + 1) 0 s
let has o s = Option.is_some (preview o s)

Both assert false branches are unreachable. view is preview with the empty case ruled out: only an iso or a lens gets past [< `Lens ], and both have exactly one focus. The same argument covers review and [< `Prism ].

preview and first are the same function. The demo originally used preview to find Ada's first potion, and the compiler refused it: each makes the path a traversal, and the type of preview promises at most one answer. first takes any optic.

§ 05

Stock optics

A key in an association list, as a lens onto an option. Setting None deletes the entry, and setting Some appends it if it is missing.

let at k =
  lens (List.assoc_opt k) (fun v kvs ->
      match v with
      | None -> List.remove_assoc k kvs
      | Some v ->
          if List.mem_assoc k kvs then
            List.map (fun (k', v') -> if k' = k then (k', v) else (k', v')) kvs
          else kvs @ [ (k, v) ])

The nth element of a list: an affine traversal, since the list may be too short.

let nth i =
  affine
    (fun xs -> if i < 0 then None else List.nth_opt xs i)
    (fun a xs -> List.mapi (fun j x -> if j = i then a else x) xs)

filtered restricts any optic to the foci a predicate accepts. It is the one stock optic that can break the laws: over can map a focus to one the predicate rejects, and the next fold will not see it.

let filtered p =
  {
    fold = (fun f acc a -> if p a then f acc a else acc);
    over = (fun f a -> if p a then f a else a);
    review = None;
  }

§ 06

The value restriction, again

The stock optics that are not functions, like fst, some and each, are polymorphic in their source and focus. That rules out defining them with the constructors.

A lens on a parameterised record, built with Optics.lens and used at two types.

type 'a pair = { left : 'a; right : 'a }
 
let left = Optics.lens (fun p -> p.left) (fun v p -> { p with left = v })
let a = Optics.view left { left = 1; right = 2 }
let b = Optics.view left { left = "x"; right = "y" }
 
File "weak_lens.ml", line 5, characters 34-37:
5 | let b = Optics.view left { left = "x"; right = "y" }
                                      ^^^
Error: This expression has type string but an expression was expected of type
         int

Optics.lens get set is an application, so its type variables are weak unless they are covariant, and 's and 'a are not: over takes an 's and returns one. The first use fixes 'a to int. The fix is to write the optic as a syntactic value, a record literal, which is generalized unconditionally.

So the stock optics are written out in full. This is also why the record type is exposed, rather than kept abstract: the ppx has to be able to write the same literals.

let fst =
  {
    fold = (fun f acc (a, _) -> f acc a);
    over = (fun f (a, b) -> (f a, b));
    review = None;
  }
 
let some =
  {
    fold = (fun f acc s -> match s with Some a -> f acc a | None -> acc);
    over = Option.map;
    review = Some Option.some;
  }
 
let each =
  {
    fold = (fun f acc xs -> List.fold_left f acc xs);
    over = List.map;
    review = None;
  }

§ 07

The deriver

[@@deriving optics] on a record produces one lens per field, and on a variant one prism per constructor. The generator turns each type into a list of entries, each a name, a focus type, a kind, and the body of the record literal, and only then decides whether they become lets in a structure or vals in a signature. Errors are raised as an exception carrying a location, and caught at the edge of each type, where they become [%ocaml.error] nodes.

The entry point. Structures and signatures share everything up to the last step.

let str_type_decl ~loc:_ ~path:_ (_rec, tds) =
  List.concat_map
    (fun td ->
      match entries td with
      | entries ->
          let source = self_type td in
          List.map
            (fun e ->
              let loc = e.at in
              let ty = optic_type ~loc ~source ~focus:e.focus e.kind in
              pstr_value ~loc Nonrecursive
                [
                  value_binding ~loc ~pat:(pvar ~loc e.name)
                    ~expr:(pexp_constraint ~loc e.body ty);
                ])
            entries
      | exception Unsupported (loc, msg) -> [ error_str ~loc msg ])
    tds

The kind of each entry becomes the third type argument, and the type annotation goes on the expression, so the binding stays a syntactic value.

type kind = Iso | Lens | Prism
 
let kind_type ~loc = function
  | Iso -> ptyp_any ~loc
  | Lens -> [%type: [> `Lens ]]
  | Prism -> [%type: [> `Prism ]]
 
let optic_type ~loc ~source ~focus kind =
  [%type: ([%t source], [%t focus], [%t kind_type ~loc kind]) Optics.t]

Names. A field or constructor gets the type name as a prefix, except in a type called t, where the module name already says which type it is. Without the prefix a constructor called Method would produce a value called method, which cannot be referred to.

let value_name ~type_name base =
  let base = String.uncapitalize_ascii base in
  let name = if type_name = "t" then base else type_name ^ "_" ^ base in
  if Keyword.is_keyword name then name ^ "_" else name

Every optic the ppx writes has this shape. The parameter names f__, acc__ and s__ are fixed rather than generated so that the output is readable; §13 covers the downside.

let optic_record ~loc ~fold ~over ~review =
  [%expr
    {
      Optics.fold = (fun f__ acc__ -> [%e fold]);
      Optics.over = (fun f__ -> [%e over]);
      Optics.review = [%e review];
    }]

§ 08

Records

One lens per field, with a special case for single-field records.

let record_entries td labels =
  let type_name = td.ptype_name.txt in
  let source = self_type td in
  (* With one field, [{ s with f = v }] lists every field and warning 23
     fires on the generated code; and the lens is an iso anyway. *)
  let single = match labels with [ _ ] -> true | _ -> false in
  List.map
    (fun ld ->
      let loc = ld.pld_loc in
      reject_poly ~what:(Printf.sprintf "field %s" ld.pld_name.txt) ld.pld_type;
      let field = Located.lident ~loc ld.pld_name.txt in
      let get = pexp_field ~loc (s_ ~loc) field in
      let update v =
        pexp_record ~loc [ (field, v) ] (if single then None else Some (s_ ~loc))
      in
      let fold =
        [%expr fun [%p annotated_s ~loc source] -> f__ acc__ [%e get]]
      in
      let over =
        [%expr
          fun [%p annotated_s ~loc source] -> [%e update [%expr f__ [%e get]]]]
      in
      let review =
        if single then [%expr Some (fun a__ -> [%e update [%expr a__]])]
        else [%expr None]
      in
      {
        name = value_name ~type_name ld.pld_name.txt;
        at = loc;
        focus = ld.pld_type;
        kind = (if single then Iso else Lens);
        body = optic_record ~loc ~fold ~over ~review;
      })
    labels

What it generates for a two-field record.

include
  struct
    let _ = fun (_ : person) -> ()
    let person_name =
      ({
         Optics.fold =
           (fun f__ -> fun acc__ -> fun (s__ : person) -> f__ acc__ s__.name);
         Optics.over =
           (fun f__ ->
              fun (s__ : person) -> { s__ with name = (f__ s__.name) });
         Optics.review = None
       } : (person, string, [> `Lens ]) Optics.t)
    let _ = person_name
    let person_age =
      ({
         Optics.fold =
           (fun f__ -> fun acc__ -> fun (s__ : person) -> f__ acc__ s__.age);
         Optics.over =
           (fun f__ -> fun (s__ : person) -> { s__ with age = (f__ s__.age) });
         Optics.review = None
       } : (person, int, [> `Lens ]) Optics.t)
    let _ = person_age
  end

With one field, { s with meters = v } lists every field, and warning 23 turns the with into an error in dune's default development profile. The generated code has to drop it. And a record with one field is a bijection with that field, so its lens is really an iso, and gets the free kind and a review.

The single-field case.

include
  struct
    let _ = fun (_ : meters) -> ()
    let meters_meters =
      ({
         Optics.fold =
           (fun f__ ->
              fun acc__ -> fun (s__ : meters) -> f__ acc__ s__.meters);
         Optics.over =
           (fun f__ -> fun (s__ : meters) -> { meters = (f__ s__.meters) });
         Optics.review = (Some (fun a__ -> { meters = a__ }))
       } : (meters, float, _) Optics.t)
    let _ = meters_meters
  end

A field with a polymorphic type cannot be a focus: the optic would need to be polymorphic in its own focus type.

File "poly_field.ml", line 1, characters 26-45:
1 | type sorter = { compare : 'a. 'a -> 'a -> int; name : string } [@@deriving optics]
                              ^^^^^^^^^^^^^^^^^^^
Error: ppx_optics: field compare has a polymorphic type, and an optic's focus
       has to be a plain type

§ 09

Variants

A prism needs to take a constructor apart and put it back together, and the parser gives four different shapes to do that for. C of a * b is a constructor with two arguments. C of (a * b) is a constructor with one, which happens to be a tuple; the two have different runtime representations, and only the first needs the pattern C (x0, x1). An inline record needs a record pattern, and the focus is then a tuple of its fields, since an inline record cannot escape its constructor.

Every shape comes down to the same five pieces: how to match the arguments, how to rebuild them, and the focus as a type, a pattern and an expression.

type shape = {
  arg_pat : pattern option;
  arg_expr : expression option;
  focus_ty : core_type;
  focus_pat : pattern;
  focus_expr : expression;
}
 
let tuple_of ~loc ~ty ~pat ~expr = function
  | [] -> ([%type: unit], [%pat? ()], [%expr ()])
  | [ x ] -> (ty x, pat x, expr x)
  | xs ->
      ( ptyp_tuple ~loc (List.map ty xs),
        ppat_tuple ~loc (List.map pat xs),
        pexp_tuple ~loc (List.map expr xs) )
 
let var i = Printf.sprintf "x%d" i
 
let shape_of_args ~loc = function
  | Pcstr_tuple tys ->
      let xs = List.mapi (fun i ty -> (var i, ty)) tys in
      let focus_ty, focus_pat, focus_expr =
        tuple_of ~loc xs
          ~ty:(fun (_, ty) -> ty)
          ~pat:(fun (x, _) -> pvar ~loc x)
          ~expr:(fun (x, _) -> evar ~loc x)
      in
      let arg_pat, arg_expr =
        match xs with
        | [] -> (None, None)
        | _ -> (Some focus_pat, Some focus_expr)
      in
      { arg_pat; arg_expr; focus_ty; focus_pat; focus_expr }
  | Pcstr_record lds ->
      List.iter
        (fun ld ->
          reject_poly ~what:(Printf.sprintf "field %s" ld.pld_name.txt)
            ld.pld_type)
        lds;
      let xs = List.mapi (fun i ld -> (var i, ld)) lds in
      let field ld = Located.lident ~loc ld.pld_name.txt in
      let focus_ty, focus_pat, focus_expr =
        tuple_of ~loc xs
          ~ty:(fun (_, ld) -> ld.pld_type)
          ~pat:(fun (x, _) -> pvar ~loc x)
          ~expr:(fun (x, _) -> evar ~loc x)
      in
      {
        arg_pat =
          Some
            (ppat_record ~loc
               (List.map (fun (x, ld) -> (field ld, pvar ~loc x)) xs)
               Closed);
        arg_expr =
          Some
            (pexp_record ~loc
               (List.map (fun (x, ld) -> (field ld, evar ~loc x)) xs)
               None);
        focus_ty;
        focus_pat;
        focus_expr;
      }

The prism itself. When the constructor is the only one, the catch-all arm would never match, warning 11 would fire, and the prism is an iso anyway.

let case_entry ~loc ~type_name ~source ~exhaustive ~name ~pat ~expr shape =
  let fallthrough ok fallback =
    if exhaustive then [ case ~lhs:pat ~guard:None ~rhs:ok ]
    else
      [
        case ~lhs:pat ~guard:None ~rhs:ok;
        case ~lhs:(ppat_any ~loc) ~guard:None ~rhs:fallback;
      ]
  in
  let fold =
    [%expr
      fun [%p annotated_s ~loc source] ->
        [%e
          pexp_match ~loc (s_ ~loc)
            (fallthrough [%expr f__ acc__ [%e shape.focus_expr]] (acc_ ~loc))]]
  in
  let over =
    [%expr
      fun [%p annotated_s ~loc source] ->
        [%e
          pexp_match ~loc (s_ ~loc)
            (fallthrough
               [%expr
                 let [%p shape.focus_pat] = f__ [%e shape.focus_expr] in
                 [%e expr]]
               (s_ ~loc))]]
  in
  let review = [%expr Some (fun [%p shape.focus_pat] -> [%e expr])] in
  {
    name = value_name ~type_name name;
    at = loc;
    focus = shape.focus_ty;
    kind = (if exhaustive then Iso else Prism);
    body = optic_record ~loc ~fold ~over ~review;
  }

Rect of float * float: two arguments, one tuple focus.

let shape_rect =
  ({
     Optics.fold =
       (fun f__ ->
          fun acc__ ->
            fun (s__ : shape) ->
              match s__ with
              | Rect (x0, x1) -> f__ acc__ (x0, x1)
              | _ -> acc__);
     Optics.over =
       (fun f__ ->
          fun (s__ : shape) ->
            match s__ with
            | Rect (x0, x1) ->
                let (x0, x1) = f__ (x0, x1) in Rect (x0, x1)
            | _ -> s__);
     Optics.review = (Some (fun (x0, x1) -> Rect (x0, x1)))
   } : (shape, (float * float), [> `Prism ]) Optics.t)

Box of (float * float): one argument that is a tuple. The focus type is the same and the patterns are not.

let shape_box =
  ({
     Optics.fold =
       (fun f__ ->
          fun acc__ ->
            fun (s__ : shape) ->
              match s__ with | Box x0 -> f__ acc__ x0 | _ -> acc__);
     Optics.over =
       (fun f__ ->
          fun (s__ : shape) ->
            match s__ with
            | Box x0 -> let x0 = f__ x0 in Box x0
            | _ -> s__);
     Optics.review = (Some (fun x0 -> Box x0))
   } : (shape, (float * float), [> `Prism ]) Optics.t)

Tri of { a : float; b : float }: an inline record, focused as a tuple in field order.

let shape_tri =
  ({
     Optics.fold =
       (fun f__ ->
          fun acc__ ->
            fun (s__ : shape) ->
              match s__ with
              | Tri { a = x0; b = x1 } -> f__ acc__ (x0, x1)
              | _ -> acc__);
     Optics.over =
       (fun f__ ->
          fun (s__ : shape) ->
            match s__ with
            | Tri { a = x0; b = x1 } ->
                let (x0, x1) = f__ (x0, x1) in Tri { a = x0; b = x1 }
            | _ -> s__);
     Optics.review = (Some (fun (x0, x1) -> Tri { a = x0; b = x1 }))
   } : (shape, (float * float), [> `Prism ]) Optics.t)

A GADT constructor has its own return type, so a prism for it would need a source type that depends on the constructor.

File "gadt.ml", line 2, characters 2-25:
2 |   | Int : int -> int expr
      ^^^^^^^^^^^^^^^^^^^^^^^
Error: ppx_optics: Int is a GADT constructor: its prism would need a
       different source type per constructor

A private type can be read and matched but not built, and every lens and prism builds.

File "private_record.ml", line 1, characters 0-55:
1 | type positive = private { n : int } [@@deriving optics]
    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: ppx_optics: positive is private: its setters and constructors cannot
       be called from outside, and an optic needs them

GADTs in OCaml covers what those return types are for. A prism into Int : int -> int expr is fine at type int expr and meaningless at bool expr, and one optic value cannot be both.

§ 10

Polymorphic variants

The same prisms over tags. A tag carries at most one argument, and an inherited row just means the listed tags are not all of them, so the catch-all arm stays.

let poly_variant_entries td rows =
  let type_name = td.ptype_name.txt in
  let source = self_type td in
  let tags =
    List.filter_map
      (fun row ->
        match row.prf_desc with
        | Rtag (label, true, []) -> Some (label, None)
        | Rtag (label, false, [ ty ]) -> Some (label, Some ty)
        | Rtag (label, _, _) ->
            unsupported ~loc:row.prf_loc
              "`%s has a conjunctive type, which only occurs in an inferred \
               type, never in a type you can build a value of"
              label.txt
        | Rinherit _ -> None)
      rows
  in
  let inherits = List.length tags <> List.length rows in
  let exhaustive = (not inherits) && List.length tags = 1 in
  List.map
    (fun (label, arg) ->
      let loc = label.loc in
      let shape =
        match arg with
        | None ->
            {
              arg_pat = None;
              arg_expr = None;
              focus_ty = [%type: unit];
              focus_pat = [%pat? ()];
              focus_expr = [%expr ()];
            }
        | Some ty ->
            {
              arg_pat = Some [%pat? x0];
              arg_expr = Some [%expr x0];
              focus_ty = ty;
              focus_pat = [%pat? x0];
              focus_expr = [%expr x0];
            }
      in
      case_entry ~loc ~type_name ~source ~exhaustive ~name:label.txt
        ~pat:(ppat_variant ~loc label.txt shape.arg_pat)
        ~expr:(pexp_variant ~loc label.txt shape.arg_expr)
        shape)
    tags

Deriving for a type that inherits another one.

type colour = [ `Red | `Rgb of int * int * int ] [@@deriving optics]
type more_colour = [ colour | `Grey of int ] [@@deriving optics]
 
(* colour_red, colour_rgb, and more_colour_grey *)
preview more_colour_grey (`Red : more_colour)   (* None *)

§ 11

Signatures, and parameterised types

Deriving in an .mli produces the matching val declarations, so the optics can be exported.

type point = { x : float; y : float } [@@deriving optics]
type 'a tagged = { tag : string; value : 'a } [@@deriving optics]
type shape = Circle of point * float | Polygon of point list [@@deriving optics]

Expanded. The type parameter carries through, and the kinds stay open so a caller can compose them.

    val point_x : (point, float, [> `Lens ]) Optics.t
    val point_y : (point, float, [> `Lens ]) Optics.t
    val tagged_tag : ('a tagged, string, [> `Lens ]) Optics.t
    val tagged_value : ('a tagged, 'a, [> `Lens ]) Optics.t
    val shape_circle : (shape, (point * float), [> `Prism ]) Optics.t
    val shape_polygon : (shape, point list, [> `Prism ]) Optics.t

tagged_value really is polymorphic, where the hand-built left in §06 was not, because the generated definition is a record literal under a type annotation, and that is still a syntactic value.

§ 12

A lens from a field path

Deriving gives one optic per field, and a path through three records is three names and two %s. [%lens person.address.city] builds the composite from the path directly. A ppx runs before type checking, though: it cannot know that address is a field of type address, or even which record city belongs to.

Instead, it writes the getter as a chain of field accesses and the setter as nested record updates, annotates the root with the type named on the left, and leaves the rest to type-directed disambiguation of record labels, which is what OCaml does anyway when it sees s.address.city with s : person known.

The expander. The path parses as nested Pexp_field nodes around an identifier, which is the type name.

let rec lens_path e =
  match e.pexp_desc with
  | Pexp_field (e', field) ->
      let root, fields = lens_path e' in
      (root, fields @ [ field ])
  | Pexp_ident root -> (root, [])
  | _ ->
      unsupported ~loc:e.pexp_loc
        "expected a path like [%%lens person.address.city]: a type name \
         followed by fields"
 
let expand_lens ~ctxt e =
  let loc = Expansion_context.Extension.extension_point_loc ctxt in
  match lens_path e with
  | _, [] ->
      error_expr ~loc
        "a lens path needs at least one field after the type name"
  | root, fields ->
      let source = ptyp_constr ~loc root [] in
      let get =
        List.fold_left (fun e f -> pexp_field ~loc e f) (s_ ~loc) fields
      in
      (* [{ base with f = v }], nested once per field; [base] is the value
         the updated field lives in. *)
      let rec update base fields v =
        match fields with
        | [] -> v
        | f :: rest ->
            let inner = pexp_field ~loc base f in
            pexp_record ~loc [ (f, update inner rest v) ] (Some base)
      in
      let body =
        optic_record ~loc
          ~fold:[%expr fun [%p annotated_s ~loc source] -> f__ acc__ [%e get]]
          ~over:
            [%expr
              fun [%p annotated_s ~loc source] ->
                ([%e update (s_ ~loc) fields [%expr f__ [%e get]]]
                [@ocaml.warning "-23"])]
          ~review:[%expr None]
      in
      pexp_constraint ~loc body
        (optic_type ~loc ~source ~focus:(ptyp_any ~loc) Lens)
  | exception Unsupported (loc, msg) -> error_expr ~loc msg

What [%lens person.address.city] expands to. The warning attribute is there because the ppx does not know when a record has only one field, and warning 23 would then fire on the with.

let city =
  ({
     Optics.fold =
       (fun f__ ->
          fun acc__ -> fun (s__ : person) -> f__ acc__ (s__.address).city);
     Optics.over =
       (fun f__ ->
          fun (s__ : person) ->
            (({
                s__ with
                address =
                  { (s__.address) with city = (f__ (s__.address).city) }
              })
            [@ocaml.warning "-23"]));
     Optics.review = None
   } : (person, _, [> `Lens ]) Optics.t)

A misspelt field is reported by the type checker, at the field.

File "lens_wrong_field.ml", line 3, characters 37-45:
3 | let postcode = [%lens person.address.postcode]
                                         ^^^^^^^^
Error: This expression has type address
       There is no field postcode within type address

Type-directed disambiguation catches out the ppx's own code too. The first version of the polymorphic variant deriver bound a tag's label, of type string loc, as label, and read label.loc before anything had fixed its type. OCaml resolved .loc to the most recent record type with a field of that name, which was entry, defined a few lines earlier, and reported that entry has no field txt. The field is called at now.

§ 13

A prism from a pattern

A pattern is already half a prism. Matching it is preview. The other half, review, is the same pattern read as an expression, which works exactly when every part of the pattern pins down the value to build. The variables it binds, left to right, are the focus.

Rebuilding a pattern as an expression, and refusing the parts that do not say what to build.

let rebuild pattern =
  let vars = ref [] in
  let refutable = ref false in
  let rec go p =
    let loc = p.ppat_loc in
    match p.ppat_desc with
    | Ppat_var v ->
        if List.mem v.txt [ "f__"; "acc__"; "s__" ] then
          unsupported ~loc "%s is a name the generated code uses itself" v.txt;
        vars := v :: !vars;
        evar ~loc v.txt
    | Ppat_construct (c, None) ->
        refutable := true;
        pexp_construct ~loc c None
    | Ppat_construct (c, Some ([], arg)) ->
        refutable := true;
        pexp_construct ~loc c (Some (go arg))
    | Ppat_construct (_, Some (_ :: _, _)) ->
        unsupported ~loc
          "a constructor with existential types cannot be a prism: the \
           focus would mention a type that escapes its scope"
    | Ppat_variant (tag, arg) ->
        refutable := true;
        pexp_variant ~loc tag (Option.map go arg)
    | Ppat_constant c ->
        refutable := true;
        pexp_constant ~loc c
    | Ppat_tuple ps -> pexp_tuple ~loc (List.map go ps)
    | Ppat_array ps ->
        refutable := true;
        pexp_array ~loc (List.map go ps)
    | Ppat_record (fields, Closed) ->
        pexp_record ~loc (List.map (fun (f, p) -> (f, go p)) fields) None
    | Ppat_record (_, Open) ->
        unsupported ~loc
          "`; _` leaves fields out, so review would not know what to put \
           in them"
    | Ppat_constraint (p, ty) -> pexp_constraint ~loc (go p) ty
    | Ppat_any ->
        unsupported ~loc
          "`_` matches anything, so review would not know what to put here; \
           bind it to a variable to make it part of the focus"
    | Ppat_alias _ ->
        unsupported ~loc
          "`as` binds the same value twice, and review could be handed two \
           different ones"
    | Ppat_or _ ->
        unsupported ~loc
          "an or-pattern has more than one shape, so review would not know \
           which one to build"
    | Ppat_interval _ ->
        unsupported ~loc "a range does not say which character to build"
    | _ -> unsupported ~loc "this kind of pattern cannot be rebuilt as a value"
  in
  let expr = go pattern in
  (expr, List.rev !vars, !refutable)

What that allows. Constants and constructors in the pattern are fixed parts of the value; variables are the focus.

let flat_tri = [%prism? Tri { a; b = 0.; c }]
 
preview flat_tri (Tri { a = 1.; b = 0.; c = 2. })   (* Some (1., 2.) *)
preview flat_tri (Tri { a = 1.; b = 5.; c = 2. })   (* None *)
review flat_tri (1., 2.)                            (* Tri { a = 1.; b = 0.; c = 2. } *)
 
let two = [%prism? [ x; y ]]                        (* lists of length exactly two *)
let nested = [%prism? Some (Circle r)]
let swap = [%prism? (a, b)]                         (* irrefutable, so an iso *)

The expansion of an inline-record pattern with a constant in it.

let p =
  ({
     Optics.fold =
       (fun f__ ->
          fun acc__ ->
            fun s__ ->
              ((match s__ with
                | Tri { a; b = 0. } -> f__ acc__ a
                | _ -> acc__)
              [@ocaml.warning "-11"]));
     Optics.over =
       (fun f__ ->
          fun s__ ->
            ((match s__ with
              | Tri { a; b = 0. } -> let a = f__ a in Tri { a; b = 0. }
              | _ -> s__)
            [@ocaml.warning "-11"]));
     Optics.review = (Some (fun a -> Tri { a; b = 0. }))
   } : (_, _, [> `Prism ]) Optics.t)

The catch-all arm is only left out when the pattern is irrefutable syntactically, with no constructor, tag, constant or array in it. A pattern like Id n for a type with one constructor is irrefutable too, but the ppx cannot know that without types, so the match carries [@ocaml.warning "-11"] rather than a guess.

A wildcard does not say what to rebuild.

File "prism_wildcard.ml", line 1, characters 22-23:
1 | let second = [%prism? _ :: x :: _]
                          ^
Error: ppx_optics: `_` matches anything, so review would not know what to put
       here; bind it to a variable to make it part of the focus

An or-pattern has two shapes to rebuild.

File "prism_or.ml", line 1, characters 26-33:
1 | let small = [%prism? Some (0 | 1)]
                              ^^^^^^^
Error: ppx_optics: an or-pattern has more than one shape, so review would not
       know which one to build

An alias binds the same value twice, and review could be handed two different ones.

File "prism_alias.ml", line 1, characters 21-34:
1 | let small = [%prism? (Some _ as o)]
                         ^^^^^^^^^^^^^
Error: ppx_optics: `as` binds the same value twice, and review could be
       handed two different ones

A guard would let review build a value that preview then rejects, breaking the first prism law.

File "prism_guard.ml", line 1, characters 31-36:
1 | let positive = [%prism? n when n > 0]
                                   ^^^^^
Error: ppx_optics: a guard cannot be a prism: review can build a value the
       guard rejects

The fixed names f__, acc__ and s__ are where this extension differs from the deriver. The deriver's variables are all x0, x1 and so on, chosen by the ppx. Here the variables come from the user, and a pattern that bound acc__ would shadow the accumulator in f__ acc__ (acc__, b) and silently fold the wrong value. Generated names would avoid this; the ppx rejects patterns that bind any of the three instead.

§ 14

The laws

The types say which operations an optic supports. They do not say the operations agree with each other. That is what the laws are for: getting what you set, setting what you got, and for a prism, previewing what you reviewed.

Each law as a named boolean, at one source and one or two foci.

module Laws = struct
  let lens ~eq_s ~eq_a o s a1 a2 =
    [
      ("get-set", eq_s (set o (view o s) s) s);
      ("set-get", eq_a (view o (set o a1 s)) a1);
      ("set-set", eq_s (set o a2 (set o a1 s)) (set o a2 s));
    ]
 
  let prism ~eq_s ~eq_a o s a =
    let preview_review =
      match preview o s with
      | Some a' -> eq_s (review o a') s
      | None -> true
    in
    [
      ("review-preview", Option.equal eq_a (preview o (review o a)) (Some a));
      ("preview-review", preview_review);
    ]
end

Run against derived optics, a composite, and both ppx extensions. The test suite checks every shape the deriver handles this way.

  check_laws "person_age" (Laws.lens ~eq_s:( = ) ~eq_a:( = ) person_age ada 1 2);
  check_laws "person_address % address_city"
    (Laws.lens ~eq_s:( = ) ~eq_a:( = )
       (person_address % address_city)
       ada "Paris" "Rome")
  ...
  check_laws "shape_tri"
    (Laws.prism ~eq_s:( = ) ~eq_a:( = ) shape_tri (Rect (1., 1.)) (1., 2., 3.))
  ...
  check_laws "%lens" (Laws.lens ~eq_s:( = ) ~eq_a:( = ) city ada "a" "b");
  check_laws "%prism"
    (Laws.prism ~eq_s:( = ) ~eq_a:( = ) flat_tri (Circle 1.) (4., 5.))

dune test

all tests passed

§ 15

Prisms on JSON

A JSON document is one recursive variant, and most accesses into it can fail. With derived prisms and at, a key lookup is a three-step path, and a deep edit that finds nothing leaves the document alone.

The type and the key optic.

type json =
  | Null
  | Bool of bool
  | Number of float
  | String of string
  | Array of json list
  | Object of (string * json) list
[@@deriving optics]
 
let key k = json_object % at k % some

Reading, writing, traversing, inserting.

  check "deep preview" (preview (key "config" % key "port" % json_number) doc = Some 8080.);
  check "deep miss" (preview (key "config" % key "nope" % json_number) doc = None);
  let doc' = set (key "config" % key "port" % json_number) 9090. doc in
  check "deep set"
    (preview (key "config" % key "port" % json_number) doc' = Some 9090.);
  check "deep set miss is identity"
    (set (key "nope" % json_number) 1. doc = doc);
  check "traversal"
    (to_list (key "tags" % json_array % each % json_string) doc
    = [ "ocaml"; "optics" ]);
  check "insert via at"
    (preview (key "config" % key "host" % json_string)
       (set (key "config" % json_object % at "host") (Some (String "localhost")) doc)
    = Some "localhost")

§ 16

Download

The library, optics.mli and optics.ml; the ppx, ppx_optics.ml; the RPG demo, main.ml; and the tests, test_optics.ml, with geometry.ml and geometry.mli for deriving in a signature.

← older

Functional Programming in Python

2026-09-20