(*
when all you can do is type, making things more complicated than a list is hard?
we need to design this somehow before implementing it
really the graphical drawing / window management funcitons i think at this point.

features:
 - message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people.......
   - i mean really what you want is an editable stream, so you can stage messages for later
   - because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory.
*)

open Lwt
open Lwt_react
module F = Fmt

module Communicator = struct
  module Message = struct
    type t = {content: string; time: string; mutable seen: bool}

    let make ?(time = "<ts>") content = {content; time; seen= false}
  end

  module Channel = struct
    type t = {name: string; content: Message.t list Lwd.var}

    let add_msg (c : t) (msg : Message.t) =
      F.epr "Channel.add_msg msg.content=\"%s\"@." msg.content ;
      let cn = Lwd.peek c.content in
      Lwd.set c.content (msg :: cn)

    let make name = {name; content= Lwd.var []}
  end

  module Tree = struct
    open Channel
    open Message

    type t =
      { channel: Channel.t
      ; subs: t Lwd_table.t
      ; focus: Nottui.Focus.handle }

    type protocol = Irc | Email | Rss | Mublog | ActivityPub

    let add (comm : t) ch : unit =
      let c' =
        { channel= ch
        ; subs= Lwd_table.make ()
        ; focus= Nottui.Focus.make () } in
      Lwd_table.append' comm.subs c'

    let make_top () =
      let channel = Channel.make "communicator-top" in
      add_msg channel (Message.make "Welcome to the Communicator") ;
      add_msg channel
        (Message.make "Currently only IRC is implemented") ;
      {channel; subs= Lwd_table.make (); focus= Nottui.Focus.make ()}
  end

  module Irc = struct
    module C = Irc_client_tls
    module M = Irc_message

    let connection (c : Tree.t) server port nick
        (channels : string list) : Channel.t =
      let channel =
        Channel.make ("IRC: " ^ server ^ ":" ^ string_of_int port)
      in
      let _c' = Tree.add c channel in
      let add_msg str = Channel.add_msg channel (Message.make str) in
      let channel_assoc = ref [] in
      let make_ch name =
        let ch = Channel.make name in
        Tree.add c ch ;
        channel_assoc := (name, ch) :: !channel_assoc ;
        ch in
      Lwt.async
        (C.reconnect_loop ~after:30
           ~connect:(fun () ->
             add_msg "Connecting..." ;
             C.connect_by_name ~server ~port ~nick ()
             >>= fun c ->
             Lwt_io.printl "connect_by_name returned"
             >>= fun () -> Lwt.return c )
           ~f:(fun connection ->
             add_msg "Connected" ;
             Lwt_list.iter_p
               (fun chname ->
                 C.send_join ~connection ~channel:chname
                 >>= fun () ->
                 ignore (make_ch chname) ;
                 Lwt.return_unit )
               channels )
           ~callback:(fun _connection result ->
             match result with
             | Result.Ok ({M.command= M.Other _; _} as msg) ->
                 add_msg (M.to_string msg) ;
                 Lwt.return_unit
             | Result.Ok
                 {M.command= M.PRIVMSG (target, data); prefix= user}
               ->
                 let user =
                   match user with
                   | Some u -> List.hd (String.split_on_char '!' u)
                   | None -> "unknown" in
                 ( match List.assoc_opt target !channel_assoc with
                 | Some ch -> Channel.add_msg ch
                 | None -> Channel.add_msg (make_ch target) )
                   (Message.make (F.str "<%s> %s" user data)) ;
                 Lwt.return_unit
             | Result.Ok msg ->
                 add_msg (M.to_string msg) ;
                 Lwt.return_unit
             | Result.Error e -> Lwt_io.printl e ) ) ;
      channel
  end

  module Panel = struct
    open Nottui
    module P = Nottui_pretty

    let string ?attr text = P.ui (Nottui_widgets.string ?attr text)
    let ( ^^ ) = P.( ^^ )
    let ( ^/^ ) a b = P.(a ^^ break 1 ^^ b)

    let messagelist (ch : Channel.t) : P.t Lwd.t =
      Lwd.map (Lwd.get ch.content) ~f:(fun (msgs : Message.t list) ->
          List.fold_left
            (fun doc (msg : Message.t) ->
              F.epr "Communicator.Panel.messagelist ch.content=%s@."
                msg.content ;
              doc
              ^^ P.group
                   ( string msg.time ^/^ string " | "
                   ^/^ string msg.content )
              ^^ P.hardline )
            P.empty msgs )

    open Nottui_widgets

    (*type focustree =
        {channel: Channel.t; subs: focustree list; focus: Focus.handle}

      let channeltree (tree : Tree.t) : focustree Lwd.t =
         let rec fold (tree : Tree.t) : focustree list Lwd.t =
           Lwd_table.map_reduce
             (fun _row (tree : Tree.t) ->
                Lwd.map (fold tree) ~f:(fun (subs : focustree list) ->
                  { channel= tree.channel
                    ; subs
                    ; focus= Focus.make () } ))
             ([], fun a b -> List.append a b)
             tree.subs in
         let {channel= tree.channel; subs= fold tree; focus= Focus.make ()} *)

    let channelview (tree : Tree.t) : 'a Lwd.t * Channel.t Lwd.var =
      let channel = Lwd.var tree.channel in
      let rec fold ?(indent = 0) ?superfocus (tree : Tree.t) :
          'a Lwd.t =
        let subfocus = Focus.make () in
        Lwd.join
          (Lwd_table.map_reduce
             (fun row (tree : Tree.t) ->
               let focus =
                 match superfocus with
                 | Some sf ->
                     Lwd.map2 (Focus.status sf)
                       (Focus.status tree.focus)
                       ~f:(fun superfocus' focus' ->
                         if Focus.has_focus superfocus' then
                           F.epr
                             "Focus.has_focus superfocus' = true@." ;
                         Focus.release sf ;
                         Focus.request tree.focus ;
                         focus' )
                 | None -> Focus.status tree.focus in
               Lwd.map2
                 (Lwd.map focus ~f:(fun focus ->
                      if Focus.has_focus focus then
                        Lwd.set channel tree.channel ;
                      Ui.keyboard_area ~focus
                        (fun key ->
                          match key with
                          | `ASCII 'w', [] -> (
                            match Lwd_table.prev row with
                            | Some r -> (
                              match Lwd_table.get r with
                              | Some r ->
                                  Focus.release tree.focus ;
                                  Focus.request r.focus ;
                                  `Handled
                              | None -> `Unhandled )
                            | None -> `Unhandled )
                          | `ASCII 'a', [] -> (
                            match superfocus with
                            | Some f ->
                                Focus.release tree.focus ;
                                Focus.request f ;
                                `Handled
                            | None -> `Unhandled )
                          | `ASCII 's', [] -> (
                            match Lwd_table.next row with
                            | Some r -> (
                              match Lwd_table.get r with
                              | Some r ->
                                  Focus.release tree.focus ;
                                  Focus.request r.focus ;
                                  `Handled
                              | None -> `Unhandled )
                            | None -> `Unhandled )
                          | `ASCII 'd', [] ->
                              Focus.release tree.focus ;
                              Focus.request subfocus ;
                              `Handled
                          | _ -> `Unhandled )
                        (Ui.join_x
                           (Ui.join_x
                              ( if Focus.has_focus focus then
                                string "+"
                              else string "" )
                              (string (String.make indent '-')) )
                           (string Tree.(tree.channel.name)) ) ) )
                 (fold ~indent:(indent + 1) ~superfocus:subfocus tree)
                 ~f:(fun parent subs -> Ui.join_y parent subs) )
             (Lwd_utils.lift_monoid Ui.pack_y)
             tree.subs ) in
      (fold tree, channel)

    let messageview (ch : Channel.t Lwd.var) =
      Panel.Nottui.scroll_area
        (Lwd.map
           (Lwd.bind (Lwd.get ch) ~f:messagelist)
           ~f:(P.pretty 200) )

    let commview c =
      let cv, ch = channelview c in
      Nottui_widgets.h_pane
        (Panel.Nottui.scroll_area cv)
        (messageview ch)

    type view = Channel of (Channel.t * view list) | Cursor of view

    let panel (comm : Tree.t) =
      let base = Lwd.var Nottui_widgets.empty_lwd in
      Lwd.set base (commview comm) ;
      Panel.Nottui.panel (Lwd.join (Lwd.get base)) ()
  end
end

let _ =
  let comm = Communicator.Tree.make_top () in
  let _irc =
    Communicator.Irc.connection comm "irc.hackint.org" 6697 "cqcaml"
      ["#CQC"] in
  root_actor := std_actor (Communicator.Panel.panel comm)

(**
   program starts...
   - spawn connections to servers
   - these connections will populate the Channel.t in a Channel.tree
       
 **)