neo: add monadic form handler

pkg/arvo/app/neo.hoon

@@ -1,10 +1,22 @@
-/-  neo
-/+  default-agent, dbug, verb
+/-  neo, sole-sur=sole
+/+  default-agent, dbug, verb, shoe
 |%
+++  sole
+  |%
+  +$  id  sole-id:sole-sur
+  +$  action  sole-action:sole-sur
+  --
 +$  pith   pith:neo
 +$  card  card:agent:gall
++$  race-form  _*eval-form:(pike:neo ,vase)
++$  race
+  $:  sock=term
+      form=race-form
+      grab=(list item:pike:neo)
+      have=(list clot:goon:neo)
+  ==
 +$  state-0
-  [%0 apex=hall:neo =fleet:neo husks=(jug stud:neo name:neo)]
+  [%0 apex=hall:neo =fleet:neo husks=(jug stud:neo name:neo) races=(map id:sole race)]
 ++  is-parent
   |=  [parent=pith kid=pith]
   ^-  ?
@@ -36,12 +48,18 @@
   =/  recur  $(wer (snoc wer p.i.kids), kids ~(tap by yard.q.i.kids))
   =.  res  (~(uni by res) recur)
   $(kids t.kids)
++$  gait
+  $%  [%start sock=@tas]
+      [%clot =clot:goon:neo]
+      [%dbug foo=*]
+  ==
 --
 =|  state-0
 =*  state  -
 =<
   %-  agent:dbug
   %+  verb  &
+  %-  (agent:shoe gait)  
   |_  =bowl:gall
   +*  this  .
       run   ~(. +> [bowl ~])
@@ -85,6 +103,27 @@
     [cards this]
   ++  on-fail   on-fail:def
   ++  on-peek   on-peek:def
+  ++  command-parser 
+    |=  =id:sole
+    ~(parser walk:run id)
+  ++  tab-list
+    |=  =id:sole
+    ~
+  ++  on-command
+    |=  [=id:sole =gait] 
+    =^  cards  state
+      abet:(~(do walk:run id) gait)
+    [cards this]
+      
+  ++  can-connect
+    |=  =id:sole
+    =(our src):bowl
+  ++  on-connect
+    |=  =id:sole
+    `this
+  ++  on-disconnect
+    |=  =id:sole
+    `this
   --
 |_  [=bowl:gall cards=(list card)]
 ++  abet  [(flop cards) state]
@@ -585,4 +624,118 @@
       (si-emil (take:si-form arvo/syn))
     --
   --
