(* indexed type *)
module type IX = sig
  type 'a t
end

(* type-aware comparison *)
type (_, _) cmp
  = Eq: ('a, 'a) cmp
  | Lt: ('a, 'b) cmp
  | Gt: ('a, 'b) cmp

module type IX_COMPARE = sig
  include IX
  val compare: 'a t -> 'b t -> ('a, 'b) cmp
end

(* indexed maps (binary tree) *)
module Make_ix_map (K: IX_COMPARE) (V: IX): sig
  type 'a key = 'a K.t
  type 'a value = 'a V.t
  type t

  val empty: t
  val add: 'a key -> 'a value -> t -> t
  val find: 'a key -> t -> 'a value option

end = struct
  type 'a key = 'a K.t
  type 'a value = 'a V.t
  type t =
    | Empty: t
    | Node: t * 'a key * 'a value * t -> t

  let empty = Empty

  type pair = Pair: 'a K.t * 'a V.t -> pair
  let rec addp (Pair (k, v)) = function
    | Empty -> Node (Empty, k, v, Empty)
    | Node (left, k', v', right) ->
       match K.compare k k' with
       | Eq -> Node (left, k, v, right)
       | Lt -> let left' = addp (Pair (k, v)) left in
               Node (left', k', v', right)
       | Gt -> let right' = addp (Pair (k, v)) left in
               Node (left, k', v', right')
  let add k v t = addp (Pair (k, v)) t

  type 'r search = Search: 'a K.t * ('a V.t -> 'r) -> 'r search
  let rec finds (Search (k, f)) = function
    | Empty -> None
    | Node (left, k', v, right) ->
       match K.compare k k' with
       | Eq -> Some (f v)
       | _ ->
          match finds (Search (k, f)) left with
          | Some r -> Some r
          | None -> finds (Search (k, f)) right
  let find k t = finds (Search (k, fun x -> x)) t
end

(*-------------------------------------------------*)

type 'a prop
  = Text: string prop
  | Size: int prop

module Prop = struct
  type 'a t = 'a prop
  let compare (type a b) (p: a prop) (q: b prop): (a, b) cmp =
    match p, q with
    | Text, Text -> Eq
    | Size, Size -> Eq
    | Size, Text -> Lt
    | Text, Size -> Gt
end

module Id = struct type 'a t = 'a end

module PropMap = Make_ix_map(Prop)(Id)

let get_size: PropMap.t -> int option =
  PropMap.find Size

let get_text: PropMap.t -> string option =
  PropMap.find Text