gall: mall -> gall

This commit is contained in:
Philip Monk 2019-11-18 20:36:21 -08:00
parent 9862dccc0e
commit 6a406e6b29
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
46 changed files with 347 additions and 1643 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:bca023b8f390b694e3aff607a5436489acf518aad3b29096d013e8d67fd80bfa
size 8950597
oid sha256:26d1409f39a9e551d7f694fc39b8e9a0d8b317caeca91a73285bdd6b717919ca
size 9048500

View File

@ -45,8 +45,8 @@
=| state
=* all-state -
=<
^- agent:mall
|_ =bowl:mall
^- agent:gall
|_ =bowl:gall
+* this .
aqua-core +>
ac ~(. aqua-core bowl)
@ -55,7 +55,7 @@
++ on-save !>(all-state)
++ on-load
|= old-state=vase
^- step:agent:mall
^- step:agent:gall
~& prep=%aqua
=+ new=((soft state) !<(* old-state))
?~ new
@ -64,7 +64,7 @@
::
++ on-poke
|= [=mark =vase]
^- step:agent:mall
^- step:agent:gall
=^ cards all-state
?+ mark ~|([%aqua-bad-mark mark] !!)
%aqua-events (poke-aqua-events:ac !<((list aqua-event) vase))
@ -75,7 +75,7 @@
::
++ on-watch
|= =path
^- step:agent:mall
^- step:agent:gall
?: ?=([?(%effects %effect) ~] path)
`this
?. ?=([?(%effects %effect %evens %boths) @ ~] path)
@ -101,8 +101,8 @@
=| unix-effects=(jar ship unix-effect)
=| unix-events=(jar ship unix-timed-event)
=| unix-boths=(jar ship unix-both)
=| cards=(list card:agent:mall)
|_ hid=bowl:mall
=| cards=(list card:agent:gall)
|_ hid=bowl:gall
::
:: Represents a single ship's state.
::
@ -138,7 +138,7 @@
:: Send cards to host arvo
::
++ emit-cards
|= ms=(list card:agent:mall)
|= ms=(list card:agent:gall)
=. this (^emit-cards ms)
..abet-pe
::
@ -244,7 +244,7 @@
this
::
++ abet-aqua
^- (quip card:agent:mall state)
^- (quip card:agent:gall state)
=. this
=/ =path /effect
%- emit-cards
@ -296,7 +296,7 @@
[(flop cards) all-state]
::
++ emit-cards
|= ms=(list card:agent:mall)
|= ms=(list card:agent:gall)
=. cards (weld ms cards)
this
::
@ -324,7 +324,7 @@
::
++ poke-pill
|= p=pill
^- (quip card:agent:mall state)
^- (quip card:agent:gall state)
=. this apex-aqua =< abet-aqua
=. pil p
~& lent=(met 3 (jam boot-ova.pil))
@ -355,7 +355,7 @@
::
++ poke-noun
|= val=*
^- (quip card:agent:mall state)
^- (quip card:agent:gall state)
=. this apex-aqua =< abet-aqua
^+ this
:: Could potentially factor out the three lines of turn-ships
@ -378,7 +378,7 @@
%f %ford
%g %gall
%j %jael
%m %mall
%g %gall
==
=/ pax
/(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/[vane]
@ -426,7 +426,7 @@
::
++ poke-aqua-events
|= events=(list aqua-event)
^- (quip card:agent:mall state)
^- (quip card:agent:gall state)
=. this apex-aqua =< abet-aqua
%+ turn-events events
|= [ae=aqua-event thus=_this]

View File

@ -74,7 +74,7 @@
::
++ jael-update
|= =udiffs:point
^- (list card:agent:mall)
^- (list card:agent:gall)
?~ udiffs
~
=/ =path /(scot %p ship.i.udiffs)
@ -85,7 +85,7 @@
::
++ start
|= [state=app-state our=ship dap=term]
^- card:agent:mall
^- card:agent:gall
=/ args=vase !>
:* %watch /[dap]
url.state launch:contracts:azimuth
@ -97,15 +97,15 @@
::
=| state=app-state
%+ verb |
^- agent:mall
|_ =bowl:mall
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
:_ this :_ ~
^- card:agent:mall
^- card:agent:gall
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]
::
++ on-save !>(state)
@ -126,7 +126,7 @@
==
++ on-watch
|= =path
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?< =(/sole/drum path)
?> ?=(?(~ [@ ~]) path)
=/ who=(unit ship)
@ -142,7 +142,7 @@
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
?. ?=([%eth-watcher ~] wire)
(on-agent:def wire sign)
?. ?=(%fact -.sign)
@ -151,7 +151,7 @@
(on-agent:def wire sign)
=+ !<(diff=diff:eth-watcher q.cage.sign)
:_ this
^- (list card:agent:mall)
^- (list card:agent:gall)
%- jael-update
?- -.diff
%history (event-logs-to-udiffs loglist.diff)

View File

@ -63,14 +63,14 @@
[%help ~] :: print usage info
== ::
::
+$ card card:agent:mall
+$ card card:agent:gall
--
=| state
=* all-state -
=<
%+ verb |
^- agent:mall
|_ =bowl:mall
^- agent:gall
|_ =bowl:gall
+* this .
talk-core +>
tc ~(. talk-core(eny eny.bowl) bowl)
@ -110,7 +110,7 @@
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards all-state
?- -.sign
@ -128,7 +128,7 @@
++ on-fail on-fail:def
--
::
|_ =bowl:mall
|_ =bowl:gall
:: +prep: setup & state adapter
::
++ prep
@ -149,7 +149,7 @@
^- (quip card state)
=/ =inbox
.^ inbox
%mx
%gx
(scot %p our.bowl)
%chat-store
(scot %da now.bowl)
@ -711,7 +711,7 @@
?~(perm ~ `?=(%white kind.u.perm))
::TODO +permission-of-target?
.^ (unit permission)
%mx
%gx
(scot %p our-self)
%permission-store
(scot %da now.bowl)
@ -910,7 +910,7 @@
::TODO refactor
::TODO remote scries fail... but moon support?
.^ (set path)
%mx
%gx
/(scot %p our-self)/chat-store/(scot %da now.bowl)/keys/noun
==
%+ turn ~(tap in all)

View File

@ -2,7 +2,7 @@
::
/+ *chat-json, *chat-eval, default-agent
|%
+$ card card:agent:mall
+$ card card:agent:gall
+$ versioned-state
$% state-zero
==
@ -21,9 +21,9 @@
::
=| state-zero
=* state -
^- agent:mall
^- agent:gall
=<
|_ =bowl:mall
|_ =bowl:gall
+* this .
chat-core +>
cc ~(. chat-core bowl)
@ -99,7 +99,7 @@
--
::
::
|_ bol=bowl:mall
|_ bol=bowl:gall
::
++ peek-x-envelopes
|= pax=path

View File

@ -9,13 +9,13 @@
=, format
::
%+ verb &
^- agent:mall
|_ =bowl:mall
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
=/ launcha
[%launch-action !>([%clock /tile '/~clock/js/tile.js'])]
:_ this
@ -26,7 +26,7 @@
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
@ -50,7 +50,7 @@
::
++ on-watch
|= =path
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?: ?=([%http-response *] path)
`this
?. =(/tile path)
@ -62,7 +62,7 @@
++ on-agent on-agent:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]

View File

@ -4,7 +4,7 @@
:: app types and boilerplate
::
=> |%
+$ card card:agent:mall
+$ card card:agent:gall
+$ app-state
$: %0
requested=(map ship address:dns)
@ -31,9 +31,9 @@
[%give %fact `the-path cage]
--
::
^- agent:mall
^- agent:gall
=| state=app-state
|_ =bowl:mall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::

View File

@ -303,7 +303,7 @@
++ xsell `$-(vase tank)`vase-to-tank:pprint
::
++ he :: per session
|_ {hid/bowl:mall =id moz/(list card:agent:mall) session}
|_ {hid/bowl:gall =id moz/(list card:agent:gall) session}
::
++ he-beam
^- beam
@ -821,7 +821,7 @@
[(flop moz) %_(state hoc (~(put by hoc) id +<+>+))]
::
++ he-card :: emit gift
|= =card:agent:mall
|= =card:agent:gall
^+ +>
=? card ?=(%pass -.card)
card(p [id p.card])
@ -908,7 +908,7 @@
== ==
::
++ he-unto :: result from agent
|= {way/wire cit/sign:agent:mall}
|= {way/wire cit/sign:agent:gall}
^+ +>
?. ?=($poke-ack -.cit)
~& [%strange-unto cit]
@ -918,7 +918,7 @@
(he-diff %tan u.p.cit)
::
++ he-wool
|= [way=wire =sign:agent:mall]
|= [way=wire =sign:agent:gall]
^+ +>
?- -.sign
%poke-ack
@ -1205,8 +1205,8 @@
!>([our=our now=now eny=eny]:hid)
--
--
^- agent:mall
|_ hid=bowl:mall
^- agent:gall
|_ hid=bowl:gall
++ on-init
`..on-init
::
@ -1220,9 +1220,9 @@
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:mall _..on-init)
^- (quip card:agent:gall _..on-init)
=^ moves state
^- (quip card:agent:mall house)
^- (quip card:agent:gall house)
?+ mark ~|([%dojo-poke-bad-mark mark] !!)
%sole-action
=+ !<([=id =sole-action] vase)
@ -1254,7 +1254,7 @@
::
++ on-watch
|= =path
^- (quip card:agent:mall _..on-init)
^- (quip card:agent:gall _..on-init)
~? !=(our.hid src.hid) [%dojo-peer-stranger src.hid]
?> (team:title our.hid src.hid)
?> ?=([%sole @ ~] path)
@ -1278,7 +1278,7 @@
*(unit (unit cage))
::
++ on-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
?> ?=([@ @ *] wire)
=/ =session (~(got by hoc) i.wire)
=/ he-full ~(. he hid i.wire ~ session)
@ -1308,7 +1308,7 @@
++ on-fail
|= [=term =tang]
=/ sessions=(list (pair id session)) ~(tap by hoc)
|- ^- (quip card:agent:mall _..on-init)
|- ^- (quip card:agent:gall _..on-init)
?~ sessions
[~ ..on-init]
=^ cards-1 state

View File

@ -10,7 +10,7 @@
--
::
=> |%
+$ card card:agent:mall
+$ card card:agent:gall
+$ app-state
$: %0
dogs=(map path watchdog)
@ -61,10 +61,10 @@
::
:: Main
::
^- agent:mall
^- agent:gall
=| state=app-state
%+ verb &
|_ =bowl:mall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
@ -130,7 +130,7 @@
::
++ on-watch
|= =path
^- (quip card agent:mall)
^- (quip card agent:gall)
?. ?=([%logs ^] path)
~| [%invalid-subscription-path path]
!!
@ -160,9 +160,9 @@
!>(number:(~(got by dogs.state) t.t.path))
::
++ on-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
|^
^- (quip card agent:mall)
^- (quip card agent:gall)
?. ?=([%running *] wire)
(on-agent:def wire sign)
?- -.sign
@ -270,7 +270,7 @@
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card agent:mall)
^- (quip card agent:gall)
?+ +<.sign-arvo ~|([%strange-sign-arvo -.sign-arvo] !!)
%wake
=; rest
@ -287,9 +287,9 @@
=/ dogs=(list [=path dog=watchdog]) ~(tap by dogs.state)
=| cards=(list card)
=/ tid-gen ~(. og eny.bowl)
^- (quip card agent:mall)
^- (quip card agent:gall)
=- [(flop -<) ->]
|- ^- (quip card agent:mall)
|- ^- (quip card agent:gall)
=* loop $
?~ dogs
[cards this]

View File

@ -24,16 +24,16 @@
+$ pith ~
++ take
|~ [wire sign-arvo]
*(quip card:agent:mall part)
*(quip card:agent:gall part)
++ take-agent
|~ [wire gift:agent:mall]
*(quip card:agent:mall part)
|~ [wire gift:agent:gall]
*(quip card:agent:gall part)
++ poke
|~ [mark vase]
*(quip card:agent:mall part)
*(quip card:agent:gall part)
--
|= [bowl:mall own=part]
|_ moz=(list card:agent:mall)
|= [bowl:gall own=part]
|_ moz=(list card:agent:gall)
++ abet [(flop moz) own]
--
--
@ -83,11 +83,11 @@
:: :: ::
:::: :: :: app proper
:: :: ::
^- agent:mall
^- agent:gall
=| hood-1 :: module states
=> |%
++ help
|= hid/bowl:mall
|= hid/bowl:gall
|%
++ able :: find+make part
=+ hed=$:hood-head
@ -124,9 +124,9 @@
|* handle/_finish
|= a=_+<.handle
=. +>.handle (start hid (able identity))
^- (quip card:agent:mall _lac)
^- (quip card:agent:gall _lac)
%- ably
^- (quip card:agent:mall hood-part)
^- (quip card:agent:gall hood-part)
(handle a)
:: per-module interface wrappers
++ from-drum (from-module %drum [..$ _se-abet]:(hood-drum))
@ -135,7 +135,7 @@
++ from-write (from-module %write [..$ _abet]:(hood-write))
--
--
|_ hid/bowl:mall :: gall environment
|_ hid/bowl:gall :: gall environment
++ on-init
`..on-init
::
@ -149,7 +149,7 @@
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=/ h (help hid)
=^ cards lac
?: =(%helm (end 3 4 mark))
@ -189,7 +189,7 @@
*(unit (unit cage))
::
++ on-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
=/ h (help hid)
=^ cards lac
?+ wire ~|([%hood-bad-wire wire] !!)

