shrub/main/app/shell/core.hook

::    Shell
::
::::  /hook/core/shell/app
  ::
/?    314
/-    term-line, kyev
/=    pit  /~  !>(.)                                    ::  kernel vase
::
::::  structures
  ::
|%                                                      ::
++  axle                                                ::
  $:  %0                                                ::  version
      tiv=?                                             ::  typing?
      pid=@u                                            ::  next process id
      pax=_`path`/=try=                                 ::  working directory
      act=(unit span)                                   ::  active child
      pip=(map span span)                               ::  pipe out->in
      pop=(map span span)                               ::  pipe in->out
      pot=(map span ,[cord prom cord])                  ::  prompts
      var=(map term vase)                               ::  variables
  ==                                                    ::
++  gift                                                ::
  $%  [%rush p=gilt]                                    ::
      [%init p=@p]                                      ::
      [%logo p=@]                                       ::
      [%mean p=ares]                                    ::
      [%nice ~]                                         ::
      [%meta p=vase]                                    ::
      [%sage p=path q=*]                                ::
      [%verb ~]                                         ::
      [%veer p=@ta q=path r=@t]                         ::
      [%vega p=path]                                    ::
  ==                                                    ::
++  gilt                                                ::
  $%  [%term-line p=term-line]                          ::
      [%txt p=cord]                                     ::
      [%type p=?]                                       ::
  ==                                                    ::
++  glas  ?(%out [%in p=cord] [%active p=cord])         ::
++  hapt  ,[p=ship q=path]                              ::
++  move  ,[p=bone q=(mold note gift)]                  ::
++  note                                                ::
  $%  $:  %c                                            ::
  $%  [%info p=@p q=toro]                               ::
      ==  ==                                            ::
      $:  %g                                            ::
  $%  [%cide p=span]                                    ::
      [%show p=hapt q=ship r=path]                      ::
      [%sire p=term q=span]                             ::
      [%mess p=hapt q=ship r=cage]                      ::
      [%meta p=vase]                                    ::
      [%nuke p=hapt q=ship]                             ::
  ==  ==  ==                                            ::
++  mand  ,[p=term q=(list twig)]                       ::  name and arguments
++  coma                                                ::
  $%  [%run p=(list mand) q=mand]                       ::  pipe into
      [%end p=(each ,@u cord)]                          ::  kill pid/name
      [%path p=path]                                    ::  chdir
      [%del p=path]                                     ::  rm file
      [%ins p=path q=(unit twig)]                       ::  add file
      [%mut p=path q=twig]                              ::  change file
      [%hoon p=twig]                                    ::  eval expression
      [%comt ~]                                         ::  comment
      [%var p=term q=twig]                              ::  set variable
      [%rvar p=term]                                    ::  unset variable
      [%help p=term]                                    ::  info about command
  ==                                                    ::
++  sign                                                ::
  $%  $:  %g                                            ::
  $%  [%gone p=hapt]                                    ::
      [%init p=@p]                                      ::
      [%dumb ~]                                         ::
      [%mean p=ares]                                    ::
      [%nice ~]                                         ::
      [%rush p=mark q=*]                                ::
      [%rust p=mark q=*]                                ::
      [%sage p=path q=*]                                ::
      [%verb ~]                                         ::
      [%veer p=@ta q=path r=@t]                         ::
      [%vega p=path]                                    ::
  ==  ==  ==                                            ::
--
!:
::::  parsers
  ::
|%
++  maybe  |*(fel=_rule (cook |*(a=(unit) (fall a ~)) (opts fel)))
++  opts                                                ::  parse unit
  |*  fel=_rule
  ;~  pose
    (cook some fel)
    (easy ~)
  ==
