(** Space operations for Matrix spaces (MSC1772).

    Spaces are special rooms with type "m.space" that contain child rooms
    via m.space.child state events. *)

(** Space hierarchy information *)
type space_room = {
  room_id : Matrix_proto.Id.Room_id.t;
  name : string option;
  topic : string option;
  canonical_alias : Matrix_proto.Id.Room_alias.t option;
  avatar_url : string option;
  num_joined_members : int;
  room_type : string option;
  join_rule : Matrix_proto.Event.Join_rule.t option;
  children_state : child_state list;
  world_readable : bool;
  guest_can_join : bool;
}

and child_state = {
  state_key : string;
  via : string list;
  order : string option;
  suggested : bool;
}

let child_state_jsont =
  Jsont.Object.(
    map (fun state_key via order suggested ->
      { state_key; via; order; suggested })
    |> mem "state_key" Jsont.string ~enc:(fun t -> t.state_key)
    |> mem "via" (Jsont.list Jsont.string) ~dec_absent:[] ~enc:(fun t -> t.via)
    |> opt_mem "order" Jsont.string ~enc:(fun t -> t.order)
    |> mem "suggested" Jsont.bool ~dec_absent:false ~enc:(fun t -> t.suggested)
    |> finish)

let space_room_jsont =
  Jsont.Object.(
    map (fun room_id name topic canonical_alias avatar_url num_joined_members
             room_type join_rule children_state world_readable guest_can_join ->
      { room_id; name; topic; canonical_alias; avatar_url; num_joined_members;
        room_type; join_rule; children_state; world_readable; guest_can_join })
    |> mem "room_id" Matrix_proto.Id.Room_id.jsont ~enc:(fun t -> t.room_id)
    |> opt_mem "name" Jsont.string ~enc:(fun t -> t.name)
    |> opt_mem "topic" Jsont.string ~enc:(fun t -> t.topic)
    |> opt_mem "canonical_alias" Matrix_proto.Id.Room_alias.jsont ~enc:(fun t -> t.canonical_alias)
    |> opt_mem "avatar_url" Jsont.string ~enc:(fun t -> t.avatar_url)
    |> mem "num_joined_members" Jsont.int ~dec_absent:0 ~enc:(fun t -> t.num_joined_members)
    |> opt_mem "room_type" Jsont.string ~enc:(fun t -> t.room_type)
    |> opt_mem "join_rule" Matrix_proto.Event.Join_rule.jsont ~enc:(fun t -> t.join_rule)
    |> mem "children_state" (Jsont.list child_state_jsont) ~dec_absent:[]
         ~enc:(fun t -> t.children_state)
    |> mem "world_readable" Jsont.bool ~dec_absent:false ~enc:(fun t -> t.world_readable)
    |> mem "guest_can_join" Jsont.bool ~dec_absent:false ~enc:(fun t -> t.guest_can_join)
    |> finish)

(** Response from [GET /_matrix/client/v1/rooms/\{roomId\}/hierarchy]. *)
type hierarchy_response = {
  rooms : space_room list;
  next_batch : string option;
}

let hierarchy_response_jsont =
  Jsont.Object.(
    map (fun rooms next_batch -> { rooms; next_batch })
    |> mem "rooms" (Jsont.list space_room_jsont) ~dec_absent:[] ~enc:(fun t -> t.rooms)
    |> opt_mem "next_batch" Jsont.string ~enc:(fun t -> t.next_batch)
    |> finish)

(** Get the hierarchy of a space.

    @param room_id The space room ID
    @param suggested_only If true, only return suggested rooms
    @param limit Maximum number of rooms to return per request
    @param max_depth Maximum depth to recurse into the hierarchy
    @param from Pagination token *)
let get_hierarchy client ~room_id ?suggested_only ?limit ?max_depth ?from () =
  let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
  let path = Printf.sprintf "/rooms/%s/hierarchy" (Uri.pct_encode room_id_str) in
  let query =
    []
    |> (fun q -> match suggested_only with
        | Some true -> ("suggested_only", "true") :: q
        | _ -> q)
    |> (fun q -> match limit with
        | Some l -> ("limit", string_of_int l) :: q
        | None -> q)
    |> (fun q -> match max_depth with
        | Some d -> ("max_depth", string_of_int d) :: q
        | None -> q)
    |> (fun q -> match from with
        | Some f -> ("from", f) :: q
        | None -> q)
  in
  let query = if query = [] then None else Some query in
  match Client.get client ~path ?query () with
  | Error e -> Error e
  | Ok body -> Client.decode_response hierarchy_response_jsont body

