tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

Indexed.hs (1400B)

      1 -- Name-neutral indexed object codec, shared by import, loading and publication.
      2 module ContentStore.Indexed
      3   ( indexedTreeDomain, encodeIndexedTree, decodeIndexedTree ) where
      4 
      5 import ContentStore.Object
      6 import Runtime (T)
      7 import Wire
      8 import Data.ByteString (ByteString)
      9 import qualified Data.Vector as V
     10 
     11 -- A single name-neutral root in the existing indexed Arboricx wire format.
     12 -- This is a distinct object kind, not a new encoding under tree-term hashes.
     13 indexedTreeDomain :: Domain
     14 indexedTreeDomain = Domain "arboricx.indexed-tree.v1"
     15 
     16 -- The same name-neutral canonical object emitted by indexed bundle import.
     17 -- Preserve sharing before serialization, without applying the supplied tree.
     18 encodeIndexedTree :: T -> IO ByteString
     19 encodeIndexedTree tree = encodeBundle <$> buildBundleShared [("root", tree)]
     20 
     21 decodeIndexedTree :: ByteString -> Either String T
     22 decodeIndexedTree payload = do
     23   bundle <- decodeBundle payload
     24   verifyBundle bundle
     25   root <- case (bundleRoots bundle, manifestExports $ bundleManifest bundle) of
     26     ([index], [exported])
     27       | exportName exported == "root" && exportRoot exported == index
     28       , exportKind exported == "term", exportAbi exported == "arboricx.abi.tree.v1" -> Right index
     29     _ -> Left "indexed tree requires one root named root with the tree ABI"
     30   let terms = reconstructBundleTerms (bundleNodes bundle)
     31   pure (terms V.! fromIntegral root)
     32