This commit is contained in:
Philip Monk 2019-03-07 21:15:42 -08:00
parent dab83cd28e
commit ae8966e5ad
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
8 changed files with 100 additions and 77 deletions

View File

@ -35,12 +35,12 @@
++ emit-aqua-events
|= aes=(list aqua-event)
%- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~
[ost %poke /aqua-events [our %aqua] %aqua-events aes]~
::
++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe)
(aqua-vane-control-handler subscribed)
:_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler our ost subscribed command)
::
++ diff-aqua-effects
|= [way=wire afs=aqua-effects]
@ -51,12 +51,13 @@
this
=. this
?+ -.q.i.ufs.afs this
%restore handle-restore
%restore (handle-restore who.afs)
%send (handle-send i.ufs.afs)
--
==
$(ufs.afs t.ufs.afs)
::
++ handle-restore
|= who=@p
%- emit-aqua-events
[%event who [//newt/0v1n.2m9vh %barn ~]]~
::

View File

@ -13,8 +13,10 @@
+$ state
$: %0
subscribed=_|
piers=(map ship next-timer=(unit @da))
piers=(map ship pier)
==
::
+$ pier next-timer=(unit @da)
--
=, gall
=| moves=(list move)
@ -31,12 +33,12 @@
++ emit-aqua-events
|= aes=(list aqua-event)
%- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~
[ost %poke /aqua-events [our %aqua] %aqua-events aes]~
::
++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe)
(aqua-vane-control-handler subscribed)
:_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler our ost subscribed command)
::
++ diff-aqua-effects
|= [way=wire afs=aqua-effects]
@ -50,7 +52,7 @@
%sleep abet-pe:handle-sleep:(pe who.afs)
%restore abet-pe:handle-restore:(pe who.afs)
%doze abet-pe:(handle-doze:(pe who.afs) i.ufs.afs)
--
==
$(ufs.afs t.ufs.afs)
::
:: Received timer wake
@ -82,15 +84,17 @@
::
++ handle-restore
^+ ..abet-pe
%- emit-aqua-events
[%event who [//behn/0v1n.2m9vh %born ~]]~
=. this
%- emit-aqua-events
[%event who [//behn/0v1n.2m9vh %born ~]]~
..abet-pe
::
++ handle-doze
|= [way=wire %doze tim=(unit @da)]
^+ ..abet-pe
?~ tim
?~ next-timer
this
..abet-pe
cancel-timer
?~ next-timer
(set-timer u.tim)
@ -101,16 +105,18 @@
=. tim +(tim) :: nobody's perfect
~& [who=who %setting-timer tim]
=. next-timer `tim
(emit-moves [ost.hid %wait /(scot %p who) tim]~)
=. this (emit-moves [ost %wait /(scot %p who) tim]~)
..abet-pe
::
++ cancel-timer
~& [who=who %cancell-timer (need next-timer)]
=. next-timer ~
(emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~)
=. this (emit-moves [ost %rest /(scot %p who) (need next-timer)]~)
..abet-pe
::
++ take-wake
|= [way=wire ~]
~& [who=who %aqua-behn-wake now.hid]
~& [who=who %aqua-behn-wake now]
=. next-timer ~
=. this
%- emit-aqua-events

View File

@ -37,12 +37,12 @@
++ emit-aqua-events
|= aes=(list aqua-event)
%- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~
[ost %poke /aqua-events [our %aqua] %aqua-events aes]~
::
++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe)
(aqua-vane-control-handler subscribed)
:_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler our ost subscribed command)
::
++ diff-aqua-effects
|= [way=wire afs=aqua-effects]
@ -53,13 +53,13 @@
this
=. this
?+ -.q.i.ufs.afs this
%blit (handle-blit i.ufs.afs)
--
%blit (handle-blit who.afs i.ufs.afs)
==
$(ufs.afs t.ufs.afs)
::
++ handle-blit
|= [way=wire %blit blits=(list blit:dill)]
^+ ..abet-pe
|= [who=@p way=wire %blit blits=(list blit:dill)]
^+ this
=/ last-line
%+ roll blits
|= [b=blit:dill line=tape]
@ -74,5 +74,5 @@
%url ~& [%activate-url p.b] line
==
~& last-line
..abet-pe
this
--

View File

@ -14,8 +14,10 @@
+$ state
$: %0
subscribed=_|
piers=(map ship http-requests=(set @ud))
piers=(map ship pier)
==
::
+$ pier http-requests=(set @ud)
--
=, gall
=| moves=(list move)
@ -32,12 +34,12 @@
++ emit-aqua-events
|= aes=(list aqua-event)
%- emit-moves
[%poke /aqua-events [our %aqua] %aqua-events aes]~
[ost %poke /aqua-events [our %aqua] %aqua-events aes]~
::
++ poke-aqua-vane-control
|= command=?(%subscribe %unsubscribe)
:_ this(subscribed =(command %subscribe)
(aqua-vane-control-handler subscribed)
:_ this(subscribed =(command %subscribe))
(aqua-vane-control-handler our ost subscribed command)
::
++ diff-aqua-effects
|= [way=wire afs=aqua-effects]
@ -51,7 +53,7 @@
%sleep abet-pe:handle-sleep:(pe who.afs)
%restore abet-pe:handle-restore:(pe who.afs)
%thus abet-pe:(handle-thus:(pe who.afs) i.ufs.afs)
--
==
$(ufs.afs t.ufs.afs)
::
:: Received inbound HTTP response
@ -59,7 +61,7 @@
++ sigh-httr
|= [way=wire res=httr:eyre]
^- (quip move _this)
=. this apex-aqua =< abet-aqua
=. this apex =< abet
?> ?=([@ *] way)
=/ who (,@p (slav %p i.way))
~& [%received-httr who]
@ -70,7 +72,7 @@
++ sigh-tang
|= [way=wire tan=tang]
^- (quip move _this)
=. this apex-aqua =< abet-aqua
=. this apex =< abet
?> ?=([@ *] way)
=/ who (,@p (slav %p i.way))
~& [%received-httr who]
@ -92,8 +94,10 @@
::
++ handle-restore
^+ ..abet-pe
%- emit-aqua-events
[%event who [//http/0v1n.2m9vh %born ~]]~
=. this
%- emit-aqua-events
[%event who [//http/0v1n.2m9vh %born ~]]~
..abet-pe
::
++ handle-thus
|= [way=wire %thus num=@ud req=(unit hiss:eyre)]
@ -110,14 +114,16 @@
..abet-pe
~& [who=who %aqua-eyre-requesting u.req]
=. http-requests (~(put in http-requests) num)
%- emit-moves :_ ~
:* ost.hid
%hiss
/(scot %p who)/(scot %ud num)
~
%httr
[%hiss u.req]
==
=. this
%- emit-moves :_ ~
:* ost
%hiss
/(scot %p who)/(scot %ud num)
~
%httr
[%hiss u.req]
==
..abet-pe
::
:: Pass HTTP response back to virtual ship
::
@ -130,7 +136,9 @@
~& [who=who %ignoring-httr num=num]
..abet-pe
=. http-requests (~(del in http-requests) num)
(emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]~)
=. this
(emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]]~)
..abet-pe
::
:: Got error in HTTP response
::
@ -145,4 +153,5 @@
=. http-requests (~(del in http-requests) num)
%- (slog tan)
..abet-pe
--
--

View File

@ -92,9 +92,9 @@
:: Enqueue events to child arvo
::
++ push-events
|= ova=(list unix-event)
|= ues=(list unix-event)
^+ ..abet-pe
=. next-events (~(gas to next-events) ova)
=. next-events (~(gas to next-events) ues)
..abet-pe
::
:: Send moves to host arvo
@ -271,7 +271,7 @@
++ peer-effects
|= pax=path
^- (quip move _this)
?: ?=([@ @ *] pax)
?. ?=([@ *] pax)
~& [%aqua-bad-peer-effects pax]
`this
?~ (slaw %p i.pax)
@ -524,11 +524,11 @@
::
++ peek-x-ships
|= pax=path
^- (unit (unit %noun (list ship)))
^- (unit (unit [%noun (list ship)]))
?. ?=(~ pax)
~
:^ ~ ~ %noun
(turn ~(tap by piers) head)
`(list ship)`(turn ~(tap by piers) head)
::
:: Trivial scry for mock
::

View File

@ -14,14 +14,20 @@
=> $~ |%
+$ move (pair bone card)
+$ card
$% [%poke wire dock poke-types]
$% [%poke wire dock poke-type]
[%peer wire dock path]
[%pull wire dock ~]
[%diff diff-type]
==
::
+$ poke-types
+$ poke-type
$% [%aqua-events (list aqua-event)]
[%drum-start term term]
[%aqua-vane-control ?(%subscribe %unsubscribe)]
==
::
+$ diff-type
$% [%aqua-effects aqua-effects]
==
::
+$ state
@ -74,7 +80,7 @@
|= [now=@da who=ship uf=unix-effect]
^- [? (quip ph-event _..start)]
~& [%num num]
:- ?
:- &
:_ ..start
(expect-dojo-output ~bud who uf "[%test-result 5]")
--
@ -97,7 +103,7 @@
++ route
|= [now=@da who=ship uf=unix-effect]
^- [? (quip ph-event _..start)]
:- ?
:- &
:_ ..start
(expect-dojo-output ~bud who uf "hi ~dev successful")
--
@ -106,7 +112,7 @@
::
:- %composed-child-boot
%+ compose-tests (planet ~linnup-torsyx)
%+ porcelain-test %composed-child-boot
%+ porcelain-test %composed-child-boot
|%
++ start
|= now=@da
@ -202,7 +208,7 @@
^- (unit move)
?. ?=([%effects ~] pax)
~
`[b %diff %aqua-effects ae]
`[ost.hid %diff %aqua-effects afs]
::
++ run-events
|= [lab=term what=(list ph-event)]
@ -305,34 +311,35 @@
++ diff-aqua-effects
|= [way=wire afs=aqua-effects]
^- (quip move _this)
:: ~& [%diff-aqua-effect way who.ae]
:: ~& [%diff-aqua-effect way who.afs]
?> ?=([@tas @ ~] way)
=/ lab i.way
=/ test-cor (~(get by test-cores) lab)
?~ test-cor
~& [%ph-dropping lab]
`this
=+ |- ^- $: thru-effects=(list unix-effects)
events=(list ph=event)
=+ |- ^- $: thru-effects=(list unix-effect)
events=(list ph-event)
cor=_u.test-cor
==
?~ ufs.ae
?~ ufs.afs
[~ ~ u.test-cor]
=. effect-log.u.test-cor
[[who i.ufs]:ae effect-log.u.test-cor]
=+ ^- [[thru=? events-1=(list ph-event)] cor=cor.u.test-cor]
(route:cor.u.test-cor now.hid who.ae i.ufs.ae)
[[who i.ufs]:afs effect-log.u.test-cor]
=+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-cor]
(route:cor.u.test-cor now.hid who.afs i.ufs.afs)
=. cor.u.test-cor cor
=+ $(ufs.ae t.ufs.ae)
=+ $(ufs.afs t.ufs.afs)
:+ ?: thru
[i.ufs.ae thru-effects]
thru-efects
[i.ufs.afs thru-effects]
thru-effects
(weld events-1 events)
cor
=. u.test=cor cor
=. u.test-cor cor
=. test-cores (~(put by test-cores) lab u.test-cor)
=^ moves this (publish-aqua-effects who.ae thru-effects)
(run-events lab events)
=/ moves-1 (publish-aqua-effects who.afs thru-effects)
=^ moves-2 this (run-events lab events)
[(weld moves-1 moves-2) this]
::
:: Subscribe to effects
::

View File

@ -27,7 +27,7 @@
::
:: Called on every effect from a ship.
::
++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start)]))
++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start))])
--
::
++ porcelain-test-core

View File

@ -69,28 +69,28 @@
snap=(unit snapshot:jael)
==
::
+$ vane-card
+$ vane-move
%+ pair bone
$% [%peer wire dock path]
[%pull wire dock ~]
==
::
++ aqua-vane-control-handler
|= subscribed=?
|= command=?(%subscribe %unsubscribe)
^- (list vane-cards)
|= [our=@p ost=bone subscribed=? command=?(%subscribe %unsubscribe)]
^- (list vane-move)
?- command
%subscribe
%+ weld
^- (list vane-card)
^- (list vane-move)
?. subscribed
~
[%pull /aqua [our %ph]]~
^- (list vane-card)
[%peer /aqua [our %ph] /effects]~
[ost %pull /aqua [our %ph] ~]~
^- (list vane-move)
[ost %peer /aqua [our %ph] /effects]~
::
%unsubscribe
?. subscribed
~
[%pull /aqua [our %ph]]~
--
[ost %pull /aqua [our %ph] ~]~
==
--