urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-12 10:29:01 +03:00
Code Issues Packages Projects Releases Wiki Activity

basic ph test composition

Browse Source
This commit is contained in:
Philip Monk 2019-02-11 15:25:25 -08:00
parent 17cea6a1c7
commit 600dc02a2f
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
2 changed files with 178 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
app/ph.hoon
View File

@ -1,4 +1,4 @@
:: Test the pH of your aquarium. See if it's safe to put real fish in. :: Test the pH of your aquarium. See if it's safe to put in real fish.
:: ::
:: usage: :: usage:
:: :aqua [%run-test %test-add] :: :aqua [%run-test %test-add]
@ -42,82 +42,64 @@
:- %add :- %add
=+ num=5 =+ num=5
|% |%
++ ships ~[~bud]
++ start ++ start
^- (trel (list ship) (list ph-event) _..start) ^- (pair (list ph-event) _..start)
=. num +(num) =. num +(num)
:+ ~[~bud] :_ ..start
%- zing %- zing
:~ (init ~bud) :~ (init ~bud)
(dojo ~bud "[%test-result (add 2 3)]") (dojo ~bud "[%test-result (add 2 3)]")
== ==
..start
:: ::
++ route ++ route
|= [who=ship ovo=unix-effect] |= [who=ship ovo=unix-effect]
^- (list ph-event) ^- (quip ph-event _..start)
~& [%num num] ~& [%num num]
:_ ..start
(expect-dojo-output ~bud who ovo "[%test-result 5]") (expect-dojo-output ~bud who ovo "[%test-result 5]")
:: XX if it's been five minutes, we failed :: XX if it's been five minutes, we failed
-- --
:: ::
:- %hi :- %hi
|% |%
++ ships ~[~bud ~marbud]
++ start ++ start
^- (trel (list ship) (list ph-event) _..start) ^- (pair (list ph-event) _..start)
:+ ~[~bud ~dev] :_ ..start
%- zing %- zing
:~ (init ~bud) :~ (init ~bud)
(init ~dev) (init ~dev)
(dojo ~bud "|hi ~dev") (dojo ~bud "|hi ~dev")
== ==
..start
:: ::
++ route ++ route
|= [who=ship ovo=unix-effect] |= [who=ship ovo=unix-effect]
^- (list ph-event) ^- (quip ph-event _..start)
:_ ..start
(expect-dojo-output ~bud who ovo "hi ~dev successful") (expect-dojo-output ~bud who ovo "hi ~dev successful")
-- --
:: ::
:- %child-sync [%headstart-marbud marbud:head-starts]
::
:- %composed-child-sync
%+ compose-tests marbud:head-starts
^- test-core
|% |%
++ ships ~[~bud ~marbud ~linnup-torsyx]
++ start ++ start
^- (trel (list ship) (list ph-event) _..start) :_ ..start
:+ ~[~bud ~marbud ~linnup-torsyx] (init ~linnup-torsyx)
%- zing ::
:~ (init ~bud)
:: (dojo ~bud "\"magic-go\":[.^(")
:: (dojo ~bud "|mount %")
:: %+ insert-file ~bud
:: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon
:: (init ~marbud)
:: (dojo ~marbud "|mount %")
:: %+ insert-file ~marbud
:: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon
==
..start
++ route ++ route
|= [who=ship ovo=unix-effect] |= [who=ship ovo=unix-effect]
^- (list ph-event) ^- (quip ph-event _..start)
:_ ..start
%- zing %- zing
:~ :~
%- on-dojo-output
:^ ~bud who ovo
:- "+ /~bud/base/2/web/testing/udon"
^- $-($~ (list ph-event))
|= ~
(init ~marbud)
::
%- on-dojo-output
:^ ~marbud who ovo
:- "; ~bud is your neighbor"
^- $-($~ (list ph-event))
|= ~
(init ~linnup-torsyx)
::
%- on-dojo-output %- on-dojo-output
:^ ~linnup-torsyx who ovo :^ ~linnup-torsyx who ovo
:- "; ~bud is your neighbor" :- "; ~bud is your neighbor"
^- $-($~ (list ph-event))
|= ~ |= ~
(dojo ~linnup-torsyx "|hi ~bud") (dojo ~linnup-torsyx "|hi ~bud")
:: ::
@ -125,11 +107,62 @@
:^ ~linnup-torsyx who ovo :^ ~linnup-torsyx who ovo
:- "hi ~bud successful" :- "hi ~bud successful"
:: :- "; ~bud is your neighbor" :: :- "; ~bud is your neighbor"
^- $-($~ (list ph-event))
|= ~ |= ~
[%test-done &]~ [%test-done &]~
== ==
-- --
::
:- %child-sync
|%
++ ships ~[~bud ~marbud ~linnup-torsyx]
++ start
^- (pair (list ph-event) _..start)
:_ ..start
%- zing
:~ (init ~bud)
==
::
++ route
|= [who=ship ovo=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- zing
:~
%- on-dojo-output
:^ ~bud who ovo
:- "+ /~bud/base/2/web/testing/udon"
|= ~
(init ~marbud)
::
%- on-dojo-output
:^ ~marbud who ovo
:- "; ~bud is your neighbor"
|= ~
(init ~linnup-torsyx)
::
%- on-dojo-output
:^ ~linnup-torsyx who ovo
:- "; ~bud is your neighbor"
|= ~
(dojo ~linnup-torsyx "|hi ~bud")
::
%- on-dojo-output
:^ ~linnup-torsyx who ovo
:- "hi ~bud successful"
:: :- "; ~bud is your neighbor"
|= ~
[%test-done &]~
==
--
:: (dojo ~bud "\"magic-go\":[.^(")
:: (dojo ~bud "|mount %")
:: %+ insert-file ~bud
:: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon
:: (init ~marbud)
:: (dojo ~marbud "|mount %")
:: %+ insert-file ~marbud
:: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon
::
:: (init ~zod) :: (init ~zod)
:: (init ~marzod) :: (init ~marzod)
:: wait for initial sync :: wait for initial sync
@ -229,10 +262,10 @@
^- (quip move _this) ^- (quip move _this)
?+ arg ~|(%bad-noun-arg !!) ?+ arg ~|(%bad-noun-arg !!)
[%run-test lab=@tas] [%run-test lab=@tas]
=/ res=[hers=(list ship) events=(list ph-event) new-state=test-core] =/ res=[events=(list ph-event) new-state=test-core]
start:(~(got by raw-test-cores) lab.arg) start:(~(got by raw-test-cores) lab.arg)
=. test-cores (~(put by test-cores) lab.arg hers.res new-state.res) =. test-cores (~(put by test-cores) lab.arg [ships .]:new-state.res)
=^ moves-1 this (subscribe-to-effects lab.arg hers.res) =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res)
=^ moves-2 this (run-events lab.arg events.res) =^ moves-2 this (run-events lab.arg events.res)
[(weld moves-1 moves-2) this] [(weld moves-1 moves-2) this]
== ==
@ -247,12 +280,15 @@
?~ test-cor ?~ test-cor
~& [%ph-dropping lab] ~& [%ph-dropping lab]
`this `this
%+ run-events lab =^ events u.test-cor
|- ^- (list ph-event) |- ^- (quip ph-event _u.test-cor)
?~ ovo.ova ?~ ovo.ova
~ [~ u.test-cor]
:: ~& [%diff-aqua-effect-i way -.q.i.ovo.ova] =^ events-1 cor.u.test-cor
%+ weld (route:cor.u.test-cor who.ova i.ovo.ova)
(route:cor.u.test-cor who.ova i.ovo.ova) =^ events-2 u.test-cor
$(ovo.ova t.ovo.ova) $(ovo.ova t.ovo.ova)
[(weld events-1 events-2) u.test-cor]
=. test-cores (~(put by test-cores) lab u.test-cor)
(run-events lab events)
-- --