+++  sock
+  |_  for=@tas
+  ++  spur
+    ^-  path
+    /lib/[for]/hoon
+  ++  resolve
+    ^-  path
+    %+  welp
+      /(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)
+    spur
+  ++  sock-vase
+    .^(vase %ca resolve)
+  ++  form-typ  form:(pike:neo vase)
+  ++  form  
+    !<(form-typ sock-vase)
+  --
+++  walk
+  |_  =id:sole
+  ++  parser
+    ^-  _|~(nail *(like [? gait]))
+    ?~  rac=(~(get by races) id)
+      ^-  _|~(nail *(like [? gait]))
+      ;~(plug (easy |) (stag %start sym))
+    ?~  grab.u.rac
+      ^-  _|~(nail *(like [? gait]))
+      ;~(plug (easy |) (stag %dbug (easy ~)))
+    ^-  _|~(nail *(like [? gait]))
+    =-  ;~(plug (easy |) (stag %clot -))
+
+    ?+  scar.i.grab.u.rac  !!
+      %cord   (stag %cord (cook crip (star prn)))
+      %patud  (stag %patud dem:ag)
+    ==
+  ++  do
+    |=  =gait
+    ^+  run
+    ~&  gait/gait
+    ?-  -.gait
+      %start  (start +.gait)
+      %dbug   run
+      %clot   (take-clot +.gait)
+    ==
+  ++  take-clot
+    |=  =clot:goon:neo
+    ~&  clot/clot
+    ^+  run
+    =/  =race  (~(got by races) id)
+    =.  have.race  (snoc have.race clot)
+    =.  grab.race
+      ?>  ?=(^ grab.race)
+      t.grab.race
+    ?~  grab.race
+      =/  have  have.race
+      =.  have.race  ~
+      =.  races  (~(put by races) id race)
+      (take `[%grab have])
+    =.  races  (~(put by races) id race)
+    show-grab
+  ::
+  ++  put
+    |=  =race
+    ^+  run
+    =.  races  (~(put by races) id race)
+    run
+  ++  make-bowl
+    `bowl:pike:neo`[*name:neo eny.bowl now.bowl]
+  ++  take
+    |=  syn=(unit sign:pike:neo)
+    =/  =race  (~(got by races) id)
+    |-
+    ~&  syn/syn
+    ~&  run/sock.race
+    =/  pike  (pike:neo vase)
+    =^  res=eval-result:pike  form.race
+      (take:pike form.race [make-bowl syn])
+    ?-    -.res
+        %done
+      %-  (slog %done (sell value.res) ~)
+      =.  races  (~(del by races) id)
+      run
+        %fail
+      =.  races  (~(del by races) id)
+      run
+        %emit  
+      ~|  res
+      ?-    -.car.res
+      :: TODO: actually scry
+          %peek  $(syn `[%peek addr-info/!>(['New York' 'NY'])])
+          %grab
+        =.  grab.race  items.car.res
+        =.  races  (~(put by races) id race)
+        show-grab
+      ==
+    ==
+  ++  show-grab
+    =/  =race  (~(got by races) id)
+    |-  ^+  run
+    ?~  grab.race
+      run
+    =/  =item:pike:neo  i.grab.race
+    ~&  print/lede.item
+    run
+
+  ++  start
+    |=  soc=@tas
+    ^+  run
+    =/  =race
+      [soc ~(form sock soc) ~ ~]
+    =.  races  (~(put by races) id race)
+    (take ~)
+    :: ?~  
+    :: =/  =wire  /race/(scot %p who.id)/[ses.id]
+    :: (emit %pass wire %agent [
+  --
 --

pkg/arvo/lib/form.hoon

@@ -0,0 +1,90 @@
+/-  neo
+=<  p-addr
+|%
++$  address
+  [one=@t two=@t city=@t zip=@ud state=@t]
+++  pike  pike:neo
+++  goon  goon:neo
+++  grab
+  |=  items=(list item:pike)
+  =/  m  (pike (pole clot:goon))
+  ^-  form:m
+  |=  in=input:pike
+  ^-  output:m 
+  ?^  syn.in
+    ?.  ?=(%grab -.u.syn.in)
+      [%fail %weird-card ~]
+    [%done items.u.syn.in]
+  [%emit %grab items]
+++  grab-validate
+  |=  [items=(list item:pike) valid=$-((list clot:goon) (list (unit @t)))]
+  =/  m  (pike (pole clot:goon))
+  ^-  form:m
+  |-  =*  loop  $
+  ;<  res=(list clot:goon)  bind:m
+    (grab items)
+  =/  errs  (valid res)
+  =/  has-err=?
+    %+  roll  errs
+    |=  [er=(unit cord) has-err=_|]
+    ?:  has-err  &
+    ?~  er  |
+    &
+  ?.  has-err
+    (pure:m res)
+  =/  new
+    =|  new=(list item:pike)
+    |-  
+    ?~  items
+      new
+    ?~  errs  
+      new
+    =.  err.i.items  i.errs
+    $(items t.items, new (snoc new i.items), errs t.errs)
+  loop(items new)
+::
+++  peek
+  |=  =path
+  =/  m  (pike cage)
+  ^-  form:m
+  |=  in=input:pike
+  ^-  output:m
+  ?^  syn.in
+    ?.  ?=(%peek -.u.syn.in)
+      [%fail %weird-card ~]
+    [%done cage.u.syn.in]
+  [%emit %peek path] 
+::
+++  p-addr
+  =/  m  (pike vase)
+  ^-  form:m
+  ;<  zip=(pole clot:goon)  bind:m 
+    =-  %+  grab-validate  ~[-]
+        |=  ls=(pole clot:goon)
+        ^-  (list (unit cord))
+        ?>  ?=([[%patud p=@ud] ~] ls)
+        =-  ~[-]
+        ?:  &((gth p.ls 10.000) (lth p.ls 99.999))
+          ~
+        `'Invalid ZIP code'
+    :*  'Zip Code'
+        'Please enter the zip code of your billing address'
+        ~
+        %patud
+    ==
+  ~&  zip
+  ?>  ?=([[%patud p=@ud] ~] zip)
+  ;<  =cage  bind:m
+    (peek /dummy/zipcode/(scot %ud p.zip))
+  ?>  =(%addr-info p.cage)
+  =+  !<([city=@t state=@t] q.cage)
+  ;<  lines=(pole clot:goon)  bind:m
+    %-  grab
+    :~  ['Address Line 1' '' ~ %cord]
+        ['Address Line 2' '' ~ %cord]
+    ==
+  ?>  ?=([one=[%cord p=cord] two=[%cord p=cord] ~] lines)
+  =/  addy=address
+    [p.one.lines p.two.lines city p.zip state]
+  (pure:m !>(addy))
+--

pkg/arvo/sur/neo.hoon

@@ -16,6 +16,142 @@
 ::
 ::  
 |%
+++  goon
+  |%
+  ::  $date: date w/ TZ offset
+  +$  date   [dat=@da off=@ud]
+  ::  $size: size of a rect
+  +$  size   [w=@ud h=@ud]
+  ::  $hsrc:  HTTP source (URL)
+  +$  hsrc   @t
+  ::  $dims: Spatial dimensions
+  +$  dims   [ideal=size min=(unit size)]
+  ::  $dimt: Temporal dimension
+  +$  dimt   [len=@dr sta=@ud]
+  +$  scar
+    $?  %patp
+        %patud
+        %cord
+        %patda
+        %date
+        %img
+        %video
+        %audio
+    ==
+  +$  clot
+    $?  [%patp p=@p]
+        [%patud p=@ud]
+        [%cord p=cord]
+        [%patda p=@da]
+        [%date =date]
+        [%img =hsrc =dims]
+        [%video =hsrc =dims =dimt]
+        [%audio =hsrc =dimt]
+    ==
+  --
+
+++  pike
+  =<  pike
+  |%
+  ++  card
+    $%  [%peek =path]
+        [%grab items=(list item)]
+    ==
+  ++  sign
+    $%  [%peek =cage]
+        [%grab items=(list clot:goon)]
+    ==
+  +$  item
+    $:  lede=cord
+        info=cord
+        err=(unit cord)
+        =scar:goon
+    ==
+  +$  bowl
+    $:  wer=name
+        eny=@uvJ
+        now=@da
+    ==
+  +$  input  [=bowl syn=(unit sign)]
+  ++  raw
+    |%
+    ++  output
+      |*  a=mold
+      $~  [%done *a]
+      $%  [%emit =card]
+          [%cont self=(form a)]
+          [%fail err=(pair term tang)]
+          [%done value=a]
+      ==
+    ++  form  |*(a=mold $-(input (output a)))
+    --
+  ++  fail
+    |=  err=(pair term tang)
+    |=  input
+    [~ %fail err]
+  ++  pikv
+    (pike vase)
+  ++  pike
+    |*  a=mold
+    |%
+    ++  output  (output:raw a)
+    ++  form    (form:raw a)
+    ++  pure    
+      |=  arg=a
+      ^-  form
+      |=  input
+      [%done arg]
+    ++  bind
+      |*  b=mold
+      |=  [m-b=(form:raw b) fun=$-(b form)]
+      ^-  form
+      =*  loop  $
+      |=  in=input
+      =/  b-res=(output:raw b)
+        (m-b in)
+      ^-  output
+      ?-    -.b-res
+        %emit   [%emit card.b-res]
+        %cont   [%cont loop(m-b self.b-res)]
+        %fail   [%fail err.b-res]
+        %done   [%cont (fun value.b-res)]
+      ==
+    +$  eval-form
+      $:  =form
+      ==
+    ::
+    ::  Convert initial form to eval-form
+    ::
+    ++  from-form
+      |=  =form
+      ^-  eval-form
+      form
+    ::
+    ::  The cases of results of +take
+    ::
+    +$  eval-result
+      $%  [%emit car=card]
+          [%fail err=(pair term tang)]
+          [%done value=a]
+      ==
+    ++  take
+      |=  [=eval-form =input]
+      ^-  [=eval-result _eval-form]
+      =*  take-loop  $
+      :: =?  car.input  ?=(^ car.input)
+      =/  =output  (form.eval-form input)
+      ?-    -.output
+          %emit  [[%emit card.output] eval-form]
+          %fail  [[%fail err.output] eval-form]
+          %done  [[%done value.output] eval-form]
+          %cont 
+        %_  take-loop
+          form.eval-form  self.output
+          input    [bowl.input ~]
+        ==
+      ==
+    --
+  --
 ::  $stud: mark name
 +$  stud
   $@  @tas                                 ::  auth=urbit