shrub/pkg/arvo/app/chat-cli.hoon

::  chat-cli: cli chat client using chat-store and friends
::
::    pulls all known messages into a single stream.
::    type ;help for usage instructions.
::
::    note that while the chat-store only cares about paths,
::    we mostly deal with [ship path] (aka target) here.
::    when sending messages (through the chat hook),
::    we concat the ship onto the head of the path,
::    and trust it to take care of the rest.
::
/-  *resource, post, store=chat-store
/+  shoe, default-agent, verb, dbug, graph=graph-store, libgraph=graph
::
|%
+$  card  card:shoe
::
+$  versioned-state
  $%  state-3
      state-2
      state-1
      state-0
  ==
::
+$  state-3
  $:  %3
      ::TODO  support multiple sessions
      sessions=(map sole-id session)                ::  sole sessions
      bound=(map resource glyph)                    ::  bound resource glyphs
      binds=(jug glyph resource)                    ::  resource glyph lookup
      settings=(set term)                           ::  frontend flags
      width=@ud                                     ::  display width
      timez=(pair ? @ud)                            ::  timezone adjustment
  ==
::
+$  sole-id  @ta
+$  session
  $:  viewing=(set resource)                        ::  connected graphs
      history=(list uid:post)                       ::  scrollback pointers
      count=@ud                                     ::  (lent history)
      audience=target                               ::  active target
  ==
::
::TODO  remove for breach
+$  target-2  [in-group=? =ship =path]
+$  mail  [source=target-2 envelope:store]
+$  state-2
  $:  %2
      grams=(list mail)                             ::  all messages
      known=(set [target-2 serial:store])           ::  known message lookup
      count=@ud                                     ::  (lent grams)
      bound=(map target-2 glyph)                    ::  bound circle glyphs
      binds=(jug glyph target-2)                    ::  circle glyph lookup
      audience=(set target-2)                       ::  active targets
      settings=(set term)                           ::  frontend flags
      width=@ud                                     ::  display width
      timez=(pair ? @ud)                            ::  timezone adjustment
  ==
::
+$  state-1
  $:  %1
      grams=(list mail)                             ::  all messages
      known=(set [target-2 serial:store])           ::  known message lookup
      count=@ud                                     ::  (lent grams)
      bound=(map target-2 glyph)                    ::  bound circle glyphs
      binds=(jug glyph target-2)                    ::  circle glyph lookup
      audience=(set target-2)                       ::  active targets
      settings=(set term)                           ::  frontend flags
      width=@ud                                     ::  display width
      timez=(pair ? @ud)                            ::  timezone adjustment
      cli=state=sole-share:shoe                     ::  console state
      eny=@uvJ                                      ::  entropy
  ==
::
+$  state-0
  $:  grams=(list [[=ship =path] envelope:store])   ::  all messages
      known=(set [[=ship =path] serial:store])      ::  known message lookup
      count=@ud                                     ::  (lent grams)
      bound=(map [=ship =path] glyph)               ::  bound circle glyphs
      binds=(jug glyph [=ship =path])               ::  circle glyph lookup
      audience=(set [=ship =path])                  ::  active targets
      settings=(set term)                           ::  frontend flags
      width=@ud                                     ::  display width
      timez=(pair ? @ud)                            ::  timezone adjustment
      cli=state=sole-share:shoe                     ::  console state
      eny=@uvJ                                      ::  entropy
  ==
::
+$  target  resource
::
+$  glyph  char
++  glyphs  "!@#$%^&()-=_+[]\{}'\\:\",.<>?"
::
+$  command
  $%  [%target target]                              ::  set messaging target
      [%say content:post]                           ::  send message
      [%eval cord hoon]                             ::  send #-message
    ::                                              ::
      [%view $?(~ target)]                          ::  notice chat
      [%flee target]                                ::  ignore chat
    ::                                              ::
      [%bind glyph target]                          ::  bind glyph
      [%unbind glyph (unit target)]                 ::  unbind glyph
      [%what (unit $@(char target))]                ::  glyph lookup
    ::                                              ::
      [%settings ~]                                 ::  show active settings
      [%set term]                                   ::  set settings flag
      [%unset term]                                 ::  unset settings flag
      [%width @ud]                                  ::  adjust display width
      [%timezone ? @ud]                             ::  adjust time printing
    ::                                              ::
      [%select $@(rel=@ud [zeros=@u abs=@ud])]      ::  rel/abs msg selection
      [%chats ~]                                    ::  list available chats
      [%help ~]                                     ::  print usage info
  ==                                                ::