::
++  from                                                ::  parse door
  =+  tol=`?(0 1 2)`%2                                  ::  wide, tallish, tall
  |_  [pax=path lat=time]
  ++  rail                                              ::  build from wide/tall
    |*  [wid=_rule wif=_rule tal=_rule]
    ?~  tol  wid
    =-  ;~(pose wif wid)
    ^=  wif
    ?:  ?=(1 tol)  wif
    ;~(pose tal wif)
  ::
  ++  rais  |*([wid=_rule tal=_rule] (rail wid wid tal))
  ::
  ++  parse                                             ::  top level
    ^-  $+(nail (like coma))
    =+  paf=pax
    =.  pax  ?.(&(?=([@ @ @ *] pax) =('0' &3.pax)) pax pax(&3 (scot da/lat)))
    %+  ifix  [(star ace) gaw]
    ;~  pose
      (stag %run ;~(plug (star ;~(sfix (task(tol %0) bar) ace)) (task col)))
      (stag %end ;~(pfix col sem ;~(pose (stag %& dem) (stag %| sym))))
      (stag %del ;~(pfix hep ace loca))
      (stag %mut ;~(pfix col ace ;~(plug loca expg)))
      (stag %ins ;~(pfix lus ace ;~(plug loca (opts expg))))
      (stag %help ;~(pfix wut ace ;~(pfix col sym)))
      (stag %path (full ;~(sfix loca(pax paf) (star ace))))
      (stag %var ;~(plug ;~(pfix tis sym) expg))
      (stag %rvar ;~(pfix ;~(plug tis tis) sym))
      (stag %hoon expr)
      (stag %comt ;~(pfix col col (cold ~ (star prn))))
      (stag %comt (easy ~))
    ==
  ::
  ++  expg  (rais ;~(pfix ace expr(tol %1)) ;~(pfix gap expr))
  ++  expr  (rais [wide tall]:(vang & pax))
  ++  loca  %+  sear  ;~(biff plex:(vang & pax) vabe)   ::  path in %clay
            [;~(pose rood ;~(simu cen scat))]:(vang & pax)
  ++  vabe  |=(a=path ?~((tome a) ~ (some a)))          ::  check valid beam
  ++  args                                              ::  task arguments
    %^  rail
        (ifix sel^ser (most ace expr))
      (plus ;~(pfix ace expr))
    ;~(sfix (plus ;~(pfix gap expr)) ;~(plug gap duz))
  ::
  ++  task  |*(fel=_rule ;~(pfix fel ;~(plug sym (maybe args))))
  ::
  --
--
!:
::::  per event
  ::
