urbit/main/app/talk/core.hook

::
::::  /hook/core/talk/app
  ::
/?  314
/-  *console, *rodeo
/+  console, rodeo
::
::::
  ::
!:
=>  |%                                                  ::  structures
    ++  town                                            ::  all client state
      $:  %0                                            ::  version
          seat=console-share                            ::  command lines
          live=(unit span)                              ::  present story
          stories=(map span story)                      ::  all stories
      ==                                                ::
    ++  grip                                            ::  subscription state
      |*  nub=$+(* *)                                   ::  wrapped state
      $|  $?  %warm                                     ::  activated
              %cool                                     ::  activating
              %dead                                     ::  inoperative
              %cold                                     ::  inactive
          ==  [%live p=nub]                             ::  operating
    ++  terminal                                        ::  terminal state
      $:  present=presence                              ::  presence state
      ==                                                ::
    ++  story                                           ::  station content
      $:  poe=posture                                   ::  security posture
          desc=@t                                       ::  description
          link=(grip bridge)                            ::  connection
          count=@ud                                     ::  message counter
          mike=(pair ,? (set partner))                  ::  passive/voice
          quiet=?                                       ::  !verbose
          past=(list partner)                           ::  past received auds
      ==                                                ::
    ++  bridge                                          ::  remote state
      $:  xm=config                                     ::  configuration
          am=register                                   ::  presence
      ==                                                ::
    ++  work                                            ::  general action
      $%  [%ask (unit work)]                            ::  help (about)
          [%exp twig]                                   ::  compute
          [%mor (list work)]                            ::  sequence
          [%rub work-adjust]                            ::  configure story
          [%say speech]                                 ::  publish in voice
          [%who (unit partner)]                         ::  show presence
          [%wry work-construct]                         ::  configure system
      ==                                                ::
    ++  work-adjust                                     ::  adjust story
      $%  [%dark p=(set ship)]                          ::  toggle blacklist
          [%lite p=(set ship)]                          ::  toggle whitelist
          [%love p=(set partner)]                       ::  toggle partners
          [%whom p=? q=(set partner)]                   ::  active/voice
          [%wind p=@dr]                                 ::  rewind by date
      ==                                                ::
    ++  work-construct                                  ::  configure system
      $%  [%make p=span]                                ::  create story
          [%raze p=span]                                ::  destroy story
          [%tune p=span]                                ::  switch to story
      ==                                                ::
    ++  gift
      $%  [%mean ares]
          [%nice ~]
          [%rush %console-effect console-effect]
      ==
    ++  hapt  ,[p=ship q=path]
    ++  move  ,[p=bone q=(mold note gift)]
    ++  note
      $?  $:  %g
      $%  [%mess p=hapt q=ship r=cage]
          [%nuke p=hapt q=ship]
          [%show p=hapt q=ship r=path]
          [%took p=hapt q=ship]
          ==  ==
          $:  %t
      $%  [%wait p=@da]
      ==  ==  ==
    ++  gall-sign                                       ::  subscription result
      $%  [%mean p=ares]
          [%nice ~]
          $:  %rush
              $=  p
              $%  [%txt p=cord]                         ::  input text
                  [%type p=?]                           ::  typing notify
                  [%rodeo-report p=report]
          ==  ==
      ==
    ++  sign
      $?  [%g gall-sign]                                ::  from %gall
          $:  %t                                        ::  from %time
      $%  [%wake ~]                                     ::  timer wakeup
      ==  ==  ==
    --
!:
::::
  ::
