mirror of
https://github.com/ilyakooo0/urbit.git
synced 2025-01-05 13:55:54 +03:00
compiles
This commit is contained in:
parent
dab83cd28e
commit
ae8966e5ad
@ -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 ~]]~
|
||||
::
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
--
|
||||
|
@ -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
|
||||
--
|
||||
--
|
||||
|
@ -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
|
||||
::
|
||||
|
45
app/ph.hoon
45
app/ph.hoon
@ -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
|
||||
::
|
||||
|
@ -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
|
||||
|
@ -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] ~]~
|
||||
==
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user