urbit/main/bin/chat.hoon

!:
::  /=main=/bin/chat/hoon
::
=>  %=    .
        +
      =>  +
      =*  sed  .
      =>  ^/===/lib/pony
      =+  ^=  flag
          $?  %leet
              %monitor
              %noob
              %quiet
              %time
              [%tower p=@p]
              [%s p=path]
          ==
      =+  [flags=*(list flag) lat=&3:%]
      =>  |%
          ++  chat                                      ::  user action
            $%  [%all p=mess]                           ::  say
                [%back p=?(%da %dr %ud) q=@]            ::  backlog
                [%def p=mess]                           ::  use current prompt
                [%how ~]                                ::  help
                [%priv p=@p q=mess]                     ::  private
                [%who ~]                                ::  who
            ==                                          ::
          ++  idad  ,[p=@p q=@t]                        ::  identity
          ++  mess                                      ::  message
            $%  [%do p=@t]                              ::  act
                [%exp p=@t q=tank]                      ::  code
                [%say p=@t]                             ::  say
            ==                                          ::
          ++  prom                                      ::  prompt type
            $%  [%pub ~]                                ::  public message
                [%pri p=ship]                           ::  private message
            ==                                          ::
          ++  user                                      ::  amigos
            $%  [%in p=idad]                            ::  coming on the air
                [%out p=idad]                           ::  signing off
            ==                                          ::
          ++  station  path                             ::
          ++  zung                                      ::  client to server
            $%  [%backlog p=path q=?(%da %dr %ud) r=@]  ::
                [%hola p=station]                       ::
                [%mess p=station q=mess]                ::
                [%tint p=ship]                          ::
            ==                                          ::
          ++  zong                                      ::  server to client
            $%  [%mess p=@da q=ship r=mess]             ::
            ==                                          ::
          --
      =>  |%
          ++  chat
            %+  cook  |=(a=^chat a)
            ;~  pose
              (cold [%how ~] wut)
              (cold [%who ~] tis)
              (stag %back dat)
              (stag %priv ;~(plug ;~(pfix sig fed:ag) ;~(pfix ace mess)))
              (stag %all ;~(pfix pam mess))
              (stag %def mess)
            ==
          ::
          ++  dat
            %+  sear
              |=  p=coin
              ?.  ?=([%$ ?(%da %dr %ud) @] p)  ~
              (some +.p)
            ;~(pfix bas bas (star ace) nuck:so)
          ::
          ++  expn
            %-  sear
            :_  text
            |=  a=@t
            ^-  (unit ,[p=@t q=tank])
            ~!  %
            =+  hun=(rush a wide:(vang | &1:% &2:% lat |3:%))
            ?~  hun  ~
            ?~(a ~ [~ a (sell (slap !>(sed) u.hun))])
          ::
          ++  mess
            %+  cook  |=(a=^mess a)
            ;~  pose
              (stag %do ;~(pfix pat text))
              (stag %exp ;~(pfix hax expn))
              (stag %do (full (easy '')))
              (stag %say text)
            ==
          ::
          ++  text  (boss 256 (star prn))
          --
      |%
      ++  idt
        |=  from=idad
          ?:  |(!(lien flags |=(a=flag ?=(%noob a))) =("" q.from))
            (scow %p p.from)
          %-  trip
          %^  cat  3  %^  cat  3  (scot %p p.from)  ' '  q.from
      ++  rend
        |=  [from=idad msg=^mess pre=tape tim=@da] ::  roo=^room
        =+  tst=(lien flags |=(a=flag ?=(%time a)))
        ^-  tank
        ?-  -.msg
            %do
          =+  mes=?:(=(0 p.msg) "remains quietly present" (trip p.msg))
          :-  %leaf
          %+  weld
            ?.  tst  ""  (timestamp tim)
          "{pre}{(idt from)} {mes}"
            %exp
          :~  %rose
              [" " "" ""]
              :-  %leaf
              %+  weld
                ?.  tst  ""  (timestamp tim)
              "{pre}{(idt from)} {(trip p.msg)}"
              q.msg
          ==
            %say
          :-  %leaf
          %+  weld
            ?.  tst  ""  (timestamp tim)
          "{pre}{(idt from)}: {(trip p.msg)}"
        ==
      ++  timestamp
        |=  t=@da
        =+  da=(yell t)
        "{?:((gth 10 h.da) "0" "")}{(scow %ud h.da)}:".
        "{?:((gth 10 m.da) "0" "")}{(scow %ud m.da)} "
      --
      ::
    ==