View File

@ -4,7 +4,7 @@
rune-snippet=language-server-rune-snippet,
default-agent
|%
+$ card card:agent:mall
+$ card card:agent:gall
+$ lsp-req
$: uri=@t
$% [%sync changes=(list change)]
@ -28,18 +28,18 @@
::
+$ all-state bufs=(map uri=@t buf=wall)
--
^- agent:mall
^- agent:gall
=| all-state
=* state -
=<
|_ =bowl:mall
|_ =bowl:gall
+* this .
lsp-core +>
lsp ~(. lsp-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^+ on-init:*agent:mall
^+ on-init:*agent:gall
^- (quip card _this)
~& > %lsp-init
:_ this :_ ~
@ -50,14 +50,14 @@
::
++ on-save !>(state)
++ on-load
^+ on-load:*agent:mall
^+ on-load:*agent:gall
|= old-state=vase
^- (quip card _this)
~& > %lsp-upgrade
[~ this(state !<(all-state old-state))]
::
++ on-poke
^+ on-poke:*agent:mall
^+ on-poke:*agent:gall
|= [=mark =vase]
^- (quip card _this)
=^ cards state
@ -72,7 +72,7 @@
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
^+ on-arvo:*agent:mall
^+ on-arvo:*agent:gall
|= [=wire =sign-arvo]
^- (quip card _this)
=^ cards state
@ -84,7 +84,7 @@
++ on-fail on-fail:def
--
::
|_ bow=bowl:mall
|_ bow=bowl:gall
::
++ parser
=, dejs:format

View File

@ -19,7 +19,7 @@
--
::
=| =state
|_ =bowl:mall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
@ -31,7 +31,7 @@
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
@ -64,7 +64,7 @@
::
++ on-watch
|= =path
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?: ?=([%http-response *] path)
`this
(on-watch:def path)
@ -72,8 +72,8 @@
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent
|= [=wire =sign:agent:mall]
^- (quip card:agent:mall _this)
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall _this)
|^
?+ wire (on-agent:def wire sign)
[%import ~]
@ -123,7 +123,7 @@
::
++ take-export
|= data=*
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?> ?=(^ job.state)
?> ?=(%export -.source.com.u.job.state)
=/ app-name=tape (trip app.source.com.u.job.state)
@ -141,7 +141,7 @@
::
++ take-sole-effect
|= fec=sole-effect
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
=/ out
|- ^- (unit lens-out)
=* loop $
@ -205,7 +205,7 @@
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]

View File

@ -2,7 +2,7 @@
/+ libstrand=strand, default-agent, verb
=, strand=strand:libstrand
|%
+$ card card:agent:mall
+$ card card:agent:gall
+$ thread thread:spider
+$ tid tid:spider
+$ input input:spider
@ -103,11 +103,11 @@
(welp next-1 next-2)
--
::
^- agent:mall
^- agent:gall
=| =state
=<
%+ verb |
|_ =bowl:mall
|_ =bowl:gall
+* this .
spider-core +>
sc ~(. spider-core bowl)
@ -168,7 +168,7 @@
==
::
++ on-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards state
?+ wire !!
@ -195,7 +195,7 @@
(on-load on-save)
--
::
|_ =bowl:mall
|_ =bowl:gall
++ on-poke-input
|= input
=/ yarn (~(got by tid.state) tid)
@ -219,7 +219,7 @@
(take-input u.yarn ~ %sign wire sign-arvo)
::
++ on-agent
|= [=tid =wire =sign:agent:mall]
|= [=tid =wire =sign:agent:gall]
=/ yarn (~(get by tid.state) tid)
?~ yarn
%- (slog leaf+"spider got agent for non-existent {<tid>}" ~)
@ -434,7 +434,7 @@
[(welp cards-children cards-our) state]
::
++ convert-bowl
|= [=yarn =bowl:mall]
|= [=yarn =bowl:gall]
^- bowl:spider
:* our.bowl
src.bowl

View File

@ -1,7 +1,7 @@
/+ default-agent
::
|%
+$ card card:agent:mall
+$ card card:agent:gall
+$ test
$% [%arvo ~] ::UNIMPLEMENTED
[%marks ~] ::UNIMPLEMENTED
@ -34,8 +34,8 @@
::
=, ford
=, format
^- agent:mall
|_ =bowl:mall
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::

View File

@ -3,7 +3,7 @@
|= [[now=@da *] ~ *]
:- %tang
=/ tree
.^((list (list tid:spider)) %mx /=spider/(scot %da now)/tree/noun)
.^((list (list tid:spider)) %gx /=spider/(scot %da now)/tree/noun)
%+ turn tree
|= yarn=(list tid:spider)
>`path`yarn<

View File

@ -7,11 +7,11 @@
|_ bowl:spider
++ handle-unix-effect
|~ [ship unix-effect]
*(quip card:agent:mall _^|(..handle-unix-effect))
*(quip card:agent:gall _^|(..handle-unix-effect))
::
++ handle-arvo-response
|~ [wire sign-arvo]
*(quip card:agent:mall _^|(..handle-unix-effect))
*(quip card:agent:gall _^|(..handle-unix-effect))
--
--
::

View File

@ -1,204 +0,0 @@
|* [input-type=mold card-type=mold contract-type=mold]
|%
+$ async-input [=bowl:gall in=(unit [=wire sign=input-type])]
+$ async-move (pair bone card-type)
::
:: cards: cards to send immediately. These will go out even if a
:: later stage of the computation fails, so they shouldn't have
:: any semantic effect on the rest of the system.
:: Alternately, they may record an entry in contracts with
:: enough information to undo the effect if the computation
:: fails.
:: effects: moves to send after the computation ends.
:: contracts: stuff to cancel at end of computation.
:: wait: don't move on, stay here. The next sign should come back
:: to this same callback.
:: cont: continue computation with new callback.
:: fail: abort computation; don't send effects
:: done: finish computation; send effects
::
+$ contract-delta
$% [%gain =bone]
[%lose ~]
==
::
++ async-output-raw
|* a=mold
$~ [~ ~ ~ %done *a]
$: cards=(list card-type)
effects=(list async-move)
contracts=(map contract-type contract-delta)
$= next
$% [%wait ~]
[%cont self=(async-form-raw a)]
[%fail err=(pair term tang)]
[%done value=a]
==
==
::
++ async-form-raw
|* a=mold
$-(async-input (async-output-raw a))
::
:: Abort asynchronous computation with error message
::
++ async-fail
|= err=(pair term tang)
|= async-input
[~ ~ ~ %fail err]
::
:: Asynchronous transcaction monad.
::
:: Combo of four monads:
:: - Reader on input-type
:: - Writer on card-type
:: - Continuation
:: - Exception
::
++ async
|* a=mold
|%
++ output (async-output-raw a)
::
:: Type of an asynchronous computation.
::
++ form (async-form-raw a)
::
:: Monadic pure. Identity computation for bind.
::
++ pure
|= arg=a
^- form
|= async-input
[~ ~ ~ %done arg]
::
:: Monadic bind. Combines two computations, associatively.
::
++ bind
|* b=mold
|= [m-b=(async-form-raw b) fun=$-(b form)]
^- form
|= input=async-input
=/ b-res=(async-output-raw b)
(m-b input)
^- output
:^ cards.b-res effects.b-res contracts.b-res
?- -.next.b-res
%wait [%wait ~]
%cont [%cont ..$(m-b self.next.b-res)]
%fail [%fail err.next.b-res]
%done [%cont (fun value.next.b-res)]
==
::
:: The async monad must be evaluted in a particular way to maintain
:: its monadic character. +take:eval implements this.
::
++ eval
|%
:: Indelible state of a async
::
+$ eval-form
$: effects=(list async-move)
contracts=(map contract-type bone)
=form
==
::
:: Convert initial form to eval-form
::
++ from-form
|= =form
^- eval-form
[~ ~ form]
::
:: The cases of results of +take
::
+$ eval-result
$% [%next ~]
[%fail contracts=(map contract-type bone) err=(pair term tang)]
[%done contracts=(map contract-type bone) value=a]
==
::
:: Take a new sign and run the async against it
::
++ take
:: moves: accumulate throughout recursion the moves to be
:: produced now
=| moves=(list async-move)
|= [=eval-form =bone =async-input]
^- [[(list async-move) =eval-result] _eval-form]
=* take-loop $
:: run the async callback
::
=/ =output (form.eval-form async-input)
:: add cards to moves
::
=. moves
%+ welp
moves
%+ turn cards.output
|= card=card-type
^- async-move
[bone card]
:: add effects to list to be produced when done
::
=. effects.eval-form
(weld effects.eval-form effects.output)
:: add or remove contracts
::
=>
=* loop-result .
=/ new=(list [contract=contract-type delta=contract-delta])
~(tap by contracts.output)
|- ^+ loop-result
=* loop $
?~ new
loop-result
=/ exists=?
(~(has by contracts.eval-form) contract.i.new)
?- -.delta.i.new
:: add contract and bone
::
%gain
?: exists
%= loop-result
next.output [%fail %contract-already-exists >contract.i.new< ~]
==
%= loop
contracts.eval-form (~(put by contracts.eval-form) [contract bone.delta]:i.new)
new t.new
==
:: remove contract
::
%lose
?: exists
%= loop
contracts.eval-form (~(del by contracts.eval-form) contract.i.new)
new t.new
==
%= loop-result
next.output [%fail %contract-doesnt-exist >contract.i.new< ~]
==
==
:: if done, produce effects
::
=? moves ?=(%done -.next.output)
%+ welp
moves
effects.eval-form
:: case-wise handle next steps
::
?- -.next.output
%wait [[moves %next ~] eval-form]
%fail [[moves %fail contracts.eval-form err.next.output] eval-form]
%done [[moves %done contracts.eval-form value.next.output] eval-form]
%cont
:: recurse to run continuation with initialization input
::
%_ take-loop
form.eval-form self.next.output
async-input [bowl.async-input ~]
==
==
--
--
--

View File

@ -1,6 +1,6 @@
|%
++ eval
|= [=bowl:mall =hoon]
|= [=bowl:gall =hoon]
^- (list tank)
=/ subj=[our=@p now=@da eny=@uvJ]
:+ our.bowl

View File

@ -3,7 +3,7 @@
?: ?=(%& help)
~| %default-agent-helpfully-crashing
skeleton
|_ =bowl:mall
|_ =bowl:gall
++ on-init
`agent
::
@ -34,8 +34,8 @@
!!
::
++ on-agent
|= [=wire =sign:agent:mall]
^- (quip card:agent:mall _agent)
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall _agent)
?- -.sign
%poke-ack
?~ p.sign

View File

