storeview

human.ml

@@ -514,12 +514,25 @@ module Display = struct
       get_events () @ [Event.event_of_sdlevent ev]
     else []
 
+  let successful_actor = ref (fun _ -> Lwt.return pane_empty)
+
   let display_frame frame (actor : actor) =
     let events = get_events () in
     handle_frame_events frame events ;
     if List.length events > 0 then (
       (* recompute the actor definition with the new events to return a new pane *)
-      !actor events
+      ( try
+          !actor events
+          >|= fun p ->
+          successful_actor := !actor ;
+          p
+        with e ->
+          F.epr
+            "Display.display_frame (!actor events) failed with:@. %s \
+             @."
+            (Printexc.to_string e) ;
+          actor := !successful_actor ;
+          !actor events )
       >>= fun p ->
       frame.last_pane <- p ;
       (* call draw_pane because we should redraw now that we have updated *)
@@ -1118,7 +1131,6 @@ module Panel = struct
 
   module Nottui = struct
     open Nottui
-    open Notty
     module P = Nottui_pretty
 
     let convert_events events : Nottui_lwt.event option list =
@@ -1227,8 +1239,6 @@ module Panel = struct
              | _, _, _ -> "fonts/Roboto-Regular.ttf" ) )
     end
 
-    open Notty
-
     let invalid_arg fmt = Format.kasprintf invalid_arg fmt
     let ( &. ) f g x = f (g x)
     let btw (x : int) a b = a <= x && x <= b

irc.ml

@@ -8,12 +8,15 @@ features:
    - 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
+  let base_path = "communicator"
+  let topch = "top"
+
   module Istore = struct
     include Human.Store
 
@@ -25,21 +28,28 @@ module Communicator = struct
   module Message = struct
     type t = {time: string list; content: string}
 
-    let make ?(time = Unix.time ()) content =
+    let make ?(time = Unix.gettimeofday ()) 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 ]
+          List.map string_of_int
+            [tm.tm_year + 1900; tm.tm_mon + 1; tm.tm_mday; tm.tm_hour]
+          @ [ string_of_float
+                ( float_of_int (tm.tm_min * tm.tm_sec)
+                +. fst (modf time) ) ]
       ; content }
   end
 
   module Channel = struct
+    (* a channels step key may not be blank (i.e. "") *)
     type t = {store: Istore.t; path: Istore.key}
 
-    let make (store : Istore.t) ~path ~name =
-      {store; path= path @ name}
+    let make (store : Istore.t) ~path ~(name : string) =
+      Lwt.return {store; path= path @ ["#" ^ name]}
 
     let add_msg {store; path} (msg : Message.t) : unit Lwt.t =
+      F.epr "add_msg path=[" ;
+      F.list ~sep:F.semi F.string F.stderr (path @ msg.time) ;
+      F.epr "] content=%s @." msg.content ;
       Istore.set_exn store ~info:Irmin.Info.none (path @ msg.time)
         msg.content
   end
@@ -49,25 +59,19 @@ module Communicator = struct
 
     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 =
+    let make_top ?(view = [base_path]) 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
+      let t = {store; view} in
+      Channel.make store ~path:view ~name:topch
+      >>= fun ch_top ->
       Channel.add_msg ch_top
         (Message.make "Communicator restarting...")
       >>= fun () ->
@@ -87,6 +91,20 @@ module Communicator = struct
       >>= fun () -> Lwt.return {store; view}
   end
 
+  module Protocol = struct
+    type t = Irc | Email | Rss | Mublog | ActivityPub
+
+    let to_string = function
+      | Irc -> ("IRC", "Internet Relay Chat")
+      | Email -> ("E-mail", "Electronic Mail")
+      | Rss -> ("RSS", "Really Simple Subscriptions???")
+      | Mublog -> ("uBlog", "Microblogging (Twitter)")
+      | ActivityPub -> ("ActivityPub", "Mastodon, etc.")
+
+    let id t = fst (to_string t)
+    let desc t = snd (to_string t)
+  end
+
   module Irc = struct
     module C = Irc_client_tls
     module M = Irc_message
