diff --git a/pkg/arvo/app/neo.hoon b/pkg/arvo/app/neo.hoon index b47c986baf..7882b711b7 100644 --- a/pkg/arvo/app/neo.hoon +++ b/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 [ + -- -- diff --git a/pkg/arvo/lib/form.hoon b/pkg/arvo/lib/form.hoon new file mode 100644 index 0000000000..36359a8e51 --- /dev/null +++ b/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)) +-- diff --git a/pkg/arvo/sur/neo.hoon b/pkg/arvo/sur/neo.hoon index 5a328ba0c3..39b71069de 100644 --- a/pkg/arvo/sur/neo.hoon +++ b/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