::                                                      ::  ::
::::  /hook/core/dojo/app                               ::  ::::
  ::                                                    ::    ::
/?  314                                                 ::  arvo kelvin
/-  *console                                            ::  console structures
/+  console                                             ::  console library
::                                                      ::  ::
::::                                                    ::  ::::
  !:                                                    ::    ::
=>  |%                                                  ::  external structures
    ++  house                                           ::  all state
      $:  hoc=(map bone session)                        ::  conversations
      ==                                                ::
    ++  session                                         ::  per conversation
      $:  say=console-share                             ::  command-line state
          syd=desk                                      ::  active desk 
          luc=(unit case)                               ::  special case
          poy=(unit dojo-project)                       ::  working 
          var=(map term cage)                           ::  variable state
          old=(set term)                                ::  used TLVs
      ==                                                ::
    ++  dojo-command                                    ::
      $%  [%poke p=goal q=dojo-source]                  ::  make and poke
          [%save p=term q=dojo-source]                  ::  save/print
          [%show p=dojo-source]                         ::  print
      ==                                                ::
    ++  dojo-source                                     ::  construction node
      $:  p=@ud                                         ::  assembly index
          q=dojo-build                                  ::  general build
      ==                                                ::
    ++  dojo-build                                      ::  one ford step
      $&  [p=dojo-build q=dojo-build]                   ::  build cell
      $%  [%ex p=twig]                                  ::  hoon expression
          [%fi p=(list dojo-filter) q=dojo-build]       ::  filter pipeline
          [%fo p=dojo-model]                            ::  form
          [%sc p=dojo-model]                            ::  script
          [%va p=term]                                  ::  dojo variable
      ==                                                ::
    ++  dojo-filter                                     ::  pipeline filter
      $%  [%a p=twig]                                   ::  direct gate
          [%b p=mark]                                   ::  simple transmute
          [%c p=dojo-model]                             ::  full filter
      ==                                                ::
    ++  dojo-model                                      ::  data construction 
      $:  p=dojo-server                                 ::  core source
          q=dojo-config                                 ::  configuration
      ==                                                ::
    ++  dojo-server                                     ::  numbered device
      $:  p=@ud                                         ::  assembly index
          q=path                                        ::  gate path
      ==                                                ::
    ++  dojo-config                                     ::  configuration
      $:  p=(list dojo-source)                          ::  by order
          q=(map term (unit dojo-source))               ::  by keyword
      ==                                                ::
    ++  dojo-problem  (each dojo-source dojo-server)    ::  construction problem
    ++  dojo-project                                    ::  construction state
      $:  mad=dojo-command                              ::  operation
          num=@ud                                       ::  number of tasks
          cur=@ud                                       ::  currently solving
          pro=(unit vase)                               ::  prompting loop
          idl=?                                         ::  not calling ford
          per=(unit console-edit)                       ::  pending reverse
          job=(map ,@ud dojo-problem)                   ::  problems
          rez=(map ,@ud cage)                           ::  results
      ==                                                ::
    ++  bead  ,[p=(set beam) q=cage]                    ::  computed result
    ++  goal  ,[p=ship q=term]                          ::  flat application
    ++  gift                                            ::  out result <-$
      $%  [%mean p=ares]                                ::  error
          [%nice ~]                                     ::  acknowledge
          [%rush %console-effect console-effect]        ::  
      ==                                                ::
    ++  hapt  ,[p=ship q=path]                          ::  
    ++  move  ,[p=bone q=(mold note gift)]              ::
    ++  hood                                            ::  assembly plan
      $:  zus=@ud                                       ::  zuse kelvin
          sur=(list hoot)                               ::  structures
          lib=(list hoof)                               ::  libraries
          fan=(list horn)                               ::  resources
          src=(list hoop)                               ::  program
      ==                                                ::
    ++  hoof  (pair term (unit (pair case ship)))       ::  resource reference
    ++  hoot  (pair bean hoof)                          ::  structure gate/core
    ++  hoop                                            ::  source in hood
      $%  [%& p=twig]                                   ::  direct twig
          [%| p=beam]                                   ::  resource location   
      ==                                                ::
    ++  horn                                            ::  resource tree
      $%  [%ape p=twig]                                 ::  /~  twig by hand
          [%arg p=twig]                                 ::  /$  argument
          [%day p=horn]                                 ::  /|  list by @dr
          [%dub p=term q=horn]                          ::  /=  apply face
          [%fan p=(list horn)]                          ::  /.  list
          [%for p=path q=horn]                          ::  /,  descend
          [%hel p=@ud q=horn]                           ::  /%  propagate heel
          [%hub p=horn]                                 ::  /@  list by @ud
          [%man p=(map span horn)]                      ::  /*  hetero map
          [%nap p=horn]                                 ::  /_  homo map
          [%now p=horn]                                 ::  /&  list by @da
          [%saw p=twig q=horn]                          ::  /;  operate on
          [%see p=beam q=horn]                          ::  /:  relative to
          [%sic p=tile q=horn]                          ::  /^  cast
          [%toy p=mark]                                 ::  /mark/  static
      ==                                                ::
    ++  silk                                            ::  construction layer
      $&  [p=silk q=silk]                               ::  cons
      $%  [%bake p=mark q=beam r=path]                  ::  local synthesis
          [%boil p=mark q=beam r=path]                  ::  general synthesis
          [%call p=silk q=silk]                         ::  slam
          [%cast p=mark q=silk]                         ::  translate
          [%done p=(set beam) q=cage]                   ::  literal
          [%dude p=tank q=silk]                         ::  error wrap
          [%dune p=(set beam) q=(unit cage)]            ::  unit literal
          [%mute p=silk q=(list (pair wing silk))]      ::  mutant
          [%plan p=beam q=spur r=hood]                  ::  structured assembly
          [%reef ~]                                     ::  kernel reef
          [%ride p=twig q=silk]                         ::  silk thru twig
          [%vale p=mark q=ship r=*]                     ::  validate [our his]
      ==                                                ::
    ++  note-ford                                       ::  note to ford
      $%  [%exec p=@p q=(unit silk)]                    ::  make / kill
      ==                                                ::
    ++  note-gall                                       ::  note to %gall
      $%  [%mess p=[p=ship q=path] q=ship r=cage]       ::
      ==                                                ::
    ++  sign-gall                                       ::  sign from %gall
      $%  [%mean p=ares]                                ::
          [%nice ~]                                     ::
      ==                                                ::
    ++  sign-ford                                       ::  sign from ford
      $%  [%made p=(each bead (list tank))]             ::  computed result
      ==                                                ::
    ++  note                                            ::  out request $->
      $%  [%f note-ford]                                ::
          [%g note-gall]                                ::
      ==                                                ::
    ++  sign                                            ::  in result $<-
      $%  [%f sign-ford]                                ::
          [%g sign-gall]                                ::
      ==                                                ::
    --                                                  ::
::                                                      ::
::::                                                    ::
  ::                                                    ::
|_  $:  hid=hide                                        ::  system state
        house                                           ::  program state
    ==                                                  ::
++  he                                                  ::  per session
  |_  [[ost=bone moz=(list move)] session]              ::
  ++  dp                                                ::  dojo parser
    |%  
    ++  dp-command                                      ::  ++dojo-command
      %+  knee  *dojo-command  |.  ~+
      ;~  pose
        %+  stag  %poke
        ;~  pfix  zap
          ;~(plug dp-goal ;~(pfix ace dp-source))
        ==
      ::
        %+  stag  %save
        ;~  pfix  tis
          ;~(plug sym ;~(pfix ace dp-source))
        ==
      ::
        (stag %show dp-source)
      ==
    ++  dp-source  (stag 0 dp-build)                    ::  ++dojo-source
    ++  dp-build                                        ::  ++dojo-build
      %+  knee  *dojo-build  |.  ~+
      ;~  pose
        (ifix [sel ser] dp-many)
        ;~(pfix col (stag %fo dp-model-gun))
        ;~(pfix bar (stag %sc dp-model-sic))
        ;~(pfix buc (stag %va sym))
        (stag %ex dp-twig)
      ==
    ++  dp-many                                         ::  ++dojo-build
      %+  cook
        |=  a=(list dojo-build) 
        ^-  dojo-build
        ?~(a !! ?~(t.a i.a [i.a $(a t.a)]))
      (most ace dp-build)
    :: 
    ++  dp-goal                                         ::  ++goal
      %+  cook  |=(a=goal a)
      ;~  pose
        ;~  plug
          ;~(pfix sig fed:ag) 
          ;~(pfix fas sym)
        ==
        (cook |=(a=term `goal`[our.hid a]) sym)
      ==
    ++  dp-model-gun  ;~(plug dp-server-gun dp-config)  ::  ++dojo-model
    ++  dp-model-sic  ;~(plug dp-server-sic dp-config)  ::  ++dojo-model
    ++  dp-server-gun   (stag 0 (stag %gun dp-device))  ::  ++dojo-server
    ++  dp-server-sic   (stag 0 (stag %sic dp-device))  ::  ++dojo-server
    ++  dp-twig         wide:(vang & ~)                 ::  ++twig
    ++  dp-device       (most fas sym)                  ::  ++dojo-device
    ++  dp-value                                        ::  ++dojo-source
      %+  cook  |=(a=dojo-source a)
      %+  stag  0
      ;~  pose
        (ifix [kel ker] dp-many)
        (stag %va ;~(pfix buc sym))
        (stag %ex dp-twig)
      ==
    ::
    ++  dp-config                                       ::  ++dojo-config
      %+  cook  |=(a=dojo-config a)
      ;~  plug
        (more ace dp-value)
        %+  cook
          ~(gas by *(map term (unit dojo-source)))
        %+  more  
          ;~(plug com ace)
        ;~  plug 
          ;~(pfix tis sym)
          ;~  pose 
            ;~(pfix ace (stag ~ dp-value)) 
            (easy ~)
          ==
        ==
      ==
    --
  ::
  ++  dy                                                ::  project work
    |_  dojo-project                                    ::
    ++  dy-abet  +>(poy `+<)                            ::  resolve
    ++  dy-amok  +>(poy ~)                              ::  terminate
    ++  dy-ford                                         ::  silk to ford
      |=  [pax=path kas=silk]
      ^+  +>+>
      (he-pass(poy `+>+<(idl %|)) pax %f %exec our.hid `kas)
    ::
    ++  dy-slam                                         ::  call by ford
      |=  [pax=path gat=vase sam=vase]
      ^+  +>+>
      (dy-ford pax %call [%done ~ %noun gat] [%done ~ %noun sam])
    ::
    ++  dy-rush                                         ::  send effects, abet
      |=  fec=console-effect
      ^+  +>+>
      (he-rush(poy `+>+<) fec)
    ::
    ++  dy-rash                                         ::  send effects, amok
      |=  fec=console-effect
      ^+  +>+>
      (he-rush(poy ~) fec)
    ::
    ++  dy-init-command                                 ::  ++dojo-command
      |=  mad=dojo-command
      ^+  [mad +>]
      ?-  -.mad
        %poke  =^(src +>.$ (dy-init-source q.mad) [[%poke p.mad src] +>.$])
        %save  =^(src +>.$ (dy-init-source q.mad) [[%save p.mad src] +>.$])
        %show  =^(src +>.$ (dy-init-source p.mad) [[%show p.mad] +>.$])
      ==
    ::
    ++  dy-init-source-unit                             ::  (unit dojo-source)
      |=  urc=(unit dojo-source)
      ^+  [urc +>]
      ?~  urc  [~ +>]
      =^  src  +>  (dy-init-source u.urc)
      [`src +>.$]
    ::
    ++  dy-init-source                                  ::  ++dojo-source
      |=  src=dojo-source
      ^+  [src +>]
      =^  bul  +>  (dy-init-build q.src)
      =:  p.src  num
          q.src  bul
        ==
      [src +>.$(num +(num), job (~(put by job) num [%& src]))]
    ::
    ++  dy-init-build                                   ::  ++dojo-build
      |=  bul=dojo-build
      ^+  [bul +>]
      ?^  -.bul
        =^  one  +>.$  $(bul -.bul)
        =^  two  +>.$  $(bul +.bul)
        [[one two] +>.$]
      ?-    -.bul
        %ex  [bul +>.$]
        %fi  !!
        %fo  =^(mod +>.$ (dy-init-model p.bul) [[%fo mod] +>.$])
        %sc  !!
        %va  [bul +>.$]
      ==
    ::
    ++  dy-init-model                                   ::  ++dojo-model
      |=  mol=dojo-model
      ^+  [mol +>]
      =^  one  +>.$  (dy-init-server p.mol)
      =^  two  +>.$  (dy-init-config q.mol)
      [[one two] +>.$]
    ::
    ++  dy-init-server                                  ::  ++dojo-server
      |=  srv=dojo-server
      =.  p.srv  num
      [srv +>.$(num +(num), job (~(put by job) num [%| srv]))]
    ::
    ++  dy-init-config                                  ::  prepare config
      |=  cig=dojo-config
      ^+  [cig +>]
      =^  ord  +>.$  (dy-init-ordered p.cig)
      =^  key  +>.$  (dy-init-named q.cig)
      [[ord key] +>.$]
    ::
    ++  dy-init-ordered                                 ::  (list dojo-source)
      |=  ord=(list dojo-source)
      ^+  [ord +>]
      ?~  ord  [~ +>.$]
      =^  fir  +>.$  (dy-init-source i.ord)
      =^  mor  +>.$  $(ord t.ord)
      [[fir mor] +>.$]
    ::
    ++  dy-init-named                                   ::  (map @tas dojo-src)
      |=  key=(map term (unit dojo-source))
      ^+  [key +>.$]
      ?~  key  [~ +>.$]
      =^  top  +>.$  (dy-init-source-unit q.n.key)
      =^  lef  +>.$  $(key l.key)
      =^  rit  +>.$  $(key r.key)
      [[[p.n.key top] lef rit] +>.$]
    ::
    ++  dy-init                                         ::  full initialize
      ^+  .
      =^(dam . (dy-init-command mad) +(mad dam))
    ::
    ++  dy-work                                         ::  console action
      |=  act=console-action
      ?-  -.act
        %det  (he-stir +.act)
        %ret  (he-done (tufa buf.say))
      ==
    ::
    ++  dy-hand                                         ::  complete step
      |=  cag=cage
      ^+  +>+>
      dy-step(cur +(cur), rez (~(put by rez) cur cag))
    ::
    ++  dy-meal                                         ::  vase to cage
      |=  vax=vase
      ?.  &(?=(@ -.q.vax) !((sane %tas) -.q.vax))
        ~&  %dy-meal-cage
        (dy-rash %bel ~)
      (dy-hand -.q.vax (slot 3 vax))
    ::
    ++  dy-made-edit                                    ::  console edit
      |=  cag=cage
      ^+  +>+>
      ?>  ?=(^ per)
      ?^  q.q.cag  
        ~&  %dy-made-edit-good
        dy-abet(per ~)
      ~&  %dy-made-edit-bad
      =^  lic  say  (~(transmit cs say) u.per)
      (dy-rush(per ~) %mor [%bel ~] [%det lic] ~)
    ::
    ++  dy-made-make                                    ::  created prompt
      |=  cag=cage
      ^+  +>+>
      ~&  %dy-made-make
      (dy-slam /dial q.cag !>(~))
    ::
    ++  dy-made-dial                                    ::  dialog product
      |=  cag=cage
      ^+  +>+>
      ?.  ?=([~ ~ *] q.q.cag)
        ~&  %dy-made-dial-fail
        (dy-rash %bel ~)
      =+  tan=((list tank) +14.q.cag)
      =+  vax=(spec (slot 15 q.cag))
      ?+    -.q.vax  !!
          %& 
        ?~  +<.q.vax
          ~&  %dy-made-dial-abort
          (dy-rash %bel ~)
        (dy-meal (slot 7 vax))
      ::
          %|
        (dy-rush(pro `(slot 2 vax)) %pro (console-prompt +.q.vax))
      ==
    ::
    ++  dy-done                                         ::  submit
      |=  txt=tape
      ~&  %dy-done
      ?>  ?=(^ pro)
      (dy-slam /dial u.pro (slop [[%atom %n] ~] !>(txt)))
    ::
    ++  dy-over                                         ::  finish construction
      ^+  +>
      ?-    -.mad
          %poke       
        %-  he-pass(poy ~)
        :*  /poke
            %g
            %mess
            [p.p.mad [q.p.mad ~]]
            our.hid 
            (~(got by rez) p.q.mad)
        ==
      ::
          %save
        dy-amok(var (~(put by var) p.mad (~(got by rez) p.q.mad)))
      ::
          %show
        (dy-rash %tan (sell q:(~(got by rez) p.p.mad)) ~)
      ==
    ::
    ++  dy-edit                                         ::  handle edit
      |=  cal=console-change
      ^+  +>+>
      =+  old=buf.say
      =^  dat  say  (~(receive cs say) cal)
      =.  dat  (~(inverse cs say(buf old)) dat)
      ?:  |(?=(^ per) !idl ?=(~ pro))
        ~&  %dy-edit-busy
        =^  lic  say  (~(transmit cs say) dat)
        (dy-rush %mor [%det lic] [%bel ~] ~)
      (dy-slam(per `dat) /edit u.pro !>(buf.say))
    ::
    ++  dy-work                                         ::  handle input
      |=  act=console-action
      ^+  +>+>
      ?-  -.act
        %det  (dy-edit +.act)
        %ret  (dy-done (tufa buf.say))
      ==
    ::
    ++  dy-cage       |=(num=@ud (~(got by rez) num))   ::  known cage
    ++  dy-vase       |=(num=@ud q:(dy-cage num))       ::  known vase
    ++  dy-silk-vase  |=(vax=vase [%done ~ %noun vax])  ::  vase to silk
    ++  dy-silk-form                                    ::  configure
      |=  [cag=cage cig=dojo-config]
      ^-  silk
      :+  %ride  [%cnzy %$]
      :+  %mute  [%done ~ cag]
      ^-  (list (pair wing silk))
      :*  :-  [[~ 12] ~]
          (dy-silk-vase !>([he-beak lat.hid]))
      ::
          :-  [[~ 46] ~]
          %-  dy-silk-vase
          |-  ^-  vase
          ?~  p.cig  !>(~)
          (slop (dy-vase p.i.p.cig) $(p.cig t.p.cig))
      ::
          %+  turn  (~(tap by q.cig))
          |=  [a=term b=(unit dojo-source)]
          ^-  (pair wing silk)
          :-  [a [~ 47] ~]
          %-  dy-silk-vase
          ?~(b !>([~ ~]) (dy-vase p.u.b))
      ==
    ::
    ++  dy-silk-build                                   ::  build to silk
      |=  bul=dojo-build
      ^-  silk
      ?^  -.bul  [$(bul -.bul) $(bul +.bul)]
      ?+  -.bul  !!
        %fo  (dy-silk-form (dy-cage p.p.p.bul) q.p.bul)
        %ex  [%ride p.bul [%reef ~]]
      ==
    ::
    ++  dy-silk-device                                  ::  device to silk
      |=  pax=path
      ^-  silk
      [%boil %gate [he-beak pax] ~]
    ::
    ++  dy-step                                         ::  advance project
      ^+  +>
      ?:  =(cur num)
        dy-over
      =+  pob=(~(got by job) cur)
      ?-  -.pob
        %&  (dy-ford /hand (dy-silk-build q.p.pob))
        %|  (dy-ford /make (dy-silk-device q.p.pob))
      ==
    --
  ::
  ++  he-dope                                           ::  sole user of ++dp
    |=  txt=tape                                        ::
    ^-  (each (unit dojo-command) hair)                 ::  prefix/result
    =+  vex=(dp-command:dp [1 1] txt)
    ?.  =(+((lent txt)) q.p.vex)                        ::  fully parsed
      [%| p.vex]                                        ::  syntax error
    [%& ?~(q.vex ~ `p.u.q.vex)]                         ::  prefix/complete
  ::
  ++  he-duke                                           ::  ++he-dope variant
    |=  txt=tape
    ^-  (each dojo-command ,@ud)
    =+  foy=(he-dope txt)
    ?-  -.foy
      %|  [%| q.p.foy]
      %&  ?~(p.foy [%| (lent txt)] [%& u.p.foy])
    ==
  ::
  ++  he-abet                                           ::  resolve
    [(flop moz) %_(+> hoc (~(put by hoc) ost +<+))]
  ::
  ++  he-beak                                           ::  logical beam
    ^-  beak
    [our.hid syd ?^(luc u.luc [%da lat.hid])]
  ::
  ++  he-give                                           ::  emit gift
    |=  git=gift
    ^+  +>
    %_(+> moz [[ost %give git] moz])
  ::
  ++  he-pass
    |=  [pax=path noy=note]
    %_(+> moz [[ost %pass pax noy] moz])
  ::
  ++  he-rush                                           ::  emit update
    |=  fec=console-effect 
    ^+  +>
    (he-give %rush %console-effect fec)
  ::
  ++  he-peer                                           ::  subscribe to
    he-prom
  ::
  ++  he-prom                                           ::  send prompt
    %-  he-rush
    :-  %pro
    [& %$ (tuba (weld (scow %p our.hid) ":dojo> "))]
  ::
  ++  he-ford                                           ::  result from ford
    |=  [pax=path rey=(each bead (list tank))]
    ^+  +>
    ?>  ?=(^ poy)
    ?-  -.rey
      %&  =+  dye=~(. dy u.poy)
          =.  idl.dye  &
          ?+  pax      ~&(%he-ford-path !!)
            [%hand ~]  (dy-hand:dye q.p.rey)
            [%dial ~]  (dy-made-dial:dye q.p.rey)
            [%make ~]  (dy-made-make:dye q.p.rey)
            [%edit ~]  (dy-made-edit:dye q.p.rey)
          ==
      %|  ~&  [%he-ford-fail pax]
          (he-rush(poy ~) %tan p.rey)
    ==
  ::
  ++  he-like                                           ::  accept line
    |=  buf=(list ,@c)
    =(%& -:(he-dope (tufa buf)))
  ::
  ++  he-stir                                           ::  apply change
    |=  cal=console-change
    ^+  +>
    =^  dut  say  (~(remit cs say) cal he-like)
    ?~  dut
      +>.$
    (he-rush %mor [%det u.dut] [%bel ~] ~)
  ::
  ++  he-plan                                           ::  execute command
    |=  mad=dojo-command
    ^+  +>
    ?>  ?=(~ poy)
    =<  dy-step
    ~(dy-init dy mad [0 0 ~ %& ~ ~ ~])
  ::
  ++  he-done                                           ::  parse command
    |=  txt=tape
    ^+  +>
    =+  doy=(he-duke txt)
    ?-    -.doy
        %|  
      %-  he-rush 
      :~  %mor 
          [%tan [%leaf "syntax error at {<p.doy>}"]~]
          [%bel ~]
      ==
    ::
        %&
      =+  old=(weld "> " (tufa buf.say))
      =^  cal  say  (~(transmit cs say) [%set ~])
      %.  p.doy
      =<  he-plan
      %-  he-rush
      :~  %mor
          [%txt old]
          [%nex ~]
          [%det cal]
      ==
    ==
  ::
  ++  he-work                                           ::  apply input
    |=  act=console-action
    ^+  +>
    ?^  poy
      (~(dy-work dy u.poy) act)
    ?-  -.act
      %det  (he-stir +.act)
      %ret  (he-done (tufa buf.say))
    ==
  --
::
++  peer
  |=  [ost=bone her=ship pax=path]
  ^-  [(list move) _+>]
  ?<  (~(has by hoc) ost)
  ?>  =(/console pax)
  ?>  =(her our.hid)
  =<  he-abet
  %~  he-peer  he
  :-  [ost ~]
  ^-  session
  :*  *console-share  ::  say=console-share
      %main           ::  syd=desk
      ~               ::  luc=(unit case)
      ~               ::  poy=(unit dojo-project)
      ~               ::  var=(map term cage)
      ~               ::  old=(set term)
  ==
::
++  poke-console-action
  |=  [ost=bone her=ship act=console-action]
  ^-  [(list move) _+>]
  he-abet:(~(he-work he [ost [ost %give %nice ~]~] (~(got by hoc) ost)) act)
::
++  pour
  |=  [ost=bone pax=path sih=sign]
  ^-  [(list move) _+>]
  ::  ~&  [%dojo-pour pax]
  ?-    -.sih
      %f
    he-abet:(~(he-ford he [[ost ~] (~(got by hoc) ost)]) pax +>.sih)
  ::
      %g  !!
  ==
--