(*
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 Human
open Lwt
open Lwt_react
module F = Fmt

module Communicator = struct
  module Istore = struct
    include Human.Store

    let from_storeview (sv : storeview) = sv.store

    include Human.Store.Istore
  end

  module Message = struct
    type t = {time: string list; content: string}

    let make ?(time = Unix.time ()) content =
      let tm = Unix.localtime time in
      { time=
          [ string_of_int tm.tm_year; string_of_int tm.tm_mon
          ; string_of_int tm.tm_mday; string_of_int tm.tm_hour ]
      ; content }
  end

  module Channel = struct
    type t = {store: Istore.t; path: Istore.key}

    let make (store : Istore.t) ~path ~name =
      {store; path= path @ name}

    let add_msg {store; path} (msg : Message.t) : unit Lwt.t =
      Istore.set_exn store ~info:Irmin.Info.none (path @ msg.time)
        msg.content
  end

  module Tree = struct
    open Message

    type selection = Istore.Key.t
    type t = {store: Istore.t; view: Istore.key}
    type protocol = Irc | Email | Rss | Mublog | ActivityPub

    let contents {store; view} (s : selection) :
        Istore.Contents.t option Lwt.t =
      Istore.find store (view @ s)

    let make_top ?(view = ["communicator"]) gitpath branchname :
        t Lwt.t =
      Istore.Repo.v (Irmin_git.config gitpath)
      >>= fun repo ->
      Istore.of_branch repo branchname
      >>= fun store ->
      let t = {store; view= []} in
      Istore.get_tree store view
      >>= fun _tree ->
      let view = Istore.Key.v view in
      Istore.list store view
      >>= fun _viewlist ->
      let ch_top = Channel.make store ~path:[] ~name:["top"] in
      Channel.add_msg ch_top
        (Message.make "Communicator restarting...")
      >>= fun () ->
      Channel.add_msg ch_top
        (Message.make "Currently only IRC is implemented")
      >>= fun () -> Lwt.return t

    let add {store; view} ~(name : string list) ~(config : Istore.tree)
        : t Lwt.t =
      Istore.get_tree store name
      >>= fun tree ->
      Istore.Tree.remove tree ["_config"]
      >>= fun tree ->
      Istore.Tree.add_tree tree [] config
      >>= fun tree ->
      Istore.set_tree_exn ~info:Irmin.Info.none store name tree
      >>= fun () -> Lwt.return {store; view}
  end

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

    module Config = struct
      type t = Istore.tree

      open Lwt.Infix

      let make_connection Tree.{store; _} server port nick =
        let name = F.str "%s@%s:%d" nick server port in
        Istore.Tree.add Istore.Tree.empty ["server"] server
        >>= fun t' ->
        Istore.Tree.add t' ["port"] (string_of_int port)
        >>= fun t' ->
        Istore.Tree.add t' ["nick"] nick
        >>= fun t' ->
        Istore.set_tree_exn ~info:Irmin.Info.none store
          ["irc"; name; "_config"]
          t'
        >>= fun _ -> Lwt.return_unit

      let server t : string Lwt.t = Istore.Tree.get t ["server"]

      let port t : int Lwt.t =
        Istore.Tree.get t ["port"] >|= fun p -> int_of_string p

      let nick t : string Lwt.t = Istore.Tree.get t ["nick"]
    end

    let get_channels ~store ~path =
      Istore.list store path
      >>= fun c -> Lwt.return (fst (List.split c))

    let connect ?(path = ["irc"]) ({store; _} : Tree.t) : unit Lwt.t =
      (* search for all connections and start them *)
      (* also need ot figure out how to preserve custom ordering of items like servers and channels
         maybe just a _order file that has the ordering of files listed and hten gets  updated etc. *)
      let top_channel =
        Channel.make store ~path:["irc"] ~name:["top"] in
      let _top_msg str =
        Channel.add_msg top_channel (Message.make str) in
      Istore.list store path
      >>= fun servers ->
      let channel_assoc = ref [] in
      let make_channel store server (name : string) =
        let ch =
          Channel.make store ~path:(["irc"] @ server) ~name:[name]
        in
        channel_assoc := (name, ch) :: !channel_assoc ;
        Channel.add_msg ch
          (Message.make (F.str "channel %s created" name))
        >>= fun () -> Lwt.return ch in
      Lwt_list.iter_p
        (fun (_server, tree) ->
          Config.nick tree
          >>= fun nick ->
          Config.server tree
          >>= fun server ->
          Config.port tree
          >>= fun port ->
          let server_channel =
            Channel.make store ~path ~name:[server; server] in
          let add_msg s =
            Channel.add_msg server_channel (Message.make s) in
          C.reconnect_loop ~after:30
            ~connect:(fun () ->
              add_msg "Connecting..."
              >>= fun () ->
              C.connect_by_name ~server ~port ~nick ()
              >>= fun c -> Lwt.return c )
            ~f:(fun connection ->
              add_msg "Connected"
              >>= fun () ->
              get_channels ~store ~path:["irc"; server]
              >>= fun chs ->
              Lwt_list.iter_p
                (fun chname ->
                  C.send_join ~connection ~channel:chname
                  >>= fun () ->
                  ignore (make_channel store [server] chname) ;
                  Lwt.return_unit )
                chs )
            ~callback:(fun _connection result ->
              match result with
              | Result.Ok ({M.command= M.Other _; _} as msg) ->
                  add_msg (M.to_string msg)
              | 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
                        (Message.make (F.str "<%s> %s" user data))
                  | None ->
                      make_channel store [server] target
                      >>= fun ch ->
                      Channel.add_msg ch
                        (Message.make (F.str "<%s> %s" user data)) )
              | Result.Ok msg ->
                  add_msg (M.to_string msg)
                  >>= fun () -> Lwt.return_unit
              | Result.Error e -> Lwt_io.printl e )
            () )
        servers
  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_watch : Istore.watch option ref) = ref None

    let messagelist ~store (ch : Channel.t) : P.t Lwd.t Lwt.t =
      ( match !messagelist_watch with
      | Some w -> Istore.unwatch w
      | None -> Lwt.return_unit )
      >>= fun () ->
      let mlist' () =
        let sl l =
          l
          >>= fun x ->
          Lwt.return (List.sort String.compare (fst (List.split x)))
        in
        sl (Istore.list store ch.path)
        >>= fun years ->
        let year = List.hd years in
        sl (Istore.list store (ch.path @ [year]))
        >>= fun months ->
        let month = List.hd months in
        sl (Istore.list store (ch.path @ [month]))
        >>= fun days ->
        let day = List.hd days in
        sl (Istore.list store (ch.path @ [day]))
        >>= fun hours ->
        let hour = List.hd hours in
        Istore.list store [year; month; day; hour]
        >>= fun mlist ->
        Lwt_list.map_p
          (fun (second, content) ->
            Istore.Tree.get content []
            >>= fun content ->
            Lwt.return ((year, month, day, hour, second), content) )
          mlist in
      mlist' ()
      >>= fun mlist ->
      let mlist = Lwd.var mlist in
      Istore.watch_key store ch.path (function _ ->
          mlist' ()
          >>= fun mlist' -> Lwt.return (Lwd.set mlist mlist') )
      >>= fun watch ->
      messagelist_watch := Some watch ;
      Lwt.return
        (Lwd.map (Lwd.get mlist) ~f:(fun mlist ->
             List.fold_left
               (fun doc ((year, month, day, hour, sec), content) ->
                 F.epr
                   "Communicator.Panel.messagelist ch.content=%s@."
                   content ;
                 doc
                 ^^ P.group
                      ( string
                          (F.str "%s.%s.%s.%s.%s" year month day hour
                             sec )
                      ^^ string " | " ^^ string content )
                 ^^ P.hardline )
               P.empty mlist ) )

    open Nottui_widgets

    module StoreTree = struct
      (* the tree structure needs to allow:
         - arbitrary traversal from a handle for any node (double linked sufficient?)
         - Incremental updates, where the tree/node generation function is only called on updated nodes
         - returns a Lwd.var which gets updated anytime the watch is triggered by a change on disk.
      *)

      type 'a t =
        {step: string; mutable super: 'a super; mutable node: 'a node}

      and 'a super = [`Tree of 'a t | `Root]

      and 'a sub = 'a t list

      and 'a node = [`Node of 'a sub | `Contents of 'a]

      let rec mapt ?(super = `Root) ~(f : 'a t -> 'b t -> 'b t)
          (a : 'a t) : 'b t =
        let this = {a with super; node= `Node []} in
        match a with
        | {node= `Node subs; _} as aa ->
            let rec iter = function
              | x :: xs -> mapt ~super:(`Tree this) ~f x :: iter xs
              | [] -> [] in
            this.node <- `Node (iter subs) ;
            f aa this
        | {node= `Contents _; _} as aa -> f aa this

      let rec map ?(super = `Root)
          ~(f : 'a node -> 'b node -> 'b node) (a : 'a node) : 'b node
          =
        match a with
        | `Node subs as aa ->
            let rec iter = function
              | ({node; _} as x) :: xs ->
                  let this = {x with super; node= `Node []} in
                  this.node <- map ~super:(`Tree this) ~f node ;
                  this :: iter xs
              | [] -> [] in
            f aa (`Node (iter subs))
        | `Contents _ as aa -> f aa (`Node [])

      let rec map2 ?(super = `Root)
          ~(f : 'a t option -> 'b t option -> 'c t -> 'c t) (a : 'a t)
          (b : 'b t) : 'c t =
        let this = {a with super; node= `Node []} in
        let rec iter2 (a : 'a sub) (b : 'b sub) : 'c sub =
          match (a, b) with
          | ae :: al, be :: bl ->
              map2 ~super:(`Tree this) ~f ae be :: iter2 al bl
          | [], be :: bl ->
              mapt ~super:(`Tree this)
                ~f:(fun x -> f None (Some x))
                be
              :: iter2 [] bl
          | ae :: al, [] ->
              mapt ~super:(`Tree this)
                ~f:(fun x -> f (Some x) None)
                ae
              :: iter2 [] al
          | [], [] -> [] in
        f (Some a) (Some b)
          { this with
            node=
              ( match (a.node, b.node) with
              | `Node nodes_a, `Node nodes_b ->
                  `Node (iter2 nodes_a nodes_b)
              | `Contents _, `Node nodes_b -> `Node (iter2 [] nodes_b)
              | `Node nodes_a, `Contents _ -> `Node (iter2 nodes_a [])
              | `Contents _, `Contents _ -> `Node [] ) }

      let rec of_istore_tree ?(super = `Root) (tree : Istore.tree) :
          'a node Lwt.t =
        Istore.Tree.kind tree []
        >>= fun kind ->
        match kind with
        | None -> Lwt.return (`Node [])
        | Some `Node ->
            Istore.Tree.list tree []
            >>= fun nlist ->
            Lwt_list.map_p
              (fun (step, tree') ->
                let t = {step; super; node= `Node []} in
                of_istore_tree ~super:(`Tree t) tree'
                >>= fun sub ->
                t.node <- sub ;
                Lwt.return t )
              nlist
            >>= fun sub -> Lwt.return (`Node sub)
        | Some `Contents ->
            Istore.Tree.get tree []
            >>= fun content -> Lwt.return (`Contents content)

      let watch_tree (store : Istore.t) (tree : Istore.tree)
          ~(f : string t Irmin.diff -> 'a t) :
          (Istore.watch * 'a t Lwd.var) Lwt.t =
        of_istore_tree tree
        >>= (function
              | `Contents _ as node ->
                  Lwt.return {step= ""; super= `Root; node}
              | `Node sub ->
                  Lwt_list.map_p
                    (fun t' ->
                      Lwt.return
                        (mapt ~f:(fun a _ -> f (`Added a)) t') )
                    sub
                  >>= fun node ->
                  Lwt.return {step= ""; super= `Root; node= `Node node}
              )
        >>= fun t ->
        let tree = Lwd.var t in
        let aux c =
          of_istore_tree (Istore.Commit.tree c)
          >>= fun t' ->
          Lwd.set tree
            (map2 (Lwd.peek tree)
               {step= ""; super= `Root; node= t'}
               ~f:(fun prev next _ ->
                 match (prev, next) with
                 | Some prev, Some next -> f (`Updated (prev, next))
                 | Some prev, None -> f (`Removed prev)
                 | None, Some next -> f (`Added next)
                 | None, None -> failwith "StoreTree.watch_tree" ) ) ;
          Lwt.return_unit in
        Istore.watch store (function
          | `Added c -> aux c
          | `Removed c -> aux c
          | `Updated (_, c') -> aux c' )
        >>= fun watch -> Lwt.return (watch, tree)
    end

    let channelview ({store; path} : Channel.t) =
      Istore.get_tree store path
      >>= fun tree -> StoreTree.watch_tree store tree ~f:(function
            `Added ({node=`Contents _;_} as t) -> t
          | `Removed _ -> 

    let _channelview ({store; _} : Tree.t) (channel : Channel.t) =
      Fold.tree store ~depth:3 ~path:[] ~f:(function
        | Tree (step, tl) -> Tree (step, tl)
        | Node (step, content) -> Node (step, content) )
      >>= fun (tree : string Fold.t Lwd.var) ->
      let channel = Lwd.var 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
                       ~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 100) )

    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

(**
   program starts...
   - spawn connections to servers
   - these connections will populate the Channel.t in a Channel.tree
       
 **)
let _ =
  Lwt.async (fun () ->
      let comm = Communicator.Tree.make_top root_storeview in
      Irc.Config.make "irc.hackint.org" 6697 "cqcaml"
      >|= fun irc_config ->
      let _irc = Communicator.Irc.connection comm irc_config in
      root_actor := std_actor (Communicator.Panel.panel comm) )