83
lib/ph.hoon
View File

@ -22,8 +22,9 @@
++ test-core ++ test-core
$_ ^? $_ ^?
|% |%
++ start *(trel (list ship) (list ph-event) _^?(..start)) ++ ships *(list ship)
++ route |~([ship unix-effect] *(list ph-event)) ++ start *(quip ph-event _^?(..start))
++ route |~([ship unix-effect] *(quip ph-event _^?(..start)))
-- --
:: ::
++ ph-event ++ ph-event
@ -90,4 +91,82 @@
:- what :- what
|= ~ |= ~
[%test-done &]~ [%test-done &]~
::
++ compose-tests
|= [a=test-core b=test-core]
^- test-core
=/ done-with-a |
|%
:: Union of ships in a and b
::
++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b)))
::
:: Start with start of a
::
++ start
^- (quip ph-event _..start)
=^ events a start:a
[events ..start]
::
:: Keep going on a until it's done. If success, go to b.
::
:: In theory, we should be able to just swap out the whole core
:: for b, but in practice the types are hard, and we generally
:: try to avoid changing the structure of a core in the middle
:: like that.
::
++ route
|= [who=ship ovo=unix-effect]
^- (quip ph-event _..start)
?: done-with-a
=^ events b (route:b who ovo)
[events ..start]
=^ events a (route:a who ovo)
=+ ^- [done=(list ph-event) other-events=(list ph-event)]
%+ skid events
|= e=ph-event
=(%test-done -.e)
?~ done
[other-events ..start]
?> ?=(%test-done -.i.done)
?. p.i.done
[[%test-done |]~ ..start]
=. done-with-a &
=^ events-start b start:b
[(weld other-events events-start) ..start]
--
::
++ head-starts
|%
++ marbud
^- test-core
|%
++ ships ~[~bud ~marbud]
++ start
^- (quip ph-event _..start)
:_ ..start
%- zing
:~ (init ~bud)
==
::
++ route
|= [who=ship ovo=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- zing
:~
%- on-dojo-output
:^ ~bud who ovo
:- "+ /~bud/base/2/web/testing/udon"
|= ~
(init ~marbud)
::
%- on-dojo-output
:^ ~marbud who ovo
:- "; ~bud is your neighbor"
|= ~
[%test-done &]~
==
--
--
-- --