shrub/pkg/arvo/age/spider.hoon

235 lines
6.4 KiB
Plaintext
Raw Normal View History

2019-09-26 22:00:11 +03:00
/- spider
/+ libthread=thread, default-agent
2019-09-26 07:12:58 +03:00
=, thread=thread:libthread
|%
+$ card card:agent:mall
+$ state (map imp-name _*eval-form:[~!(. eval)]:(thread ,~))
2019-09-26 22:00:11 +03:00
+$ imp imp:spider
2019-09-26 07:12:58 +03:00
+$ imp-name term
+$ imput [=imp-name =cage]
--
^- agent:mall
=; spider-core
=| =state
|_ =bowl:mall
+* this .
2019-11-05 22:30:58 +03:00
sc ~(. spider-core bowl state)
def ~(. default-agent bowl this)
2019-09-26 07:12:58 +03:00
::
++ handle-init handle-init:def
++ handle-extract-state handle-extract-state:def
++ handle-upgrade-state handle-upgrade-state:def
++ handle-poke
|= [=mark =vase]
^- (quip card _this)
=^ cards state
?+ mark (handle-poke:def mark vase)
%spider-imput (handle-poke-imput:sc !<(imput vase))
2019-09-26 22:13:01 +03:00
%spider-start (handle-start-imp:sc !<([imp-name term] vase))
%spider-stop (handle-stop-imp:sc !<([imp-name ?] vase))
2019-09-26 07:12:58 +03:00
==
[cards this]
::
2019-10-11 01:30:24 +03:00
++ handle-subscribe
|= =path
^- (quip card _this)
=^ cards state
?+ path (handle-subscribe:def path)
[%imp @ *] (handle-subscribe:sc t.path)
==
[cards this]
::
2019-09-26 07:12:58 +03:00
++ handle-unsubscribe handle-unsubscribe:def
2019-09-29 07:44:31 +03:00
++ handle-peek
|= =path
^- (unit (unit cage))
?+ path (handle-peek:def path)
[%x %started @ ~] ``noun+!>((~(has by state) i.t.t.path))
==
::
++ handle-agent-response
|= [=wire =gift:agent:mall]
^- (quip card _this)
=^ cards state
?+ wire !!
[%imp @ *] (handle-agent-response:sc i.t.wire t.t.wire gift)
==
[cards this]
::
2019-09-26 07:12:58 +03:00
++ handle-arvo-response
|= [=wire =sign-arvo]
^- (quip card _this)
=^ cards state
?+ wire (handle-arvo-response:def wire sign-arvo)
2019-09-26 22:00:11 +03:00
[%imp @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
2019-09-29 07:44:31 +03:00
[%find @ ~] (handle-find:sc i.t.wire sign-arvo)
2019-09-26 22:00:11 +03:00
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
2019-09-26 07:12:58 +03:00
==
[cards this]
2019-09-29 07:44:31 +03:00
::
2019-09-26 07:12:58 +03:00
++ handle-error handle-error:def
--
::
|_ [=bowl:mall =state]
++ handle-poke-imput
|= imput
(take-input imp-name ~ %poke cage)
::
2019-10-11 01:30:24 +03:00
++ handle-subscribe
|= [=imp-name =path]
(take-input imp-name ~ %subscribe path)
::
2019-09-26 07:12:58 +03:00
++ handle-sign
|= [=imp-name =wire =sign-arvo]
(take-input imp-name ~ %sign wire sign-arvo)
::
2019-09-29 07:44:31 +03:00
++ handle-agent-response
|= [=imp-name =wire =gift:agent:mall]
(take-input imp-name ~ %agent wire gift)
::
2019-09-26 07:12:58 +03:00
++ handle-start-imp
2019-09-26 22:13:01 +03:00
|= [=imp-name =term]
2019-09-26 07:12:58 +03:00
^- (quip card ^state)
?: (~(has by state) imp-name)
~| [%already-started imp-name]
!!
2019-09-26 22:00:11 +03:00
=/ =card
2019-09-29 07:44:31 +03:00
=/ =schematic:ford [%path [our.bowl %home] %imp term]
[%pass /find/[imp-name] %arvo %f %build live=%.n schematic]
[[card ~] state]
::
++ handle-find
|= [=imp-name =sign-arvo]
^- (quip card ^state)
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
%- (slog leaf+"{<imp-name>} find incomplete" tang.result.sign-arvo)
`state
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
%- (slog leaf+"{<imp-name>} find error" message.build-result)
`state
?. ?=([%path *] +.build-result)
%- (slog leaf+"{<imp-name>} find strange" ~)
`state
=/ =card
=/ =schematic:ford [%core rail.build-result]
2019-09-26 22:00:11 +03:00
[%pass /build/[imp-name] %arvo %f %build live=%.y schematic]
[[card ~] state]
::
++ handle-build
|= [=imp-name =sign-arvo]
^- (quip card ^state)
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
2019-09-27 20:40:22 +03:00
%- (slog leaf+"{<imp-name>} build incomplete" tang.result.sign-arvo)
2019-09-26 22:00:11 +03:00
`state
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
2019-09-27 20:40:22 +03:00
%- (slog leaf+"{<imp-name>} build error" message.build-result)
2019-09-26 22:00:11 +03:00
`state
=/ =cage (result-to-cage:ford build-result)
?. ?=(%noun p.cage)
2019-09-27 20:40:22 +03:00
%- (slog leaf+"{<imp-name>} build not noun, is {<p.cage>}" ~)
2019-09-26 22:00:11 +03:00
`state
=/ maybe-imp (mule |.(!<(imp q.cage)))
?: ?=(%| -.maybe-imp)
2019-09-27 20:40:22 +03:00
%- (slog leaf+"{<imp-name>} not valid imp" p.maybe-imp)
2019-09-26 22:00:11 +03:00
`state
(start-imp imp-name p.maybe-imp)
::
++ start-imp
|= [=imp-name =imp]
^- (quip card ^state)
=^ cards-1 state
?. (~(has by state) imp-name)
`state
(imp-done imp-name)
2019-09-26 07:12:58 +03:00
=/ m (thread ,~)
2019-09-26 22:00:11 +03:00
=/ =eval-form:eval:m (from-form:eval:m (imp bowl))
2019-09-26 07:12:58 +03:00
=. state (~(put by state) imp-name eval-form)
=^ cards-2 state
(take-input imp-name ~)
[(weld cards-1 cards-2) state]
2019-09-26 07:12:58 +03:00
::
2019-09-29 07:44:31 +03:00
++ handle-stop-imp
|= [=imp-name nice=?]
2019-09-29 07:44:31 +03:00
^- (quip card ^state)
~? !(~(has by state) imp-name)
[%not-started imp-name]
?: nice
(imp-done imp-name)
2019-09-29 07:44:31 +03:00
(imp-fail imp-name %cancelled ~)
::
2019-09-26 07:12:58 +03:00
++ take-input
|= [=imp-name input=(unit input:thread)]
^- (quip card ^state)
=/ m (thread ,~)
?. (~(has by state) imp-name)
:: %- (slog leaf+"spider got input for non-existent {<imp-name>}" ~)
`state
2019-09-26 07:12:58 +03:00
=/ =eval-form:eval:m
(~(got by state) imp-name)
=| cards=(list card)
|- ^- (quip card ^state)
=^ r=[cards=(list card) =eval-result:eval:m] eval-form
=/ out
%- mule |.
(take:eval:m eval-form bowl input)
?- -.out
%& p.out
%| [[~ [%fail %crash p.out]] eval-form]
==
=. state (~(put by state) imp-name eval-form)
=. cards.r
%+ turn cards.r
|= =card
^- ^card
?+ card card
[%pass * *] [%pass [%imp imp-name p.card] q.card]
[%give %subscription-update *]
?~ path.p.card
card
card(path.p `[%imp imp-name u.path.p.card])
::
[%give %subscription-close *]
?~ path.p.card
card
card(path.p `[%imp imp-name u.path.p.card])
==
=. cards (weld cards cards.r)
=^ final-cards=(list card) state
?- -.eval-result.r
%next `state
%fail (imp-fail imp-name err.eval-result.r)
%done (imp-done imp-name)
==
[(weld cards final-cards) state]
::
++ imp-fail
|= [=imp-name =term =tang]
^- (quip card ^state)
%- (slog leaf+"thread {<imp-name>} failed" leaf+<term> tang)
(imp-clean imp-name)
2019-09-26 07:12:58 +03:00
::
++ imp-done
|= =imp-name
^- (quip card ^state)
%- (slog leaf+"thread {<imp-name>} finished" ~)
(imp-clean imp-name)
::
++ imp-clean
|= =imp-name
^- (quip card ^state)
:_ (~(del by state) imp-name)
:- [%pass /build/[imp-name] %arvo %f %kill ~]
%+ murn ~(tap by wex.bowl)
|= [[=wire =ship =term] [acked=? =path]]
^- (unit card)
?. ?& ?=([%imp @ *] wire)
=(imp-name i.t.wire)
==
~
`[%pass wire %agent [ship term] %unsubscribe ~]
2019-09-26 07:12:58 +03:00
--