@@ -96,7 +114,9 @@ module Communicator = struct
 
       open Lwt.Infix
 
-      let make_connection Tree.{store; _} server port nick =
+      let path = "_config"
+
+      let make_connection Tree.{store; view} server port nick =
         let name = F.str "%s@%s:%d" nick server port in
         Istore.Tree.add Istore.Tree.empty ["server"] server
         >>= fun t' ->
@@ -104,52 +124,76 @@ module Communicator = struct
         >>= fun t' ->
         Istore.Tree.add t' ["nick"] nick
         >>= fun t' ->
+        Istore.Tree.add t' ["protocol"] (Protocol.id Irc)
+        >>= fun t' ->
+        F.epr "Creating connection config /%s/%s/@." name path ;
         Istore.set_tree_exn ~info:Irmin.Info.none store
-          ["irc"; name; "_config"]
+          (view @ [name; path])
           t'
         >>= fun _ -> Lwt.return_unit
 
-      let server t : string Lwt.t = Istore.Tree.get t ["server"]
+      let server t : string Lwt.t = Istore.Tree.get t [path; "server"]
 
       let port t : int Lwt.t =
-        Istore.Tree.get t ["port"] >|= fun p -> int_of_string p
+        Istore.Tree.get t [path; "port"] >|= fun p -> int_of_string p
 
-      let nick t : string Lwt.t = Istore.Tree.get t ["nick"]
+      let nick t : string Lwt.t = Istore.Tree.get t [path; "nick"]
+
+      let protocol t : string option Lwt.t =
+        Istore.Tree.find t [path; "protocol"]
     end
 
     let get_channels ~store ~path =
       Istore.list store path
-      >>= fun c -> Lwt.return (fst (List.split c))
+      >>= fun c ->
+      let rec iter l =
+        Lwt_list.filter_map_p
+          (fun (s, _) ->
+            if String.length s > 1 && String.get s 0 = '#' then
+              Lwt.return (Some s)
+            else Lwt.return None )
+          l in
+      iter c
 