=>  |%                                                  ::  tools
    ++  hy                                              ::  messenger
      |_  [[moz=(list move)] hide]
      ++  hy-abet  moz                                  ::  resolve core
      ++  hy-transmit                                   ::  send to radio
        |=  cod=command 
        %_    +>
            moz  :_  moz
          [0 %pass /command %g %mess [our /rodeo] our [%rodeo-command !>(cod)]]
        ==
      ::
      ++  hy-general                                    ::  serve all peers
        |=  fec=console-effect
        %_    +>
            moz
          =+  oss=(~(tap in (~(get ju pus) /console)))
          |-  ^-  (list move)
          ?~  oss  moz
          [`move`[i.oss %give %rush %console-effect fec] $(oss t.oss)]
        ==
      ::
      ++  hy-subscribe                                  ::  send %show
        |=  [way=path hoc=path]
        %_(+> moz :_(moz [0 %pass way %g %show [our /rodeo] our hoc]))
      ::
      ++  hy-unsubscribe                                ::  send %nuke
        |=  way=path
        %_(+> moz :_(moz [0 %pass way %g %nuke [our /rodeo] our]))
      ::
      ++  hy-display                                    ::  print to console
        |=(tay=(list tank) (hy-general %tan tay))
      ::
      ++  hy-print                                      ::  simple print
        |=(tep=tape (hy-display [%leaf tep]~))
      ::
      ++  hy-accept                                     ::  set prompt
        |=(asq=cord (hy-general %pro & %gar (tuba (trip asq))))
      --
    ::
    ++  parse                                           ::  command parser
      |=  our=ship
      =+  vag=(vang | [&1:% &2:% '0' |3:%])
      |%  
      ++  come                                          ::  keyword command
        |*  [a=@tas b=_rule] 
        ;~((glue (plus ace)) (cold a (jest a)) b)
      ::
      ++  gone                                          ::  parse unit
        |*  a=_rule
        ;~(pose (stag ~ a) (easy ~))
      ::
      ++  posh                                          ::  parse each
        |*  [a=_rule b=_rule]
        ;~(pose (stag %& a) (stag %| b))
      ::
      ++  ship  ;~(pfix sig fed:ag)                     ::  ship
      ++  shiz                                          ::  ship set
        %+  cook
          |=(a=(list ^ship) (~(gas in *(set ^ship)) a))
        (most ;~(plug com (star ace)) ship)
      ::
      ++  stat                                          ::  partner
        %+  posh
          ;~  plug
            ship
            ;~(pose ;~(pfix fas urs:ab) (easy (main our)))
          ==
        ;~  pose
          ;~(pfix pat (stag %twitter urs:ab))
        ==
      ::
      ++  staz                                          ::  partner set
        %+  cook
          |=(a=(list partner) (~(gas in *(set partner)) a))
        (most ;~(plug com (star ace)) stat)
      ::
      ++  step                                          ::  rollback interval
        %+  sear
          |=  a=coin
          ?.  ?=([%$ %dr @] a)  ~
          (some `@dr`+>.a)
        nuck:so
      ::
      ++  text  (boss 256 (star prn))                   ::  utf8 text
      ++  tome
        %+  stag  %lin
        ;~  pose
          (stag %| ;~(pfix pat text))
          (stag %& text)
        ==
      ::
      ++  work                                          ::  all commands
        %+  knee  *^work  |.  ~+
        ;~  pose
          ;~  pfix  zap
            %+  stag  %wry
            ;~  pose 
              (come %make urs:ab)
              (come %raze urs:ab)
              (come %tune urs:ab)
            ==
          ==
        ::
          ;~  pfix  cen
            %+  stag  %rub
            ;~  pose
              (come %dark shiz)
              (come %lite shiz)
              (come %whom (stag %& staz))
              (come %wind step)
            ==
          ==
        ::
          ;~(pfix wut (stag %ask (gone work)))
          ;~(pfix tis (stag %who (gone stat)))
          ;~(pfix cen (stag %exp wide:vag))
        ::
          %+  cook
            |=  [a=(set partner) b=(unit ,[%lin p=? q=@t])]
            ^-  ^work
            =.  b  ?~(b ~ ?:(=(0 q.u.b) ~ b))
            =+  c=[%rub %whom %& a]
            ?~(b c [%mor c [%say u.b] ~])
          ;~  plug
            staz
            (gone ;~(pfix (star ace) tome))
          ==
        ::
          (stag %say tome)
        ==
      --
    ::
    ++  swatch                                          ::  print partner set
      |=  [our=ship tou=(set partner)]
      =+  tuo=(~(tap in tou))
      |-  ^-  tape
      ?~  tuo  ~
      =+  ted=$(tuo t.tuo)
      =+  ^=  ind  ^-  tape
          ?-  -.i.tuo
            %&  =+  sip=(scow %p p.p.i.tuo)
                ?:  =((main p.p.i.tuo) q.p.i.tuo)
                  sip
                :(welp sip "/" (trip q.p.i.tuo))
            %|  ['@' (trip p.p.i.tuo)] 
          ==
      ?~  ted  ind
      (welp ind `tape`[',' ' ' ted])
    ::
    ++  stog                                            ::  toggle set
      |*  [tog=(set) tag=(set)]
      =+  got=(~(tap in tog))
      |-  ^+  tag
      ?~  got  tag
      %=    $
          got  t.got
          tag  ?:  (~(has in tag) i.got)
                 (~(del in tag) i.got)
               (~(put in tag) i.got)
      == 
    --