::
--
=|  state-3
=*  state  -
::
%-  agent:dbug
%+  verb  |
%-  (agent:shoe command)
^-  (shoe:shoe command)
=<
  |_  =bowl:gall
  +*  this       .
      talk-core  +>
      tc         ~(. talk-core bowl)
      def        ~(. (default-agent this %|) bowl)
      des        ~(. (default:shoe this command) bowl)
  ::
  ++  on-init
    ^-  (quip card _this)
    =^  cards  state  (prep:tc ~)
    [cards this]
  ::
  ++  on-save  !>(state)
  ::
  ++  on-load
    |=  old-state=vase
    ^-  (quip card _this)
    =/  old  !<(versioned-state old-state)
    =^  cards  state  (prep:tc `old)
    [cards this]
  ::
  ++  on-poke
    |=  [=mark =vase]
    ^-  (quip card _this)
    =^  cards  state
      ?+  mark        (on-poke:def mark vase)
        %noun         (poke-noun:tc !<(* vase))
      ==
    [cards this]
  ::
  ++  on-agent
    |=  [=wire =sign:agent:gall]
    ^-  (quip card _this)
    =^  cards  state
      ?-    -.sign
        %poke-ack   [- state]:(on-agent:def wire sign)
        %watch-ack  [- state]:(on-agent:def wire sign)
      ::
          %kick
        :_  state
        ?+  wire  ~
          [%graph-store ~]  ~[connect:tc]
        ==
      ::
          %fact
        ?+  p.cage.sign  ~|([dap.bowl %bad-sub-mark wire p.cage.sign] !!)
            %graph-update-1
          %-  on-graph-update:tc
          !<(update:graph q.cage.sign)
        ==
      ==
    [cards this]
  ::
  ++  on-watch  on-watch:def
  ++  on-leave  on-leave:def
  ++  on-peek   on-peek:def
  ++  on-arvo   on-arvo:def
  ++  on-fail   on-fail:def
  ::
  ++  command-parser
    |=  =sole-id
    parser:(make:sh:tc sole-id)
  ::
  ++  tab-list
    |=  =sole-id
    tab-list:sh:tc
  ::
  ++  on-command
    |=  [=sole-id =command]
    =^  cards  state
      (work:(make:sh:tc sole-id) command)
    [cards this]
  ::
  ++  on-connect
    |=  =sole-id
    ^-  (quip card _this)
    [[prompt:(make:sh-out:tc sole-id)]~ this]
  ::
  ++  can-connect     can-connect:des
  ++  on-disconnect   on-disconnect:des
  --
::
|_  =bowl:gall
+*  libgraph  ~(. ^libgraph bowl)
::  +prep: setup & state adapter
::
++  prep
  |=  old=(unit versioned-state)
  ^-  (quip card _state)
  ?~  old
    [~[connect] state(width 80)]
  ::
  =?  u.old  ?=(?(~ ^) -.u.old)
    ^-  state-1
    :-  %1
    %=  u.old
      grams  ~  ::NOTE  this only impacts historic message lookup in chat-cli
    ::
        known
      ^-  (set [target-2 serial:store])
      %-  ~(run in known.u.old)
      |=  [t=[ship path] s=serial:store]
      [`target-2`[| t] s]
    ::
        bound
      ^-  (map target-2 glyph)
      %-  ~(gas by *(map target-2 glyph))
      %+  turn  ~(tap by bound.u.old)
      |=  [t=[ship path] g=glyph]
      [`target-2`[| t] g]
    ::
        binds
      ^-  (jug glyph target-2)
      %-  ~(run by binds.u.old)
      |=  s=(set [ship path])
      %-  ~(run in s)
      |=  t=[ship path]
      `target-2`[| t]
    ::
        audience
      ^-  (set target-2)
      %-  ~(run in audience.u.old)
      |=  t=[ship path]
      `target-2`[| t]
    ==
  ::
  =?  u.old  ?=(%1 -.u.old)
    ^-  state-2
    =,  u.old
    :*  %2
      grams  known  count
      bound  binds  audience
      settings  width  timez
    ==
  ::
  =^  cards  u.old
    ?.  ?=(%2 -.u.old)  [~ u.old]
    :-  :~  [%pass /chat-store %agent [our-self %chat-store] %leave ~]
            [%pass /invites %agent [our.bowl %invite-store] %leave ~]
        ==
    ^-  state-3
    :-  %3
    :*  %+  ~(put in *(map sole-id session))
          (cat 3 'drum_' (scot %p our.bowl))
        :*  ~  ~  0
          ::
            ?~  audience.u.old  *target
            [ship ?~(path %$ i.path)]:n.audience.u.old
        ==
      ::
        %-  ~(gas by *(map resource glyph))
        %+  turn  ~(tap in bound.u.old)
        |=  [t=target-2 g=glyph]
        [[ship.t ?~(path.t %$ i.path.t)] g]
      ::
        ^-  (jug glyph resource)
        %-  ~(run by binds.u.old)
        |=  s=(set target-2)
        %-  ~(run in s)
        |=  t=target-2
        [ship.t ?~(path.t %$ i.path.t)]
      ::
        settings.u.old
        width.u.old
        timez.u.old
    ==
  ::
  ?>  ?=(%3 -.u.old)
  :_  u.old
  %+  welp
    cards
  ?:  %-  ~(has by wex.bowl)
      [/graph-store our-self %graph-store]
    ~
  ~[connect]
::  +connect: connect to the graph-store
::
++  connect
  ^-  card
  [%pass /graph-store %agent [our-self %graph-store] %watch /updates]
::
::TODO  better moon support. (name:title our.bowl)
++  our-self  our.bowl
::
++  get-session
  |=  =sole-id
  ^-  session
  (~(gut by sessions) sole-id %*(. *session audience [our-self %$]))
::  +tor: term ordering for targets
::
++  tor
  |=  [[* a=term] [* b=term]]
  (aor a b)
::  +ior: index ordering for nodes
::
++  ior
  |=  [[a=index:post *] [b=index:post *]]
  (aor a b)
::  +safe-get-graph: virtualized +get-graph
::
++  safe-get-graph
  |=  =resource
  ^-  (unit update:graph)
  =/  res=(each update:graph tang)
    ::TODO  doesn't actually contain the crash?
    %-  mule  |.
    (get-graph:libgraph resource)
  ?-  -.res
    %&  `p.res
    %|  ~
  ==
::  +is-chat-graph: check whether graph contains chat-style data
::
++  is-chat-graph
  |=  =resource
  ^-  ?
  =/  update=(unit update:graph)
    (safe-get-graph resource)
  ?~  update  |
  ?>  ?=(%add-graph -.q.u.update)
  =(`%graph-validator-chat mark.q.u.update)
::  +poke-noun: debug helpers
::
++  poke-noun
  |=  a=*
  ^-  (quip card _state)
  ?:  ?=(%connect a)
    [[connect ~] state]
  [~ state]
::  +handle-graph-update: get new mailboxes & messages
::
++  on-graph-update
  |=  upd=update:graph
  ^-  (quip card _state)
  ?.  ?=(?(%remove-graph %add-nodes) -.q.upd)
    [~ state]
  =/  sez=(list [=sole-id =session])
    ~(tap by sessions)
  =|  cards=(list card)
  |-
  ?~  sez  [cards state]
  =^  caz  session.i.sez
    ?-  -.q.upd
      %remove-graph  (~(notice-remove se i.sez) +.q.upd)
    ::
        %add-nodes
      ?.  (~(has in viewing.session.i.sez) resource.q.upd)
        [~ session.i.sez]
      %+  ~(read-posts se i.sez)
        resource.q.upd
      (sort ~(tap by nodes.q.upd) ior)
    ==
  =.  sessions  (~(put by sessions) i.sez)
  $(sez t.sez, cards (weld cards caz))
::  +se: session event handling
::
++  se
  |_  [=sole-id =session]
  +*  sh-out  ~(. ^sh-out sole-id session)
  ::
  ++  read-posts
    |=  [=target nodes=(list [=index:post =node:graph])]
    ^-  (quip card _session)
    =^  cards  nodes
      ^-  (quip card _nodes)
      =+  count=(lent nodes)
      ?.  (gth count 10)  [~ nodes]
      :_  (swag [(sub count 10) 10] nodes)
      [(print:sh-out "skipping {(scow %ud (sub count 10))} messages...")]~
    |-
    ?~  nodes  [cards session]
    =^  caz  session
      (read-post target [index post.node]:i.nodes)
    $(cards (weld cards caz), nodes t.nodes)
  ::
  ::  +read-post: add envelope to state and show it to user
  ::
  ++  read-post
    |=  [=target =index:post =maybe-post:graph]
    ^-  (quip card _session)
    ?-    -.maybe-post
        %|  [~ session]
        %&
      :-  (show-post:sh-out target p.maybe-post)
      %_  session
        history  [[target index] history.session]
        count    +(count.session)
      ==
    ==
  ::
  ++  notice-remove
    |=  =target
    ^-  (quip card _session)
    ?.  (~(has in viewing.session) target)
      [~ session]
    :-  [(show-delete:sh-out target) ~]
    session(viewing (~(del in viewing.session) target))
  --
::
::  +bind-default-glyph: bind to default, or random available
::
++  bind-default-glyph
  |=  =target
  ^-  (quip card _state)
  =;  =glyph  (bind-glyph glyph target)
  |^  =/  g=glyph  (choose glyphs)
      ?.  (~(has by binds) g)  g
      =/  available=(list glyph)
        %~  tap  in
        (~(dif in `(set glyph)`(sy glyphs)) ~(key by binds))
      ?~  available  g
      (choose available)
  ++  choose
    |=  =(list glyph)
    =;  i=@ud  (snag i list)
    (mod (mug target) (lent list))
  --
::  +bind-glyph: add binding for glyph
::
++  bind-glyph
  |=  [=glyph =target]
  ^-  (quip card _state)
  ::TODO  should send these to settings store eventually
  ::  if the target was already bound to another glyph, un-bind that
  ::
  =?  binds  (~(has by bound) target)
    (~(del ju binds) (~(got by bound) target) target)
  =.  bound  (~(put by bound) target glyph)
  =.  binds  (~(put ju binds) glyph target)
  [(show-glyph:sh-out glyph `target) state]