@ -149,11 +149,11 @@
::
::::
::
|= {hid/bowl:mall part} :: main drum work
|= {hid/bowl:gall part} :: main drum work
=/ ost 0
=+ (~(gut by bin) ost *source)
=* dev -
|_ {moz/(list card:agent:mall) biz/(list dill-blit:dill)}
|_ {moz/(list card:agent:gall) biz/(list dill-blit:dill)}
++ diff-sole-effect-phat :: app event
|= {way/wire fec/sole-effect}
=< se-abet =< se-view
@ -170,7 +170,7 @@
::
++ poke-set-boot-apps ::
|= lit/?
^- (quip card:agent:mall part)
^- (quip card:agent:gall part)
:: We do not run se-abet:se-view here because that starts the apps,
:: and some apps are not ready to start (eg Talk crashes because the
:: terminal has width 0). It appears the first message to drum must
@ -262,7 +262,7 @@
==
::
++ take-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
?+ wire ~|([%drum-bad-take-agent wire -.sign] !!)
[%drum %phat *]
?- -.sign
@ -287,11 +287,11 @@
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip card:agent:mall part)
^- (quip card:agent:gall part)
=* pith +<+.$
=. . se-subze:se-adze:se-adit
:_ pith(bin (~(put by bin) ost dev))
^- (list card:agent:mall)
^- (list card:agent:gall)
?~ biz (flop moz)
:_ (flop moz)
=/ =dill-blit:dill ?~(t.biz i.biz [%mor (flop biz)])
@ -310,7 +310,7 @@
=. +>.$ (se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
%- se-emit(fur (~(put by fur) q.wel ~))
=/ =wire [%drum p.wel q.wel ~]
[%pass wire %arvo %m %conf [our.hid q.wel] our.hid p.wel]
[%pass wire %arvo %g %conf [our.hid q.wel] our.hid p.wel]
::
++ se-adze :: update connections
^+ .
@ -519,7 +519,7 @@
(se-just ta-vew:(se-tame u.gul))
::
++ se-emit
|= card:agent:mall
|= card:agent:gall
%_(+> moz [+< moz])
::
++ se-text :: return text

View File

@ -33,16 +33,16 @@
:: :: ::
:::: :: ::
:: :: ::
|: $:{bowl:mall part} :: main helm work
|: $:{bowl:gall part} :: main helm work
=/ ost 0
=+ sez=(~(gut by hoc) ost $:session)
=| moz=(list card:agent:mall)
=| moz=(list card:agent:gall)
|%
++ abet
[(flop moz) %_(+<+.$ hoc (~(put by hoc) ost sez))]
::
++ emit
|= card:agent:mall
|= card:agent:gall
%_(+> moz [+< moz])
::
++ flog
@ -50,7 +50,7 @@
(emit %pass /di %arvo %d %flog flog)
::
++ emil :: return cards
|= (list card:agent:mall)
|= (list card:agent:gall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
@ -174,7 +174,7 @@
|= hood-reset
=< abet
%- emil %- flop
^- (list card:agent:mall)
^- (list card:agent:gall)
=/ top=path /(scot %p our)/home/(scot %da now)/sys
=/ hun .^(@ %cx (welp top /hoon/hoon))
=/ arv .^(@ %cx (welp top /arvo/hoon))
@ -216,7 +216,7 @@
==
::
++ take-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
?+ wire ~|([%helm-bad-take-agent wire -.sign] !!)
[%helm %hi *] ?> ?=(%poke-ack -.sign)
(coup-hi t.t.wire p.sign)

View File

@ -57,18 +57,18 @@
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:mall part} :: main kiln work
|= {bowl:gall part} :: main kiln work
?> =(src our)
|_ moz/(list card:agent:mall)
|_ moz/(list card:agent:gall)
++ abet :: resolve
[(flop moz) `part`+<+.$]
::
++ emit
|= card:agent:mall
|= card:agent:gall
%_(+> moz [+< moz])
::
++ emil :: return cards
|= (list card:agent:mall)
|= (list card:agent:gall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
@ -211,7 +211,7 @@
++ autoload
|%
++ emit
|= a/card:agent:mall
|= a/card:agent:gall
+>(..autoload (^emit a))
::
++ tracked-vanes
@ -300,9 +300,9 @@
::
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
abet:(emit %pass /kiln %arvo %m %goad force agent)
abet:(emit %pass /kiln %arvo %g %goad force agent)
::
++ poke-wash-gall |=(* abet:(emit %pass /kiln %arvo %m [%wash ~]))
++ poke-wash-gall |=(* abet:(emit %pass /kiln %arvo %g [%wash ~]))
::
++ mack
|= {way/wire saw/(unit tang)}
@ -310,7 +310,7 @@
abet
::
++ take-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
?+ wire ~|([%kiln-bad-take-agent wire -.sign] !!)
[%kiln %fancy *] ?> ?=(%poke-ack -.sign)
(take-coup-fancy t.t.wire p.sign)
@ -448,7 +448,7 @@
..auto(syn (~(put by syn) [syd her sud] let))
::
++ blab
|= new/(list card:agent:mall)
|= new/(list card:agent:gall)
^+ +>
+>.$(moz (welp new moz))
::
@ -558,7 +558,7 @@
..work(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab
|= new/(list card:agent:mall)
|= new/(list card:agent:gall)
^+ +>
+>.$(moz (welp new moz))
::

View File

@ -19,12 +19,12 @@
::
::::
::
|= {bowl:mall part}
|= {bowl:gall part}
=* par +<+
|_ moz/(list card:agent:mall)
|_ moz/(list card:agent:gall)
++ abet [(flop moz) `part`par]
++ emit
|= =card:agent:mall
|= =card:agent:gall
%_(+> moz :_(moz card))
::
++ beak-now byk(r [%da now])
@ -138,6 +138,6 @@
+>.sign-arvo
::
++ take-agent
|= [=wire =sign:agent:mall]
|= [=wire =sign:agent:gall]
~|([%write-bad-take-agent wire -.sign] !!)
--

View File

@ -101,7 +101,7 @@
++ scry-aqua
|* [a=mold our=@p now=@da pax=path]
.^ a
%mx
%gx
(scot %p our)
%aqua
(scot %da now)

View File

@ -45,7 +45,7 @@
[%f /vane/ford]
:: sys/vane/gall: applications
::
[%m /vane/mall]
[%g /vane/gall]
:: sys/vane/iris: http client
::
[%i /vane/iris]

View File

@ -41,7 +41,7 @@
::
++ give-simple-payload
|= [eyre-id=@ta =simple-payload:http]
^- (list card:agent:mall)
^- (list card:agent:gall)
=/ header-cage
[%http-response-header !>(response-header.simple-payload)]
=/ data-cage

View File

@ -1,8 +1,8 @@
:: Similar to default-agent except crashes everywhere
^- agent:mall
|_ bowl:mall
^- agent:gall
|_ bowl:gall
++ on-init
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
!!
::
++ on-save
@ -11,22 +11,22 @@
::
++ on-load
|~ old-state=vase
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
!!
::
++ on-poke
|~ in-poke-data=cage
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
!!
::
++ on-watch
|~ path
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
!!
::
++ on-leave
|~ path
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
!!
::
++ on-peek
@ -35,17 +35,17 @@
!!
::
++ on-agent
|~ [wire sign:agent:mall]
^- (quip card:agent:mall agent:mall)
|~ [wire sign:agent:gall]
^- (quip card:agent:gall agent:gall)
!!
::
++ on-arvo
|~ [wire =sign-arvo]
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
!!
::
++ on-fail
|~ [term tang]
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
!!
--

View File

@ -1,442 +0,0 @@
:: Standard input/output functions.
::
:: These are all asynchronous computations, which means they produce a
:: form:(async A) for some type A. You can always tell what they
:: produce by checking their first three lines.
::
:: Functions with the word "raw" in their name are for internal use
:: only because they carry a high salmonella risk. More specifcally,
:: improper use of them may result in side effects that the tapp
:: runtime doesn't know about and can't undo in case the transaction
:: fails.
::
/- tapp-sur=tapp
/+ async
|* [poke-data=mold out-peer-data=mold]
=/ tapp-sur (tapp-sur poke-data out-peer-data)
=, card=card:tapp-sur
=, sign=sign:tapp-sur
=, contract=contract:tapp-sur
=+ (async sign card contract)
|%
::
:: Raw power
::
++ send-raw-card
|= =card
=/ m (async ,~)
^- form:m
|= =async-input
[[card]~ ~ ~ %done ~]
::
:: Add or remove a contract
::
++ set-raw-contract
|= [add=? =contract]
=/ m (async ,~)
^- form:m
|= =async-input
=/ delta=contract-delta:async
?.(add [%lose ~] [%gain ost.bowl.async-input])
[~ ~ (my [contract delta] ~) %done ~]
::
:: Send effect on current bone
::
++ send-effect
|= =card
=/ m (async ,~)
^- form:m
;< =bone bind:m
|= =async-input
[~ ~ ~ %done ost.bowl.async-input]
(send-effect-on-bone bone card)
::
:: Send effect on particular bone
::
++ send-effect-on-bone
|= [=bone =card]
=/ m (async ,~)
^- form:m
|= async-input
[~ [bone card]~ ~ %done ~]
::
:: ----
::
:: Scry from the namespace.
::
:: Direct scrys are impossible in a tapp, so this routes around that.
::
++ scry
|* result-type=mold
|= =path
=/ m (async ,result-type)
;< ~ bind:m (send-raw-card %scry path)
|= =async-input
:^ ~ ~ ~
?~ in.async-input
[%wait ~]
?. ?=(%scry-result -.sign.u.in.async-input)
[%fail %expected-scry-result >got=-.sign< ~]
[%done (result-type result.sign.u.in.async-input)]
::
:: ----
::
:: Outgoing HTTP requests
::
++ send-request
|= =request:http
=/ m (async ,~)
^- form:m
=/ =card
[%request / request *outbound-config:iris]
;< ~ bind:m (send-raw-card card)
(set-raw-contract & %request ~)
::
++ send-hiss
|= =hiss:eyre
=/ m (async ,~)
^- form:m
(send-request (hiss-to-request:html hiss))
::
:: Wait until we get an HTTP response or cancelation
::
++ take-response-raw
=/ m (async (unit client-response:iris))
^- form:m
|= =async-input
:^ ~ ~ ~
?~ in.async-input
[%wait ~]
=* sign sign.u.in.async-input
:: fail on anything other than an http-response
::
?. ?=(%http-response -.sign)
[%fail %expected-http-response >got=-.sign< ~]
?- -.response.sign
:: ignore progress notifications
::
%progress
[%wait ~]
::
%cancel
[%done ~]
::
%finished
[%done (some response.sign)]
==
:: Wait until we get an HTTP response or cancelation and unset contract
::
++ take-maybe-response
=/ m (async (unit client-response:iris))
^- form:m
;< rep=(unit client-response:iris) bind:m
take-response-raw
;< ~ bind:m (set-raw-contract | %request ~)
(pure:m rep)
::
:: Wait until we get an HTTP response and unset contract
::
++ take-response
=/ m (async (unit client-response:iris))
^- form:m
;< rep=(unit client-response:iris) bind:m
take-maybe-response
?^ rep
(pure:m rep)
|= =async-input
[~ ~ ~ %fail %http-canceled ~]
::
:: Wait until we get an HTTP response or cancelation and unset contract
::
++ take-maybe-sigh
=/ m (async (unit httr:eyre))
^- form:m
;< rep=(unit client-response:iris) bind:m
take-maybe-response
?~ rep
(pure:m ~)
:: XX s/b impossible
::
?. ?=(%finished -.u.rep)
(pure:m ~)
(pure:m (some (to-httr:iris +.u.rep)))
::
:: Wait until we get an HTTP response and unset contract
::
++ take-sigh
=/ m (async ,httr:eyre)
^- form:m
;< rep=(unit httr:eyre) bind:m take-maybe-sigh
?^ rep
(pure:m u.rep)
|= =async-input
[~ ~ ~ %fail %http-canceled ~]
::
:: Extract body from raw httr
::
++ extract-httr-body
|= =httr:eyre
=/ m (async ,cord)
^- form:m
?. =(2 (div p.httr 100))
(async-fail %httr-error >p.httr< >+.httr< ~)
?~ r.httr
(async-fail %expected-httr-body >httr< ~)
(pure:m q.u.r.httr)
::
:: Parse cord to json
::
++ parse-json
|= =cord
=/ m (async ,json)
^- form:m
=/ json=(unit json) (de-json:html cord)
?~ json
(async-fail %json-parse-error ~)
(pure:m u.json)
::
:: Fetch json at given url
::
++ fetch-json
|= url=tape
=/ m (async ,json)
^- form:m
=/ =hiss:eyre
:* purl=(scan url auri:de-purl:html)
meth=%get
math=~
body=~
==
;< ~ bind:m (send-hiss hiss)
;< =httr:eyre bind:m take-sigh
;< =cord bind:m (extract-httr-body httr)
(parse-json cord)
::
:: ----
::
:: Incoming HTTP requests
::
++ bind-route-raw
|= [=binding:eyre =term]
=/ m (async ,~)
^- form:m
(send-raw-card [%connect / binding term])
::
++ take-bound
=/ m (async ?)
^- form:m
|= =async-input
:^ ~ ~ ~
?~ in.async-input
[%wait ~]
=* sign sign.u.in.async-input
?. ?=(%bound -.sign)
[%fail %expected-bound >got=-.sign< ~]
[%done success.sign]
::
++ bind-route
|= [=binding:eyre =term]
=/ m (async ?)
^- form:m
;< ~ bind:m (bind-route-raw binding term)
take-bound
::
:: ----
::
:: Identity is immutable
::
:: XX should be statefully cycled
::
++ get-identity
=/ m (async ,@p)
^- form:m
|= =async-input
[~ ~ ~ %done our.bowl.async-input]
::
:: Entropy is always increasing
::
++ get-entropy
=/ m (async ,@uvJ)
^- form:m
|= =async-input
[~ ~ ~ %done eny.bowl.async-input]
::
:: ----
::
:: Time is what keeps everything from happening at once
::
++ get-time
=/ m (async ,@da)
^- form:m
|= =async-input
[~ ~ ~ %done now.bowl.async-input]
::
:: Set a timer
::
++ send-wait
|= at=@da
=/ m (async ,~)
^- form:m
;< ~ bind:m (send-raw-card %wait /note/(scot %da at) at)
(set-raw-contract & %wait at)
::
:: Wait until we get a wake event
::
++ take-wake-raw
=/ m (async ,@da)
^- form:m
|= =async-input
:^ ~ ~ ~
?~ in.async-input
[%wait ~]
?. ?=(%wake -.sign.u.in.async-input)
[%fail %expected-wake >got=-.sign.u.in.async-input< ~]
?~ wire.u.in.async-input
[%fail %expected-wake-time ~]
=/ at=(unit @da) (slaw %da i.wire.u.in.async-input)
?~ at
[%fail %expected-wake-time-da >wire< ~]
[%done u.at]
::
:: Wait until we get a wake event and unset contract
::
++ take-wake
=/ m (async ,~)
^- form:m
;< at=@da bind:m take-wake-raw
(set-raw-contract | %wait at)
::
:: Wait until time
::
++ wait
|= until=@da
=/ m (async ,~)
^- form:m
;< ~ bind:m (send-wait until)
take-wake
::
:: Wait until time then start new computation
::
++ wait-effect
|= until=@da
=/ m (async ,~)
^- form:m
(send-effect %wait /effect/(scot %da until) until)
::
:: Cancel computation if not done by time
::
++ set-timeout
|* computation-result=mold
=/ m (async ,computation-result)
|= [when=@da computation=form:m]
^- form:m
;< ~ bind:m (send-wait when)
|= =async-input
=* loop $
?: ?& ?=([~ * %wake *] in.async-input)
=(/(scot %da when) wire.u.in.async-input)
==
[~ ~ (my [[%wait when] [%lose ~]] ~) %fail %async-timeout ~]
=/ c-res (computation async-input)
?. ?=(%cont -.next.c-res)
c-res
c-res(self.next ..loop(computation self.next.c-res))
::
:: ----
::
:: Output
::
++ flog
|= =flog:dill
=/ m (async ,~)
^- form:m
(send-raw-card %flog / flog)
::
++ flog-text
|= =tape
=/ m (async ,~)
^- form:m
(flog %text tape)
::
++ flog-tang
|= =tang
=/ m (async ,~)
^- form:m
=/ =wall
(zing (turn (flop tang) (cury wash [0 80])))
|- ^- form:m
=* loop $
?~ wall
(pure:m ~)
;< ~ bind:m (flog-text i.wall)
loop(wall t.wall)
::
:: ----
::
:: Apps
::
++ poke-app
|= [[her=ship app=term] =poke-data]
=/ m (async ,~)
^- form:m
=/ =wire /(scot %p her)/[app]
(send-effect %poke wire [her app] poke-data)
::
++ peer-app
|= [[her=ship app=term] =path]
=/ m (async ,~)
^- form:m
=/ =wire (weld /(scot %p her)/[app] path)
(send-effect %peer wire [her app] path)
::
++ pull-app
|= [[her=ship app=term] =path]
=/ m (async ,~)
^- form:m
=/ =wire (weld /(scot %p her)/[app] path)
(send-effect %pull wire [her app] ~)
::
:: ----
::
:: Handle subscriptions
::
:: Get bones at particular path; for internal use only
::
++ get-bones-on-path
|= =the=path
=/ m (async ,(list bone))
^- form:m
|= =async-input
:^ ~ ~ ~
:- %done
%+ murn ~(tap by sup.bowl.async-input)
|= [ost=bone her=ship =sub=path]
^- (unit bone)
?. =(the-path sub-path)
~
`ost
::
:: Give a result to subscribers on particular path
::
++ give-result
|= [=path =out-peer-data]
=/ m (async ,~)
^- form:m
;< bones=(list bone) bind:m (get-bones-on-path path)
|- ^- form:m
=* loop $
?~ bones
(pure:m ~)
;< ~ bind:m (send-effect-on-bone i.bones %diff out-peer-data)
loop(bones t.bones)
::
:: ----
::
:: Handle domains
::
++ install-domain
|= =turf
=/ m (async ,~)
^- form:m
(send-effect %rule / %turf %put turf)
--

View File

@ -1,9 +1,9 @@
|%
+$ card card:agent:mall
+$ card card:agent:gall
+$ input
$% [%poke =cage]
[%sign =wire =sign-arvo]
[%agent =wire =sign:agent:mall]
[%agent =wire =sign:agent:gall]
[%watch =path]
==
+$ strand-input [=bowl in=(unit input)]
@ -13,8 +13,8 @@
src=ship
tid=tid
mom=(unit tid)
wex=boat:mall
sup=bitt:mall
wex=boat:gall
sup=bitt:gall
eny=@uvJ
now=@da
byk=beak

View File

@ -4,14 +4,14 @@
=, strand-fail=strand-fail:libstrand
|%
++ send-raw-cards
|= cards=(list =card:agent:mall)
|= cards=(list =card:agent:gall)
=/ m (strand ,~)
^- form:m
|= strand-input:strand
[cards %done ~]
::
++ send-raw-card
|= =card:agent:mall
|= =card:agent:gall
=/ m (strand ,~)
^- form:m
(send-raw-cards card ~)
@ -209,7 +209,7 @@
|= [=dock =cage]
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall [%pass /poke %agent dock %poke cage]
=/ =card:agent:gall [%pass /poke %agent dock %poke cage]
;< ~ bind:m (send-raw-card card)
(take-poke-ack /poke)
::
@ -224,7 +224,7 @@
|= [=wire =dock =path]
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall [%pass watch+wire %agent dock %watch path]
=/ =card:agent:gall [%pass watch+wire %agent dock %watch path]
;< ~ bind:m (send-raw-card card)
(take-watch-ack wire)
::
@ -239,7 +239,7 @@
|= [=wire =dock]
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall [%pass watch+wire %agent dock %leave ~]
=/ =card:agent:gall [%pass watch+wire %agent dock %leave ~]
(send-raw-card card)
::
++ leave-our
@ -275,7 +275,7 @@
|= until=@da
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall
=/ =card:agent:gall
[%pass /wait/(scot %da until) %arvo %b %wait until]
(send-raw-card card)
::
@ -286,7 +286,7 @@
^- form:m
;< now=@da bind:m get-time
=/ when (add now time)
=/ =card:agent:mall
=/ =card:agent:gall
[%pass /timeout/(scot %da when) %arvo %b %wait when]
;< ~ bind:m (send-raw-card card)
|= tin=strand-input:strand
@ -299,7 +299,7 @@
?: ?=(%cont -.next.c-res)
c-res(self.next ..loop(computation self.next.c-res))
?: ?=(%done -.next.c-res)
=/ =card:agent:mall
=/ =card:agent:gall
[%pass /timeout/(scot %da when) %arvo %b %rest when]
c-res(cards [card cards.c-res])
c-res

View File

@ -1,554 +0,0 @@
/- tapp-sur=tapp
/+ async
|* $: state-type=mold
peek-data=mold
in-poke-data=mold
out-poke-data=mold
in-peer-data=mold
out-peer-data=mold
==
|%
++ tapp-sur (^tapp-sur out-poke-data out-peer-data)
++ card card:tapp-sur
++ sign sign:tapp-sur
++ contract contract:tapp-sur
+$ tapp-admin-in-poke-data
[%tapp-admin tapp-admin=?(%cancel %restart)]
+$ tapp-in-poke-data
$% tapp-admin-in-poke-data
in-poke-data
==
+$ command
$% [%init ~]
[%poke =in-poke-data]
[%peer =path]
[%diff =dock =path =in-peer-data]
[%take =sign]
==
::
++ async-lib (^async sign card contract)
++ async async:async-lib
::
+$ move (pair bone card)
++ tapp-async (async state-type)
+$ tapp-state
$: waiting=(qeu [=bone command])
active=(unit eval-form:eval:tapp-async)
app-state=state-type
==
+$ tapp-peek
[%noun ?(? (set contract))]
::
:: The form of a tapp
::
+$ tapp-core-all
$_ ^|
|_ [bowl:gall state-type]
::
:: Initialization
::
++ handle-init
*form:tapp-async
::
:: Input
::
++ handle-poke
|~ in-poke-data
*form:tapp-async
::
:: Read
::
++ handle-peek
|~ path
*(unit (unit peek-data))
::
:: Subscription request
::
++ handle-peer
|~ path
*form:tapp-async
::
:: Receive subscription result
::
++ handle-diff
|~ [dock path in-peer-data]
*form:tapp-async
::
:: Receive syscall result
::
++ handle-take
|~ sign
*form:tapp-async
--
::
:: Default handlers for all comands
::
++ default-tapp
=/ m tapp-async
^- tapp-core-all
|_ [=bowl:gall state=state-type]
++ handle-init
(pure:m state)
::
++ handle-poke
|=(* (async-fail:async-lib %no-poke-handler ~))
::
++ handle-peek _~
::
++ handle-peer
|= =path
^- form:m
?: ?=([%sole *] path)
~| %default-tapp-no-sole !!
(async-fail:async-lib %no-peer-handler >path< ~)
::
++ handle-diff
|=(* (async-fail:async-lib %no-diff-handler ~))
::
++ handle-take
=> |%
++ print-if-error
|= [msg=tape error=(unit tang)]
%. (pure:m state)
?~ error
same
(slog [leaf+msg u.error])
--
|= =sign
^- form:m
?: ?=(%coup -.sign)
(print-if-error "poke failed" error.sign)
?: ?=(%reap -.sign)
(print-if-error "peer {<path.sign>} failed" error.sign)
(async-fail:async-lib %no-take-handler ~)
--
::
:: The form of a tapp that only handles pokes
::
++ tapp-core-poke
$_ ^|
|_ [bowl:gall state-type]
++ handle-poke handle-poke:*tapp-core-all
--
::
++ create-tapp-poke
|= handler=tapp-core-poke
%- create-tapp-poke-peer
|_ [=bowl:gall state=state-type]
++ handle-peer ~(handle-peer default-tapp bowl state)
::
++ handle-poke ~(handle-poke handler bowl state)
--
::
:: The form of a tapp that only handles pokes and peers
::
++ tapp-core-poke-peer
$_ ^|
|_ [bowl:gall state-type]
++ handle-poke handle-poke:*tapp-core-all
++ handle-peer handle-peer:*tapp-core-all
--
::
++ create-tapp-poke-peer
|= handler=tapp-core-poke-peer
%- create-tapp-all
|_ [=bowl:gall state=state-type]
++ handle-init ~(handle-init default-tapp bowl state)
++ handle-peek ~(handle-peek default-tapp bowl state)
++ handle-diff ~(handle-diff default-tapp bowl state)
++ handle-take ~(handle-take default-tapp bowl state)
::
++ handle-poke ~(handle-poke handler bowl state)
++ handle-peer ~(handle-peer handler bowl state)
--
::
:: The form of a tapp that only handles pokes and diffs
::
++ tapp-core-poke-diff
$_ ^|
|_ [bowl:gall state-type]
++ handle-poke handle-poke:*tapp-core-all
++ handle-diff handle-diff:*tapp-core-all
--
::
++ create-tapp-poke-diff
|= handler=tapp-core-poke-diff
%- create-tapp-all
|_ [=bowl:gall state=state-type]
++ handle-init ~(handle-init default-tapp bowl state)
++ handle-peek ~(handle-peek default-tapp bowl state)
++ handle-peer ~(handle-peer default-tapp bowl state)
++ handle-take ~(handle-take default-tapp bowl state)
::
++ handle-poke ~(handle-poke handler bowl state)
++ handle-diff ~(handle-diff handler bowl state)
--
::
:: The form of a tapp that only handles pokes, peers, and takes
::
++ tapp-core-poke-peer-take
$_ ^|
|_ [bowl:gall state-type]
++ handle-poke handle-poke:*tapp-core-all
++ handle-peer handle-peer:*tapp-core-all
++ handle-take handle-take:*tapp-core-all
--
::
++ create-tapp-poke-peer-take
|= handler=tapp-core-poke-peer-take
%- create-tapp-all
|_ [=bowl:gall state=state-type]
++ handle-init ~(handle-init default-tapp bowl state)
++ handle-peek ~(handle-peek default-tapp bowl state)
++ handle-diff ~(handle-diff default-tapp bowl state)
::
++ handle-poke ~(handle-poke handler bowl state)
++ handle-peer ~(handle-peer handler bowl state)
++ handle-take ~(handle-take handler bowl state)
--
::
:: The form of a tapp that only handles pokes, peers, diffs, and takes
::
++ tapp-core-poke-peer-diff-take
$_ ^|
|_ [bowl:gall state-type]
++ handle-poke handle-poke:*tapp-core-all
++ handle-peer handle-peer:*tapp-core-all
++ handle-diff handle-diff:*tapp-core-all
++ handle-take handle-take:*tapp-core-all
--
::
++ create-tapp-poke-peer-diff-take
|= handler=tapp-core-poke-peer-diff-take
%- create-tapp-all
|_ [=bowl:gall state=state-type]
++ handle-init ~(handle-init default-tapp bowl state)
++ handle-peek ~(handle-peek default-tapp bowl state)
::
++ handle-poke ~(handle-poke handler bowl state)
++ handle-peer ~(handle-peer handler bowl state)
++ handle-diff ~(handle-diff handler bowl state)
++ handle-take ~(handle-take handler bowl state)
--
::
++ create-tapp-all
|= handler=tapp-core-all
|_ [=bowl:gall tapp-state]
++ this-tapp .
::
:: Initialize or upgrade tapp
::
:: If state is upgraded incompatibly, hard-reset and cancel if active.
:: Otherwise, upgrade, cancel and restart if active.
::
++ prep
|= old-state=(unit)
^- (quip move _this-tapp)
?~ old-state
~& [%tapp-init dap.bowl]
=. waiting (~(put to waiting) ost.bowl [%init ~])
start-async
::
=/ old ((soft tapp-state) u.old-state)
?~ old
:: XX use only for development may break contracts!
:: XX if active clam contracts only to abort transaction?
::
:: ~& [%tapp-reset dap.bowl]
:: `this-tapp
~| [%tapp-load-incompatible dap.bowl]
!!
::
:: because the clam replaces the active continuation with
:: the bunt of its mold, we must fail the transaction
::
~& [%tapp-loaded dap.bowl]
=. +<+.this-tapp u.old
?^ active
=. waiting (~(put to waiting) (need ~(top to waiting)))
(oob-fail-async %reset-restart ~)
`this-tapp
::
:: Start a command
::
++ poke
|= =tapp-in-poke-data
^- (quip move _this-tapp)
?: ?=(tapp-admin-in-poke-data tapp-in-poke-data)
?~ active
~& [%tapp-admin-idle dap.bowl]
`this-tapp
?- tapp-admin.tapp-in-poke-data
%cancel
(oob-fail-async %tapp-admin-cancel ~)
::
%restart
=. waiting (~(put to waiting) (need ~(top to waiting)))
(oob-fail-async %tapp-admin-restart ~)
==
::
=. waiting (~(put to waiting) ost.bowl [%poke tapp-in-poke-data])
?^ active
~& [%waiting-until-current-async-finishes waiting]
`this-tapp
start-async
::
:: Receive acknowledgement of outgoing poke
::
:: XX these can be distinguished by dock, but, without a wire or
:: some alternative, that's not very useful if you poke the same
:: dock multiple times. %poke wires are not currently exposed ...
:: Wat do?
::
++ coup
|= [=wire error=(unit tang)]
^- (quip move _this-tapp)
?> ?=([@ @ *] wire)
=/ her (slav %p i.wire)
=* app i.t.wire
=. waiting (~(put to waiting) ost.bowl [%take %coup [her app] error])
?^ active
`this-tapp
start-async
::
:: Read from tapp state
::
++ peek
|= =path
^- (unit (unit ?(tapp-peek peek-data)))
?- path
[%x %tapp %active ~]
[~ ~ %noun ?=(^ active)]
::
[%x %tapp %contracts ~]
[~ ~ %noun ?~(active ~ ~(key by contracts.u.active))]
::
*
(~(handle-peek handler bowl app-state) path)
==
::
:: Receive subscription request
::
++ peer
|= =path
^- (quip move _this-tapp)
=. waiting (~(put to waiting) ost.bowl [%peer path])
?^ active
`this-tapp
start-async
::
:: Receive (involuntary) unsubscription
::
++ quit
|= =wire
^- (quip move _this-tapp)
?> ?=([@ @ *] wire)
=/ her (slav %p i.wire)
=* app i.t.wire
=* pax t.t.wire
=. waiting (~(put to waiting) ost.bowl [%take %quit [her app] pax])
?^ active
`this-tapp
start-async
::
:: Receive acknowledgement of outgoing subscription request
::
++ reap
|= [=wire error=(unit tang)]
^- (quip move _this-tapp)
?> ?=([@ @ *] wire)
=/ her (slav %p i.wire)
=* app i.t.wire
=* pax t.t.wire
=. waiting (~(put to waiting) ost.bowl [%take %reap [her app] pax error])
?^ active
`this-tapp
start-async
::
:: Receive subscription response
::
++ diff
|= [=wire =in-peer-data]
^- (quip move _this-tapp)
?> ?=([@ @ *] wire)
=/ her (slav %p i.wire)
=* app i.t.wire
=* pax t.t.wire
=. waiting (~(put to waiting) ost.bowl [%diff [her app] pax in-peer-data])
?^ active
`this-tapp
start-async
::
:: Pass response to async
::
++ http-response
|= [=wire response=client-response:iris]
^- (quip move _this-tapp)
(take-async bowl `[wire %http-response response])
::
:: Pass timer to async, or fail
::
++ wake-note
|= [=wire error=(unit tang)]
^- (quip move _this-tapp)
?^ error
(oob-fail-async %timer-fire-failed u.error)
(take-async bowl `[wire %wake ~])
::
:: Enqueue timer transaction
::
++ wake-effect
|= [=wire error=(unit tang)]
^- (quip move _this-tapp)
=. waiting (~(put to waiting) ost.bowl [%take %wake error])
?^ active
`this-tapp
start-async
::
:: Receive route binding notification
::
++ bound
|= [=wire success=? =binding:eyre]
^- (quip move _this-tapp)
(take-async bowl `[wire %bound success binding])
::
:: Receive source update from jael
::
++ source
|= [=wire whos=(set ship) =source:jael]
^- (quip move _this-tapp)
=. waiting (~(put to waiting) ost.bowl [%take %source whos source])
?^ active
`this-tapp
start-async
::
:: Continue computing async
::
++ take-async
|= =async-input:async-lib
^- (quip move _this-tapp)
=/ m tapp-async
=| moves=(list move)
=| scrys=(list path)
|- ^- (quip move _this-tapp)
?~ active
~| %no-active-async
~| ?~ in.async-input
~
wire.u.in.async-input
!!
=^ r=[moves=(list move) =eval-result:eval:m] u.active
=/ out
%- mule |.
(take:eval:m u.active ost.bowl async-input)
?- -.out
%& p.out
%| [[~ [%fail contracts.u.active %crash p.out]] u.active]
==
=. moves (weld moves (skip moves.r |=(=move =(%scry -.q.move))))
=. scrys
%+ weld scrys
^- (list path)
%+ murn moves.r
|= =move
^- (unit path)
?. ?=(%scry -.q.move)
~
`path.q.move
?^ scrys
=/ scry-result .^(* i.scrys)
$(scrys t.scrys, in.async-input `[i.scrys %scry-result scry-result])
=> .(active `(unit eval-form:eval:tapp-async)`active) :: TMI
=^ final-moves=(list move) this-tapp
?- -.eval-result.r
%next `this-tapp
%fail (fail-async [contracts err]:eval-result.r)
%done (done-async [contracts value]:eval-result.r)
==
[(weld moves final-moves) this-tapp]
::
:: Fails currently-running async
::
++ oob-fail-async
(cury fail-async contracts:(need active))
::
:: Called on async failure
::
++ fail-async
|= [contracts=(map contract bone) err=(pair term tang)]
^- (quip move _this-tapp)
%- %- slog
:* leaf+(weld "tapp command failed in app/" (trip dap.bowl))
leaf+(weld " %" (trip p.err))
q.err
==
(finish-async contracts)
::
:: Called on async success
::
++ done-async
|= [contracts=(map contract bone) state=state-type]
^- (quip move _this-tapp)
=. app-state state
(finish-async contracts)
::
:: Called whether async failed or succeeded
::
++ finish-async
|= contracts=(map contract bone)
^- (quip move _this-tapp)
=^ moves-1 this-tapp (cancel-contracts contracts)
=. active ~
=. waiting +:~(get to waiting)
=^ moves-2 this-tapp start-async
[(weld moves-1 moves-2) this-tapp]
::
:: Try to start next command
::
++ start-async
^- (quip move _this-tapp)
?. =(~ active)
~| %async-already-active !!
=/ next=(unit [=bone =command]) ~(top to waiting)
?~ next
`this-tapp
=. active
:- ~
%- from-form:eval:tapp-async
^- form:tapp-async
=/ out
%- mule |.
=. ost.bowl bone.u.next
=* input +.command.u.next
?- -.command.u.next
%init ~(handle-init handler bowl app-state)
%poke (~(handle-poke handler bowl app-state) input)
%peer (~(handle-peer handler bowl app-state) input)
%diff (~(handle-diff handler bowl app-state) input)
%take (~(handle-take handler bowl app-state) input)
==
?- -.out
%& p.out
%| |= async-input:async-lib
[~ ~ ~ %fail %crash p.out]
==
(take-async bowl ~)
::
:: Cancel outstanding contracts
::
++ cancel-contracts
|= contracts=(map contract bone)
^- (quip move this-tapp)
[(zing (turn ~(tap by contracts) cancel-contract)) this-tapp]
::
:: Cancel individual contract
::
++ cancel-contract
|= [=contract =bone]
^- (list move)
?- -.contract
%wait [bone %rest /note/(scot %da at.contract) at.contract]~
%request [bone %cancel-request / ~]~
==
--
--

View File

@ -1,13 +1,13 @@
:: Print what your agent is doing.
::
|= [loud=? =agent:mall]
^- agent:mall
|_ =bowl:mall
|= [loud=? =agent:gall]
^- agent:gall
|_ =bowl:gall
+* this .
ag ~(. agent bowl)
::
++ on-init
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- (slog leaf+"{<dap.bowl>}: on-init" ~)
.
@ -23,7 +23,7 @@
::
++ on-load
|= old-state=vase
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- (slog leaf+"{<dap.bowl>}: on-load" ~)
.
@ -32,7 +32,7 @@
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- (slog leaf+"{<dap.bowl>}: on-poke with mark {<mark>}" ~)
.
@ -43,7 +43,7 @@
::
++ on-watch
|= =path
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- (slog leaf+"{<dap.bowl>}: on-watch on path {<path>}" ~)
.
@ -52,7 +52,7 @@
::
++ on-leave
|= =path
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- (slog leaf+"{<dap.bowl>}: on-leave on path {<path>}" ~)
.
@ -68,8 +68,8 @@
(on-peek:ag path)
::
++ on-agent
|= [=wire =sign:agent:mall]
^- (quip card:agent:mall agent:mall)
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- (slog leaf+"{<dap.bowl>}: on-agent on wire {<wire>}, {<-.sign>}" ~)
.
@ -78,7 +78,7 @@
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- %+ slog
leaf+"{<dap.bowl>}: on-arvo on wire {<wire>}, {<[- +<]:sign-arvo>}"
@ -89,7 +89,7 @@
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:mall agent:mall)
^- (quip card:agent:gall agent:gall)
=> ?. loud .
%- (slog leaf+"{<dap.bowl>}: on-fail with term {<term>}" ~)
.

View File

@ -545,7 +545,7 @@
~? &(!lac !=(%$ p.gum))
:- (runt [s.gum '|'] "")
:^ %pass [p.gum p.q.r.gum]
?: ?=(?(%deal %deal-mall) +>-.q.q.r.gum)
?: ?=(?(%deal %deal-gall) +>-.q.q.r.gum)
:- :- +>-.q.q.r.gum
(,[[ship ship] term term] [+>+< +>+>- +>+>+<]:q.q.r.gum)
p.r.gum

View File

@ -43,10 +43,10 @@
== ::
gift:able:jael ::
== ::
$: %m :: from %gall
$: %g :: from %gall
$% [%mean p=ares] :: XX obsolete
[%nice ~] :: XX obsolete
$>(%unto gift:able:mall) :: application ack
$>(%unto gift:able:gall) :: application ack
== == ::
$: @tas :: from any
$% $>(%crud vane-task) :: XX strange
@ -1372,7 +1372,7 @@
%milk
:: ~& [%milk p.bon q.bon]
?> ?=([@ @ *] q.q.bon)
?> ?=(?(%a %c %e %m %j) i.q.q.bon)
?> ?=(?(%a %c %e %g %j) i.q.q.bon)
=/ =wire [(scot %p our) (scot %p p.bon) q.q.bon]
:_ fox [hen %pass wire i.q.q.bon %west p.bon t.q.q.bon r.bon]~
::
@ -1446,8 +1446,8 @@
?- +<.sih
%crud [[[hen [%slip %d %flog +.sih]] ~] +>]
::
%mack ?~ +>.sih $(sih [%m %nice ~]) :: XX using old code
$(sih [%m %mean `[%mack +>+.sih]])
%mack ?~ +>.sih $(sih [%g %nice ~]) :: XX using old code
$(sih [%g %mean `[%mack +>+.sih]])
::
%public-keys
?. ?=([%pubs @ ~] tea)

View File

@ -77,13 +77,13 @@
$: %f ::
$>(%wegh task:able:ford) ::
== ::
$: %m ::
$: %g ::
$> $? %conf ::
%deal ::
%goad ::
%wegh ::
== ::
task:able:mall ::
task:able:gall ::
== ::
$: %i ::
$>(%wegh task:able:iris) ::
@ -130,12 +130,12 @@
$: %f ::
$>(%mass gift:able:ford) ::
== ::
$: %m ::
$: %g ::
$> $? %mass ::
%onto ::
%unto ::
== ::
gift:able:mall ::
gift:able:gall ::
== ::
$: %i ::
$>(%mass gift:able:iris) ::
@ -174,7 +174,7 @@
[%auto %one ~]
?~ error
~& %behn-goad
(pass / [%m %goad force=| ~])
(pass / [%g %goad force=| ~])
:: %goad crashed, wait again, then force
::
~& %behn-goad-retry
@ -184,7 +184,7 @@
[%auto %two ~]
?~ error
~& %behn-goad-again
(pass / [%m %goad force=& ~])
(pass / [%g %goad force=& ~])
:: %goad crashed again, bail out
::
~& %behn-goad-fail
@ -239,8 +239,8 @@
+>(moz :_(moz [hen %give git]))
::
++ deal :: pass to %gall
|= [=wire =deal:mall]
(pass wire [%m %deal [our our] ram deal])
|= [=wire =deal:gall]
(pass wire [%g %deal [our our] ram deal])
::
++ pass :: pass note
|= [=wire =note]
@ -344,7 +344,7 @@
=< (pass /heft/clay [%c %wegh ~])
=< (pass /heft/eyre [%e %wegh ~])
=< (pass /heft/ford [%f %wegh ~])
=< (pass /heft/gall [%m %wegh ~])
=< (pass /heft/gall [%g %wegh ~])
=< (pass /heft/iris [%i %wegh ~])
=< (pass /heft/jael [%j %wegh ~])
.
@ -365,7 +365,7 @@
=/ myt (flop (fall tem ~))
=/ can (clan:title our)
=. tem ~
=. +> (pass / [%m %conf [[our ram] our %home]])
=. +> (pass / [%g %conf [[our ram] our %home]])
=. +> (sync %home our %base)
=? +> ?=(?($earl $duke $king) can)
(sync %base (sein our) %kids)
@ -416,7 +416,7 @@
|= {tea/wire sih/sign}
^+ +>
?- sih
{?($a $b $c $e $f $m $i $j) $mass *}
{?($a $b $c $e $f $g $i $j) $mass *}
(wegh -.sih p.sih)
::
{$a $nice *}
@ -431,14 +431,14 @@
{$a $send *}
+>(moz :_(moz [hen %give +.sih]))
::
{$m $onto *}
{$g $onto *}
:: ~& [%take-gall-onto +>.sih]
?- -.+>.sih
%| (crud %onto p.p.+>.sih)
%& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
==
::
{$m $unto *}
{$g $unto *}
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
$poke-ack ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
@ -473,7 +473,7 @@
:: +wegh: receive a memory report from a vane and maybe emit full report
::
++ wegh
|= [lal=?(%a %b %c %e %f %m %i %j) mas=mass]
|= [lal=?(%a %b %c %e %f %g %i %j) mas=mass]
^+ +>
:: update our listing of vane responses with this new one
::
@ -484,7 +484,7 @@
%c ~?(?=(^ c.hef.all) %double-mass-c hef.all(c `mas))
%e ~?(?=(^ e.hef.all) %double-mass-e hef.all(e `mas))
%f ~?(?=(^ f.hef.all) %double-mass-f hef.all(f `mas))
%m ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas))
%g ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas))
%i ~?(?=(^ i.hef.all) %double-mass-i hef.all(i `mas))
%j ~?(?=(^ j.hef.all) %double-mass-j hef.all(j `mas))
==