!:
::::
  ::
|_  [hid=hide town]
++  hype                                                ::  global messenger
  |=([moz=(list move)] ~(. hy moz hid))
::
++  sy
  |_  $:  $:  ost=bone                                  ::  cause
              man=span                                  ::  u.live
              moz=(list move)                           ::  pending moves
          ==                                            ::
          story                                         ::  current story
      ==
  ::
  ++  sy-abet                                           ::  resolve core
    ^-  [(list move) _+>]
    [(flop moz) +>(stories (~(put by stories) man +<+))]
  ::
  ++  sy-subscribe                                      ::  story subscribe
    ?>  =(%cold link)
    =+  cub=?.(=(0 count) (scot %ud count) (scot %da (sub lat.hid ~d1)))
    =.  +  (sy-message "subscribe <{(trip cub)}>")
    %_  +
      link  %cool
      moz   =<  hy-abet
            %+  hy-subscribe:(hype moz)
              /story/[man]
            :~  %afx
                man
                ?:  =(0 count)
                  ::  ~&  [%story-init man `@da`(sub lat.hid ~d1)]
                  (scot %da (sub lat.hid ~d1))
                (scot %ud count)
            ==
    ==
  ::
  ++  sy-unsubscribe                                    ::  story unsubscribe
    ?:  =(& ?=(?(%cold %dead) link))  .
    %_  .
      link  %cold
      moz   hy-abet:(hy-unsubscribe:(hype moz) /story/[man])
    ==
  ::
  ++  sy-serial                                         ::  make serial no
    ^-  [serial _.]
    [(shaf %serial eny.hid) .(eny.hid (shax eny.hid))]
  ::
  ++  sy-audience                                       ::  speech audience
    %-  ~(gas by *audience)
    %+  turn  `(list partner)`[[%& our.hid man] (~(tap in q.mike))]
    |=(a=partner [a *envelope %pending])
  ::
  ++  sy-awake                                          ::  introduce prompt
    %_    .
        moz   
      =<  hy-abet
      :-  hy-accept:(hype moz)
      (crip (sy-prompt q.mike))
    ==
  ::
  ++  sy-voice                                          ::  set targets
    |=  [pas=? tou=(set partner)]
    ?:  &(!p.mike pas)  +>
    %_  +>.$
      mike  [pas tou]
      moz   hy-abet:(hy-accept:(hype moz) (crip (sy-prompt tou)))
    ==
  ::
  ++  sy-message                                        ::  print message
    |=  msg=tape
    %_(+> moz hy-abet:(hy-print:(hype moz) ":{(trip man)}: {msg}"))
  ::
  ++  sy-present
    |=  [msg=tape tay=(list tank)]
    =.  tay  (welp tay `(list tank)`[%leaf "::"]~)
    =.  tay  :_(tay [%leaf ":{(trip man)}: {msg}:: "])
    %_(+>.$ moz hy-abet:(hy-display:(hype moz) tay))
  ::
  ++  sy-prompt
    |=  tou=(set partner)
    ^-  tape
    ;:  welp
      (scow %p our.hid)
      ?:(=(man (main our.hid)) "" `tape`:(welp "/" (trip man)))
      ?~  tou  "& "
      `tape`:(welp "(" (swatch our.hid tou) ")& ")
    ==
  ::
  ++  sy-voice                                          ::  set targets
    |=  [pas=? tou=(set partner)]
    ?:  &(!p.mike pas)  +>
    %_  +>.$
      mike  [pas tou]
      moz   hy-abet:(hy-accept:(hype moz) (crip (sy-prompt tou)))
    ==
  ::
  ++  sy-rollback
    |=  lon=@dr
    !!
  ::
  ++  sy-work                                           ::  run user command
    |=  job=work
    ^+  +>
    ?-    -.job
        %ask  ~|(%sy-work-ask-stub !!)
        %exp  ~|(%sy-work-exp-stub !!)
        %mor
      |-  ^+  +>.^$
      ?~  +.job  +>.^$
      $(+.job t.+.job, +>.^$ ^$(job i.+.job))
    ::
        %rub
      ?:  ?=(%whom +<.job)
        (sy-voice +>.job)
      ?:  ?=(%wind +<.job)
        ~&  %rub-wind-stub
        !!
      =+  suz=sy-live
      ?~  suz  (sy-message "not connected")
      ?-  +<.job
        %lite  sz-abet:(sz-cordon:u.suz [%white +>.job])
        %dark  sz-abet:(sz-cordon:u.suz [%black +>.job])
        %love  sz-abet:(sz-sources:u.suz +>.job)
      ==
    ::
        %say
      =^  sir  +>.$  sy-serial
      %=    +>.$
          moz 
        =<  hy-abet
        %-  ~(hy-transmit hy moz hid)
        [%publish [[sir sy-audience [lat.hid ~ +.job]] ~]]
      ==
    ::
        %wry  ~|(%sy-work-wry !!)
        %who  ~|(%sy-work-who-stub !!)
    ==
  ::
  ++  sy-gram                                           ::  apply telegram
    |=  [num=@ud gam=telegram]
    ^+  +>
    %=    +>
        moz
      =<  hy-abet
      %-  hy-general:(hype moz)
      =*  sta  r.q.gam
      ?+    -.r.sta  ~|([%strange-gram -.r.sta] !!)
      ::
          %lin  
        :-  %txt 
        %-  trip
        %+  rap  3
        :~  (scot %ud num)  ')' 
            (scot %p p.gam)  ?:(p.r.sta ': ' ' ') 
            q.r.sta
        ==
      ==
    ==
  ::
  ++  sy-grams                                          ::  apply telegrams
    |=  [num=@ud gaz=(list telegram)]
    ^+  +>
    ::  ~&  [%sy-grams [num count] (lent gaz)]
    ?:  (gth num count)
      (sy-message(count 0) "message gap: {<num>} at {<count>}")
    =.  .  
      ?:  =(num count)  .
      .(num count, gaz (slag (sub count num) gaz))
    =+  las=(add count (lent gaz))
    |-  ^+  +>.^$
    ?~  gaz  +>.^$(count las)
    $(gaz t.gaz, count +(count), +>.^$ (sy-gram num i.gaz))
  ::
  ++  sy-error                                          ::  report error
    |=  ars=ares
    %=    +>
        moz
      =<  hy-abet
      %-  hy-print:(hype moz)
      ?~(ars "connection error" "disaster: (trip p.u.ars)")
    ==
  ::
  ++  sy-sign                                           ::  subscription sign
    |=  res=gall-sign
    ^+  +>
    ::  ~&  [%sy-sign res]
    ?-    -.res
        %mean
      =.  link  %dead
      (sy-error p.res)
    ::
        %nice                                           ::  misordered, ignore
    ::  ?.  ?=(%cool link)
    ::  ~&  [%sy-sign-nice-bad link]
    ::  +>.$
    ::+>(link %warm) 
      +>.$
    ::
        %rush                                           ::  direct update
      ?:  ?=(?(%cold %dead) link)
        ~&  [%sy-sign-rust-bad `@tas`link]
        +>.$
      ?>  ?=(%rodeo-report +<.res)
      ?:  ?=(%cool link)
        ::  XX workaround for inverted nice
        $(link %warm)
      =+  suz=sy-live
      ?~  suz  (sy-message "not connected")
      sz-abet:(sz-apply:u.suz +>.res)
    ==
  ::
  ++  sy-live                                           ::  as connected
    ^-  (unit ,_sz)
    ?:  ?=([%live *] link)
      `~(. sz p.link)
    ?.(?=(%warm link) ~ `~(. sz *bridge))
  ::
  ++  sz                                                ::  story, connected
    |_  big=bridge
    ++  sz-abet  %_(+> link [%live big])                ::  resolve to ++sy
    ++  sz-amok
      |=  why=?(%cold %cool %dead %warm)
      %_(+>+> link why)
    ::
    ++  sz-cordon                                       ::  design cordon
      |=  con=control
      ^+  +>
      =.  cordon.xm.big
        ?:  =(p.cordon.xm.big p.con)
          [p.con (stog q.con q.cordon.xm.big)]
        con
      +>.$(moz hy-abet:(hy-transmit:(hype moz) [%design man ~ xm.big]))
    ::
    ++  sz-sources                                      ::  design sources
      |=  src=(set partner)
      ^+  +>
      =.  sources.xm.big  (stog src sources.xm.big)
      +>.$(moz hy-abet:(hy-transmit:(hype moz) [%design man ~ xm.big]))
    ::
    ++  sz-config                                       ::  apply config
      |=  cof=config
      =.  +>+>  (sy-present "config" >cof< ~)
      ::  ~&  [%sz-config cof]
      %_(+> xm.big cof, +> (sy-voice %& sources.cof))
    ::
    ++  sz-group                                        ::  apply register
      |=  rex=register
      =.  +>+>  (sy-present "register" >rex< ~)
      %_(+> am.big rex)
    ::
    ++  sz-apply                                        ::  apply report
      |=  rad=report
      ^+  +>
      ?-  -.rad
        %house   ~|(%sz-apply-house !!)
        %grams   +>(+> (sy-grams +.rad))
        %config  (sz-config +.rad)
        %group   (sz-group +.rad)
      ==
    --
  --
