lib/zipper.ml


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

(* Module [Zipper]: functional zippers *)

open Base

type !+'a zipper = { pos : int; before : 'a Sequence.t; after : 'a Sequence.t }
type !+'a t = 'a zipper

let empty = { pos = 0; before = Sequence.empty; after = Sequence.empty }
let before z = z.before
let after z = z.after
let focus z = after z |> Sequence.next |> Option.map ~f:fst
let focus_or ~default z = Option.value ~default (focus z)
let is_far_left z = before z |> Sequence.is_empty
let is_far_right z = after z |> Sequence.is_empty
let is_empty z = is_far_left z && is_far_right z
let left_length z = z.pos
let right_length z = after z |> Sequence.length
let length z = left_length z + right_length z

let left z =
  match Sequence.next z.before with
  | None -> z
  | Some (h, t) ->
      { pos = z.pos - 1; before = t; after = Sequence.shift_right z.after h }

let rec left_while f z =
  if (not (is_far_left z)) && Option.(focus z |> map ~f |> value ~default:false)
  then left z |> left_while f
  else z

let rec far_left z = if is_far_left z then z else z |> left |> far_left

let right z =
  match Sequence.next z.after with
  | None -> z
  | Some (h, t) ->
      { pos = z.pos + 1; before = Sequence.shift_right z.before h; after = t }

let rec right_while f z =
  if
    (not (is_far_right z)) && Option.(focus z |> map ~f |> value ~default:false)
  then right z |> right_while f
  else z

let rec far_right z = if is_far_right z then z else z |> right |> far_right

let goto n z =
  let n = n - z.pos in
  let step = if n < 0 then left else right in
  Fn.apply_n_times ~n:(abs n) step z

let pop ?(n = 1) z = { z with after = Sequence.drop_eagerly z.after n }

let pop_before ?(n = 1) =
  let rec aux m z =
    if m < n && not (is_far_left z) then aux (m + 1) (left z) else pop ~n:m z
  in
  aux 0

let pop_after ?(n = 1) z =
  if right_length z < 2 then z else right z |> pop ~n |> left

let push x z = { z with after = Sequence.shift_right z.after x }
let push_after x z = right z |> push x |> left

let push_before x z =
  { z with pos = z.pos + 1; before = Sequence.shift_right z.before x }

let split z =
  ( { z with after = Sequence.empty },
    { z with pos = 0; before = Sequence.empty } )

let join z1 ~z2 =
  let z1 = far_right z1 and z2 = far_left z2 in
  { z1 with after = z2.after }

let iter_left f z = Sequence.iter ~f z.before
let iter_right f z = Sequence.iter ~f z.after

let iter f z =
  iter_left f z;
  iter_right f z

let for_all f z = Sequence.(for_all ~f z.before && for_all ~f z.after)
let exists f z = Sequence.(exists ~f z.before || exists ~f z.after)
let find_left f z = Sequence.find ~f z.before
let find_right f z = Sequence.find ~f z.after
let apply_focus f z = Option.map ~f (focus z)
let apply_focus_or ~default f z = Option.value ~default (apply_focus f z)
let map_left f z = { z with before = Sequence.map ~f z.before }
let map_right f z = { z with after = Sequence.map ~f z.after }

let map_focus f z =
  match Sequence.next z.after with
  | None -> z
  | Some (h, t) -> { z with after = Sequence.shift_right t (f h) }

let map_focus_or ~default f z =
  match Sequence.next z.after with
  | None -> { z with after = Sequence.singleton default }
  | Some (h, t) -> { z with after = Sequence.shift_right t (f h) }

let map f z =
  { z with before = Sequence.map ~f z.before; after = Sequence.map ~f z.after }

let mapi_left f z = { z with before = Sequence.mapi ~f z.before }
let mapi_right f z = { z with after = Sequence.mapi ~f z.after }

let mapi f z =
  {
    z with
    before = Sequence.mapi ~f z.before;
    after = Sequence.mapi ~f z.after;
  }

let filter_left f z = { z with before = Sequence.filter ~f z.before }
let filter_right f z = { z with after = Sequence.filter ~f z.after }
let filter p z = z |> filter_left p |> filter_right p
let context_left n z = { z with before = Sequence.take z.before n }
let context_right n z = { z with after = Sequence.take z.after n }
let context ~l ?(r = l) z = z |> context_left l |> context_right r
let swap_focus a = map_focus (Fn.const a)
let of_seq s = { empty with after = s }
let to_seq z = z |> far_left |> after
let window ~from ~len z = goto from z |> context_right len |> after