-    let connect ?(path = ["irc"]) ({store; _} : Tree.t) : unit Lwt.t =
+    let connect ?(path = [base_path]) ({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
+      Channel.make store ~path ~name:topch
+      >>= fun top_channel ->
       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
+      let make_channel store path (name : string) =
+        Channel.make store ~path ~name
+        >>= fun ch ->
         channel_assoc := (name, ch) :: !channel_assoc ;
         Channel.add_msg ch
           (Message.make (F.str "channel %s created" name))
         >>= fun () -> Lwt.return ch in
+      Istore.list store path
+      >>= fun servers ->
+      Lwt_list.filter_p
+        (fun (_, tree) ->
+          Config.protocol tree
+          >|= function Some p -> p = Protocol.id Irc | None -> false
+          )
+        servers
+      (* filter out non-irc protocols, TODO currently relying on this to filter out non-server folders too *)
+      >>= fun servers ->
+      F.epr "protocols filtered for irc@." ;
       Lwt_list.iter_p
-        (fun (_server, tree) ->
+        (fun (name, tree) ->
+          F.epr "Irc.connect server=%s @." name ;
           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
+          Channel.make store ~path:(path @ [name]) ~name:topch
+          >>= fun server_channel ->
           let add_msg s =
             Channel.add_msg server_channel (Message.make s) in
           C.reconnect_loop ~after:30
@@ -159,15 +203,16 @@ module Communicator = struct
               C.connect_by_name ~server ~port ~nick ()
               >>= fun c -> Lwt.return c )
             ~f:(fun connection ->
+              F.epr "Irc.connect C.reconnect_loop ~f:(Connected...)@." ;
               add_msg "Connected"
               >>= fun () ->
-              get_channels ~store ~path:["irc"; server]
+              get_channels ~store ~path:[name]
               >>= fun chs ->
               Lwt_list.iter_p
                 (fun chname ->
                   C.send_join ~connection ~channel:chname
                   >>= fun () ->
-                  ignore (make_channel store [server] chname) ;
+                  ignore (make_channel store [name] chname) ;
                   Lwt.return_unit )
                 chs )
             ~callback:(fun _connection result ->
@@ -199,301 +244,227 @@ module Communicator = struct
   end
 
   module Panel = struct
+    type viewer =
+      { step: string
+      ; var: view Lwd.var
+      ; mutable parent: view
+      ; mutable node: viewer list }
+
+    and view = [`Empty | `View of viewer]
+
+    let add v node =
+      ( match v with
+      | `View v ->
+          v.node <- node :: v.node ;
+          Lwd.set v.var (`View v)
+      | `Empty -> () ) ;
+      node.parent <- v ;
+      Lwd.set node.var (`View node) ;
+      `View node
+
+    let make step parent node =
+      let v = {step; var= Lwd.var `Empty; parent; node} in
+      ( match parent with
+      | `View parent ->
+          parent.node <- v :: parent.node ;
+          Lwd.set parent.var (`View parent)
+      | `Empty -> () ) ;
+      let rec iter = function
+        | [] -> ()
+        | x :: xs ->
+            x.parent <- `View v ;
+            Lwd.set x.var (`View x) ;
+            iter xs in
+      iter node ;
+      Lwd.set v.var (`View v) ;
+      `View v
+
+    let rec last = function
+      | [] -> None
+      | [x] -> Some x
+      | _ :: xs -> last xs
+
+    let rec last_def = function
+      | [] -> "[]"
+      | [x] -> x
+      | _ :: xs -> last_def xs
+
+    let find_node ~step ~view =
+      match view with
+      | `Empty -> None
+      | `View v -> List.find_opt (fun v' -> v'.step = step) v.node
+
+    let string_of_path path =
+      "[" ^ F.str "%a" (F.list ~sep:F.semi F.string) path ^ "]"
+
+    let remove (v : viewer) =
+      Lwd.set v.var `Empty ;
+      `Empty
+
+    let storeview store path =
+      Istore.get_tree store path
+      >>= fun tree ->
+      let update d key (view : view) : view option Lwt.t =
+        F.epr "fold ~pre:update key=%s @." (string_of_path key) ;
+        Lwt.return
+          ( match
+              ( List.rev key
+              , find_node
+                  ~step:(Option.value (last key) ~default:"[]")
+                  ~view
+              , d )
+            with
+          | [], None, `Added | [], None, `Updated ->
+              Some (make "[]" view [])
+          | [], Some v, _ -> Some (`View v)
+          | [], None, `Removed -> None
+          | _ :: k :: _, _, _ when k.[0] == '#' -> None
+          | k :: _, None, `Added | k :: _, None, `Updated ->
+              Some (make k view [])
+          | _ :: _, None, `Removed -> None
+          | _ :: _, Some v, _ -> Some (`View v) ) in
+      (* if pre returns None, the children of that node are skipped. *)
+      let rec map ?(key = []) ~node tree (acc : view) : view Lwt.t =
+        let acc =
+          match acc with
+          | `Empty -> make (last_def key) acc []
+          | v -> v in
+        Istore.Tree.list tree []
+        >>= fun tree ->
+        Lwt_list.iter_s
+          (fun (s, t) ->
+            let k = key @ [s] in
+            node k acc
+            >|= function
+            | Some a ->
+                F.epr "storeview Fold step=%s @." s ;
+                ignore (map ~key:k ~node t a)
+            | None -> F.epr "storeview None step=%s @." s )
+          tree
+        >|= fun () -> acc in
+      map ~node:(update `Added) tree `Empty
+      >>= fun t ->
+      let root = Lwd.var t in
+      Istore.watch_key store path (fun diff ->
+          let d, tree =
+            match diff with
+            | `Added (_, tree) -> (`Added, tree)
+            | `Removed (_, tree) -> (`Removed, tree)
+            | `Updated (_, (_, tree)) -> (`Updated, tree) in
+          map ~node:(update d) tree t
+          >>= fun t' -> Lwd.set root t' ; Lwt.return_unit )
+      >>= fun watch -> Lwt.return (watch, root)
+
     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 channelview (store, path) =