=>  %=    .
        -
      :-  :*  ami=*(map ,@p ,@t)                        ::
              bud=(sein `@p`-<)                         ::  chat server
              dun=|                                     ::  done
              giz=*(list gift)                          ::  stuff to send
              mon=*?                                    ::  leet mode
              nub=*?                                    ::  monitor mode
              pro=`prom`[%pub ~]                        ::  prompt state
              sta=*station                              ::  station
              sub=*(list path)                          ::  subscriptions
              tod=*(map ,@p ,@ud)                       ::  outstanding, friend
              tst=|                                     ::  timestamp mode
              wak=_@da                                  ::  next heartbeat
          ==
      [who=`@p`-< how=`path`->]
    ==
|=  [est=time *]
|=  args=(list flag)
=.  flags  args
=.  wak  est
=.  bud
  ?:  (lien args |=(a=flag &(?=(^ a) ?=(%tower -.a))))
    (roll args |=([p=flag q=@p] ?:(&(?=(^ p) ?=(%tower -.p)) p.p q)))
  bud
=.  nub  (lien args |=(a=flag ?=(%noob a)))
=.  mon  (lien args |=(a=flag ?=(%monitor a)))
=.  sta
  ?:  (lien args |=(a=flag &(?=(^ a) ?=(%s -.a))))
    (roll args |=([p=flag q=station] ?:(&(?=(^ p) ?=(%s -.p)) p.p q)))
  sta
=.  tst  (lien args |=(a=flag ?=(%time a)))
|-  ^-  bowl
=<  abet:init
|%
++  abet  `bowl`[(flop giz) ?:(dun ~ [~ hope vent(giz ~)])]
++  hope
  :^    [/wa %wa wak]
      [/ya %lq %ya]
    :^  /up  %up  %text
    :_  ""
    ?-  -.pro
      %pub  "& "
      %pri  (weld (scow %p p.pro) " ")
    ==
  %+  welp
    (turn sub |=(pax=path [[%gr pax] [%gr ~]]))
  %+  turn  (~(tap by tod))
  |=  [p=@p q=@ud]
  [[%ra (scot %p p) ~] [%ow ~]]
::
++  iden
  |=  her=@p
  (fall (~(get by ami) her) *@t)
::
++  init
  (joke:(subs:(subs:tint (welp sta /amigos)) (welp sta /mensajes)) %hola sta)
::
++  jake
  |=  [her=@p msg=^mess]
  ^+  +>
  %=  +>.$
    giz  :_(giz [%sq her %ya [%ra (scot %p her) ~] msg])
    pro  [%pri her]
    tod  (~(put by tod) her +((fall (~(get by tod) her) 0)))
  ==
::
++  joke                                                ::  send message
  |=  msg=zung
  ^+  +>
  +>(giz :_(giz [%xz [who %chat ~] who %zung msg]))
::
++  join
  |=  you=user
  ^+  +>
  ?-  -.you
      %in
    =.  ami  (~(put by ami) p.you)
    ?.  mon  +>.$
    (show %leaf "{(idt p.you)} comes on the air")
      %out
    =.  ami  (~(del by ami) p.p.you)
    ?.  mon  +>.$
    (show %leaf "{(idt p.you)} signs off")
  ==
