ford: add +got-build helper

Replaced manual calls to (~(got by builds.state) build) with a new
+got-build helper function that prints a helpful error message on
failure.
This commit is contained in:
Ted Blackman 2020-01-28 14:13:35 -08:00 committed by Jared Tobin
parent 87581ba5f8
commit 0d69031c72
No known key found for this signature in database
GPG Key ID: 0E4647D58F8A69E4
2 changed files with 26 additions and 30 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1 version https://git-lfs.github.com/spec/v1
oid sha256:9063b34d6f7bd309df947753fbc1e5cda5fca9399bbfd62c2a2a67ac6e21f3b1 oid sha256:e95d9cf2bd687c90b9696bed7dd82635f24d324483b06cf0eebf07f3c16c39f0
size 9654478 size 9651263

View File

@ -1538,7 +1538,7 @@
:: ::
|- ^+ state |- ^+ state
:: ::
=/ client-status=build-status (~(got by builds.state) build) =/ client-status=build-status (got-build build)
=/ subs=(list ^build) ~(tap in ~(key by subs.client-status)) =/ subs=(list ^build) ~(tap in ~(key by subs.client-status))
:: ::
|- ^+ state |- ^+ state
@ -1586,14 +1586,14 @@
|= [=build =anchor] |= [=build =anchor]
^+ builds.state ^+ builds.state
:: ::
=/ =build-status (~(got by builds.state) build) =/ =build-status (got-build build)
=/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) =/ subs=(list ^build) ~(tap in ~(key by subs.build-status))
=/ client=^build build =/ client=^build build
:: ::
|- ^+ builds.state |- ^+ builds.state
?~ subs builds.state ?~ subs builds.state
:: ::
=/ sub-status=^build-status (~(got by builds.state) i.subs) =/ sub-status=^build-status (got-build i.subs)
:: ::
=. clients.sub-status =. clients.sub-status
(~(del ju clients.sub-status) anchor client) (~(del ju clients.sub-status) anchor client)
@ -1612,7 +1612,7 @@
|= =build |= =build
^+ state ^+ state
:: ::
=/ =build-status (~(got by builds.state) build) =/ =build-status (got-build build)
=/ new-anchors =/ new-anchors
~(tap in (~(put in ~(key by clients.build-status)) [%duct duct])) ~(tap in (~(put in ~(key by clients.build-status)) [%duct duct]))
=/ subs ~(tap in ~(key by subs.build-status)) =/ subs ~(tap in ~(key by subs.build-status))
@ -1642,14 +1642,14 @@
|= [=anchor =build] |= [=anchor =build]
^+ builds.state ^+ builds.state
:: ::
=/ =build-status (~(got by builds.state) build) =/ =build-status (got-build build)
=/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) =/ subs=(list ^build) ~(tap in ~(key by subs.build-status))
=/ client=^build build =/ client=^build build
:: ::
|- ^+ builds.state |- ^+ builds.state
?~ subs builds.state ?~ subs builds.state
:: ::
=/ sub-status=^build-status (~(got by builds.state) i.subs) =/ sub-status=^build-status (got-build i.subs)
:: ::
=/ already-had-anchor=? (~(has by clients.sub-status) anchor) =/ already-had-anchor=? (~(has by clients.sub-status) anchor)
:: ::
@ -1687,9 +1687,7 @@
++ copy-node ++ copy-node
^+ state ^+ state
:: ::
=/ old-build-status=build-status =/ old-build-status=build-status (got-build old-client)
~| old-client=(build-to-tape old-client)
(~(got by builds.state) old-client)
:: ::
=/ old-subs=(list build) ~(tap in ~(key by subs.old-build-status)) =/ old-subs=(list build) ~(tap in ~(key by subs.old-build-status))
=/ new-subs=(list build) (turn old-subs |=(a=build a(date new-date))) =/ new-subs=(list build) (turn old-subs |=(a=build a(date new-date)))
@ -1837,7 +1835,7 @@
=. state (add-build build) =. state (add-build build)
:: ignore blocked builds :: ignore blocked builds
:: ::
=/ =build-status (~(got by builds.state) build) =/ =build-status (got-build build)
?: ?=(%blocked -.state.build-status) ?: ?=(%blocked -.state.build-status)
=. state (add-anchors-to-build-subs build) =. state (add-anchors-to-build-subs build)
:: ::
@ -1887,10 +1885,7 @@
?~ old-build ?~ old-build
(add-build-to-next build) (add-build-to-next build)
:: ::
=/ old-build-status=^build-status =/ old-build-status=^build-status (got-build u.old-build)
~| [%missing-old-build (build-to-tape u.old-build)]
~| [%build-state (turn ~(tap in ~(key by builds.state)) build-to-tape)]
(~(got by builds.state) u.old-build)
:: selectively promote scry builds :: selectively promote scry builds
:: ::
:: We can only promote a scry if it's not forced and we ran the same :: We can only promote a scry if it's not forced and we ran the same
@ -1918,7 +1913,7 @@
?. ?=([~ %value *] old-build-record) ?. ?=([~ %value *] old-build-record)
(add-build-to-next build) (add-build-to-next build)
:: ::
=. old-build-status (~(got by builds.state) u.old-build) =. old-build-status (got-build u.old-build)
:: ::
=/ old-subs=(list ^build) ~(tap in ~(key by subs.old-build-status)) =/ old-subs=(list ^build) ~(tap in ~(key by subs.old-build-status))
=/ new-subs=(list ^build) =/ new-subs=(list ^build)
@ -5482,6 +5477,13 @@
:: ::
::+| utilities ::+| utilities
:: ::
:: +got-build: lookup :build in state, asserting presence
::
++ got-build
|= =build
^- build-status
~| [%ford-missing-build build=(build-to-tape build) duct=duct]
(~(got by builds.state) build)
:: +add-build: store a fresh, unstarted build in the state :: +add-build: store a fresh, unstarted build in the state
:: ::
++ add-build ++ add-build
@ -5554,9 +5556,7 @@
|= [=build update-func=$-(build-status build-status)] |= [=build update-func=$-(build-status build-status)]
^- [build-status builds=_builds.state] ^- [build-status builds=_builds.state]
:: ::
=/ original=build-status =/ original=build-status (got-build build)
~| [%update-build (build-to-tape build)]
(~(got by builds.state) build)
=/ mutant=build-status (update-func original) =/ mutant=build-status (update-func original)
:: ::
[mutant (~(put by builds.state) build mutant)] [mutant (~(put by builds.state) build mutant)]
@ -5615,9 +5615,7 @@
|= =build |= =build
^+ [unblocked builds.state] ^+ [unblocked builds.state]
:: ::
=/ =build-status =/ =build-status (got-build build)
~| [%unblocking (build-to-tape build)]
(~(got by builds.state) build)
:: ::
=/ clients=(list ^build) ~(tap in (~(get ju clients.build-status) [%duct duct])) =/ clients=(list ^build) ~(tap in (~(get ju clients.build-status) [%duct duct]))
:: ::
@ -5661,7 +5659,7 @@
:: ::
=/ duct-status (~(got by ducts.state) duct) =/ duct-status (~(got by ducts.state) duct)
:: ::
=/ =build-status (~(got by builds.state) build) =/ =build-status (got-build build)
?: (~(has in requesters.build-status) [%duct duct]) ?: (~(has in requesters.build-status) [%duct duct])
(on-root-build-complete build) (on-root-build-complete build)
:: ::
@ -5698,7 +5696,7 @@
:: ::
res res
:: ::
=/ =build-status (~(got by builds.state) build) =/ =build-status (got-build build)
=/ =duct-status (~(got by ducts.state) duct) =/ =duct-status (~(got by ducts.state) duct)
:: make sure we have something to send :: make sure we have something to send
:: ::
@ -5807,7 +5805,7 @@
|= =build |= =build
^+ ..execute ^+ ..execute
:: ::
=/ =build-status (~(got by builds.state) build) =/ =build-status (got-build build)
:: ::
=/ orphans=(list ^build) =/ orphans=(list ^build)
%+ murn ~(tap by subs.build-status) %+ murn ~(tap by subs.build-status)
@ -5919,9 +5917,7 @@
?: ?=(%pin -.schematic.build) ?: ?=(%pin -.schematic.build)
~ ~
:: ::
=/ subs =/ subs ~(tap in ~(key by subs:(got-build build)))
~| [%collect-live-resource (build-to-tape build)]
~(tap in ~(key by subs:(~(got by builds.state) build)))
=| resources=(jug disc resource) =| resources=(jug disc resource)
|- |-
?~ subs ?~ subs
@ -5947,7 +5943,7 @@
:: only recurse on blocked sub-builds :: only recurse on blocked sub-builds
:: ::
=/ subs=(list ^build) =/ subs=(list ^build)
%+ murn ~(tap by subs:(~(got by builds.state) build)) %+ murn ~(tap by subs:(got-build build))
|= [sub=^build =build-relation] |= [sub=^build =build-relation]
^- (unit ^build) ^- (unit ^build)
:: ::