::  +unbind-glyph: remove all binding for glyph
::
++  unbind-glyph
  |=  [=glyph targ=(unit target)]
  ^-  (quip card _state)
  ?^  targ
    =.  binds  (~(del ju binds) glyph u.targ)
    =.  bound  (~(del by bound) u.targ)
    [(show-glyph:sh-out glyph ~) state]
  =/  ole=(set target)
    (~(get ju binds) glyph)
  =.  binds  (~(del by binds) glyph)
  =.  bound
    |-
    ?~  ole  bound
    =.  bound  $(ole l.ole)
    =.  bound  $(ole r.ole)
    (~(del by bound) n.ole)
  [(show-glyph:sh-out glyph ~) state]
::  +decode-glyph: find the target that matches a glyph, if any
::
++  decode-glyph
  |=  [=session =glyph]
  ^-  (unit target)
  =+  lax=(~(get ju binds) glyph)
  ::  no target
  ?:  =(~ lax)  ~
  %-  some
  ::  single target
  ?:  ?=([* ~ ~] lax)  n.lax
  ::  in case of multiple matches, pick one we're viewing
  =.  lax  (~(uni in lax) viewing.session)
  ?:  ?=([* ~ ~] lax)  n.lax
  ::  in case of multiple audiences, pick the most recently active one
  |-  ^-  target
  ?~  history.session  -:~(tap in lax)
  =*  resource  resource.i.history.session
  ?:  (~(has in lax) resource)
    resource
  $(history.session t.history.session)