(** Add a child room to a space.

    @param space_id The parent space room ID
    @param child_id The child room ID
    @param via Server names to route through
    @param order Optional ordering string
    @param suggested Whether the room is suggested *)
(* Response type for state setting *)
type set_state_response = {
  event_id : Matrix_proto.Id.Event_id.t;
}

let set_state_response_jsont =
  Jsont.Object.(
    map (fun event_id -> { event_id })
    |> mem "event_id" Matrix_proto.Id.Event_id.jsont
    |> finish)

let add_child client ~space_id ~child_id ?(via = []) ?order ?(suggested = false) () =
  let space_id_str = Matrix_proto.Id.Room_id.to_string space_id in
  let child_id_str = Matrix_proto.Id.Room_id.to_string child_id in
  let path = Printf.sprintf "/rooms/%s/state/m.space.child/%s"
    (Uri.pct_encode space_id_str)
    (Uri.pct_encode child_id_str)
  in
  let content : Matrix_proto.Event.Space_child_content.t = {
    via = if via = [] then None else Some via;
    order;
    suggested = if suggested then Some true else None;
  } in
  match Client.encode_body Matrix_proto.Event.Space_child_content.jsont content with
  | Error e -> Error e
  | Ok body ->
      match Client.put client ~path ~body () with
      | Error e -> Error e
      | Ok resp_body ->
          match Client.decode_response set_state_response_jsont resp_body with
          | Error e -> Error e
          | Ok resp -> Ok resp.event_id

(** Remove a child room from a space. *)
let remove_child client ~space_id ~child_id =
  let space_id_str = Matrix_proto.Id.Room_id.to_string space_id in
  let child_id_str = Matrix_proto.Id.Room_id.to_string child_id in
  let path = Printf.sprintf "/rooms/%s/state/m.space.child/%s"
    (Uri.pct_encode space_id_str)
    (Uri.pct_encode child_id_str)
  in
  (* Send empty content to remove the child *)
  match Client.put client ~path ~body:"{}" () with
  | Error e -> Error e
  | Ok _ -> Ok ()

(** Set the parent space for a room.

    @param room_id The child room ID
    @param parent_id The parent space ID
    @param via Server names to route through
    @param canonical Whether this is the canonical parent *)
let set_parent client ~room_id ~parent_id ?(via = []) ?(canonical = false) () =
  let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
  let parent_id_str = Matrix_proto.Id.Room_id.to_string parent_id in
  let path = Printf.sprintf "/rooms/%s/state/m.space.parent/%s"
    (Uri.pct_encode room_id_str)
    (Uri.pct_encode parent_id_str)
  in
  let content : Matrix_proto.Event.Space_parent_content.t = {
    via = if via = [] then None else Some via;
    canonical = if canonical then Some true else None;
  } in
  match Client.encode_body Matrix_proto.Event.Space_parent_content.jsont content with
  | Error e -> Error e
  | Ok body ->
      match Client.put client ~path ~body () with
      | Error e -> Error e
      | Ok resp_body ->
          match Client.decode_response set_state_response_jsont resp_body with
          | Error e -> Error e
          | Ok resp -> Ok resp.event_id

(** Remove a parent space from a room. *)
let remove_parent client ~room_id ~parent_id =
  let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
  let parent_id_str = Matrix_proto.Id.Room_id.to_string parent_id in
  let path = Printf.sprintf "/rooms/%s/state/m.space.parent/%s"
    (Uri.pct_encode room_id_str)
    (Uri.pct_encode parent_id_str)
  in
  match Client.put client ~path ~body:"{}" () with
  | Error e -> Error e
  | Ok _ -> Ok ()

(** Check if a room is a space. *)
let is_space room_type =
  match room_type with
  | Some "m.space" -> true
  | _ -> false

(** Create a new space.

    @param name The space name
    @param topic Optional topic
    @param visibility Room visibility (public or private)
    @param invite List of users to invite *)
let create_space client ~name ?topic ?(visibility = `Private) ?(invite = []) () =
  Rooms.create_room client
    ~name
    ?topic
    ~visibility
    ~invite
    ~room_type:"m.space"
    ()