View File

@ -45,12 +45,12 @@
$% [%build live=? schematic=schematic:ford]
[%kill ~]
== ==
:: %m: to mall
:: %g: to gall
::
$: %m
$: %g
::
::
$>(%deal task:able:mall)
$>(%deal task:able:gall)
== ==
:: +sign: private response from another vane to ford
::
@ -69,13 +69,13 @@
::
$% [%made date=@da result=made-result:ford]
== ==
:: %m: from mall
:: %g: from gall
::
$: %m
$: %g
::
::
gift:able:mall
:: $>(%unto gift:able:mall)
gift:able:gall
:: $>(%unto gift:able:gall)
== ==
--
:: more structures
@ -878,12 +878,12 @@
|= [app=term =inbound-request:eyre]
^- (list move)
:~ :* duct %pass /watch-response/[eyre-id]
%m %deal [our our] app
%g %deal [our our] app
%watch /http-response/[eyre-id]
==
::
:* duct %pass /run-app-request/[eyre-id]
%m %deal [our our] app
%g %deal [our our] app
%poke %handle-http-request
!>([eyre-id inbound-request])
==
@ -910,7 +910,7 @@
:_ state
:_ ~
:* duct %pass /watch-response/[eyre-id]
%m %deal [our our] app.action.u.connection
%g %deal [our our] app.action.u.connection
%leave ~
==
::
@ -1394,8 +1394,8 @@
^- move
:^ duct %pass /channel/poke/[channel-id]/(scot %ud request-id.i.requests)
=, i.requests
:* %m %deal `sock`[our ship] app
`task:agent:mall`[%poke-as mark %json !>(json)]
:* %g %deal `sock`[our ship] app
`task:agent:gall`[%poke-as mark %json !>(json)]
==
::
$(requests t.requests)
@ -1410,8 +1410,8 @@
^- move
:^ duct %pass channel-wire
=, i.requests
:* %m %deal [our ship] app
`task:agent:mall`[%watch-as %json path]
:* %g %deal [our ship] app
`task:agent:gall`[%watch-as %json path]
==
::
=. session.channel-state.state
@ -1443,8 +1443,8 @@
^- move
:^ duc.u.maybe-subscription %pass channel-wire
=, u.maybe-subscription
:* %m %deal [our ship] app
`task:agent:mall`[%leave ~]
:* %g %deal [our ship] app
`task:agent:gall`[%leave ~]
==
::
=. session.channel-state.state
@ -1474,7 +1474,7 @@
|= [channel-wire=wire ship=@p app=term =path duc=^duct]
^- move
::
[duc %pass channel-wire [%m %deal [our ship] app %leave ~]]
[duc %pass channel-wire [%g %deal [our ship] app %leave ~]]
::
?: ?=([%& *] state.session)
=. gall-moves
@ -1505,7 +1505,7 @@
:: +on-gall-response: turns a gall response into an event
::
++ on-gall-response
|= [channel-id=@t request-id=@ud =sign:agent:mall]
|= [channel-id=@t request-id=@ud =sign:agent:gall]
^- [(list move) server-state]
::
?- -.sign
@ -1671,7 +1671,7 @@
|= [channel-wire=wire ship=@p app=term =path duc=^duct]
^- move
::
[duc %pass channel-wire [%m %deal [our ship] app %leave ~]]
[duc %pass channel-wire [%g %deal [our ship] app %leave ~]]
--
:: +handle-ford-response: translates a ford response for the outside world
::
@ -1737,7 +1737,7 @@
~
:_ ~
:* duct %pass /watch-response/[eyre-id]
%m %deal [our our] app.action.connection
%g %deal [our our] app.action.connection
%leave ~
==
::
@ -1839,7 +1839,7 @@
~
:_ ~
:* duct %pass /watch-response/[eyre-id]
%m %deal [our our] app.action.u.connection-state
%g %deal [our our] app.action.u.connection-state
%leave ~
==
--
@ -2110,7 +2110,7 @@
:_ http-server-gate
=/ cmd
[%acme %poke `cage`[%acme-order !>(mod)]]
[duct %pass /acme/order %m %deal [our our] cmd]~
[duct %pass /acme/order %g %deal [our our] cmd]~
==
::
%request
@ -2164,7 +2164,7 @@
=/ =sign q.wrapped-sign
=> %= .
sign
?: ?=(%m -.sign)
?: ?=(%g -.sign)
?> ?=(%unto +<.sign)
sign
sign
@ -2187,7 +2187,7 @@
::
++ run-app-request
::
?> ?=([%m %unto *] sign)
?> ?=([%g %unto *] sign)
::
::
?> ?=([%poke-ack *] p.sign)
@ -2210,7 +2210,7 @@
=/ event-args [[our eny duct now scry-gate] server-state.ax]
::
?> ?=([@ *] t.wire)
?: ?=([%m %unto %watch-ack *] sign)
?: ?=([%g %unto %watch-ack *] sign)
?~ p.p.sign
:: received a positive acknowledgment: take no action
::
@ -2222,13 +2222,13 @@
=^ moves server-state.ax (handle-gall-error u.p.p.sign)
[moves http-server-gate]
::
?: ?=([%m %unto %kick ~] sign)
?: ?=([%g %unto %kick ~] sign)
=/ handle-response handle-response:(per-server-event event-args)
=^ moves server-state.ax
(handle-response %continue ~ &)
[moves http-server-gate]
::
?> ?=([%m %unto %fact *] sign)
?> ?=([%g %unto %fact *] sign)
=/ =mark p.cage.p.sign
=/ =vase q.cage.p.sign
?. ?= ?(%http-response-header %http-response-data %http-response-cancel)
@ -2287,7 +2287,7 @@
[moves http-server-gate]
::
?(%poke %subscription)
?> ?=([%m %unto *] sign)
?> ?=([%g %unto *] sign)
?> ?=([@ @ @t @ *] wire)
=/ on-gall-response
on-gall-response:by-channel:(per-server-event event-args)
@ -2298,7 +2298,7 @@
==
::
++ acme-ack
?> ?=([%m %unto *] sign)
?> ?=([%g %unto *] sign)
::
?> ?=([%poke-ack *] p.sign)
?~ p.p.sign

