feat(haskell): CLI rewrite

src/ContentStore.hs

@@ -40,8 +40,15 @@ serializeNameList :: [Text] -> Text
 serializeNameList = T.intercalate "," . nub . sort
 
 initContentStore :: IO Connection
-initContentStore = do
+initContentStore = initContentStoreWithPath Nothing
-  dbPath <- getContentStorePath
+
+-- | Initialise a content store with an explicit path, or fall back
+--   to the environment variable / default location.
+initContentStoreWithPath :: Maybe FilePath -> IO Connection
+initContentStoreWithPath mPath = do
+  dbPath <- case mPath of
+    Just p  -> return p
+    Nothing -> getContentStorePath
   createDirectoryIfMissing True (takeDirectory dbPath)
   conn <- open dbPath
   setupDatabase conn

src/Eval.hs

@@ -93,6 +93,43 @@ evalAST mconn selectedVersions ast = do
   resolvedEnv <- resolveTermsFromStore mconn selectedVersions varNames
   return $ evalASTSync resolvedEnv ast
 
+-- | Evaluate a single AST term using a local environment augmented by
+--   lazily-resolved store terms.
+evalASTWithEnv :: Maybe Connection -> Env -> TricuAST -> IO T
+evalASTWithEnv mconn localEnv ast = do
+  let varNames = collectVarNames ast
+  storeEnv <- resolveTermsFromStore mconn Map.empty varNames
+  let combinedEnv = Map.union localEnv storeEnv
+  return $ evalASTSync combinedEnv ast
+
+-- | Store-aware version of 'evalSingle'.
+evalSingleWithStore :: Maybe Connection -> Env -> TricuAST -> IO Env
+evalSingleWithStore mconn env term
+  | SDef name [] body <- term = do
+      res <- evalASTWithEnv mconn env body
+      case Map.lookup name env of
+        Just existingValue
+          | existingValue == res -> return env
+          | otherwise -> return $ Map.insert "!result" res (Map.insert name res env)
+        Nothing -> return $ Map.insert "!result" res (Map.insert name res env)
+  | otherwise = do
+      res <- evalASTWithEnv mconn env term
+      return $ Map.insert "!result" res env
+
+-- | Store-aware version of 'evalTricu'.  Does not preload the entire
+--   content store; terms are resolved on demand as variables are
+--   encountered.
+evalTricuWithStore :: Maybe Connection -> Env -> [TricuAST] -> IO Env
+evalTricuWithStore mconn env x = go env (reorderDefs env x)
+  where
+    go env' []     = return env'
+    go env' [def]  = do
+      updatedEnv <- evalSingleWithStore mconn env' def
+      return $ Map.insert "!result" (result updatedEnv) updatedEnv
+    go env' (def:xs) = do
+      updatedEnv <- evalSingleWithStore mconn env' def
+      evalTricuWithStore mconn updatedEnv xs
+
 collectVarNames :: TricuAST -> [(String, Maybe String)]
 collectVarNames = go []
   where

src/FileEval.hs

@@ -2,21 +2,22 @@ module FileEval
   ( preprocessFile
   , evaluateFile
   , evaluateFileWithContext
+  , evaluateFileWithStore
   , evaluateFileResult
   , compileFile
   ) where
 
-import Eval (evalTricu)
+import Eval (evalTricu, evalTricuWithStore)
 import Lexer
 import Parser
 import Research
-import ContentStore (initContentStore, storeTerm, hashTerm)
+import ContentStore (newContentStore, storeTerm, hashTerm)
+import Database.SQLite.Simple (Connection)
 import Wire (exportNamedBundle, defaultExportNames)
 
 import Control.Monad   (forM_)
 import Data.List       (partition)
 import Data.Maybe      (mapMaybe)
-import System.Environment (setEnv)
 import System.FilePath (takeDirectory, normalise, (</>))
 import System.Exit (die)
 import Database.SQLite.Simple (close)
@@ -79,6 +80,18 @@ evaluateFileWithContext env filePath = do
       ast <- preprocessFile filePath
       pure $ evalTricu env ast
 
+-- | File evaluation that lazily resolves missing names from the
+--   content store instead of pre-loading the entire store into memory.
+evaluateFileWithStore :: Maybe Connection -> Env -> FilePath -> IO Env
+evaluateFileWithStore mconn env filePath = do
+  contents <- readFile filePath
+  let tokens = lexTricu contents
+  case parseProgram tokens of
+    Left err -> errorWithoutStackTrace (handleParseError err)
+    Right _ast -> do
+      ast <- preprocessFile filePath
+      evalTricuWithStore mconn env ast
+
 preprocessFile :: FilePath -> IO [TricuAST]
 preprocessFile p = preprocessFile' Set.empty p p
 