::
::  +sh: shoe handling
::
++  sh
  |_  [=sole-id session]
  +*  session  +<+
      sh-out   ~(. ^sh-out sole-id session)
      put-ses  state(sessions (~(put by sessions) sole-id session))
  ::
  ++  make
    |=  =^sole-id
    %_  ..make
      sole-id  sole-id
      +<+      (get-session sole-id)
    ==
  ::  +read: command parser
  ::
  ::    parses the command line buffer.
  ::    produces commands which can be executed by +work.
  ::
  ++  parser
    |^
      %+  stag  |
      %+  knee  *command  |.  ~+
      =-  ;~(pose ;~(pfix mic -) message)
      ;~  pose
        (stag %target targ)
      ::
        ;~((glue ace) (tag %view) targ)
        ;~((glue ace) (tag %flee) targ)
        ;~(plug (tag %view) (easy ~))
      ::
        ;~((glue ace) (tag %bind) glyph targ)
        ;~((glue ace) (tag %unbind) ;~(plug glyph (punt ;~(pfix ace targ))))
        ;~(plug (perk %what ~) (punt ;~(pfix ace ;~(pose glyph targ))))
      ::
        ;~(plug (tag %settings) (easy ~))
        ;~((glue ace) (tag %set) flag)
        ;~((glue ace) (tag %unset) flag)
        ;~(plug (cold %width (jest 'set width ')) dem:ag)
      ::
        ;~  plug
          (cold %timezone (jest 'set timezone '))
          ;~  pose
            (cold %| (just '-'))
            (cold %& (just '+'))
          ==
          %+  sear
            |=  a=@ud
            ^-  (unit @ud)
            ?:(&((gte a 0) (lte a 14)) `a ~)
          dem:ag
        ==
      ::
        ;~(plug (tag %chats) (easy ~))
        ;~(plug (tag %help) (easy ~))
      ::
        (stag %select nump)
      ==
    ::
    ::TODO
    :: ++  cmd
    ::   |*  [cmd=term req=(list rule) opt=(list rule)]
    ::   |^  ;~  plug
    ::         (tag cmd)
    ::       ::
    ::         ::TODO  this feels slightly too dumb
    ::         ?~  req
    ::           ?~  opt  (easy ~)
    ::           (opt-rules opt)
    ::         ?~  opt  (req-rules req)
    ::         ;~(plug (req-rules req) (opt-rules opt))  ::TODO  rest-loop
    ::       ==
    ::   ++  req-rules
    ::     |*  req=(lest rule)
    ::     =-  ;~(pfix ace -)
    ::     ?~  t.req  i.req
    ::     ;~(plug i.req $(req t.req))
    ::   ++  opt-rules
    ::     |*  opt=(lest rule)
    ::     =-  (punt ;~(pfix ace -))
    ::     ?~  t.opt  ;~(pfix ace i.opt)
    ::     ;~(pfix ace ;~(plug i.opt $(opt t.opt)))
    ::   --
    ::
    ++  group  ;~((glue fas) ship sym)
    ++  tag   |*(a=@tas (cold a (jest a)))  ::TODO  into stdlib
    ++  ship  ;~(pfix sig fed:ag)
    ++  name  ;~(pfix fas urs:ab)
    ::  +tarl: local target, as /path
    ::
    ++  tarl  (stag our-self name)
    ::  +targ: any target, as tarl, tarp, ~ship/path or glyph
    ::
    ++  targ
      ;~  pose
        tarl
        ;~(plug ship name)
        (sear (cury decode-glyph session) glyph)
      ==
    ::  +tars: set of comma-separated targs
    ::
    ++  tars
      %+  cook  ~(gas in *(set target))
      (most ;~(plug com (star ace)) targ)
    ::  +ships: set of comma-separated ships
    ::
    ++  ships
      %+  cook  ~(gas in *(set ^ship))
      (most ;~(plug com (star ace)) ship)
    ::  +glyph: shorthand character
    ::
    ++  glyph  (mask glyphs)
    ::  +flag: valid flag
    ::
    ++  flag
      %-  perk  :~
        %notify
        %showtime
      ==
    ::  +nump: message number reference
    ::
    ++  nump
      ;~  pose
        ;~(pfix hep dem:ag)
        ;~  plug
          (cook lent (plus (just '0')))
          ;~(pose dem:ag (easy 0))
        ==
        (stag 0 dem:ag)
        (cook lent (star mic))
      ==
    ::  +message: all messages
    ::
    ++  message
      ;~  pose
        ;~(plug (cold %eval hax) expr)
        (stag %say content)
      ==
    ::  +content: simple messages
    ::TODO  mentions
    ::
    ++  content
      ;~  pose
        (stag %url turl)
        (stag %text ;~(less mic hax text))
      ==
    ::  +turl: url parser
    ::
    ++  turl
      =-  (sear - text)
      |=  t=cord
      ^-  (unit cord)
      ?~((rush t aurf:de-purl:html) ~ `t)
    ::  +text: text message body
    ::
    ++  text
      %+  cook  crip
      (plus next)
    ::  +expr: parse expression into [cord hoon]
    ::
    ++  expr
      |=  tub=nail
      %.  tub
      %+  stag  (crip q.tub)
      wide:(vang & [&1:% &2:% (scot %da now.bowl) |3:%])
    --
  ::  +tab-list: command descriptions
  ::
  ++  tab-list
    ^-  (list [@t tank])
    :~
      [';view' leaf+";view ~ship/chat-name (glyph)"]
      [';flee' leaf+";flee ~ship/chat-name"]
    ::
      [';bind' leaf+";bind [glyph] ~ship/chat-name"]
      [';unbind' leaf+";unbind [glyph]"]
      [';what' leaf+";what (~ship/chat-name) (glyph)"]
    ::
      [';settings' leaf+";settings"]
      [';set' leaf+";set key (value)"]
      [';unset' leaf+";unset key"]
    ::
      [';chats' leaf+";chats"]
      [';help' leaf+";help"]
    ==
  ::  +work: run user command
  ::
  ++  work
    |=  job=command
    ^-  (quip card _state)
    |^  ?-  -.job
          %target    (set-target +.job)
          %say       (say +.job)
          %eval      (eval +.job)
        ::
          %view      (view +.job)
          %flee      (flee +.job)
        ::
          %bind      (bind-glyph +.job)
          %unbind    (unbind-glyph +.job)
          %what      (lookup-glyph +.job)
        ::
          %settings  show-settings
          %set       (set-setting +.job)
          %unset     (unset-setting +.job)
          %width     (set-width +.job)
          %timezone  (set-timezone +.job)
        ::
          %select    (select +.job)
          %chats     chats
          %help      help
        ==
    ::  +act: build action card
    ::
    ++  act
      |=  [what=term app=term =cage]
      ^-  card
      :*  %pass
          /cli-command/[what]
          %agent
          [our-self app]
          %poke
          cage
      ==
    ::  +set-target: set audience, update prompt
    ::
    ++  set-target
      |=  =target
      ^-  (quip card _state)
      =.  audience  target
      [[prompt:sh-out ~] put-ses]
    ::  +view: start printing messages from a resource
    ::
    ++  view
      |=  target=$?(~ target)
      ^-  (quip card _state)
      ::  without argument, print all we're viewing
      ::
      ?~  target
        [[(show-chats:sh-out ~(tap in viewing))]~ state]
      ::  only view existing chat-type graphs
      ::
      ?.  (is-chat-graph target)
        [[(note:sh-out "no such chat")]~ put-ses]
      =.  viewing  (~(put in viewing) target)
      =^  cards  state
        ?:  (~(has by bound) target)
          [~ state]
        (bind-default-glyph target)
      [[prompt:sh-out cards] put-ses]
    ::  +flee: stop printing messages from a resource
    ::
    ++  flee
      |=  =target
      ^-  (quip card _state)
      =.  viewing  (~(del in viewing) target)
      [~ put-ses]
    ::  +say: send messages
    ::
    ++  say
      |=  msg=content:post
      ^-  (quip card _state)
      =/  =serial:store  (shaf %msg-uid eny.bowl)
      :_  state
      :_  ~
      ::TODO  move creation into lib?
      %^  act  %out-message
        %graph-push-hook
      :-  %graph-update-2
      !>  ^-  update:graph
      :-  now.bowl
      :+  %add-nodes  audience
      %-  ~(put by *(map index:post node:graph))
      :-  ~[now.bowl]
      :_  *internal-graph:graph
      ^-  maybe-post:graph
      [%& `post:post`[our-self ~[now.bowl] now.bowl [msg]~ ~ ~]]
    ::  +eval: run hoon, send code and result as message
    ::
    ::    this double-virtualizes and clams to disable .^ for security reasons
    ::
    ++  eval
      |=  [txt=cord exe=hoon]
      ~&  %eval-tmp-disabled
      [~ state]
      ::TODO  why -find.eval??
      :: (say %code txt (eval:store bowl exe))
    ::  +lookup-glyph: print glyph info for all, glyph or target
    ::
    ++  lookup-glyph
      |=  qur=(unit $@(glyph target))
      ^-  (quip card _state)
      =-  [[- ~] state]
      ?^  qur
        ?^  u.qur
          =+  gyf=(~(get by bound) u.qur)
          (print:sh-out ?~(gyf "none" [u.gyf]~))
        =+  pan=~(tap in (~(get ju binds) `@t`u.qur))
        ?:  =(~ pan)  (print:sh-out "~")
        =<  (effect:sh-out %mor (turn pan .))
        |=(t=target [%txt ~(phat tr t)])
      %-  print-more:sh-out
      %-  ~(rep by binds)
      |=  $:  [=glyph tars=(set target)]
              lis=(list tape)
          ==
      %+  weld  lis
      ^-  (list tape)
      %-  ~(rep in tars)
      |=  [t=target l=(list tape)]
      %+  weld  l
      ^-  (list tape)
      [glyph ' ' ~(phat tr t)]~
    ::  +show-settings: print enabled flags, timezone and width settings
    ::
    ++  show-settings
      ^-  (quip card _state)
      :_  state
      :~  %-  print:sh-out
          %-  zing
          ^-  (list tape)
          :-  "flags: "
          %+  join  ", "
          (turn `(list @t)`~(tap in settings) trip)
        ::
          %-  print:sh-out
          %+  weld  "timezone: "
          ^-  tape
          :-  ?:(p.timez '+' '-')
          (scow %ud q.timez)
        ::
          (print:sh-out "width: {(scow %ud width)}")
      ==
    ::  +set-setting: enable settings flag
    ::
    ++  set-setting
      |=  =term
      ^-  (quip card _state)
      [~ state(settings (~(put in settings) term))]
    ::  +unset-setting: disable settings flag
    ::
    ++  unset-setting
      |=  =term
      ^-  (quip card _state)
      [~ state(settings (~(del in settings) term))]
    ::  +set-width: configure cli printing width
    ::
    ++  set-width
      |=  w=@ud
      [~ state(width (max 40 w))]
    ::  +set-timezone: configure timestamp printing adjustment
    ::
    ++  set-timezone
      |=  tz=[? @ud]
      [~ state(timez tz)]
    ::  +select: expand message from number reference
    ::
    ++  select
      ::NOTE  rel is the nth most recent message,
      ::      abs is the last message whose numbers ends in n
      ::      (with leading zeros used for precision)
      ::
      |=  num=$@(rel=@ud [zeros=@u abs=@ud])
      ^-  (quip card _state)
      |^  ?@  num
            =+  tum=(scow %s (new:si | +(num)))
            ?:  (gte rel.num count)
              %-  just-print
              "{tum}: no such telegram"
            (activate tum rel.num)
          ?.  (gte abs.num count)
            ?:  =(count 0)
              (just-print "0: no messages")
            =+  msg=(index (dec count) num)
            (activate (scow %ud msg) (sub count +(msg)))
          %-  just-print
          "…{(reap zeros.num '0')}{(scow %ud abs.num)}: no such telegram"
      ::  +just-print: full [cards state] output with a single print card
      ::
      ++  just-print
        |=  txt=tape
        [[(print:sh-out txt) ~] state]
      ::  +index: get message index from absolute reference
      ::
      ++  index
        |=  [max=@ud nul=@u fin=@ud]
        ^-  @ud
        =+  dog=|-(?:(=(0 fin) 1 (mul 10 $(fin (div fin 10)))))
        =.  dog  (mul dog (pow 10 nul))
        =-  ?:((lte - max) - (sub - dog))
        (add fin (sub max (mod max dog)))
      ::  +activate: echo message selector and print details
      ::
      ++  activate
        |=  [number=tape index=@ud]
        ^-  (quip card _state)
        ::NOTE  graph store allows node deletion, so can this crash?
        =/  =uid:post    (snag index history)
        =/  =node:graph  (got-node:libgraph uid)
        =.  audience     resource.uid
        ?-    -.post.node
            %|  [~ state]
            %&
          :_  put-ses
          ^-  (list card)
          :~  (print:sh-out ['?' ' ' number])
              (effect:sh-out ~(render-activate mr resource.uid p.post.node))
              prompt:sh-out
          ==
        ==
      --
    ::  +chats: display list of joined chats
    ::
    ++  chats
      ^-  (quip card _state)
      :_  state
      :_  ~
      %-  show-chats:sh-out
      (skim ~(tap in get-keys:libgraph) is-chat-graph)
    ::  +help: print (link to) usage instructions
    ::
    ++  help
      ^-  (quip card _state)
      :_  state
      =-  (turn - print:sh-out)
      :~  ";view ~host/chat to print messages for a chat you've already jonied."
          ";flee ~host/chat to stop printing messages for a chat."
          "For more details:"
          "https://urbit.org/using/operations/using-your-ship/#messaging"
      ==
    --
  --