|%
++  ve
  |=  [hid=hide ost=bone axle]
  =*  vat  +<+>
  =|  mow=(list move)
  |%
  ++  abet
    ^-  [(list move) axle]
    [(flop mow) vat]
  ::
  ++  blab
    |=  mof=(list move)
    +>.$(mow (welp mof mow))
  ::
  ++  chew-file
    |=  [paf=path mor=$|(cord toro)]
    ^-  (list move)
    ?@  mor
      (print palm/[" " ~ ~ ~]^~[leaf/(trip mor) (dank:ut paf)])
    [ost %pass writ/paf %c %info our.hid mor]~
  ::
  ++  cubs                                              ::  tasks with open /in
    %-  sort  :_  |=([a=span b=span] (lth (slav %ud a) (slav %ud b)))
    ^-  (list span)
    %+  murn  (~(tap by sup.hid))
    |=  [@ @ a=path] 
    ?.  ?&  ?=([%in cord ~] a)
            (~(has by cub.hid) i.t.a)
            !(~(has by pop) i.t.a)
        ==
      ~
    (some i.t.a)
  ::
  ++  eat
    |=  [you=ship com=coma]
    ?-  -.com
      %comt  +>.$
      %del   (eat-del +.com)
      %end   (eat-end +.com)
      %hoon  (eat-hoon +.com)
      %ins   (eat-ins +.com)
      %mut   (eat-mut +.com)
      %help  (eat-help +.com)
      %path  (eat-path +.com)
      %run   (eat-run you +.com)
      %rvar  (eat-rvar +.com)
      %var   (eat-var +.com)
    ==
  ::
  ++  eat-del
    |=  paf=path
    ^+  +>
    %-  blab
    %+  chew-file  paf
    ?~  (file paf)  '! none'
    (fray paf)
  ::
  ++  eat-end                                           ::  XX  clean up state
    |=  poc=(each ,@u cord)
    ^+  +>
    ?-    -.poc
        %&
      =+  cil=(scot %ud p.poc)
      =+  cin=(trip (~(got by cub.hid) cil))
      %-  blab
      %+  welp
        (kill cil)
      (print leaf/"- :{cin}({(trip cil)})")
    ::
        %|
      =+  ^-  moz=(list move)
          %-  zing
          %+  turn  (~(tap by cub.hid))
          |=  [a=span b=term]
          ?.  =(b p.poc)  ~
          (kill a)
      %-  blab  %+  welp  moz
      (print leaf/"-{<(lent moz)>} :{(trip p.poc)}")
    ==
  ::
  ++  eat-hoon
    |=  gen=twig
    ^+  +>
    (blab (print (sell (exec gen))))
  ::
  ++  eat-ins
    |=  [paf=path gen=(unit twig)]
    ^+  +>
    %-  blab
    %+  chew-file  paf
    ?^  (file paf)  '! exists'
    (foal paf q:(exec (fall gen [%bczp atom/%t])))
  ::
  ++  eat-mut
    |=  [paf=path gen=twig]
    ^+  +>
    %-  blab
    %+  chew-file  paf
    ?~  (file paf)  '! none'
    (foal paf q:(exec gen))
  ::
  ++  eat-help
    |=  app=term
    ^+  +>
    %-  blab  %-  print
    ^-  tank
    =+  rup=/(scot %p our.hid)/main/(scot %da lat.hid)
    =+  paf=`path`(welp rup /app/[app]/core/hook)
    =+  src=(file paf)
    ?.  ?=([~ @t] src)
      leaf/"app {<app>} does not exist"
    =+  cot=;~(pfix col col (plus ace) (star prn))
    =+  led=(cot 1^1 (trip u.src))
    ?^  q.led
      leaf/"::  {(wonk led)}"
    palm/[" " ``~]^~[leaf/"no leading comment in" >paf<]
  ::
  ++  eat-path
    |=  paf=path
    ^+  +>
    =.  pax  paf
    (blab (print leaf/"=% {(spud paf)}"))
  ::
  ++  eat-run
    |=  [you=ship mud=(list mand) mad=mand]
    ^+  +>
    ::  =.  +>.$  (blab (print leaf/"+ :{(trip p.mad)}"))
    ?.  =-  (~(has by r:(arch -)) %core)
        .^(%cy /(scot %p our.hid)/main/(scot %da lat.hid)/app/[p.mad])
      (blab (print leaf/"app {<p.mad>} does not exist"))
    =|  inp=(unit span) 
    =<  +>.$
    %+  reel
      `(list mand)`(welp mud mad ~)
    =+  a=[app=*mand .]
    |.
    =>  a
    =+  cil=(scot %ud pid)
    %_    +>  
        pid  +(pid)
        pip  ?~  inp  pip  (~(put by pip) cil u.inp)
        pop  ?~  inp  pop  (~(put by pop) u.inp cil)
        inp  `cil
        mow
      =+  yon=[our.hid cil imp.hid]
      =+  mez=[(cat 3 p.app '-args') (exec [%clsg q.app])]
      %-  welp  :_  mow
      ^-  (list move)
      :~  [ost %pass /child/[cil]/fork %g %sire p.app cil]
          [ost %pass /child/[cil]/out %g %show yon you /out]
          [ost %pass /child/[cil]/main %g %meta !>([%mess yon you mez])]
      ==
    ==
  ::
  ++  eat-rvar
    |=  vor=term
    ^+  +>
    =+  mod=(~(has by var) vor)
    =.  var  (~(del by var) vor)
    (blab (print leaf/"{?:(mod "var gone" "no var")} {<vor>}"))
  ::
  ++  eat-var
    |=  [vor=term gen=twig]
    ^+  +>
    =+  old=(~(get by var) vor)
    =+  new=(exec gen)
    =+  mod=?~(old "new var" ?:(=(new u.old) "same var" "changed"))
    =.  var  (~(put by var) vor new)
    (blab (print leaf/"{mod} {<vor>}"))
  ::
  ++  exec
    |=  gen=twig
    %-  slap  :_  gen
    %+  slop
      %+  slop  [[%face %our p] q]:!>(our.hid)
      %+  slop  [[%face %tym p] q]:!>(lat.hid)
      [[%face %eny p] q]:!>(eny.hid)
    %+  roll  (~(tap by var))
    =<  .(q pit)
    |=  [[n=term v=vase] q=vase]
    (slop [[%face n p.v] q.v] q)
  ::
  ++  kill
    |=  cil=span
    ^-  (list move)
    :~  [ost %pass /child/[cil]/fork %g %cide cil]
        ::[ost %pass /child/[cil]/out %g %nuke [our.hid cil imp.hid] our.hid]
    ==
  ::
  ++  next-act                                          ::  rotate active task
    =+  ^-  nex=(unit span)
        =+  opt=[i=`(unit span)`~ t=(turn cubs |=(a=span `(unit span)`[~ a]))]
        |-
        ?~  t.opt  ~
        ?:  =(act i.opt)
          i.t.opt
        $(opt t.opt)
    ?.  tiv  +(act nex)
    %-  blab(act nex) 
    %+  weld
      ?~  nex  ~
      (spam /active/[u.nex] %rush %type %&)
    ?~  act  ~
    (spam /active/[u.act] %rush %type %|)
  ::
  ++  peer
    |=  [you=ship gal=glas]
    ^+  +>
    ?@  gal
      %_  +>.$
        mow  :_(mow [ost %give %rush %term-line prompt ~ ~])
      ==
    ?:  ?=(%active -.gal)
      (blab [ost %give %rush %type %|] ~)
    ?.  (~(has by cub.hid) p.gal)  +>.$
    ?:  (~(has by pop) p.gal)  +>.$
    =.  act  `p.gal
    (blab ping)
  ::
  ++  ping  (print-vase !>(*(list tank)))
  ++  poke-kyev
    |=  [you=ship key=kyev]
    ^+  +>
    ?:  ?=([~ @] key)  (poke-txt you q.key)             ::  simple keypress ?
    ?>  ?=([[%ctrl ~ ~] @t] key)
    ?+    q.key
        %+  blab
          [ost %give %nice ~]
        (print leaf/"no command \\{(trip q.key)}")
      %d  ?~  act
            %^    blab
                [ost %give %nice ~]
              [ost %give %logo ~]
            ~
          (eat-end:next-act %& (slav %ud u.act))
      %g  =+  =-  tak=rose/[" " "[" "]"]^(turn cubs -)
              |=  a=span
              leaf/(trip (rap 3 (~(got by cub.hid) a) '(' a ')' ~))
          (blab [ost give/nice/~] (print tak))
      %x  =.  +>.$  next-act
          (blab [ost %give %nice ~] ping)
    ==
  ::
  ++  poke-txt                                            ::  handle command
    |=  [you=ship txt=cord]
    ^+  +>
    ?^  act                                               ::  pipe to child
      %+  blab
        [ost %give %nice ~]
      (spam /in/[u.act] %rush %txt txt)
    =+  pas=((full ~(parse from pax lat.hid)) [1 1] (trip txt))
    ?~  q.pas
      (blab (print leaf/"<syntax error at {<`[@ @]`p.pas>}>"))
    =+  com=(wonk pas)
    =>  .(+>.$ (eat you com))
    =.  +>.$  (blab (stash txt))
    +>.$(mow :_(mow [ost %give %nice ~]))
  ::
  ++  poke-type
    |=  [you=ship tiv=?]
    ^+  +>
    =.  tiv  tiv
    ?^  act
      %+  blab
        [ost %give %nice ~]
      (spam /active/[u.act] %rush %type tiv)
    (blab [ost %give %nice ~] ~)
  ::
  ++  print  |=(a=tank (print-vase !>(`(list tank)`[a ~])))
  ++  print-vase
    |=  tan=vase ::  [p=p:!>(*(list tank)) q=*]
    ^-  (list move)
    %^  spam  /out  %meta
    :(slop !>(%rush) !>(%term-line) !>(prompt) !>(~) tan)
  ::
  ++  prompt
    ^-  [cord prom cord]
    ?^  act
      =+  por=(~(get by pot) u.act)
      ?^  por  u.por
      [(rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) %text '']
    :_  [%text '']
    ?.  &(?=([@ @ @ *] pax) =('0' &3.pax))
      (rsh 3 1 (cat 3 (spat pax) '> '))
    (rap 3 &1.pax '/' &2.pax '=' ?~(|3.pax ~['> '] ~[(spat |3.pax) '> ']))
  ::
  ++  purr
    |=  [cil=span fom=?(%fork %out %main) typ=type sih=sign]
    ^+  +>
    ?<  ?=(?(%init %sage %verb %veer %vega) +<.sih)
    ?-    fom
        %fork
      ?>  ?=(%gone +<.sih)
      %_  +>.$
        mow  :_(mow [ost %give %nice ~])
        act  ?:(=(act [~ cil]) ~ act)
      ==
    ::
        %main
      ?>  ?=(?(%nice %mean) +<.sih)
      (blab [ost %give +.sih] ping)
    ::
        %out
      ?.  ?=(?(%rust %rush) +<.sih)  +>.$
      ?:  ?=(%prompt p.sih)
        ?:  (~(has by pip) cil)  +>.$
        =.  pot  (~(put by pot) cil (,[cord prom cord] q.sih))
        (blab ping)
      %-  blab
      ?:  (~(has by pip) cil)
          (spam /in/(~(got by pip) cil) %meta (slot 3 typ sih))
      %-  print-vase
      ?+  p.sih 
        !>([(sell (slot 15 [typ sih]))]~)
          %tang  (slot 15 [typ sih])
          %txt
        ?^  q.sih  !!                                   ::  move to vase space?
        !>([leaf/(trip q.sih)]~)
      ==
    ==
  ::
  ++  spam
    |=  [pax=path gip=gift]
    ^-  (list move)
    %+  turn
      (~(tap in (~(get ju pus.hid) pax)))
    |=(a=bone [a %give gip])
  ::
  ++  stash
    |=  a=cord
    %^  spam  /out  %meta
    !>([%rush %term-line `term-line`[prompt [a]~ ~]])
  --
