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
open! Core
open! Import0
module T = struct
include Value.Make_subtype (struct
let name = "window"
let here = [%here]
let is_in_subtype = Value.is_window
end)
let equal = eq
end
include T
type window = t [@@deriving sexp_of]
module Edges = struct
type t =
{ bottom : int
; left : int
; right : int
; top : int
}
[@@deriving sexp_of]
include Valueable.Make (struct
type nonrec t = t
let type_ =
Value.Type.(
map
(tuple int (tuple int (tuple int (tuple int unit))))
~name:[%sexp "Window.Tree.Position_and_size.t"])
~of_:(fun (left, (top, (right, (bottom, ())))) -> { bottom; left; right; top })
~to_:(fun { bottom; left; right; top } -> left, (top, (right, (bottom, ()))))
;;
end)
end
module Tree = struct
module Direction = struct
module T = struct
type t =
| Left_to_right
| Top_to_bottom
[@@deriving enumerate, sexp_of]
end
include T
let is_top_to_bottom = function
| Left_to_right -> false
| Top_to_bottom -> true
;;
include Valueable.Make (struct
type nonrec t = t
let type_ =
Value.Type.enum
[%sexp "Window.Tree.Direction.t"]
(module T)
(is_top_to_bottom >> Value.of_bool)
;;
end)
end
type t =
| Combination of
{ children : t list
; direction : Direction.t
; edges : Edges.t
}
| Window of window
[@@deriving sexp_of]
let tuple_type = Value.Type.(tuple Direction.t (tuple Edges.t (list value)))
let rec of_value_exn value =
match T.is_in_subtype value with
| true -> Window (T.of_value_exn value)
| false ->
let direction, (edges, children) = Value.Type.of_value_exn tuple_type value in
let children = List.map children ~f:of_value_exn in
Combination { children; direction; edges }
;;
let rec to_value = function
| Window window -> T.to_value window
| Combination { children; direction; edges } ->
Value.Type.to_value tuple_type (direction, (edges, List.map children ~f:to_value))
;;
let type_ =
Value.Type.create [%message "Window.Tree.t"] [%sexp_of: t] of_value_exn to_value
;;
let t = type_
let parent_exn t window =
let rec aux t ~parent =
match t with
| Window window' ->
(match T.equal window window' with
| true -> Some parent
| false -> None)
| Combination { children; direction = _; edges = _ } ->
List.find_map children ~f:(aux ~parent:t)
in
match aux t ~parent:t with
| Some t -> t
| None -> raise_s [%message "Window not in this tree." (window : window) ~_:(t : t)]
;;
end