View File

@ -1,9 +1,9 @@
!: :: %mall, agent execution
!: :: %gall, agent execution
!? 163
!:
::::
|= pit=vase
=, mall
=, gall
=> =~
|%
:: +reverse-ames: reverse ames message
@ -175,18 +175,18 @@
::
ska=sley
==
~% %mall-top ..is ~
~% %gall-top ..is ~
|%
:: +mall-payload: mall payload
:: +gall-payload: gall payload
::
++ mall-payload +
++ gall-payload +
:: +mo: Arvo-level move handling
::
:: An outer core responsible for routing moves to and from Arvo; it calls
:: an inner core, +ap, to route internal moves to and from agents.
::
++ mo
~% %mall-mo +> ~
~% %gall-mo +> ~
|_
$: hen=duct
moves=(list move)
@ -202,10 +202,10 @@
:: +mo-abet: resolve moves.
::
++ mo-abet
^- [(list move) _mall-payload]
^- [(list move) _gall-payload]
::
=/ resolved (flop moves)
[resolved mall-payload]
[resolved gall-payload]
::
:: +mo-boot: ask %ford to build us a core for the specified agent.
::
@ -287,12 +287,12 @@
:: +mo-receive-core: receives an app core built by %ford.
::
:: Presuming we receive a good core, we first check to see if the agent
:: is already running. If so, we update its beak in %mall's state,
:: is already running. If so, we update its beak in %gall's state,
:: initialise an +ap core for the agent, install the core we got from
:: %ford, and then resolve any moves associated with it.
::
:: If we're dealing with a new agent, we create one using the result we
:: got from %ford, add it to the collection of agents %mall is keeping
:: got from %ford, add it to the collection of agents %gall is keeping
:: track of, and then do more or less the same procedure as we did for the
:: running agent case.
::
@ -344,9 +344,9 @@
=. mo-core (mo-clear-queue term)
=/ =suss [term %boot now]
(mo-give %onto [%.y suss])
:: +mo-new-agent: create a new agent and add it to %mall's state.
:: +mo-new-agent: create a new agent and add it to %gall's state.
::
:: %mall maintains a collection of running agents. This arm creates a
:: %gall maintains a collection of running agents. This arm creates a
:: new one with the provided name, beak, and state (held in a vase).
::
++ mo-new-agent
@ -592,22 +592,22 @@
=/ =sock [him our]
=/ =deal [%pump ~]
=/ =task:able [%deal sock dap deal]
[%m task]
[%g task]
(mo-pass sys-path note-arvo)
::
=/ mall-move=note-arvo
=/ gall-move=note-arvo
=/ =sock [him our]
=/ =deal [%leave ~]
=/ =task:able [%deal sock dap deal]
[%m task]
[%g task]
::
=/ ames-move=note-arvo
=/ path [%m %gh dap ~]
=/ path [%g %gh dap ~]
=/ =noun [num %x ~]
=/ =task:able:ames [%want him path noun]
[%a task]
::
=. mo-core (mo-pass sys-path mall-move)
=. mo-core (mo-pass sys-path gall-move)
=. mo-core (mo-pass sys-path ames-move)
::
?. ?=([~ ~ %mack *] coop)
@ -676,13 +676,13 @@
=/ sys-path [%sys path]
=/ =note-arvo
=/ =cage (result-to-cage:ford build-result)
[%m %deal [him our] i.t.t.path %poke cage]
[%g %deal [him our] i.t.t.path %poke cage]
(mo-pass sys-path note-arvo)
::
?: ?=([%a %woot *] sign-arvo)
mo-core
::
?> ?=([%m %unto *] sign-arvo)
?> ?=([%g %unto *] sign-arvo)
=/ =sign:agent +>.sign-arvo
::
?- -.sign
@ -692,7 +692,7 @@
%fact
=/ sys-path [%sys %red t.path]
=/ =note-arvo
=/ path [%m %gh dap ~]
=/ path [%g %gh dap ~]
=/ noun [num %d p.cage.sign q.q.cage.sign]
[%a %want him path noun]
(mo-pass sys-path note-arvo)
@ -700,7 +700,7 @@
%kick
=/ sys-path [%sys path]
=/ =note-arvo
=/ path [%m %gh dap ~]
=/ path [%g %gh dap ~]
=/ noun [num %x ~]
[%a %want him path noun]
(mo-pass sys-path note-arvo)
@ -762,7 +762,7 @@
!!
::
=/ =sign-arvo q.hin
?. ?=([%m %unto *] sign-arvo)
?. ?=([%g %unto *] sign-arvo)
=/ app
=/ =term i.path
=/ =ship (slav %p i.t.path)
@ -808,7 +808,7 @@
::
=/ move
=/ =sock [attributing.routes our]
=/ card [%slip %m %deal sock term deal]
=/ card [%slip %g %deal sock term deal]
[duct card]
$(moves [move moves])
:: +mo-beak: assemble a beak for the specified agent.
@ -907,25 +907,25 @@
=/ =task:able
=/ =deal [%raw-poke [mark noun]:forward-ames]
[%deal sock term deal]
[%m task]
[%g task]
::
%l
=/ =task:able
=/ =deal [%watch-as [mark path]:forward-ames]
[%deal sock term deal]
[%m task]
[%g task]
::
%s
=/ =task:able
=/ =deal [%watch path.forward-ames]
[%deal sock term deal]
[%m task]
[%g task]
::
%u
=/ =task:able
=/ =deal [%leave ~]
[%deal sock term deal]
[%m task]
[%g task]
==
(mo-pass path note-arvo)
:: +mo-handle-backward: handle reverse %ames message.
@ -966,7 +966,7 @@
:: currently focused on.
::
++ ap
~% %mall-ap +> ~
~% %gall-ap +> ~
|_ $: agent-name=term
agent-routes=routes
agent-duct=duct
@ -977,7 +977,7 @@
++ ap-core .
:: +ap-abed: initialise state for an agent, with the supplied routes.
::
:: The agent must already be running in +mall -- here we simply update
:: The agent must already be running in +gall -- here we simply update
:: +ap's state to focus on it.
::
++ ap-abed
@ -1116,7 +1116,7 @@
=/ =task:able
=/ =sock [our ship.neat]
[%deal sock [name deal]:neat]
[%m task]
[%g task]
==
[duct %pass wire note-arvo]~
==
@ -1269,7 +1269,7 @@
==
==
=/ incoming (~(get by incoming.subscribers.current-agent) agent-duct)
~& [%mall-pulling-20 agent-duct incoming]
~& [%gall-pulling-20 agent-duct incoming]
[%.n ap-core]
::
=/ next
@ -1599,7 +1599,7 @@
?~ moves
[(flop new-moves) ap-core]
=/ =move i.moves
?: ?=([* %pass * %m %deal * * %leave *] move)
?: ?=([* %pass * %g %deal * * %leave *] move)
=/ =wire p.move.move
?> ?=([%use @ @ %out @ @ *] wire)
=/ short-wire t.t.t.t.t.t.wire
@ -1607,7 +1607,7 @@
=. outgoing.subscribers.current-agent
(~(del by outgoing.subscribers.current-agent) [short-wire dock])
$(moves t.moves, new-moves [move new-moves])
?. ?=([* %pass * %m %deal * * %watch *] move)
?. ?=([* %pass * %g %deal * * %watch *] move)
$(moves t.moves, new-moves [move new-moves])
=/ =wire p.move.move
?> ?=([%use @ @ %out @ @ *] wire)
@ -1630,11 +1630,11 @@
:: +call: request
::
++ call
~% %mall-call +> ~
~% %gall-call +> ~
|= [=duct hic=(hypo (hobo task:able))]
^- [(list move) _mall-payload]
^- [(list move) _gall-payload]
::
~| [%mall-call-failed duct q.hic]
~| [%gall-call-failed duct q.hic]
:: make sure our task is hard
::
=/ =task:able
@ -1644,12 +1644,12 @@
::
=/ initialised (mo-abed:mo duct)
?- -.task
?(%conf %conf-mall)
%conf
=/ =dock p.task
=/ =ship p.dock
?. =(our ship)
~& [%mall-not-ours ship]
[~ mall-payload]
~& [%gall-not-ours ship]
[~ gall-payload]
::
=> (mo-boot:initialised q.dock q.task)
mo-abet
@ -1670,7 +1670,7 @@
mo-abet:(mo-goad:initialised force.task agent.task)
::
%init
=/ payload mall-payload(system-duct.agents.state duct)
=/ payload gall-payload(system-duct.agents.state duct)
[~ payload]
::
%trim
@ -1679,11 +1679,11 @@
:: XX cancel subscriptions if =(0 trim-priority) ?
::
~> %slog.[0 leaf+"gall: trim: clearing caches"]
=/ =move [duct %pass / %m [%wash ~]]
[[move ~] mall-payload]
=/ =move [duct %pass / %g [%wash ~]]
[[move ~] gall-payload]
::
%vega
[~ mall-payload]
[~ gall-payload]
::
%west
=/ =ship p.task
@ -1707,7 +1707,7 @@
%- ~(run by running.agents.state)
|= =running-agent
running-agent(cache *worm)
[~ mall-payload]
[~ gall-payload]
::
%wegh
=/ blocked
@ -1719,7 +1719,7 @@
(sort ~(tap by active) aor)
::
=/ =mass
:+ %mall %.n
:+ %gall %.n
:~ [%foreign %.y contacts.agents.state]
[%blocked %.n blocked]
[%active %.n running]
@ -1730,23 +1730,23 @@
=/ =move [duct %give %mass mass]
[move ~]
::
[moves mall-payload]
[moves gall-payload]
==
:: +load: recreate vane
::
++ load
:: |= *
:: mall-payload
:: gall-payload
|= =state-old
^+ mall-payload
^+ gall-payload
::
?- -.state-old
%1 mall-payload(state state-old)
%1 gall-payload(state state-old)
==
:: +scry: standard scry
::
++ scry
~/ %mall-scry
~/ %gall-scry
|= [fur=(unit (set monk)) =term =shop =desk =coin =path]
^- (unit (unit cage))
?. ?=(%.y -.shop)
@ -1783,11 +1783,11 @@
:: +take: response
::
++ take
~/ %mall-take
~/ %gall-take
|= [=wire =duct hin=(hypo sign-arvo)]
^- [(list move) _mall-payload]
^- [(list move) _gall-payload]
::
~| [%mall-take-failed wire]
~| [%gall-take-failed wire]
?> ?=([?(%sys %use) *] wire)
=/ initialised (mo-abed:mo duct)
=/ =sign-arvo q.hin

