::                                                      ::  ::
::::  /hook/core/dojo/app                               ::  ::
  ::                                                    ::  ::
/?  314                                                 ::  zuse version
/-  *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
          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=dojo-device                                 ::  loadable
      ==                                                ::
    ++  dojo-device                                     ::  core devices
      $%  [%& p=term]                                   ::  general device
          [%| p=term q=path]                            ::  special device
      ==                                                ::
    ++  dojo-config                                     ::  configuration
      $:  p=(list dojo-source)                          ::  by order
          q=(map term 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))
        ;~(pfix bar (stag %sc dp-model))
        ;~(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   ;~(plug dp-server dp-config)         ::  ++dojo-model
    ++  dp-server  (stag 0 dp-device)                   ::  ++dojo-server
    ++  dp-twig    wide:(vang & ~)                      ::  ++twig
    ++  dp-device                                       ::  ++dojo-device
      %+  cook
        |=  [a=term b=path]
        ^-  dojo-device
        ?~(b [%& a] [%| a b])
      ;~(plug sym (more fas sym))
    ::
    ++  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 ;~(plug com ace) dp-value)
        %+  cook
          |=  a=(list (pair term (unit dojo-source)))
          %-  ~(gas by *(map term dojo-source))
          %+  turn  a
          |=  b=(pair term (unit dojo-source))
          [p.b ?~(q.b [0 %ex [%dtzy %f &]] u.q.b)]
        %+  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                                  ::  ++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 dojo-source)
      ^+  [key +>.$]
      ?~  key  [~ +>.$]
      =^  top  +>.$  (dy-init-source 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-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 [[%atom %n] ~])
    ::
    ++  dy-made-dial                                    ::  dialog result
      |=  cag=cage
      ?.  ?=([~ ~ a=* b=*] q.q.cag)
        ~&  %dy-made-init-fail
        (dy-rash %bel ~)
      =.  +>+>  
          ?:  =(a.q.q.cag ~) 
            +>+> 
          (he-rush %tan ((list tank) a.q.q.cag))
      ?+    -.b.q.q.cag  (dy-rash %bel ~)
          %&
        ?~  +.b.q.q.cag
          (dy-rash %bel ~)
        (dy-hand %noun (slot 63 q.cag))
      ::
          %|
        (dy-rush(pro `(slot 63 q.cag)) %pro (console-prompt +<.b.q.q.cag))
      ==
    ::
    ++  dy-done
      |=  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-silk-build                                   ::  build to silk
      |=  bul=dojo-build
      ^-  silk
      ?^  -.bul  [$(bul -.bul) $(bul +.bul)]
      ?+  -.bul  !!
        %ex  [%ride p.bul [%reef ~]]
      ==
    ::
    ++  dy-silk-device                                  ::  device to silk
      |=  dov=dojo-device
      ^-  silk
      :*  %boil
          %noun
          :-  [our.hid %main %da lat.hid] 
            ?-  -.dov
              %&  [%mad p.dov ~]
              %|  [%app p.dov %mad q.dov]
            ==
          ~
      ==
    ::
    ++  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-give                                           ::  emit gift
    |=  git=gift
    ^+  +>
    %_(+> moz [[ost %give git] moz])
  ::
  ++  he-pass
    |=  [pax=path noy=note]
    ~&  [%he-pass pax noy]
    %_(+> 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-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)
::
++  poke-console-action
  |=  [ost=bone her=ship act=console-action]
  ~&  %poke-console-action
  ^-  [(list move) _+>]
  he-abet:(~(he-work he [ost [ost %give %nice ~]~] (~(got by hoc) ost)) act)
::
++  pour
  |=  [ost=bone pax=path sih=*]
  ^-  [(list move) _+>]
  =+  sih=((hard sign) sih)
  ?-    -.sih
      %f
    he-abet:(~(he-ford he [[ost ~] (~(got by hoc) ost)]) pax +>.sih)
  ::
      %g  !!
  ==
--