::
::  +sh-out: ouput to session
::
++  sh-out
  |_  [=sole-id session]
  ++  make
    |=  =^sole-id
    %_  ..make
      sole-id  sole-id
      +<+      (get-session sole-id)
    ==
  ::  +effex: emit shoe effect card
  ::
  ++  effex
    |=  effect=shoe-effect:shoe
    ^-  card
    [%shoe ~[sole-id] effect]
  ::  +effect: emit console effect card
  ::
  ++  effect
    |=  effect=sole-effect:shoe
    ^-  card
    (effex %sole effect)
  ::  +print: puts some text into the cli as-is
  ::
  ++  print
    |=  txt=tape
    ^-  card
    (effect %txt txt)
  ::  +print-more: puts lines of text into the cli
  ::
  ++  print-more
    |=  txs=(list tape)
    ^-  card
    %+  effect  %mor
    (turn txs |=(t=tape [%txt t]))
  ::  +note: prints left-padded ---| txt
  ::
  ++  note
    |=  txt=tape
    ^-  card
    =+  lis=(simple-wrap txt (sub width 16))
    %-  print-more
    =+  ?:((gth (lent lis) 0) (snag 0 lis) "")
    :-  (runt [14 '-'] '|' ' ' -)
    %+  turn  (slag 1 lis)
    |=(a=tape (runt [14 ' '] '|' ' ' a))
  ::  +prompt: update prompt to display current audience
  ::
  ++  prompt
    ^-  card
    %+  effect  %pro
    :+  &  %talk-line
    =+  ~(show tr audience)
    ?:(=(1 (lent -)) "{-} " "[{-}] ")
  ::  +show-post: print incoming message
  ::
  ::    every five messages, prints the message number also.
  ::    if the message mentions the user's (shortened) ship name,
  ::    and the %notify flag is set, emit a bell.
  ::
  ++  show-post
    |=  [=target =post:post]
    ^-  (list card)
    %+  weld
      ^-  (list card)
      ?.  =(0 (mod count 5))  ~
      :_  ~
      =+  num=(scow %ud count)
      %-  print
      (runt [(sub 13 (lent num)) '-'] "[{num}]")
    ^-  (list card)
    :-  (effex ~(render-inline mr target post))
    =;  mentioned=?
      ?.  mentioned  ~
      [(effect %bel ~)]~
    %+  lien  contents.post
    (cury test %mention our.bowl)
  ::  +show-create: print mailbox creation notification
  ::
  ++  show-create
    |=  =target
    ^-  card
    (note "new: {~(phat tr target)}")
  ::  +show-delete: print mailbox deletion notification
  ::
  ++  show-delete
    |=  =target
    ^-  card
    (note "del: {~(phat tr target)}")
  ::  +show-glyph: print glyph un/bind notification
  ::
  ++  show-glyph
    |=  [=glyph target=(unit target)]
    ^-  (list card)
    :_  [prompt ~]
    %-  note
    %+  weld  "set: {[glyph ~]} "
    ?~  target  "unbound"
    ~(phat tr u.target)
  ::  +show-chats: print list of targets
  ::
  ++  show-chats
    |=  chats=(list target)
    ^-  card
    %-  print-more
    %+  turn  (sort chats tor)
    |=  resource
    "{(nome:mr entity)}/{(trip name)}"
  --