--
!:
::::  formal interface
  ::
|_  [hid=hide vat=axle]
::
++  peer                                                ::  handle subscription
  |=  [ost=bone you=ship pax=path]
  ^-  [(list move) _+>]
  ?~  pax  `+>.$
  ?.  ?=(?(%in %out %active) i.pax)  `+>.$
  =+  ^=  gal
      ?:  ?=(%out i.pax)  %out
      ?:  ?=(%in i.pax)   [%in ?<(?=(~ t.pax) i.t.pax)]
      [%active ?<(?=(~ t.pax) i.t.pax)]
  =+  abet:(peer:(ve hid ost vat) you gal)
  [-< +>.$(vat ->)]
::
++  poke-kyev                                           ::  handle key event
  |=  [ost=bone you=ship key=kyev]
  ^-  [(list move) _+>]
  =+  abet:(poke-kyev:(ve hid ost vat) you key)
  [-< +>.$(vat ->)]
::
++  poke-txt                                            ::  handle command
  |=  [ost=bone you=ship txt=cord]
  ^-  [(list move) _+>]
  =+  abet:(poke-txt:(ve hid ost vat) you txt)
  [-< +>.$(vat ->)]
::
++  poke-type                                           ::  handle command
  |=  [ost=bone you=ship tiv=?]
  ^-  [(list move) _+>]
  =+  abet:(poke-type:(ve hid ost vat) you tiv)
  [-< +>.$(vat ->)]
::
++  purr
  |=  [ost=bone pax=path typ=type sih=sign]
  ^-  [(list move) _+>]
  ?:  ?=(%init +<.sih)                                  ::  vomit
    [[ost %give +.sih]~ +>.$]
  ?:  ?=(%dumb +<.sih)                                  ::  sleep
    [~ +>.$]
  ?:  ?=(%sage +<.sih)                                  ::  vomit
    [[ost %give +.sih]~ +>.$]
  ?:  ?=(%verb +<.sih)                                  ::  vomit
    [[ost %give +.sih]~ +>.$]
  ?:  ?=(%veer +<.sih)                                  ::  vomit
    [[ost %give +.sih]~ +>.$]
  ?:  ?=(%vega +<.sih)                                  ::  vomit
    [[ost %give +.sih]~ +>.$]
  ?~  pax  ~&  %no-path  !!
  ?>  ?=([%child span ?(%fork %out %main) ~] pax)
  =+  abet:(purr:(ve hid ost vat) i.t.pax i.t.t.pax typ sih)
  [-< +>.$(vat ->)]
--