@@ -181,9 +194,8 @@ compileFile inputPath outputPath maybeNames = do
                 $ map (\(n,t) -> (T.pack n, t)) compiledTerms
       compiledNames :: [T.Text] = Map.keys compiledMap
       compiledTermsList :: [T] = Map.elems compiledMap
-  -- Create a temp content store
+  -- Create a temp in-memory content store
-  setEnv "TRICU_DB_PATH" "/tmp/tricu-compile.db"
+  conn <- newContentStore
-  conn <- initContentStore
   -- Store each term in the temp store under its requested name
   forM_ (zip compiledNames compiledTermsList) $ \(n, t) ->
     storeTerm conn [T.unpack n] t

src/Main.hs

@@ -1,280 +1,374 @@
 module Main where
 
-import ContentStore (initContentStore, loadEnvironment, loadTerm, resolveExportTarget)
+import ContentStore (initContentStoreWithPath, loadEnvironment, loadTerm, resolveExportTarget)
 import System.Exit (die)
-import Server (runServer)
+import Server (runServerWithPath)
-import Eval                   (evalTricu, mainResult, result)
+import Eval (evalTricu, evalTricuWithStore, mainResult, result)
-import FileEval
+import FileEval (evaluateFileWithContext, evaluateFileWithStore, compileFile)
 import Parser (parseTricu)
-import REPL
+import REPL (repl)
-import Research
+import Research (T, EvaluatedForm(..), Env, formatT, exportDag)
-import Wire
+import Wire (exportNamedBundle, defaultExportNames, importBundle)
 
-import Control.Monad          (foldM)
+import Control.Monad (foldM, unless, when)
-import Data.Text              (Text, unpack)
+import Data.Text (unpack, pack)
 import qualified Data.Text as T
 import Data.Version (showVersion)
 import Paths_tricu (version)
-import System.Console.CmdArgs
+import Options.Applicative
-import System.Environment     (lookupEnv)
-import System.IO              (hPutStrLn, stderr)
-import Text.Megaparsec        ()
 
 import qualified Data.ByteString.Lazy as BL
-import Database.SQLite.Simple (close)
+import Database.SQLite.Simple (Connection, close)
 
 import qualified Data.Map as Map
+import System.Environment (lookupEnv)
+
+-- ---------------------------------------------------------------------------
+-- CLI argument types
+-- ---------------------------------------------------------------------------
 
 data TricuArgs
   = Repl
