137 lines
4.3 KiB
Plaintext
137 lines
4.3 KiB
Plaintext
!import "arboricx-manifest.tri" !Local
|
|
|
|
-- Read and validate a full Arboricx bundle.
|
|
-- Returns (pair validManifest afterContainer).
|
|
-- The manifest core fields are validated against expected values.
|
|
readArboricxBundle = (bs :
|
|
bindResult (readArboricxRequiredSections bs)
|
|
(sections afterContainer :
|
|
matchPair
|
|
(manifestBytes _ :
|
|
bindResult (readManifest manifestBytes)
|
|
(parsedManifest afterManifest :
|
|
matchPair
|
|
(coreManifest metadataWithExtensions :
|
|
bindResult (validateManifestCore coreManifest afterManifest)
|
|
(validCore _ : ok (pair validCore metadataWithExtensions) afterContainer))
|
|
parsedManifest))
|
|
sections))
|
|
|
|
-- Select an export from a validated bundle and reconstruct its root tree.
|
|
-- Returns ok executable afterContainer, or propagates parse/selection/node errors.
|
|
readArboricxExecutableByName = (nameBytes bs :
|
|
bindResult (readArboricxBundle bs)
|
|
(bundleResult afterBundle :
|
|
matchPair
|
|
(validCore _ :
|
|
bindResult (selectExport (manifestExports validCore) nameBytes)
|
|
(selectedExport _ :
|
|
readArboricxTreeFromHash (exportRoot selectedExport) bs))
|
|
bundleResult))
|
|
|
|
readArboricxExecutable = (bs :
|
|
readArboricxExecutableByName [] bs)
|
|
|
|
applyArgs = (f args :
|
|
foldl
|
|
(acc arg : acc arg)
|
|
f
|
|
args)
|
|
|
|
runArboricxByName = (nameBytes bs arg :
|
|
bindResult (readArboricxExecutableByName nameBytes bs)
|
|
(executable rest : ok (executable arg) rest))
|
|
|
|
runArboricx = (bs arg :
|
|
runArboricxByName [] bs arg)
|
|
|
|
runArboricxArgsByName = (nameBytes bs args :
|
|
bindResult (readArboricxExecutableByName nameBytes bs)
|
|
(executable rest : ok (applyArgs executable args) rest))
|
|
|
|
runArboricxArgs = (bs args :
|
|
runArboricxArgsByName [] bs args)
|
|
|
|
errHostCodecFailed = 14
|
|
|
|
hostTreeTag = 0
|
|
hostStringTag = 1
|
|
hostNumberTag = 2
|
|
hostBoolTag = 3
|
|
hostListTag = 4
|
|
hostBytesTag = 5
|
|
|
|
hostTree = (value : pair hostTreeTag value)
|
|
hostString = (bytes : pair hostStringTag bytes)
|
|
hostNumber = (n : pair hostNumberTag n)
|
|
hostBool = (b : pair hostBoolTag b)
|
|
hostList = (xs : pair hostListTag xs)
|
|
hostBytes = (bytes : pair hostBytesTag bytes)
|
|
|
|
hostValueTag = (hostValue : pairFirst hostValue)
|
|
hostValuePayload = (hostValue : pairSecond hostValue)
|
|
|
|
hostBool? = (value : or? (equal? value false) (equal? value true))
|
|
|
|
hostNumber? = y (self value :
|
|
triage
|
|
true
|
|
(_ : false)
|
|
(bit rest :
|
|
and?
|
|
(or? (equal? bit false) (equal? bit true))
|
|
(self rest))
|
|
value)
|
|
|
|
hostList? = y (self value :
|
|
triage
|
|
true
|
|
(_ : false)
|
|
(_ rest : self rest)
|
|
value)
|
|
|
|
hostString? = y (self value :
|
|
matchList
|
|
true
|
|
(byte rest : and? (hostNumber? byte) (self rest))
|
|
value)
|
|
|
|
hostBytes? = hostString?
|
|
|
|
wrapHostValue = (validator wrapper resultValue rest :
|
|
matchBool
|
|
(ok (wrapper resultValue) rest)
|
|
(err errHostCodecFailed resultValue)
|
|
(validator resultValue))
|
|
|
|
runArboricxByNameToTree = (nameBytes bs args :
|
|
bindResult (runArboricxArgsByName nameBytes bs args)
|
|
(value rest : ok (hostTree value) rest))
|
|
|
|
runArboricxByNameToString = (nameBytes bs args :
|
|
bindResult (runArboricxArgsByName nameBytes bs args)
|
|
(value rest : wrapHostValue hostString? hostString value rest))
|
|
|
|
runArboricxByNameToNumber = (nameBytes bs args :
|
|
bindResult (runArboricxArgsByName nameBytes bs args)
|
|
(value rest : wrapHostValue hostNumber? hostNumber value rest))
|
|
|
|
runArboricxByNameToBool = (nameBytes bs args :
|
|
bindResult (runArboricxArgsByName nameBytes bs args)
|
|
(value rest : wrapHostValue hostBool? hostBool value rest))
|
|
|
|
runArboricxByNameToList = (nameBytes bs args :
|
|
bindResult (runArboricxArgsByName nameBytes bs args)
|
|
(value rest : wrapHostValue hostList? hostList value rest))
|
|
|
|
runArboricxByNameToBytes = (nameBytes bs args :
|
|
bindResult (runArboricxArgsByName nameBytes bs args)
|
|
(value rest : wrapHostValue hostBytes? hostBytes value rest))
|
|
|
|
runArboricxToTree = (bs args : runArboricxByNameToTree [] bs args)
|
|
runArboricxToString = (bs args : runArboricxByNameToString [] bs args)
|
|
runArboricxToNumber = (bs args : runArboricxByNameToNumber [] bs args)
|
|
runArboricxToBool = (bs args : runArboricxByNameToBool [] bs args)
|
|
runArboricxToList = (bs args : runArboricxByNameToList [] bs args)
|
|
runArboricxToBytes = (bs args : runArboricxByNameToBytes [] bs args)
|