+      storeview store path
+      >>= fun (_watch, root) ->
+      let ui =
+        Lwd.join
+          (Lwd.map (Lwd.get root) ~f:(function
+            | `Empty ->
+                failwith "channelview says root Lwd.var is `Empty"
+            | `View v ->
+                let rec iter ?(indent = 0) (v : viewer) =
+                  Lwd.bind (Lwd.get v.var) ~f:(function
+                    | `Empty -> Lwd.return Ui.empty
+                    | `View v' ->
+                        let sub =
+                          Lwd_utils.pack Ui.pack_y
+                            (List.map
+                               (iter ~indent:(indent + 1))
+                               v'.node ) in
+                        Lwd.map sub ~f:(fun sub ->
+                            Ui.join_y
+                              (Nottui_widgets.string
+                                 ( String.make indent '>' ^ " "
+                                 ^ v'.step ) )
+                              sub ) ) in
+                iter v ) ) in
+      let chs, chs_push = Lwt_stream.create () in
+      Channel.make store ~path:[base_path] ~name:topch
+      >>= fun ch ->
+      chs_push (Some ch) ;
+      Lwt.return (chs, ui)
+
+    let messagelist ({store; path} : Channel.t) mlist :
+        Istore.watch Lwt.t =
       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
+        Istore.get_tree store path
+        >>= fun tree ->
+        Istore.Tree.fold ~depth:(`Eq 5)
+          ~contents:(fun key contents view ->
+            match key with
+            | [y; m; d; h; s] ->
+                Lwt.return (((y, m, d, h, s), contents) :: view)
+            | _ ->
+                F.epr
+                  "ERROR: messagelist (fold ~depth:(`Eq 5)) got \
+                   wrong number of steps@." ;
+                Lwt.return view )
+          ~node:(fun _key _node view ->
+            F.epr
+              "ERROR: messagelist (fold ~depth:(`Eq 5)) found a \
+               node@." ;
+            Lwt.return view )
+          tree [] in
       mlist' ()
-      >>= fun mlist ->
-      let mlist = Lwd.var mlist in
-      Istore.watch_key store ch.path (function _ ->
+      >>= fun ml ->
+      Lwd.set mlist ml ;
+      Istore.watch_key store path (fun _ ->
           mlist' ()
           >>= fun mlist' -> Lwt.return (Lwd.set mlist mlist') )
-      >>= fun watch ->
-      messagelist_watch := Some watch ;
+
+    let messageview ch =
+      let mlist = Lwd.var [(("", "", "", "", ""), "")] in
+      let rec update_messagelist watch () =
+        Lwt_stream.last_new ch
+        >>= fun ch ->
+        ( match watch with
+        | None -> Lwt.return_unit
+        | Some w -> Istore.unwatch w )
+        >>= fun () ->
+        messagelist ch mlist
+        >>= fun watch -> update_messagelist (Some watch) () in
+      Lwt.async (update_messagelist None) ;
+      let doc =
+        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 ) in
       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 ) )
+        (Panel.Nottui.scroll_area (Lwd.map doc ~f:(P.pretty 100)))
+
+    let commview (store, path) =
+      channelview (store, List.rev (List.tl (List.rev path)))
+      >>= fun (ch, cv) ->
+      messageview ch
+      >>= fun mv ->
+      Lwt.return
+        (Nottui_widgets.h_pane (Panel.Nottui.scroll_area cv) mv)
 
     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 panel ({store; view} : Tree.t) =
       let base = Lwd.var Nottui_widgets.empty_lwd in
-      Lwd.set base (commview comm) ;
+      commview (store, view)
+      >>= fun cv ->
+      Lwd.set base cv ;
       Panel.Nottui.panel (Lwd.join (Lwd.get base)) ()
   end
 end
@@ -506,8 +477,12 @@ end
  **)
 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
+      Communicator.Tree.make_top "commstore" "current"
+      >>= fun comm ->
+      Communicator.Irc.Config.make_connection comm "irc.hackint.org"
+        6697 "cqcaml"
+      >|= fun () ->
+      Lwt.async (fun () -> Communicator.Irc.connect comm) ;
+      F.epr
+        "root_actor := std_actor (Communicator.Panel.panel comm)@." ;
       root_actor := std_actor (Communicator.Panel.panel comm) )