::
::  +tr: render targets (resource identifiers)
::
++  tr
  |_  tr=target
  ::  +full: render target fully, always (as ~ship/path)
  ::
  ++  full
    ^-  tape
    "{(scow %p entity.tr)}/{(trip name.tr)}"
  ::  +phat: render target with local shorthand
  ::
  ::    renders as ~ship/path.
  ::    for local mailboxes, renders just /path.
  ::
  ++  phat
    ^-  tape
    %+  weld
      ?:  =(our-self entity.tr)  ~
      (scow %p entity.tr)
    "/{(trip name.tr)}"
  ::  +show: render as tape, as glyph if we can
  ::
  ++  show
    ^-  tape
    =+  cha=(~(get by bound) tr)
    ?~(cha phat [u.cha ~])
  ::  +glyph: tape for glyph of target, defaulting to *
  ::
  ++  glyph
    ^-  tape
    [(~(gut by bound) tr '*') ~]
  --
::
::  +mr: render messages
::
++  mr
  |_  $:  source=target
          post:post
      ==
  +*  showtime  (~(has in settings) %showtime)
      notify    (~(has in settings) %notify)
  ::
  ++  content-width
    ::  termwidth, minus author, timestamp, and padding
    %+  sub  width
    %+  add  15
    ?:(showtime 11 0)
  ::
  ++  render-inline
    ^-  shoe-effect:shoe
    :+  %row
      :-  15
      ?.  showtime
        ~[(sub width 16)]
      ~[(sub width 26) 9]
    :+  t+(crip (weld (nome author) ~(glyph tr source)))
      t+(crip line)
    ?.  showtime  ~
    :_  ~
    :-  %t
    =.  time-sent
      %-  ?:(p.timez add sub)
      [time-sent (mul q.timez ~h1)]
    =+  dat=(yore time-sent)
    =*  t   (d-co:co 2)
    =,  t.dat
    %-  crip
    :(weld "~" (t h) "." (t m) "." (t s))
  ::
  ++  line
    ^-  tape
    %-  zing
    %+  join  "\0a"
    %-  turn
    :_  |=(ls=(list tape) `tape`(zing (join " " ls)))
    %+  roll  contents
    |=  [=content:post out=(list (list tape))]
    ?-  -.content
      %text       (append-inline out (trip text.content))
      %mention    (append-inline out (scow %p ship.content))
      %reference  (append-inline out "^")
    ::
        %code
      %+  snoc  out
      ^-  (list tape)
      :-  (trip expression.content)
      ?:  =(~ output.content)  ~
      :-  "\0a"
      ~(ram re (snag 0 output.content))^~
    ::
        %url
      %+  append-inline  out
      =+  wyd=content-width
      =+  ful=(trip url.content)
      ::  if the full url fits, just render it.
      ?:  (gte wyd (lent ful))  ful
      ::  if it doesn't, prefix with _ and truncate domain with ellipses
      =.  wyd  (sub wyd 2)
      :-  '_'
      =-  (weld - "_")
      =+  prl=(rust ful aurf:de-purl:html)
      ?~  prl  (scag wyd ful)
      =+  hok=r.p.p.u.prl
      =;  domain=tape
        %+  swag
          [(sub (max wyd (lent domain)) wyd) wyd]
        domain
      ?.  ?=(%& -.hok)
        +:(scow %if p.hok)
      %+  reel  p.hok
      |=  [a=knot b=tape]
      ?~  b  (trip a)
      (welp b '.' (trip a))
    ==
  ::
  ++  append-newline
    |=  [content=(list (list tape)) newline=tape]
    ^-  (list (list tape))
    (snoc content ~[newline])
  ::
  ++  append-inline
    |=  [content=(list (list tape)) inline=tape]
    ^-  (list (list tape))
    ?:  =(~ content)
      ~[~[inline]]
    =/  last
      (dec (lent content))
    =/  old=(list tape)
      (snag last content)
    =/  new=(list tape)
      (snoc old inline)
    (snap content last new)

  ::  +activate: produce sole-effect for printing message details
  ::
  ++  render-activate
    ^-  sole-effect:shoe
    ~[%mor [%tan meta] body]
  ::  +meta: render message metadata (serial, timestamp, author, target)
  ::
  ++  meta
    ^-  tang
    =+  hed=leaf+"{(scow %uv (fall hash 0))} at {(scow %da time-sent)}"
    =/  src=tape  ~(phat tr source)
    [%rose [" " ~ ~] [hed >author< [%rose [", " "to " ~] [leaf+src]~] ~]]~
  ::  +body: long-form render of message contents
  ::
  ++  body
    |-  ^-  sole-effect:shoe
    :-  %mor
    %+  turn  contents
    |=  =content:post
    ^-  sole-effect:shoe
    ?-  -.content
      %text       txt+(trip text.content)
      %url        url+url.content
    ::
        %reference
      ?-  -.reference.content
          %graph
        txt+"[reference to msg in {~(phat tr resource.uid.reference.content)}]"
        ::
          %group
        txt+"[reference to msg in {~(phat tr group.reference.content)}]"
      ==
    ::
        %mention
      ?.  =(ship.content our-self)  txt+(scow %p ship.content)
      :-  %mor
      :-  klr+[[`%br ~ ~]^(scow %p ship.content)]~  ::TODO  inline
      ?.(notify ~ [%bel ~]~)
    ::
        %code
      :-  %txt
      %+  weld  (trip expression.content)
      ?:  =(~ output.content)  ~
      :-  '\0a'
      ~(ram re (snag 0 output.content))
    ==
  ::  +nome: prints a ship name in 14 characters, left-padding with spaces
  ::
  ++  nome
    |=  =ship
    ^-  tape
    =+  raw=(cite:title ship)
    (runt [(sub 14 (lent raw)) ' '] raw)
  --
::
++  simple-wrap
  |=  [txt=tape wid=@ud]
  ^-  (list tape)
  ?~  txt  ~
  =/  [end=@ud nex=?]
    =+  ret=(find "\0a" (scag +(wid) `tape`txt))
    ?^  ret  [u.ret &]
    ?:  (lte (lent txt) wid)  [(lent txt) &]
    =+  ace=(find " " (flop (scag +(wid) `tape`txt)))
    ?~  ace  [wid |]
    [(sub wid u.ace) &]
  :-  (tufa (scag end `(list @)`txt))
  $(txt (slag ?:(nex +(end) end) `tape`txt))
::
::NOTE  anything that uses this breaks moons support, because moons don't sync
::      full app state rn
++  scry-for
  |*  [=mold app=term =path]
  .^  mold
    %gx
    (scot %p our.bowl)
    app
    (scot %da now.bowl)
    (snoc `^path`path %noun)
  ==
--