++  joyn
  |=  yall=(list idad)
  ^+  +>
  =.  ami  (~(gas by ami) yall)
  ?.  mon  +>.$
  (shew (turn yall |=(you=idad [%leaf "{(idt you)} is on the air"])))
::
++  nice                                                ::  got response
  |=  [her=@p kay=cape]
  ^+  +>
  =.  +>
    =+  dyt=(need (~(get by tod) her))
    %_    +>.$
        tod
      ?:  =(1 dyt)
        (~(del by tod) her)
      (~(put by tod) her (dec dyt))
    ==
  ?-  kay
    %good  +>
    %dead  (show %leaf "server {(scow %p her)} choked")
  ==
::
++  priv
  |=  [now=@da her=@p mes=^mess]
  ^+  +>
  (show (rend [her (iden her)] mes "(private) " now))
::
++  said                                                ::  server message
  |=  duz=(list zong)
  ^+  +>
  ?~  duz  +>
  %=    $
      duz  t.duz
      +>
    ?-    -.i.duz
        %mess
      (show (rend [q.i.duz (iden q.i.duz)] r.i.duz "" p.i.duz))
==  ==
::
++  shew  |=(tax=(list tank) +>(giz [[%lo tax] giz]))   ::  print to screen
++  show  |=(tan=tank +>(giz [[%la tan] giz]))          ::  print to screen
::
++  subs
  |=  pax=path
  ^+  +>
  +>(sub [pax sub], giz :_(giz [%zz /g [%gr pax] %show [who %chat ~] who pax]))
::
++  take  (joke(wak (add ~m1 (max wak est))) %hola sta) ::  beat heart
++  tint  (joke %tint bud)                              ::  init local chat
++  toke                                                ::  user action
  |=  [now=@da txt=@t]
  ^+  +>
  ?:  =(0 txt)  +>
  =+  rey=(rush txt chat(lat (scot da/est)))
  ?~  rey
    (show %leaf "invalid input")
  |-
  ?-  -.u.rey
    %all   (joke(pro [%pub ~]) %mess sta p.u.rey)
    %back  (joke %backlog sta p.u.rey q.u.rey)
    %def   $(u.rey ?-(-.pro %pub [%all p.u.rey], %pri [%priv p.pro p.u.rey]))
    %how   (shew (turn (lore ^:@/===pub/src/doc/chat/help/txt) |=(a=@t [%leaf (trip a)])))
    %priv  (jake p.u.rey q.u.rey)
    %who
      %^  show  %rose  [", " "" ""]
      %+  turn  (~(tap by ami))
      |=  p=idad
      :-  %leaf 
      %-  trip
      %^  cat  3  %^  cat  3  (scot %p p.p)  ' '  q.p
  ==
::
++  vent                                                ::  handle event
  |=  [now=@da pax=path nut=note]
  ^-  bowl
  =.  est  now
  =<  abet
  ?+  -.pax  ~&  [%chat-vent-unknown -.nut]  +>.$
    %gr  ?>  ?=(%gr -.nut)
         ?+  p.nut  ~&  %chat-vent-logo-fail  +>.$
           %user   (join ((hard user) q.nut))
           %users  (joyn ((hard (list idad)) q.nut))
           %zong   =+(zog=((hard zong) q.nut) (said ?:(=(who q.zog) ~ [zog ~])))
           %zongs  (said (flop ((hard (list zong)) q.nut)))
         ==
    %up  ?>(?=(%up -.nut) (toke now p.nut))
    %ra  ?>  &(?=(%ow -.nut) ?=(^ t.pax))
         (nice (need (slaw %p i.t.pax)) p.nut)
    %wa  ?>(?=(%wa -.nut) take)
    %ya  ?>  ?=(%lq -.nut)
         =+  n=((soft ^mess) r.nut)
         ?~  n
           ~&  %chat-mess-fail  +>+
         (priv now p.nut u.n)
  ==
--