++  ny                                                  ::  top configuration
  |_  [ost=bone moz=(list move)]
  ++  ny-abet                                           ::  resolve core
    ^-  [(list move) _+>]
    [(flop moz) +>]
  ::
  ++  ny-amid                                           ::  integrate story
    |=  nov=_sy
    =^  zom  +>+>  sy-abet:nov
    +>.$(moz (weld (flop zom) moz))
  ::
  ++  ny-tune                                           ::  connect to story
    |=  man=span
    ^+  +>
    ?:  =(`man live)
      +>(moz hy-abet:(hy-print:(hype moz) "already tuned to {(trip man)}"))
    ?.  (~(has by stories) man)
      +>(moz hy-abet:(hy-print:(hype moz) "no story {(trip man)}"))
    =.  +>  ny-stop
    =.  live  `man
    ::  ~&  [%tune-start man]
    (ny-amid sy-subscribe:sy-awake:(need (novel ost moz)))
  ::
  ++  ny-stop                                           ::  disconnect story
    ^+  .
    ?~  live  .
    (ny-amid(live ~) sy-unsubscribe:(need (novel ost moz)))
  ::
  ++  ny-tell                                           ::  hear from server
    |=  sap=(map span (pair posture cord))
    ^+  +>
    =.  +>  ?.(&(?=(^ live) !(~(has by sap) u.live)) +> ny-stop)
    =.  stories
      =+  pas=(~(tap by sap))
      =+  ros=(skim (~(tap by stories)) |=([a=span *] (~(has by sap) a)))
      %-  ~(gas by *(map span story))
      |-  ^-  (list (pair span story))
      ?~  pas  
        %+  turn  ros
        |=  [a=span b=story]
        =+  hig=(~(get by sap) a)
        [a ?~(hig b b(poe p.u.hig, desc q.u.hig))]
      =+  sor=$(pas t.pas)
      ?:  (~(has by stories) i.pas) 
        sor 
      =+  soy=*story
      [[p.i.pas soy(poe p.q.i.pas, desc q.q.i.pas)] sor]
    ?^  live  +>.$
    ?~  stories  +>.$
    ?:  (~(has by `(map span story)`stories) (main our.hid))
      (ny-tune (main our.hid))
    (ny-tune p.n.stories)
  ::
  ++  ny-work                                           ::  user command
    |=  jaw=work-construct
    ^+  +>
    ?-    -.jaw
        %raze  +>(moz hy-abet:(hy-transmit:(hype moz) [%design p.jaw ~]))
        %tune  (ny-tune p.jaw)
        %make  
      %=    +>
          moz 
        =<  hy-abet
        (hy-transmit:(hype moz) [%design p.jaw [~ ~ %default %black ~]])
      ==
    ==
  --
::
++  novel                                               ::  live story
  |=  [ost=bone moz=(list move)]
  ^-  (unit ,_sy)
  ?~  live  ~
  `~(. sy [ost u.live moz] (~(got by stories) u.live))
::
++  peer
  |=  [ost=bone you=ship pax=path]
  ^-  [(list move) _+>]
  =+  nuv=(novel ost ~)
  ?~  nuv  
    :_  +>.$
    [ost %give %rush %console-effect %pro & %$ (tuba "no story ")]~
  sy-abet:sy-awake:u.nuv
::
++  submit
  |=  [ost=bone txt=cord]
  ^-  [(list move) _+>]
  =+  jub=(rush txt work:(parse our.hid))
  ?~  jub
    [hy-abet:(hy-print:(hype ~) "invalid input") +>.$]
  ?:  ?=(%wry -.u.jub)
    ny-abet:(~(ny-work ny ost ~) +.u.jub)
  =+  nuv=(novel ost ~)
  ?~  nuv  [hy-abet:(hy-print:(hype ~) "not tuned to any story") +>.$]
  sy-abet:(sy-work:u.nuv u.jub)
::
++  pour
  |=  [ost=bone pax=path sih=*]
  ^-  [(list move) _+>]
  ~|  sign=sih
  =>  .(sih ((hard sign) sih))
  ::  ~&  talk-pour/sih
  ?~  pax  ~&  talk-pour-strange-path/pax  !!
  ?+    i.pax  ~&  talk-pour-strange-path/pax  
               ~&  sign/sih
               !!
      %command
    ?+    +<.sih  !!
      %nice  [~ +>.$]
      %mean  ~|([%pour-mean-command +>.sih] !!)
    ==
  ::
      %server
    ?+    +<.sih  !!
        %nice  [~ +>.$]
        %mean  ~|(%talk-server-crash !!)
        %rush
      ?>  ?=([%rodeo-report %house *] p.sih)
      =^  moz  +>.$  ny-abet:(~(ny-tell ny ost ~) +.p.p.sih)
      :_  +>.$
      :_(moz [ost %pass pax %g %took [our.hid /rodeo] our.hid])
    ==
  ::
      %time
    :_  +>.$
    ::  ~&  [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)]
    :~  [0 %pass /time %t %wait (add ~s10 lat.hid)]
    ==
  ::
      %story
    ?>  ?=([@ *] t.pax)
    ?.  =(& &(?=(^ live) =(u.live i.t.pax)))
      ~&  [%talk-wrong-story live i.t.pax] 
      [~ +>.$]
    ?>  ?=(%g -.sih)
    =^  moz  +>.$  sy-abet:(sy-sign:(need (novel ost ~)) +.sih)
    :_  +>.$
    :_(moz `move`[ost %pass pax %g %took [our.hid /rodeo] our.hid])
  ==
::
++  prep
  |=  old=(unit (unit town))
  ^-  [(list move) _+>]
  ?:  ?=([~ ~ *] old)
    [~ +>(+<+ u.u.old)]
  :_  +>
  :~  [0 %pass /time %t %wait (add ~s10 lat.hid)]
      ^-  move
      :*  0    %pass  /server
          %g   %show  
          [our.hid /rodeo]  our.hid
          /
      ==
  ==
::
++  poke-console-action
  |=  [ost=bone her=ship act=console-action]
  =+  moz=`(list move)`[ost %give %nice ~]~
  ?+  -.act  [moz +>.$]
    %det  [moz +>.$(seat abet:(~(receive cs seat) `console-change`+.act))]
    %ret  =+  sed=buf.seat
          =^  zom  +>.$  (submit ost (crip (tufa sed)))
          =^  cal  seat  =<([- abet:+] (~(transmit cs seat) [%set ~]))
          :_  +>.$
          :*  [ost %give %rush %console-effect %nex ~]
              [ost %give %rush %console-effect %det cal]
              [ost %give %rush %console-effect %txt (tufa sed)]
              (weld zom moz)
          ==
  ==
--