Handle list head and tail updates with explicit empty-list errors

README.md

@@ -3,3 +3,5 @@
 Lenses for reading and updating immutable data in OCaml.
 
 Build with `make`; run the checks with `make test`.
+
+The `_hd` and `_tl` lenses raise `Invalid_argument` on empty lists.

fieldglass.ml

@@ -13,3 +13,15 @@ let compose (outer_get, outer_put) (inner_get, inner_put) =
 let _1 = (fun (left, _) -> left), (fun left (_, right) -> left, right)
 let _2 = (fun (_, right) -> right), (fun right (left, _) -> left, right)
 let _id = (fun value -> value), (fun value _ -> value)
+
+let split = function
+  | head :: tail -> head, tail
+  | [] -> invalid_arg "Fieldglass: empty list"
+
+let _hd =
+  (fun source -> fst (split source)),
+  (fun head source -> head :: snd (split source))
+
+let _tl =
+  (fun source -> snd (split source)),
+  (fun tail source -> fst (split source) :: tail)

fieldglass.mli

@@ -9,3 +9,5 @@ val compose : ('s, 't, 'a, 'b) lens -> ('a, 'b, 'c, 'd) lens -> ('s, 't, 'c, 'd)
 val _1 : ('a * 'c, 'b * 'c, 'a, 'b) lens
 val _2 : ('c * 'a, 'c * 'b, 'a, 'b) lens
 val _id : ('a, 'b, 'a, 'b) lens
+val _hd : ('a list, 'a) lens'
+val _tl : ('a list, 'a list) lens'

runtime.ml

@@ -30,3 +30,13 @@ let () =
   assert (set _id "grey" 9 = "grey");
   assert (view (compose _id _1) (9, false) = view _1 (9, false));
   assert (set (compose _2 _id) "grey" (true, 9) = set _2 "grey" (true, 9))
+
+let () =
+  assert (view _hd [1; 2] = 1);
+  assert (view _tl [1] = []);
+  assert (set _hd 3 [1; 2] = [3; 2]);
+  assert (set _tl [3; 4] [1; 2] = [1; 3; 4]);
+  List.iter (fun action ->
+    try action (); assert false with Invalid_argument _ -> ())
+    [(fun () -> ignore (view _hd [])); (fun () -> ignore (view _tl []));
+     (fun () -> ignore (set _hd 1 [])); (fun () -> ignore (set _tl [] []))]