-  | Evaluate { file :: [FilePath], form :: EvaluatedForm, outFile :: FilePath }
+  | Eval
-  | TDecode { file :: [FilePath] }
+      { evalFiles   :: [FilePath]
-  | Compile { inputFile :: FilePath, outFile :: FilePath, names :: [String] }
+      , evalFormat  :: EvaluatedForm
-  | Export { hash :: String, exportNameOpt :: String, outFile :: FilePath, names :: [String] }
+      , evalOutput  :: FilePath
-  | Import { inFile :: FilePath }
+      , evalDb      :: Maybe FilePath
-  | Serve { host :: String, port :: Int }
-  | ExportDag { target :: String, outFile :: FilePath }
-  deriving (Show, Data, Typeable)
-
-replMode :: TricuArgs
-replMode = Repl
-  &= help "Start interactive REPL"
-  &= auto
-  &= name "repl"
-
-evaluateMode :: TricuArgs
-evaluateMode = Evaluate
-  { file = def &= help "Input file path(s) for evaluation.\n \
-      \ Defaults to stdin."
-      &= name "f" &= typ "FILE"
-    , form = TreeCalculus &= typ "FORM"
-      &= help "Optional output form: (tree|fsl|ast|ternary|ascii|decode).\n \
-      \ Defaults to tricu-compatible `t` tree form."
-      &= name "t"
-    , outFile = def &= help "Optional output file path. Defaults to stdout."
-      &= name "o" &= typ "FILE"
       }
-  &= help "Evaluate tricu and return the result of the final expression."
+  | ArboricxCompile
-  &= explicit
+      { compileInput  :: FilePath
-  &= name "eval"
+      , compileOutput :: FilePath
-
+      , compileNames  :: [String]
-decodeMode :: TricuArgs
+      , compileDb     :: Maybe FilePath
-decodeMode = TDecode
-  { file = def
-    &= help "Optional input file path to attempt decoding.\n \
-    \ Defaults to stdin."
-    &= name "f" &= typ "FILE"
       }
-  &= help "Decode a Tree Calculus value into a string representation."
+  | ArboricxImport
-  &= explicit
+      { importFile :: FilePath
-  &= name "decode"
+      , importDb   :: Maybe FilePath
-
-exportMode :: TricuArgs
-exportMode = Export
-  { hash = def &= help "Hash or stored term name(s) to export (comma-separated)."
-             &= name "h" &= typ "HASH_OR_NAME"
-    , exportNameOpt = def &= help "Export name (legacy; use -n NAME for full control)."
-             &= name "n" &= typ "NAME"
-    , outFile = def &= help "Output file path for the bundle." &= name "o" &= typ "FILE"
-    , names = def &= help "Export name(s) for the bundle manifest (comma-separated or repeated -n)."
-               &= typ "NAME"
       }
-  &= help "Export a Merkle bundle from the content store."
+  | ArboricxExport
-  &= explicit
+      { exportTargets :: [String]
-  &= name "export"
+      , exportOutput  :: FilePath
-
+      , exportNames   :: [String]
-importMode :: TricuArgs
+      , exportDb      :: Maybe FilePath
-importMode = Import
+      , dag           :: Bool
-  { inFile = def &= help "Path to the bundle file to import."
-               &= name "f" &= typ "FILE"
       }
-  &= help "Import a Merkle bundle into the content store."
+  | ArboricxServe
-  &= explicit
+      { serveHost :: String
-  &= name "import"
+      , servePort :: Int
-
+      , serveDb   :: Maybe FilePath
-compileMode :: TricuArgs
-compileMode = Compile
-  { inputFile = def &= help "Path to the tricu source file (.tri) to compile."
-                  &= name "f" &= typ "FILE"
-  , outFile = def &= help "Output bundle file path (.tri.bundle)."
-                &= name "o" &= typ "FILE"
-  , names = def &= help "Definition name(s) to export as bundle roots (comma-separated or repeated -x). Defaults to 'main'."
-              &= name "x" &= typ "NAME"
       }
-  &= help "Compile a tricu source file into a standalone Arboricx portable bundle."
+  deriving (Show)
-  &= explicit
-  &= name "compile"
 
-serveMode :: TricuArgs
+-- ---------------------------------------------------------------------------
-serveMode = Serve
+-- optparse-applicative parsers
-  { host = "127.0.0.1" &= help "Host to bind the server to." &= name "h" &= typ "HOST"
+-- ---------------------------------------------------------------------------
-    , port = 8787 &= help "HTTP port to listen on." &= name "p" &= typ "PORT"
-  }
-  &= help "Start a read-only HTTP server for exporting Arboricx bundles."
-  &= explicit
-  &= name "server"
 
-exportDagMode :: TricuArgs
+readEvaluatedForm :: ReadM EvaluatedForm
-exportDagMode = ExportDag
+readEvaluatedForm = eitherReader $ \s -> case s of
-  { target = def &= help "Stored term name or hash to export as a DAG node table."
+  "tree"    -> Right Tree
-                 &= name "t" &= typ "NAME_OR_HASH"
+  "fsl"     -> Right FSL
-  , outFile = def &= help "Optional output file path. Defaults to stdout."
+  "ast"     -> Right AST
-                  &= name "o" &= typ "FILE"
+  "ternary" -> Right Ternary
-  }
+  "ascii"   -> Right Ascii
-  &= help "Export a term's Merkle DAG as a topologically-sorted node table for host embedding."
+  "decode"  -> Right Decode
-  &= explicit
+  _         -> Left $ "Unknown format: " ++ s ++ ". Expected: tree, fsl, ast, ternary, ascii, decode"
-  &= name "export-dag"
+
+evalParser :: Parser TricuArgs
+evalParser = Eval
+  <$> many (argument str (metavar "FILE..."))
+  <*> option readEvaluatedForm
+      ( long "format"
+     <> short 'f'
+     <> metavar "FORM"
+     <> value Tree
+     <> help "Output format: tree, fsl, ast, ternary, ascii, decode"
+      )
+  <*> option str
+      ( long "output"
+     <> short 'o'
+     <> metavar "FILE"
+     <> value ""
+     <> help "Write output to file instead of stdout"
+      )
+  <*> optional (option str
+      ( long "db"
+     <> short 'd'
+     <> metavar "PATH"
+     <> help "Content store database path"
+      ))
+
+compileParser :: Parser TricuArgs
+compileParser = ArboricxCompile
+  <$> option str
+      ( long "file"
+     <> short 'f'
+     <> metavar "FILE"
+     <> value ""
+     <> help "Input .tri source file"
+      )
+  <*> option str
+      ( long "output"
+     <> short 'o'
+     <> metavar "FILE"
+     <> value ""
+     <> help "Output bundle file path (required)"
+      )
+  <*> many (option str
+      ( long "name"
+     <> short 'n'
+     <> metavar "NAME"
+     <> help "Definition name(s) to export as bundle roots (repeatable)"
+      ))
+  <*> optional (option str
+      ( long "db"
+     <> short 'd'
+     <> metavar "PATH"
+     <> help "Content store database path"
+      ))
+
+importParser :: Parser TricuArgs
+importParser = ArboricxImport
+  <$> option str
+      ( long "file"
+     <> short 'f'
+     <> metavar "FILE"
+     <> value ""
+     <> help "Bundle file to import"
+      )
+  <*> optional (option str
+      ( long "db"
+     <> short 'd'
+     <> metavar "PATH"
+     <> help "Content store database path"
+      ))
+
+exportParser :: Parser TricuArgs
+exportParser = ArboricxExport
+  <$> many (option str
+      ( long "target"
+     <> short 't'
+     <> metavar "TARGET"
+     <> help "Target hash or name (repeatable)"
+      ))
+  <*> option str
+      ( long "output"
+     <> short 'o'
+     <> metavar "FILE"
+     <> value ""
+     <> help "Output file path (required for bundle export)"
+      )
+  <*> many (option str
+      ( long "name"
+     <> short 'n'
+     <> metavar "NAME"
+     <> help "Export name(s) for the bundle manifest (repeatable)"
+      ))
+  <*> optional (option str
+      ( long "db"
+     <> short 'd'
+     <> metavar "PATH"
+     <> help "Content store database path"
+      ))
+  <*> switch
+      ( long "dag"
+     <> help "Export as a topologically-sorted DAG node table instead of a bundle"
+      )
+
+serveParser :: Parser TricuArgs
+serveParser = ArboricxServe
+  <$> option str
+      ( long "host"
+     <> metavar "HOST"
+     <> value "127.0.0.1"
+     <> help "Host to bind the server to"
+      )
+  <*> option auto
+      ( long "port"
+     <> short 'p'
+     <> metavar "PORT"
+     <> value 8787
+     <> help "HTTP port to listen on"
+      )
+  <*> optional (option str
+      ( long "db"
+     <> short 'd'
+     <> metavar "PATH"
+     <> help "Content store database path"
+      ))
+
+versionStr :: String
+versionStr = "tricu " ++ showVersion version
+
+tricuParser :: Parser TricuArgs
+tricuParser = (subparser topCommands <|> pure Repl)
+  <**> infoOption versionStr (long "version" <> help "Show version")
+  where
+    topCommands = mconcat
+      [ command "eval" (info (evalParser <**> helper)
+          (progDesc "Evaluate tricu source and print the result of the final expression"))
+      , command "arboricx" (info (arboricxParser <**> helper)
+          (progDesc "Arboricx bundle operations"))
+      ]
+
+arboricxParser :: Parser TricuArgs
+arboricxParser = subparser $ mconcat
+  [ command "compile" (info (compileParser <**> helper)
+      (progDesc "Compile a .tri file into a standalone Arboricx bundle"))
+  , command "import" (info (importParser <**> helper)
+      (progDesc "Import an Arboricx bundle into the content store"))
+  , command "export" (info (exportParser <**> helper)
+      (progDesc "Export one or more terms from the content store"))
+  , command "serve" (info (serveParser <**> helper)
+      (progDesc "Start a read-only HTTP server for Arboricx bundles"))
+  ]
+
+-- ---------------------------------------------------------------------------
+-- Entry point
+-- ---------------------------------------------------------------------------
 
 main :: IO ()
 main = do
-  let versionStr = "tricu Evaluator and REPL " ++ showVersion version
+  args <- execParser $ info (tricuParser <**> helper)
-  cmdArgsParsed <- cmdArgs $ modes [replMode, evaluateMode, decodeMode, compileMode, exportMode, importMode, serveMode, exportDagMode]
+    ( fullDesc
-    &= help "tricu: Exploring Tree Calculus"
+   <> progDesc "Exploring Tree Calculus"
-    &= program "tricu"
+   <> header versionStr
-    &= summary versionStr
+    )
-    &= versionArg [explicit, name "version", summary versionStr]
+  case args of
-  case cmdArgsParsed of
+    Repl               -> runRepl
-    Repl -> do
+    Eval {}            -> runEval args
+    ArboricxCompile {} -> runCompile args
+    ArboricxImport {}  -> runImport args
+    ArboricxExport {}  -> runExport args
+    ArboricxServe {}   -> runServe args
+
+-- ---------------------------------------------------------------------------
+-- Command runners
+-- ---------------------------------------------------------------------------
+
+runRepl :: IO ()
+runRepl = do
   putStrLn "Welcome to the tricu REPL"
   putStrLn "You may exit with `CTRL+D` or the `!exit` command."
   repl
-    Evaluate { file = filePaths, form = outputForm, outFile = evalOutFile } -> do
+
-      maybeDbPath <- lookupEnv "TRICU_DB_PATH"
+runEval :: TricuArgs -> IO ()
-      evalResult <- case filePaths of
+runEval opts = do
+  let files = evalFiles opts
+      form  = evalFormat opts
+      out   = evalOutput opts
+  mconn <- case evalDb opts of
+    Just dbPath -> Just <$> initContentStoreWithPath (Just dbPath)
+    Nothing     -> do
+      mDbPath <- lookupEnv "TRICU_DB_PATH"
+      case mDbPath of
+        Just _  -> Just <$> initContentStoreWithPath Nothing
+        Nothing -> return Nothing
+  resultT <- case files of
     [] -> do
-            initialEnv <- case maybeDbPath of
-              Just _ -> do
-                conn <- initContentStore
-                env <- loadEnvironment conn
-                close conn
-                return env
-              Nothing -> return Map.empty
       input <- getContents
-            pure $ runTricuTEnv initialEnv input
+      env <- evalTricuWithStore mconn Map.empty (parseTricu input)
-        filePaths@(_:_) -> do
+      return $ result env
-            initialEnv <- case maybeDbPath of
+    _  -> do
-              Just _ -> do
+      finalEnv <- foldM (evaluateFileWithStore mconn) Map.empty files
-                conn <- initContentStore
+      return $ mainResult finalEnv
-                env <- loadEnvironment conn
+  case mconn of
-                close conn
+    Just conn -> close conn
-                return env
+    Nothing   -> return ()
-              Nothing -> return Map.empty
+  writeOutput out (formatT form resultT)
-            finalEnv <- foldM evaluateFileWithContext initialEnv filePaths
+
-            pure $ mainResult finalEnv
+runCompile :: TricuArgs -> IO ()
-      let fRes = formatT outputForm evalResult
+runCompile opts = do
-      if null evalOutFile
+  let input = compileInput opts
-        then putStr fRes
+      out   = compileOutput opts
-        else writeFile evalOutFile fRes
+      names = compileNames opts
-    TDecode { file = filePaths } -> do
+  when (null out)   $ die "tricu arboricx compile: --output is required"
-      value <- case filePaths of
+  when (null input) $ die "tricu arboricx compile: input file is required"
-        [] -> getContents
+  let nameTexts = if null names then [] else map T.pack names
-        (filePath:_) -> readFile filePath
+  compileFile input out nameTexts
-      putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value
+
-    Export { hash = hashStr, exportNameOpt = legacyName, names = namesArg, outFile = outFilePath } -> do
+runImport :: TricuArgs -> IO ()
-      conn <- initContentStore
+runImport opts = do
-      let hashList = T.split (== ',') (T.pack hashStr)
+  let file = importFile opts
-      hashes <- mapM (\h -> do
+  when (null file) $ die "tricu arboricx import: input file is required"
-        (resolvedHash, _) <- resolveExportTarget conn (T.unpack h)
+  withContentStore (importDb opts) $ \conn -> do
-        return resolvedHash) hashList
+    bundleData <- BL.readFile file
-      -- Merge legacy -n and new -n (names); names wins when non-empty
-      let allNames = if null namesArg
-            then if null legacyName then [] else [legacyName]
-            else namesArg
-      let expNames = if null allNames
-            then defaultExportNames (length hashes)
-            else map T.pack allNames
-      let exports = zip expNames hashes
-      bundleData <- exportNamedBundle conn exports
-      BL.writeFile outFilePath (BL.fromStrict bundleData)
-      putStrLn $ "Exported bundle with " ++ show (length exports) ++ " export(s) to " ++ outFilePath
-      close conn
-    Import { inFile = importFile } -> do
-      conn <- initContentStore
-      bundleData <- BL.readFile importFile
     roots <- importBundle conn (BL.toStrict bundleData)
     putStrLn $ "Imported " ++ show (length roots) ++ " root(s):"
     mapM_ (\r -> putStrLn $ "  " ++ unpack r) roots
-      close conn
+
-    Compile { inputFile = compileInputFile, outFile = compileOutFile, names = namesArg } ->
+runExport :: TricuArgs -> IO ()
-      let exportNames = if null namesArg then [] else map T.pack namesArg
+runExport opts =
-      in compileFile compileInputFile compileOutFile exportNames
+  if dag opts
-    Serve { host = hostStr, port = portNum } -> do
+    then runExportDag opts
+    else runExportBundle opts
+
+runExportBundle :: TricuArgs -> IO ()
+runExportBundle opts = do
+  let targets = exportTargets opts
+      out     = exportOutput opts
+      names   = exportNames opts
+  when (null out)     $ die "tricu arboricx export: --output is required"
+  when (null targets) $ die "tricu arboricx export: at least one --target is required"
+  withContentStore (exportDb opts) $ \conn -> do
+    hashes <- mapM (\t -> do
+      (h, _) <- resolveExportTarget conn t
+      return h) targets
+    let expNames = if null names
+          then defaultExportNames (length hashes)
+          else map T.pack names
+    when (length expNames /= length hashes) $
+      die "tricu arboricx export: number of --name values must match number of TARGETs"
+    let exports = zip expNames hashes
+    bundleData <- exportNamedBundle conn exports
+    BL.writeFile out (BL.fromStrict bundleData)
+    putStrLn $ "Exported bundle with " ++ show (length exports) ++ " export(s) to " ++ out
+
+runExportDag :: TricuArgs -> IO ()
+runExportDag opts = do
+  let targets = exportTargets opts
+      out     = exportOutput opts
+  case targets of
+    [target] -> withContentStore (exportDb opts) $ \conn -> do
+      maybeTerm <- loadTerm conn target
+      case maybeTerm of
+        Nothing -> die $ "Term not found: " ++ target
+        Just term -> do
+          let (rootIdx, nodes) = Research.exportDag term
+              output = unlines $
+                show rootIdx :
+                map (\(tag, refs) -> unwords (tag : map show refs)) nodes
+          writeOutput out output
+    [] -> die "tricu arboricx export --dag: exactly one --target is required"
+    _  -> die "tricu arboricx export --dag: exactly one --target is required"
+
+runServe :: TricuArgs -> IO ()
+runServe opts = do
+  let hostStr = serveHost opts
+      portNum = servePort opts
   putStrLn $ "Starting Arboricx bundle server on " ++ hostStr ++ ":" ++ show portNum
   putStrLn $ "  GET /bundle/hash/:hash   -- primary endpoint"
   putStrLn $ "  GET /bundle/name/:name   -- convenience endpoint"
   putStrLn $ "  Content-Type: application/vnd.arboricx.bundle"
-      runServer hostStr portNum
+  runServerWithPath (serveDb opts) hostStr portNum
-    ExportDag { target = targetName, outFile = dagOutFile } -> do
+
-      conn <- initContentStore
+-- ---------------------------------------------------------------------------
-      maybeTerm <- loadTerm conn targetName
+-- Helpers
+-- ---------------------------------------------------------------------------
+
+withContentStore :: Maybe FilePath -> (Connection -> IO a) -> IO a
+withContentStore mPath act = do
+  conn <- initContentStoreWithPath mPath
+  result <- act conn
   close conn
-      case maybeTerm of
+  return result
-        Nothing -> die $ "Term not found: " ++ targetName
-        Just term -> do
-          let (rootIdx, nodes) = exportDag term
-              output = unlines $ show rootIdx : map (\(tag, refs) -> unwords (tag : map show refs)) nodes
-          if null dagOutFile
-            then putStr output
-            else writeFile dagOutFile output
 
-runTricu :: String -> String
+writeOutput :: FilePath -> String -> IO ()
-runTricu = formatT TreeCalculus . runTricuT
+writeOutput path content
-
+  | null path = putStr content
-runTricuT :: String -> T
+  | otherwise = writeFile path content
-runTricuT input =
-  let asts     = parseTricu input
-      finalEnv = evalTricu Map.empty asts
-   in result finalEnv
-
-runTricuEnv :: Env -> String -> String
-runTricuEnv env = formatT TreeCalculus . runTricuTEnv env
 
 runTricuTEnv :: Env -> String -> T
 runTricuTEnv env input =
   let asts     = parseTricu input
       finalEnv = evalTricu env asts
    in result finalEnv
-
-runTricuWithEnvT :: String -> (Env, T)
-runTricuWithEnvT input =
-  let asts     = parseTricu input
-      finalEnv = evalTricu Map.empty asts
-   in (finalEnv, result finalEnv)
-
-runTricuWithEnv :: String -> (Env, String)
-runTricuWithEnv input =
-  let asts     = parseTricu input
-      finalEnv = evalTricu Map.empty asts
-      res      = result finalEnv
-   in (finalEnv, formatT TreeCalculus res)
-
-runTricuEnvWithEnvT :: Env -> String -> (Env, T)
-runTricuEnvWithEnvT env input =
-  let asts     = parseTricu input
-      finalEnv = evalTricu env asts
-   in (finalEnv, result finalEnv)
-
-runTricuEnvWithEnv :: Env -> String -> (Env, String)
-runTricuEnvWithEnv env input =
-  let asts     = parseTricu input
-      finalEnv = evalTricu env asts
-      res      = result finalEnv
-   in (finalEnv, formatT TreeCalculus res)
-
-chooseExportName :: String -> String -> [Text] -> IO Text
-chooseExportName explicitName input storedNames
-  | not (null explicitName) = return $ T.pack explicitName
-  | Just firstName <- firstNonEmpty storedNames = return firstName
-  | otherwise = do
-      hPutStrLn stderr $
-        "No stored name found for export target " ++ input ++ "; using export name 'root'. "
-        ++ "Use export -n NAME to preserve a semantic name."
-      return "root"
-
-firstNonEmpty :: [Text] -> Maybe Text
-firstNonEmpty = go
-  where
-    go [] = Nothing
-    go (x:xs)
-      | T.null x = go xs
-      | otherwise = Just x

src/REPL.hs

@@ -130,7 +130,7 @@ repl = do
 
     handleOutput :: REPLState -> InputT IO ()
     handleOutput state = do
-      let formats = [Decode, TreeCalculus, FSL, AST, Ternary, Ascii]
+      let formats = [Decode, Tree, FSL, AST, Ternary, Ascii]
       outputStrLn "Available output formats:"
       mapM_ (\(i, f) -> outputStrLn $ show (i :: Int) ++ ". " ++ show f)
         (zip [1..] formats)

src/Research.hs

@@ -8,8 +8,6 @@ import Data.Map                  ()
 import Data.Text                 (Text, replace)
 import Data.Text.Encoding        (decodeUtf8, encodeUtf8)
 import Data.Word                 (Word8)
-import System.Console.CmdArgs    (Data, Typeable)
-
 import qualified Data.ByteString as BS
 import qualified Data.Map        as Map
 import qualified Data.Set        as Set
@@ -55,8 +53,8 @@ data LToken
   deriving (Eq, Show, Ord)
 
 -- Output formats
-data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
+data EvaluatedForm = Tree | FSL | AST | Ternary | Ascii | Decode
-  deriving (Show, Data, Typeable)
+  deriving (Show)
 
 -- Environment containing previously evaluated TC terms
 type Env = Map.Map String T
@@ -243,7 +241,7 @@ toList _ = Left "Invalid Tree Calculus list"
 
 -- Outputs
 formatT :: EvaluatedForm -> T -> String
-formatT TreeCalculus = toSimpleT . show
+formatT Tree = toSimpleT . show
 formatT FSL          = show
 formatT AST          = show . toAST
 formatT Ternary      = toTernaryString
@@ -289,7 +287,7 @@ decodeResult tc =
     (_, _, Right n) -> show n
     (_, Right xs@(_:_), _) -> "[" ++ intercalate ", " (map decodeResult xs) ++ "]"
     (_, Right [], _) -> "[]"
-    _ -> formatT TreeCalculus tc
+    _ -> formatT Tree tc
   where
     isCommonChar c =
       let n = fromEnum c

src/Server.hs

@@ -1,15 +1,15 @@
 module Server
   ( runServer
+  , runServerWithPath
   ) where
 
-import ContentStore (initContentStore, nameToTerm, hashToTerm, listStoredTerms,
+import ContentStore (initContentStore, initContentStoreWithPath, nameToTerm, hashToTerm, listStoredTerms,
                      parseNameList, StoredTerm(..), termHash)
-import Database.SQLite.Simple (close)
+import Database.SQLite.Simple (Connection, close)
 import Wire (exportNamedBundle)
 
-import Control.Monad (when)
+import Control.Monad (when, void)
 import Data.Maybe (catMaybes)
-import Control.Monad (void)
 
 import Network.HTTP.Types (Header, Status, status200, status400, status404, status405, hContentType)
 import Network.Wai
@@ -25,48 +25,36 @@ import qualified Data.Text as T
 
 -- | Start an HTTP server that serves Arboricx bundles from the
 --   local content store.
---
--- This is a read-only export surface.  Clients fetch bundle bytes
--- and independently inspect / verify / run them.  The server does
--- not execute bundles.
---
--- Bind host defaults to @127.0.0.1@.
---
--- Endpoints
--- ---------
---   GET /health                           - 200 "ok"
---   GET /bundle/name/:name                - export single term by name
---   GET /bundle/hash/:hash                - export single term by hash
---   GET /bundle/roots?n=...&h=...         - export multiple roots (n=name, h=hash)
---   GET /terms                            - plain-text listing (debug)
---
 runServer :: String -> Int -> IO ()
-runServer hostStr port =
+runServer = runServerWithPath Nothing
-  runSettings settings app
+
+-- | Start an HTTP server with an explicit database path.
+runServerWithPath :: Maybe FilePath -> String -> Int -> IO ()
+runServerWithPath mDbPath hostStr port =
+  runSettings settings (app mkConn)
   where
+    mkConn = initContentStoreWithPath mDbPath
     settings = setPort port $ setHost (fromString hostStr) defaultSettings
 
 -- | WAI application backed by the content store.
---   Uses the same database path as @eval@ mode (env var
+app :: IO Connection -> Application
---   @TRICU_DB_PATH@ or the default location).
+app mkConn request respond = case (requestMethod request, pathInfo request) of
-app :: Application
-app request respond = case (requestMethod request, pathInfo request) of
   ("GET", ["health"]) ->
     respond $ healthResponse
 
   ("GET", ["bundle", "roots"]) ->
-    rootsHandler request respond
+    rootsHandler mkConn request respond
 
   ("GET", ["bundle", "name", nameText]) -> do
-    body <- nameHandler nameText
+    body <- nameHandler mkConn nameText
     respond body
 
   ("GET", ["bundle", "hash", hashText]) -> do
-    body <- hashHandler hashText
+    body <- hashHandler mkConn hashText
     respond body
 
   ("GET", ["terms"]) -> do
-    body <- termsResponse
+    body <- termsResponse mkConn
     respond body
 
   ("POST", _) ->
@@ -85,18 +73,9 @@ healthResponse :: Response
 healthResponse = responseLBS status200 [] "ok"
 
 -- | GET /bundle/roots?n=root&n=helper&h=abc123...
---   Resolve multiple named roots (by stored term name or raw hash)
+rootsHandler :: IO Connection -> Request -> (Response -> IO a) -> IO a
---   and return a single bundle containing all of them.
+rootsHandler mkConn request respond = do
---
+  conn <- mkConn
---   Query parameters:
---     - @n=<name>@ — one or more stored term names (resolved via nameToTerm)
---     - @h=<hash>@ — one or more full Merkle hashes (validated as 16-64 hex chars)
---
---   The bundle manifest receives all resolved (name, hash) pairs as roots
---   and exports. The node section is the union of all reachable nodes.
-rootsHandler :: Request -> (Response -> IO a) -> IO a
-rootsHandler request respond = do
-  conn <- initContentStore
   let qs = queryString request
       nParams = catMaybes [v | (k, v) <- qs, map toLower (unpack k) == "n"]
       hParams = catMaybes [v | (k, v) <- qs, map toLower (unpack k) == "h"]
@@ -133,14 +112,9 @@ rootsHandler request respond = do
     (fromStrict bundleData)
 
 -- | GET /bundle/name/:name
---   Resolve a stored term name, export it as an Arboricx bundle,
+nameHandler :: IO Connection -> Text -> IO Response
---   and return the raw bundle bytes.
+nameHandler mkConn nameText = do
---
+  conn <- mkConn
---   Sets @Content-Type@ and @X-Arboricx-Root-Hash@ headers.
---   Returns 404 when the name does not resolve to any stored term.
-nameHandler :: Text -> IO Response
-nameHandler nameText = do
-  conn <- initContentStore
   stored <- nameToTerm conn nameText
   case stored of
     Nothing -> do
@@ -155,19 +129,13 @@ nameHandler nameText = do
       return $ responseLBS status200 (bundleHeaders th cd) (fromStrict bundleData)
 
 -- | GET /bundle/hash/:hash
---   Resolve a full Merkle hash and export the root as an Arboricx
+hashHandler :: IO Connection -> Text -> IO Response
---   bundle.
+hashHandler mkConn hashText =
---
---   - Malformed hash (non-hex or < 16 chars): 400
---   - Well-formed but absent: 404
---   - Present: 200 with bundle bytes
-hashHandler :: Text -> IO Response
-hashHandler hashText =
   let raw = T.pack (dropWhile (== '#') (T.unpack hashText))
   in if not (T.all isHexDigit raw) || T.length raw < 16
         then return $ responseLBS status400 [] "400 Bad Request: invalid hash"
         else do
-          conn <- initContentStore
+          conn <- mkConn
           stored <- hashToTerm conn raw
           case stored of
             Nothing -> do
@@ -183,10 +151,9 @@ hashHandler hashText =
                 (fromStrict bundleData)
 
 -- | GET /terms
---   Plain-text listing of all stored terms (debugging only).
+termsResponse :: IO Connection -> IO Response
-termsResponse :: IO Response
+termsResponse mkConn = do
-termsResponse = do
+  conn <- mkConn
-  conn <- initContentStore
   terms <- listStoredTerms conn
   close conn
   let lines' = [ names <> "  " <> hash <> "  " <> T.pack (show created)
@@ -212,14 +179,12 @@ bundleHeaders root cd =
   , ("Content-Disposition", encodeUtf8 cd)
   ]
 
--- | Pick the first stored name, falling back to "root" when names are empty.
 firstOrRoot :: Text -> Text
 firstOrRoot names =
   case parseNameList names of
     [] -> "root"
     (x:_) -> x
 
--- | Sanitise a string to a safe filename prefix.
 safeFileName :: String -> String
 safeFileName = map go
   where

tricu.cabal

@@ -17,7 +17,6 @@ executable tricu
   hs-source-dirs:
     src
   default-extensions:
-    DeriveDataTypeable
     LambdaCase
     MultiWayIf
     OverloadedStrings
@@ -41,7 +40,7 @@ executable tricu
     , base16-bytestring
     , base64-bytestring
     , bytestring
-    , cmdargs
+    , optparse-applicative
     , containers
     , cryptonite
     , directory
@@ -82,7 +81,6 @@ test-suite tricu-tests
   main-is:             Spec.hs
   hs-source-dirs:      test, src
   default-extensions:
-      DeriveDataTypeable
       LambdaCase
       MultiWayIf
       OverloadedStrings
@@ -93,7 +91,7 @@ test-suite tricu-tests
     , base16-bytestring
     , base64-bytestring
     , bytestring
-    , cmdargs
+    , optparse-applicative
     , containers
     , cryptonite
     , directory