!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)