Arboricx bundle format 1.1

We don't need SHA verification or Merkle dags in our transport bundle. Content
stores can handle both bundle and term verification and hashing.

src/FileEval.hs

@@ -11,20 +11,19 @@ import Eval (evalTricu, evalTricuWithStore)
 import Lexer
 import Parser
 import Research
-import ContentStore (newContentStore, storeTerm, hashTerm)
+import Wire (buildBundle, encodeBundle, decodeBundle, verifyBundle, Bundle(..))
 import Database.SQLite.Simple (Connection)
-import Wire (exportNamedBundle, defaultExportNames)
 
-import Control.Monad   (forM_)
 import Data.List       (partition)
 import Data.Maybe      (mapMaybe)
 import System.FilePath (takeDirectory, normalise, (</>))
 import System.Exit (die)
-import Database.SQLite.Simple (close)
 
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.Sequence as Seq
 import qualified Data.Text as T
 
 extractMain :: Env -> Either String T
@@ -176,37 +175,27 @@ nsVariable "" name = name
 nsVariable moduleName name = moduleName ++ "." ++ name
 
 -- | Compile a tricu source file to a standalone Arboricx bundle.
--- Uses a temp content store so it does not collide with the global one.
--- Supports multiple named exports; each is stored separately in the
--- temp store so that resolveExportTarget can look them up by name.
+-- Emits a canonical indexed bundle with no SHA-256 hashing.
 compileFile :: FilePath -> FilePath -> [T.Text] -> IO ()
 compileFile inputPath outputPath maybeNames = do
-  -- Evaluate the file to get the full environment
   env <- evaluateFile inputPath
-  -- Look up each requested definition name
   let defaultNames = ["main"]
       wantedNames  = if null maybeNames then defaultNames else maybeNames
       wantedNamesUnpacked = map T.unpack wantedNames
   compiledTerms <- mapM (\n -> case Map.lookup n env of
     Nothing -> die $ "No definition '" ++ n ++ "' found in " ++ inputPath
-    Just t  -> return (n, t)) wantedNamesUnpacked
-  let compiledMap :: Map.Map T.Text T = Map.fromList
-                $ map (\(n,t) -> (T.pack n, t)) compiledTerms
-      compiledNames :: [T.Text] = Map.keys compiledMap
-      compiledTermsList :: [T] = Map.elems compiledMap
-  -- Create a temp in-memory content store
-  conn <- newContentStore
-  -- Store each term in the temp store under its requested name
-  forM_ (zip compiledNames compiledTermsList) $ \(n, t) ->
-    storeTerm conn [T.unpack n] t
-  -- Generate default export names when none were supplied
-  let expNames = if null maybeNames
-        then defaultExportNames (length compiledNames)
-        else compiledNames
-      exports :: [(T.Text, MerkleHash)] = zip expNames (map hashTerm compiledTermsList)
-  -- Export the bundle (exportNamedBundle returns already-encoded bytes)
-  bundleData <- exportNamedBundle conn exports
+    Just t  -> return (T.pack n, t)) wantedNamesUnpacked
+  let bundle = buildBundle compiledTerms
+      bundleData = encodeBundle bundle
+      nodeCount = Seq.length (bundleNodes bundle)
+      bundleSize = BS.length bundleData
   BL.writeFile outputPath (BL.fromStrict bundleData)
-  close conn
   putStrLn $ "Compiled " ++ inputPath ++ " -> " ++ outputPath
-  putStrLn $ "  exports: " ++ T.unpack (T.intercalate ", " expNames)
+  putStrLn $ "  exports: " ++ T.unpack (T.intercalate ", " (map fst compiledTerms))
+  putStrLn $ "  nodes: " ++ show nodeCount
+  putStrLn $ "  size: " ++ show bundleSize ++ " bytes"
+  case decodeBundle bundleData of
+    Left err -> putStrLn $ "  round-trip decode failed: " ++ err
+    Right decoded -> case verifyBundle decoded of
+      Left err -> putStrLn $ "  round-trip verify failed: " ++ err
+      Right () -> putStrLn $ "  round-trip: OK"