├── .gitignore ├── .ocamlformat ├── README.md ├── dune ├── dune-project ├── optics.opam └── src ├── dune └── optics.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.24.1 -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ocaml-optics 2 | ------------ 3 | 4 | *Status: WIP & Experimental* 5 | 6 | Monomorphic (I think) optics using [existentials](https://www.tweag.io/blog/2022-05-05-existential-optics/). This work was inspired by [ocaml-generics](https://github.com/CraigFe/ocaml-generics). Note that the optics here are quite heavy and will likely use more memory than hand-crafted accessors with pattern-matching. However, in cases of deeply nested data-structures that introduce lots of branches with variants with many construcotrs (e.g. [ocaml-geojson](https://github.com/geocaml/ocaml-geojson)), they can be a much more pleasant way to get values out of the data structuree. 7 | 8 | ```ocaml 9 | # #require "optics";; 10 | # open Optics;; 11 | ``` 12 | 13 | - [Usage](#usage) 14 | - [Lenses](#lenses) 15 | - [Constructing Lenses](#constructing-lenses) 16 | - [Composing Lenses](#composing-lenses) 17 | - [Getting and Setting Values](#getting-and-setting-values) 18 | - [Prisms](#prisms) 19 | - [Constructing Prisms](#constructing-prisms) 20 | - [Composing Prisms](#composing-prisms) 21 | - [Getting and Setting Values](#getting-and-setting-values) 22 | - [Optionals](#optionals) 23 | - [Deeper Composition with Infix Operators](#deeper-composition-with-infix-operators) 24 | - [Optionals from Lenses and Prisms](#optionals-from-lenses-and-prisms) 25 | 26 | 27 | ## Usage 28 | 29 | ```ocaml 30 | type t = { 31 | point : point; 32 | props : prop list; 33 | } 34 | 35 | and point = Point2D of point2d | Point3D of point3d 36 | 37 | and point2d = { x: float; y: float } 38 | 39 | and point3d = { x : float; y: float; z: float} 40 | 41 | and prop = { key : string; value : prop_value } 42 | 43 | and prop_value = String of string | Int of int 44 | ``` 45 | 46 | and we'll make a quick value too. 47 | 48 | ```ocaml 49 | # let example = 50 | { 51 | point = Point2D { x = 1.0; y = 2.0 }; 52 | props = [ { key = "Hello"; value = String "World" }; { key = "Bonjour"; value = String "Monde" } ] 53 | };; 54 | val example : t = 55 | {point = Point2D {x = 1.; y = 2.}; 56 | props = 57 | [{key = "Hello"; value = String "World"}; 58 | {key = "Bonjour"; value = String "Monde"}]} 59 | ``` 60 | 61 | ### Lenses 62 | 63 | A lens allows you to get and set fields of a record. Defining one requires you to provide two functions that break apart a record into a field and the rest of the record, and another function which builds the record back together. 64 | 65 | #### Constructing Lenses 66 | 67 | ```ocaml 68 | # let props = Lens.V ((fun t -> (t.props, t)), (fun (props, t) -> { t with props }));; 69 | val props : (t, prop list) Lens.t = Optics.Lens.V (, ) 70 | # let point = Lens.V ((fun t -> (t.point, t)), (fun (point, t) -> { t with point }));; 71 | val point : (t, point) Lens.t = Optics.Lens.V (, ) 72 | # let key = Lens.V ((fun t -> (t.key, t)), (fun (key, t) -> { t with key }));; 73 | val key : (prop, string) Lens.t = Optics.Lens.V (, ) 74 | # let value = Lens.V ((fun t -> (t.value, t)), (fun (value, t) -> { t with value }));; 75 | val value : (prop, prop_value) Lens.t = Optics.Lens.V (, ) 76 | ``` 77 | 78 | #### Composing Lenses 79 | 80 | Lenses compose nicely in the way you might expect. Given a `('a, 'b) Lens.t` and a `('b, 'c) Lens.t` we compose the two to get a `('a, 'c) Lens.t`. 81 | 82 | ```ocaml 83 | # let key_at n = Lens.(props >> nth n >> key);; 84 | val key_at : int -> (t, string) Lens.t = 85 | # let value_at n = Lens.(props >> nth n >> value);; 86 | val value_at : int -> (t, prop_value) Lens.t = 87 | ``` 88 | 89 | #### Getting and Setting Values 90 | 91 | ```ocaml 92 | # Lens.(get (key_at 0) example), Lens.(get (value_at 0) example);; 93 | - : string * prop_value = ("Hello", String "World") 94 | ``` 95 | 96 | ```ocaml 97 | # Lens.set (key_at 0) example "Salut" |> Lens.get (key_at 0);; 98 | - : string = "Salut" 99 | ``` 100 | 101 | 102 | ### Prisms 103 | 104 | Prisms are to sum-types (variants) what lenses are to product types (records). The difference is we need to encode the idea that a variant could be the constructor we want or something else entirely. We do this with the `('a, 'b) result` type. 105 | 106 | #### Constructing Prisms 107 | 108 | ```ocaml 109 | # let point2d = 110 | let into = function 111 | | Point2D f -> Ok f 112 | | v -> Error v 113 | in 114 | let out_of = function 115 | | Ok f -> Point2D f 116 | | Error v -> v 117 | in 118 | Optics.Prism.V (into, out_of);; 119 | val point2d : (point, point2d) Prism.t = Optics.Prism.V (, ) 120 | # let point3d = 121 | let into = function 122 | | Point3D f -> Ok f 123 | | v -> Error v 124 | in 125 | let out_of = function 126 | | Ok f -> Point3D f 127 | | Error v -> v 128 | in 129 | Optics.Prism.V (into, out_of);; 130 | val point3d : (point, point3d) Prism.t = Optics.Prism.V (, ) 131 | ``` 132 | 133 | And for property values (only `string` shown for brevity). 134 | 135 | ```ocaml 136 | # let string = 137 | let into = function 138 | | String s -> Ok s 139 | | v -> Error v 140 | in 141 | let out_of = function 142 | | Ok f -> String f 143 | | Error v -> v 144 | in 145 | Optics.Prism.V (into, out_of);; 146 | val string : (prop_value, string) Prism.t = Optics.Prism.V (, ) 147 | ``` 148 | 149 | #### Composing Prisms 150 | 151 | Prisms compose just like [lenses](#composing-lenses). 152 | 153 | ```ocaml 154 | # Prism.(>>);; 155 | - : ('a, 'b) Prism.t -> ('b, 'c) Prism.t -> ('a, 'c) Prism.t = 156 | ``` 157 | 158 | #### Getting and Setting Values 159 | 160 | Getting and setting values works much the same way as lenses except getting values can return `None` if the you are trying to get a different variant constructor. 161 | 162 | ```ocaml 163 | # let p = example.point;; 164 | val p : point = Point2D {x = 1.; y = 2.} 165 | # Prism.get point3d p;; 166 | - : point3d option = None 167 | # Prism.get point2d p;; 168 | - : point2d option = Some {x = 1.; y = 2.} 169 | # Prism.set point2d {x = 1.; y = 2.} ;; 170 | - : point = Point2D {x = 1.; y = 2.} 171 | ``` 172 | 173 | ### Optionals 174 | 175 | Optionals are lenses but with optional values for the type under focus. 176 | 177 | ```ocaml 178 | # #show_type Optional.t;; 179 | type nonrec ('s, 'a) t = ('s, 'a option) Lens.t 180 | ``` 181 | 182 | Optionals are actually a middle-ground between prisms and lenses that allow us to compose a lens and prism. 183 | 184 | ```ocaml 185 | # let t_to_point2d = Optional.(point >& point2d);; 186 | val t_to_point2d : (t, point2d) Optional.t = Optics.Lens.V (, ) 187 | # Lens.get t_to_point2d example;; 188 | - : point2d option = Some {x = 1.; y = 2.} 189 | ``` 190 | 191 | #### Deeper Composition with Infix Operators 192 | 193 | The library comes with a `Optics.Infix` set of operators that can help with deeply nested composition. For example getting the string value of the `nth` property in the `example` value. 194 | 195 | 196 | ```ocaml 197 | # open Infix;; 198 | # let t_to_prop_value_string n = props & Lens.nth n & value >& string;; 199 | val t_to_prop_value_string : int -> (t, string option) Lens.t = 200 | # Lens.get (t_to_prop_value_string 0) example;; 201 | - : string option = Some "World" 202 | ``` 203 | 204 | Within the `Infix` operator the rules are: 205 | 206 | - If the operator starts with `>` then it produces an `Optional.t` 207 | - If the operator contains `&`, it is closely tied to `Lens.t`. Either it composes lenses or the LHS should be a lens. 208 | + `&>` composes an optional followed by a lens returning an optional 209 | + `&` is `Lens.(>>)` 210 | + `>&` composes a lens with a prism and returns an optional 211 | - If the operator contains `$`, it is closely tied to `Prism.t`. 212 | + `$>` composes an optional followed by a prism returning an optional 213 | + `$` is `Prism.(>>)` 214 | + `>$` composes a prism with a lens and returns an optional 215 | 216 | ```ocaml 217 | # #show_module Infix;; 218 | module Infix : 219 | sig 220 | val ( >> ) : 221 | ('a, 'b) Optional.t -> ('b, 'c) Optional.t -> ('a, 'c) Optional.t 222 | val ( &> ) : 223 | ('a, 'b) Optional.t -> ('b, 'c) Lens.t -> ('a, 'c) Optional.t 224 | val ( $> ) : 225 | ('a, 'b) Optional.t -> ('b, 'c) Prism.t -> ('a, 'c) Optional.t 226 | val ( >& ) : ('a, 'b) Lens.t -> ('b, 'c) Prism.t -> ('a, 'c) Optional.t 227 | val ( >$ ) : ('a, 'b) Prism.t -> ('b, 'c) Lens.t -> ('a, 'c) Optional.t 228 | val ( & ) : ('a, 'b) Lens.t -> ('b, 'c) Lens.t -> ('a, 'c) Lens.t 229 | val ( $ ) : ('a, 'b) Prism.t -> ('b, 'c) Prism.t -> ('a, 'c) Prism.t 230 | end 231 | ``` 232 | 233 | ### Optionals from Lenses and Prisms 234 | 235 | You can always create an `Optional.t` from a `Prism.t` or a `Lens.t`. 236 | 237 | ```ocaml 238 | # Optional.prism point2d;; 239 | - : (point, point2d) Optional.t = Optics.Lens.V (, ) 240 | # Optional.lens props;; 241 | - : (t, prop list) Optional.t = Optics.Lens.V (, ) 242 | ``` 243 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (mdx 2 | (packages optics) 3 | (files README.md)) 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | (using mdx 0.1) -------------------------------------------------------------------------------- /optics.opam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/geocaml/ocaml-optics/e091ab03175204e68b6666e1202de7f00002aa7c/optics.opam -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name optics) 3 | (public_name optics)) 4 | -------------------------------------------------------------------------------- /src/optics.ml: -------------------------------------------------------------------------------- 1 | let undefined _ = 2 | let exception Undefined in 3 | raise Undefined 4 | 5 | module Lens = struct 6 | type ('s, 'a) t = V : ('s -> 'a * 'r) * ('a * 'r -> 's) -> ('s, 'a) t 7 | 8 | let v (type a b r) (f : a -> b * r) (g : b * r -> a) = V (f, g) 9 | let get (type a b) (V (f, _) : (a, b) t) (v : a) : b = fst @@ f v 10 | 11 | let set (type a b) (V (f, g) : (a, b) t) (t : a) (v : b) = 12 | let _, r = f t in 13 | g (v, r) 14 | 15 | let fst : ('a * 'b, 'a) t = V (Fun.id, Fun.id) 16 | let snd : ('a * 'b, 'b) t = V ((fun (a, b) -> (b, a)), fun (b, a) -> (a, b)) 17 | 18 | let head : ('a list, 'a) t = 19 | V ((fun lst -> (List.hd lst, List.tl lst)), fun (hd, tl) -> hd :: tl) 20 | 21 | let splice_out lst n = 22 | let rec aux ((before, after) as acc) n = function 23 | | [] -> (List.rev before, List.rev after) 24 | | x :: xs when n < 0 -> aux (before, x :: after) (n - 1) xs 25 | | _ :: xs when n = 0 -> aux acc (n - 1) xs 26 | | x :: xs -> aux (x :: before, after) (n - 1) xs 27 | in 28 | aux ([], []) n lst 29 | 30 | let nth n : ('a list, 'a) t = 31 | V 32 | ( (fun lst -> (List.nth lst n, splice_out lst n)), 33 | fun (n, (b, a)) -> b @ [ n ] @ a ) 34 | 35 | let ( >> ) (type a b c) (V (f, g) : (a, b) t) (V (f', g') : (b, c) t) : 36 | (a, c) t = 37 | V 38 | ( (fun x -> 39 | let a, r1 = f x in 40 | let v, r2 = f' a in 41 | (v, (r1, r2))), 42 | fun (y, (r1, r2)) -> g (g' (y, r2), r1) ) 43 | end 44 | 45 | module Prism = struct 46 | type ('s, 'a) t = 47 | | V : ('s -> ('a, 'r) result) * (('a, 'r) result -> 's) -> ('s, 'a) t 48 | 49 | let get (type s a) (V (f, _) : (s, a) t) (v : s) : a option = 50 | Result.to_option @@ f v 51 | 52 | let set (type s a) (V (_, g) : (s, a) t) (v : a) = g (Ok v) 53 | 54 | let some = 55 | V 56 | ( (function Some t -> Ok t | None -> Error ()), 57 | function Ok t -> Some t | Error () -> None ) 58 | 59 | let none = 60 | V 61 | ( (function None -> Ok () | Some t -> Error t), 62 | function Ok () -> None | Error t -> Some t ) 63 | 64 | let ( >> ) (type a b c) (V (f, g) : (a, b) t) (V (f', g') : (b, c) t) : 65 | (a, c) t = 66 | let first x = 67 | match f x with 68 | | Error r1 -> Error (Either.left r1) 69 | | Ok b -> ( 70 | match f' b with Ok c -> Ok c | Error r2 -> Error (Either.right r2)) 71 | in 72 | let second = function 73 | | Ok v -> g (Ok (g' (Ok v))) 74 | | Error (Either.Left r1) -> g (Error r1) 75 | | Error (Either.Right r2) -> g (Ok (g' (Error r2))) 76 | in 77 | V (first, second) 78 | end 79 | 80 | module Optional = struct 81 | type ('s, 'a) t = ('s, 'a option) Lens.t 82 | 83 | let lens (type a b) (Lens.V (f, g) : (a, b) Lens.t) : (a, b) t = 84 | let wrapped_focus x = 85 | let v, r = f x in 86 | (Some v, r) 87 | in 88 | let wrapped_return = function 89 | | Some x, r -> g (x, r) 90 | | None, _ -> undefined () (* Not possible for a lens! *) 91 | in 92 | Lens.V (wrapped_focus, wrapped_return) 93 | 94 | let prism (type a b) (Prism.V (f, g) : (a, b) Prism.t) : (a, b) t = 95 | let wrapped_focus x = 96 | match f x with Ok v -> (Some v, None) | Error r -> (None, Some r) 97 | in 98 | let wrapped_return = function 99 | | Some x, None -> g (Ok x) 100 | | None, Some r -> g (Error r) 101 | | _ -> undefined () (* Other cases are not possible *) 102 | in 103 | Lens.V (wrapped_focus, wrapped_return) 104 | 105 | let ( >& ) (type a b c) (Lens.V (f1, g1) : (a, b) Lens.t) 106 | (Prism.V (f2, g2) : (b, c) Prism.t) : (a, c) t = 107 | let wrapped_focus x = 108 | let b, r1 = f1 x in 109 | match f2 b with 110 | | Ok c -> (Some c, Either.left r1) 111 | | Error r2 -> (None, Either.right (r1, r2)) 112 | in 113 | let wrapped_return = function 114 | | Some c, Either.Left r1 -> g1 (g2 (Ok c), r1) 115 | | None, Either.Right (r1, r2) -> g1 (g2 (Error r2), r1) 116 | | _ -> undefined () 117 | in 118 | Lens.V (wrapped_focus, wrapped_return) 119 | 120 | let ( >$ ) (type a b c) (Prism.V (f1, g1) : (a, b) Prism.t) 121 | (Lens.V (f2, g2) : (b, c) Lens.t) : (a, c) t = 122 | let wrapped_focus x = 123 | match f1 x with 124 | | Ok b -> 125 | let c, r2 = f2 b in 126 | (Some c, Either.right r2) 127 | | Error r1 -> (None, Either.left r1) 128 | in 129 | let wrapped_return = function 130 | | Some c, Either.Right r2 -> g1 (Ok (g2 (c, r2))) 131 | | None, Either.Left r1 -> g1 (Error r1) 132 | | _ -> undefined () 133 | in 134 | Lens.V (wrapped_focus, wrapped_return) 135 | 136 | let ( >> ) (type a b c) (Lens.V (f1, g1) : (a, b) t) 137 | (Lens.V (f2, g2) : (b, c) t) : (a, c) t = 138 | let wrapped_focus x = 139 | let b, r1 = f1 x in 140 | match b with 141 | | Some b -> 142 | let c, r2 = f2 b in 143 | (c, Either.right (r1, r2)) 144 | | None -> (None, Either.left r1) 145 | in 146 | let wrapped_return = function 147 | | c, Either.Right (r1, r2) -> g1 (Some (g2 (c, r2)), r1) 148 | | None, Either.Left r1 -> g1 (None, r1) 149 | | _ -> undefined () 150 | in 151 | Lens.V (wrapped_focus, wrapped_return) 152 | end 153 | 154 | module Infix = struct 155 | let ( >> ) = Optional.( >> ) 156 | let ( &> ) o l = Optional.(o >> lens l) 157 | let ( $> ) o p = Optional.(o >> prism p) 158 | let ( >& ) = Optional.( >& ) 159 | let ( >$ ) = Optional.( >$ ) 160 | let ( & ) = Lens.( >> ) 161 | let ( $ ) = Prism.( >> ) 162 | end 163 | --------------------------------------------------------------------------------