View File

@ -75,8 +75,8 @@
$% $: %a :: to %ames
$>(%want task:able:ames) :: send message
== ::
$: %m :: to self
$>(%deal task:able:mall) :: set ethereum source
$: %g :: to self
$>(%deal task:able:gall) :: set ethereum source
== ::
$: %j :: to self
$>(%listen task) :: set ethereum source
@ -90,11 +90,11 @@
+$ sign :: in result $<-
$~ [%a %woot *ship ~] ::
$% [%a $>(%woot gift:able:ames)] :: message result
$: %m ::
$: %g ::
$> $? %onto ::
%unto ::
== ::
gift:able:mall ::
gift:able:gall ::
==
== ::
-- ::
@ -186,7 +186,7 @@
:* hen
%pass
/[app]/poke
%m
%g
%deal
[our our]
app
@ -320,7 +320,7 @@
%+ weld moz
:: order is crucial!
::
:: %dill must init after %mall
:: %dill must init after %gall
:: the %give init (for unix) must be after %dill init
:: %jael init must be deferred (makes http requests)
::
@ -328,7 +328,7 @@
:~ [hen %give %init our]
[hen %slip %e %init our]
[hen %slip %d %init our]
[hen %slip %m %init our]
[hen %slip %g %init our]
[hen %slip %c %init our]
[hen %slip %a %init our]
==
@ -370,7 +370,7 @@
:~ [hen %give %init our]
[hen %slip %e %init our]
[hen %slip %d %init our]
[hen %slip %m %init our]
[hen %slip %g %init our]
[hen %slip %c %init our]
[hen %slip %a %init our]
==
@ -529,11 +529,11 @@
::TODO fail:et
+>.$
::
[%m %onto *]
[%g %onto *]
~& [%jael-onto tea hin]
+>.$
::
[%m %unto *]
[%g %unto *]
?- +>-.hin
$kick ~|([%jael-unexpected-quit tea hin] !!)
$poke-ack
@ -569,7 +569,7 @@
:: :: ++wind:of
++ pump
|= [hen=duct =wire app=term]
(emit [hen %pass wire %m %deal [our our] app %pump ~])
(emit [hen %pass wire %g %deal [our our] app %pump ~])
--
:: :: ++su
:::: ## relative^heavy :: subjective engine
@ -617,7 +617,7 @@
:* hen
%pass
[app path]
%m
%g
%deal
[our our]
app

