Wire prepped and basics tested

src/Main.hs

@@ -1,25 +1,37 @@
 module Main where
 
-import ContentStore ()
+import ContentStore (initContentStore, termNames, hashToTerm, parseNameList)
 import Eval                   (evalTricu, mainResult, result)
 import FileEval
 import Parser                 (parseTricu)
 import REPL
 import Research
+import Wire
 
 import Control.Monad          (foldM)
+import Data.Char              (isHexDigit)
 import Control.Monad.IO.Class ()
+import Data.Text              (Text, unpack)
+import qualified Data.Text    as T
 import Data.Version           (showVersion)
 import Paths_tricu            (version)
 import System.Console.CmdArgs
+import System.IO              (hPutStrLn, stderr)
+import System.Exit            (die)
 import Text.Megaparsec        ()
 
+import qualified Data.ByteString.Lazy as BL
+import Database.SQLite.Simple (Connection, Only(..), close)
+import qualified Database.SQLite.Simple as DB (query)
+
 import qualified Data.Map as Map
 
 data TricuArgs
   = Repl
   | Evaluate { file :: [FilePath], form :: EvaluatedForm }
   | TDecode { file :: [FilePath] }
+  | Export { hash :: String, exportNameOpt :: String, outFile :: FilePath }
+  | Import { inFile :: FilePath }
   deriving (Show, Data, Typeable)
 
 replMode :: TricuArgs
@@ -53,10 +65,31 @@ decodeMode = TDecode
   &= explicit
   &= name "decode"
 
+exportMode :: TricuArgs
+exportMode = Export
+  { hash = def &= help "Full/prefix hash or stored term name to export."
+             &= name "h" &= typ "HASH_OR_NAME"
+    , exportNameOpt = def &= help "Export name to place in the bundle manifest. Defaults to the stored term name when exporting by name; otherwise defaults to root."
+             &= name "n" &= typ "NAME"
+    , outFile = def &= help "Output file path for the bundle." &= name "o" &= typ "FILE"
+  }
+  &= help "Export a Merkle bundle from the content store."
+  &= explicit
+  &= name "export"
+
+importMode :: TricuArgs
+importMode = Import
+  { inFile = def &= help "Path to the bundle file to import."
+               &= name "f" &= typ "FILE"
+  }
+  &= help "Import a Merkle bundle into the content store."
+  &= explicit
+  &= name "import"
+
 main :: IO ()
 main = do
   let versionStr = "tricu Evaluator and REPL " ++ showVersion version
-  cmdArgsParsed <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
+  cmdArgsParsed <- cmdArgs $ modes [replMode, evaluateMode, decodeMode, exportMode, importMode]
     &= help "tricu: Exploring Tree Calculus"
     &= program "tricu"
     &= summary versionStr
@@ -80,6 +113,21 @@ main = do
         [] -> getContents
         (filePath:_) -> readFile filePath
       putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value
+    Export { hash = hashStr, exportNameOpt = exportNameArg, outFile = outFile } -> do
+      conn <- initContentStore
+      (resolvedHash, storedNames) <- resolveExportTarget conn hashStr
+      exportName <- chooseExportName exportNameArg hashStr storedNames
+      bundleData <- exportNamedBundle conn [(exportName, resolvedHash)]
+      BL.writeFile outFile (BL.fromStrict bundleData)
+      putStrLn $ "Exported bundle export " ++ unpack exportName ++ " -> " ++ unpack resolvedHash ++ " to " ++ outFile
+      close conn
+    Import { inFile = inFile } -> do
+      conn <- initContentStore
+      bundleData <- BL.readFile inFile
+      roots <- importBundle conn (BL.toStrict bundleData)
+      putStrLn $ "Imported " ++ show (length roots) ++ " root(s):"
+      mapM_ (\r -> putStrLn $ "  " ++ unpack r) roots
+      close conn
 
 runTricu :: String -> String
 runTricu = formatT TreeCalculus . runTricuT
@@ -124,3 +172,50 @@ runTricuEnvWithEnv env input =
       finalEnv = evalTricu env asts
       res      = result finalEnv
    in (finalEnv, formatT TreeCalculus res)
+
+resolveExportTarget :: Connection -> String -> IO (Text, [Text])
+resolveExportTarget conn input = do
+  let raw = T.pack $ dropWhile (== '#') input
+  byName <- DB.query conn
+    "SELECT hash FROM terms WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC"
+    (raw, raw <> T.pack ",%", T.pack "," <> raw <> T.pack ",%", T.pack "%," <> raw) :: IO [Only T.Text]
+  case byName of
+    [Only fullHash] -> namesForHash conn fullHash >>= \names -> return (fullHash, names)
+    (_:_) -> die $ "Ambiguous term name: " ++ input
+    [] -> do
+      byHash <- DB.query conn "SELECT hash FROM terms WHERE hash LIKE ? ORDER BY created_at DESC"
+        (Only (raw <> T.pack "%")) :: IO [Only T.Text]
+      case byHash of
+        [Only fullHash] -> namesForHash conn fullHash >>= \names -> return (fullHash, names)
+        [] -> if looksLikeHash raw
+          then return (raw, [])
+          else die $ "No term found matching: " ++ input
+        _ -> die $ "Ambiguous hash prefix: " ++ input
+
+namesForHash :: Connection -> Text -> IO [Text]
+namesForHash conn h = do
+  stored <- hashToTerm conn h
+  return $ maybe [] (parseNameList . termNames) stored
+
+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
+
+looksLikeHash :: Text -> Bool
+looksLikeHash t =
+  let len = T.length t
+  in len >= 16 && len <= 64 && T.all isHexDigit t