View File

@ -1863,12 +1863,12 @@
~
--
:: ::::
:::: ++mall :: (1g) extensions
:::: ++gall :: (1g) extensions
:: ::::
++ mall ^?
++ gall ^?
|%
:: ::
:::: ++able:mall :: (1g1) arvo moves
:::: ++able:gall :: (1g1) arvo moves
:: ::::
++ able ^?
|%
@ -1882,7 +1882,6 @@
++ task :: incoming request
$~ [%vega ~] ::
$% {$conf p/dock q/dock} :: configure app
{$conf-mall p/dock q/dock} :: configure app
$>(%init vane-task) :: set owner
{$deal p/sock q/term r/deal} :: full transmission
[%goad force=? agent=(unit dude)] :: rebuild agent(s)
@ -2001,82 +2000,6 @@
*(quip card _^|(..on-init))
--
--
-- ::mall
:: ::::
:::: ++gall :: (1g) extensions
:: ::::
++ gall ^?
|%
:: ::
:::: ++able:gall :: (1g1) arvo moves
:: ::::
++ able ^?
|%
++ gift :: outgoing result
$% {$mass p/mass} :: memory usage
{$onto p/(each suss tang)} :: about agent
{$rend p/path q/*} :: network request
{$unto p/internal-gift} ::
{$mack p/(unit tang)} :: message ack
== ::
++ task :: incoming request
$~ [%vega ~] ::
$% {$conf p/dock q/dock} :: configure app
$>(%init vane-task) :: set owner
{$deal p/sock q/internal-task} :: full transmission
[%goad force=? agent=(unit dude)] :: rebuild agent(s)
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
$>(%west vane-task) :: network request
[%wash ~] :: clear caches
$>(%wegh vane-task) :: report memory
== ::
-- ::able
++ bitt (map bone (pair ship path)) :: incoming subs
++ boat :: outgoing subs
%+ map (pair bone wire) ::
(trel bean ship path) ::
++ bowl :: standard app state
$: $: our/ship :: host
src/ship :: guest
dap/term :: agent
== ::
$: wex/boat :: outgoing subs
sup/bitt :: incoming subs
== ::
$: ost/bone :: opaque cause
act/@ud :: change number
eny/@uvJ :: entropy
now/@da :: current time
byk/beak :: load source
== == ::
++ agent-action :: agent action
$% {$peel p/mark q/path} :: translated peer
{$peer p/path} :: subscribe
{$poke p/cage} :: apply
{$puff p/mark q/noun} :: unchecked poke
{$pull ~} :: unsubscribe
{$punk p/mark q/cage} :: translated poke
{$pump ~} :: pump yes+no
{$peer-not p/tang} :: poison pill peer
== ::
++ internal-gift ::
$% {$coup p/(unit tang)} :: poke result
{$diff p/cage} :: subscription output
{$quit ~} :: close subscription
{$reap p/(unit tang)} :: peer result
[%http-response =http-event:http] :: serve http result
== ::
++ internal-task (pair term agent-action) :: internal task
++ dude term :: server identity
++ gill (pair ship term) :: general contact
++ scar :: opaque duct
$: p/@ud :: bone sequence
q/(map duct bone) :: by duct
r/(map bone duct) :: by bone
== ::
++ suss (trel dude @tas @da) :: config report
++ well (pair desk term) ::
-- ::gall
:: %iris http-client interface
::
@ -2472,7 +2395,7 @@
gift:able:dill
gift:able:eyre
gift:able:ford
gift:able:mall
gift:able:gall
gift:able:iris
gift:able:jael
==
@ -2483,7 +2406,7 @@
task:able:dill
task:able:iris
task:able:ford
task:able:mall
task:able:gall
task:able:eyre
task:able:jael
==
@ -2495,7 +2418,7 @@
{$d task:able:dill}
[%e task:able:eyre]
{$f task:able:ford}
{$m task:able:mall}
{$g task:able:gall}
[%i task:able:iris]
{$j task:able:jael}
{@tas $meta vase}
@ -2512,7 +2435,7 @@
{$d gift:able:dill}
{$f gift:able:ford}
[%e gift:able:eyre]
{$m gift:able:mall}
{$g gift:able:gall}
[%i gift:able:iris]
{$j gift:able:jael}
==
@ -7677,25 +7600,6 @@
?@ &2.rul [%| p=;;(tape rul)]
[%& p=rul]
-- ::scanf
:: ::
:::: ++pubsub:userlib :: (2uG) application
:: ::::
++ pubsub ^?
=, gall
|%
:: :: ++pale:pubsub:
++ pale :: filter peers
|= {hid/bowl fun/$-(sink ?)}
(skim ~(tap by sup.hid) fun)
:: :: ++prix:pubsub:
++ prix :: filter gate
|= pax/path |= sink ^- ?
?~ pax & ?~ r.+< |
&(=(i.pax i.r.+<) $(pax t.pax, r.+< t.r.+<))
:: :: ++prey:pubsub:
++ prey :: prefix
|=({pax/path hid/bowl} (pale hid (prix pax)))
-- ::pubsub
--
::
++ zuse %309 :: hoon+zuse kelvin

View File

@ -12,22 +12,22 @@
|%
++ emit-aqua-events
|= [our=ship aes=(list aqua-event)]
^- (list card:agent:mall)
^- (list card:agent:gall)
[%pass /aqua-events %agent [our %aqua] %poke %aqua-events !>(aes)]~
::
++ handle-restore
|= [our=ship who=@p]
^- (quip card:agent:mall _ships)
^- (quip card:agent:gall _ships)
:_ ships
%+ emit-aqua-events our
[%event who [//newt/0v1n.2m9vh %barn ~]]~
::
++ handle-send
|= [our=ship now=@da way=wire %send lan=lane:ames pac=@]
^- (quip card:agent:mall _ships)
^- (quip card:agent:gall _ships)
=/ hear [//newt/0v1n.2m9vh %hear lan pac]
=? ships & :: =(~ ships)
.^((list ship) %mx /(scot %p our)/aqua/(scot %da now)/ships/noun)
.^((list ship) %gx /(scot %p our)/aqua/(scot %da now)/ships/noun)
:_ ships
%+ emit-aqua-events our
%+ turn ships
@ -40,7 +40,7 @@
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
=^ cards ships
?+ -.q.ue `ships
%restore (handle-restore our.bowl who)

View File

@ -12,16 +12,16 @@
|= [bowl:spider who=ship]
=+ (~(gut by piers) who *pier)
=* pier-data -
=| cards=(list card:agent:mall)
=| cards=(list card:agent:gall)
|%
++ this .
++ abet-pe
^- (quip card:agent:mall _piers)
^- (quip card:agent:gall _piers)
=. piers (~(put by piers) who pier-data)
[(flop cards) piers]
::
++ emit-cards
|= cs=(list card:agent:mall)
|= cs=(list card:agent:gall)
%_(this cards (weld cs cards))
::
++ emit-aqua-events
@ -90,7 +90,7 @@
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect:aquarium]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
=^ cards piers
?+ -.q.ue `piers
%sleep abet-pe:handle-sleep:(pe bowl who)

View File

@ -12,7 +12,7 @@
|%
++ handle-blit
|= [who=@p way=wire %blit blits=(list blit:dill)]
^- (list card:agent:mall)
^- (list card:agent:gall)
=/ last-line
%+ roll blits
|= [b=blit:dill line=tape]
@ -35,7 +35,7 @@
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect:aquarium]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
=/ cards
?+ -.q.ue ~
%blit (handle-blit who ue)

View File

@ -50,7 +50,7 @@
::
++ router
|= [our=ship her=ship uf=unix-effect]
^- (unit card:agent:mall)
^- (unit card:agent:gall)
=, enjs:format
=/ ask (extract-request:util uf 'http://localhost:8545/')
?~ ask
@ -58,7 +58,7 @@
?~ body.request.u.ask
~
=/ req q.u.body.request.u.ask
|^ ^- (unit card:agent:mall)
|^ ^- (unit card:agent:gall)
=/ method (get-method req)
?: =(method 'eth_blockNumber')
:- ~
@ -138,7 +138,7 @@
::
++ answer-request
|= [req=@t result=json]
^- card:agent:mall
^- card:agent:gall
=/ resp
%- crip
%- en-json:html

View File

@ -14,16 +14,16 @@
|= [bowl:spider who=ship]
=+ (~(gut by piers) who *pier)
=* pier-data -
=| cards=(list card:agent:mall)
=| cards=(list card:agent:gall)
|%
++ this .
++ abet-pe
^- (quip card:agent:mall _piers)
^- (quip card:agent:gall _piers)
=. piers (~(put by piers) who pier-data)
[(flop cards) piers]
::
++ emit-cards
|= cs=(list card:agent:mall)
|= cs=(list card:agent:gall)
%_(this cards (weld cs cards))
::
++ emit-aqua-events
@ -105,7 +105,7 @@
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect:aquarium]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
=^ cards piers
?+ -.q.ue `piers
%sleep abet-pe:handle-sleep:(pe bowl who)
@ -116,7 +116,7 @@
::
++ handle-arvo-response
|= [=wire =sign-arvo]
^- (quip card:agent:mall _this)
^- (quip card:agent:gall _this)
?> ?=([%i %http-response %finished *] sign-arvo)
?> ?=([@ *] wire)
=/ who (,@p (slav %p i.wire))

View File

@ -299,7 +299,7 @@
:* wire=/watch-response/[eyre-id] duct=~[/http-blah]
^- (hypo sign:http-server-gate)
:- *type
:* %m %unto %fact
:* %g %unto %fact
%http-response-header
!>([200 ['content-type' 'text/html']~])
==
@ -394,14 +394,14 @@
:* wire=/run-app-request/app1 duct=~[/http-blah]
^- (hypo sign:http-server-gate)
:- *type
:* %m %unto %poke-ack ~
:* %g %unto %poke-ack ~
:~ [%leaf "/~zod/...../app1:<[1 1].[1 20]>"]
== ==
==
^= expected-move
:~ :* duct=~[/http-blah] %pass
/watch-response/[eyre-id]
%m %deal [~nul ~nul] %app1 %leave ~
%g %deal [~nul ~nul] %app1 %leave ~
==
::
:* duct=~[/http-blah] %give %response
@ -496,7 +496,7 @@
^= take-args
:* wire=/watch-response/[eyre-id] duct=~[/http-blah]
^- (hypo sign:http-server-gate) :- *type
:* %m %unto %fact
:* %g %unto %fact
%http-response-header
!>([200 ['content-type' 'text/html']~])
==
@ -515,7 +515,7 @@
^= take-args
:* wire=/watch-response/[eyre-id] duct=~[/http-blah]
^- (hypo sign:http-server-gate) :- *type
:* %m %unto %fact
:* %g %unto %fact
%http-response-data
!>(`(as-octs:mimes:html 'ya!'))
==
@ -611,7 +611,7 @@
^= take-args
:* wire=/watch-response/[eyre-id] duct=~[/http-blah]
^- (hypo sign:http-server-gate) :- *type
:* %m %unto %fact
:* %g %unto %fact
%http-response-header
!>([307 ['location' '/~/login?redirect=/~landscape/inner-path']~])
==
@ -987,7 +987,7 @@
:* wire=/channel/poke/'0123456789abcdef'/'0' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %poke-ack ~]
[%g %unto %poke-ack ~]
==
moves=~
==
@ -1002,7 +1002,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %watch-ack ~]
[%g %unto %watch-ack ~]
==
moves=~
==
@ -1017,7 +1017,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
[%g %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
==
moves=~
==
@ -1202,7 +1202,7 @@
:* wire=/channel/poke/'0123456789abcdef'/'0' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %poke-ack ~]
[%g %unto %poke-ack ~]
==
moves=~
==
@ -1217,7 +1217,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %watch-ack ~]
[%g %unto %watch-ack ~]
==
moves=~
==
@ -1303,7 +1303,7 @@
:* wire=/channel/poke/'0123456789abcdef'/'0' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %poke-ack ~]
[%g %unto %poke-ack ~]
==
moves=~
==
@ -1318,7 +1318,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %watch-ack ~]
[%g %unto %watch-ack ~]
==
moves=~
==
@ -1393,7 +1393,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
[%g %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
==
moves=~
==
@ -1408,7 +1408,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'2' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
[%g %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
==
moves=~
==
@ -1529,7 +1529,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'2' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
[%g %unto %fact %json !>(`json`[%a [%n '1'] [%n '2'] ~])]
==
^= comparator
|= moves=(list move:http-server-gate)
@ -1590,7 +1590,7 @@
:* wire=/channel/poke/'0123456789abcdef'/'0' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %poke-ack ~]
[%g %unto %poke-ack ~]
==
moves=~
==
@ -1605,7 +1605,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %watch-ack ~]
[%g %unto %watch-ack ~]
==
moves=~
==
@ -1675,7 +1675,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %fact %json !>(`json`[%a [%n '1'] ~])]
[%g %unto %fact %json !>(`json`[%a [%n '1'] ~])]
==
^= moves
^- (list move:http-server-gate)
@ -1763,7 +1763,7 @@
:* wire=/channel/subscription/'0123456789abcdef'/'1' duct=~[/http-put-request]
^- (hypo sign:http-server-gate)
:- *type
[%m %unto %fact %json !>(`json`[%a [%n '2'] ~])]
[%g %unto %fact %json !>(`json`[%a [%n '2'] ~])]
==
moves=~
==
@ -2020,7 +2020,7 @@
[output http-server-gate]
::
++ expect-gall-deal
|= $: expected=[wire=path id=sock app=term =deal:mall]
|= $: expected=[wire=path id=sock app=term =deal:gall]
actual=(wind note:http-server-gate gift:able:http-server-gate)
==
^- tang
@ -2032,7 +2032,7 @@
(expect-eq !>(wire.expected) !>(p.actual))
::
=/ note=note:http-server-gate q.actual
?. ?=([%m %deal *] note)
?. ?=([%g %deal *] note)
[%leaf "bad move, not a %deal: {<actual>}"]~
::
%+ weld

View File

@ -1,6 +1,6 @@
/+ *test
::
/= gall-raw /: /===/sys/vane/mall /!noun/
/= gall-raw /: /===/sys/vane/gall /!noun/
::
=/ test-pit=vase !>(..zuse)
=/ gall-gate (gall-raw test-pit)
@ -15,8 +15,8 @@
::
=/ call-args
=/ =duct ~[/init]
=/ =type -:!>(*task:able:mall)
=/ =task:able:mall [%init ~nec]
=/ =type -:!>(*task:able:gall)
=/ =task:able:gall [%init ~nec]
[duct type task]
::
=/ expected-moves ~
@ -36,8 +36,8 @@
=/ ship ~nec
::
=/ call-args
=/ =type -:!>(*task:able:mall)
=/ =task:able:mall
=/ =type -:!>(*task:able:gall)
=/ =task:able:gall
=/ =dock [ship term]
[%conf dock dock]
[duct type task]
@ -62,7 +62,7 @@
|= $: gall-gate=_gall-gate
now=@da
scry=sley
call-args=[=duct =type wrapped-task=(hobo task:able:mall)]
call-args=[=duct =type wrapped-task=(hobo task:able:gall)]
expected-moves=(list move:gall-gate)
==
^- [tang _gall-gate]