nova-nix-0.4.0.0: app/Main.hs

-- | nova-nix CLI entry point.
--
-- Commands:
--
-- @
-- nova-nix eval  FILE.nix                  Evaluate a .nix file, print result
-- nova-nix eval  --expr 'EXPR'             Evaluate an inline expression
-- nova-nix build FILE.nix                  Build a derivation from a .nix file
-- @
--
-- Flags:
--
-- @
-- --nix-path NAME=PATH   Add a search path entry (repeatable, merged with NIX_PATH)
-- --expr EXPR            Evaluate an inline expression instead of a file
-- @
module Main (main) where

import Control.Monad (void, (>=>))
import Data.IORef (readIORef)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Nix.Builder (BuildConfig (..), BuildResult (..), buildWithDeps, defaultBuildConfig)
import Nix.Builtins (builtinEnv, parseNixPath)
import Nix.Derivation (Derivation (..), DerivationOutput (..), toATerm)
import Nix.Eval (MonadEval, NixValue (..), Thunk (..), attrSetFromMap, attrSetLookup, attrSetToAscList, attrSetToMap, eval, evaluated, force, readThunkValue)
import Nix.Eval.Arena (arenaInit)
import Nix.Eval.IO (EvalState (..), newEvalState, runEvalIO)
import Nix.Eval.Types (clistFromThunks, clistThunks, thunkToCPtr)
import Nix.Parser (parseNix, readFileAutoEncoding)
import Nix.Store (Store (..), closeStore, isValid, openStore, registerPaths, registrationFor, setReadOnly, writeDrv, writeDrvAterm)
import Nix.Store.Path (StorePath, defaultStoreDir, parseStorePath, platformStoreDir, storePathToFilePath)
import Paths_nova_nix (getDataDir)
import System.Directory (canonicalizePath, copyFile, createDirectoryIfMissing, doesDirectoryExist, getCurrentDirectory, getTemporaryDirectory, listDirectory)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.FilePath (takeDirectory)
import qualified System.FilePath as FP
import System.IO (BufferMode (..), hPutStrLn, hSetBuffering, stderr, stdout)

-- ---------------------------------------------------------------------------
-- Argument parsing
-- ---------------------------------------------------------------------------

-- | Parsed CLI options.
data CliOpts = CliOpts
  { optNixPaths :: ![T.Text],
    optStrict :: !Bool,
    optAterm :: !Bool,
    optCommand :: !Command
  }

data Command
  = CmdEvalFile !FilePath
  | CmdEvalExpr !T.Text
  | CmdBuild !FilePath
  | CmdHelp

parseArgs :: [String] -> CliOpts
parseArgs = go (CliOpts [] False False CmdHelp)
  where
    go opts [] = opts
    go opts ("--nix-path" : val : rest) =
      go (opts {optNixPaths = optNixPaths opts ++ [T.pack val]}) rest
    go opts ("--strict" : rest) =
      go (opts {optStrict = True}) rest
    go opts ("--aterm" : rest) =
      go (opts {optAterm = True}) rest
    go opts ("eval" : rest) = goEval opts rest
    go opts ("build" : path : rest) =
      go (opts {optCommand = CmdBuild path}) rest
    go opts _ = opts
    -- Sub-parser for eval: handles --strict and --expr interleaved with the file arg.
    goEval opts [] = opts
    goEval opts ("--strict" : rest) = goEval (opts {optStrict = True}) rest
    goEval opts ("--aterm" : rest) = goEval (opts {optAterm = True}) rest
    goEval opts ("--nix-path" : val : rest) =
      goEval (opts {optNixPaths = optNixPaths opts ++ [T.pack val]}) rest
    goEval opts ("--expr" : expr : rest) =
      go (opts {optCommand = CmdEvalExpr (T.pack expr)}) rest
    goEval opts (path : rest) =
      go (opts {optCommand = CmdEvalFile path}) rest

-- | Merge --nix-path entries, bundled data dir, and NIX_PATH search paths.
-- The data dir is appended last so user paths take priority.
mergeSearchPaths :: [T.Text] -> FilePath -> [Thunk] -> [Thunk]
mergeSearchPaths extraPaths dataDir envPaths =
  concatMap parseNixPath extraPaths ++ envPaths ++ parseNixPath (T.pack dataDir)

-- ---------------------------------------------------------------------------
-- Main
-- ---------------------------------------------------------------------------

main :: IO ()
main = do
  hSetBuffering stdout LineBuffering
  -- Initialize C data layer (symbol interning, thunk arena, env allocator)
  arenaInit
  args <- getArgs
  dataDir <- getDataDir
  let opts = parseArgs args
  case optCommand opts of
    CmdEvalFile filePath -> evalFile (optStrict opts) (optNixPaths opts) dataDir filePath
    CmdEvalExpr expr
      | optAterm opts -> evalExprAterm (optNixPaths opts) dataDir expr
      | otherwise -> evalExpr (optStrict opts) (optNixPaths opts) dataDir expr
    CmdBuild filePath -> buildFile (optNixPaths opts) dataDir filePath
    CmdHelp -> do
      hPutStrLn stderr "Usage: nova-nix [--nix-path NAME=PATH] <command>"
      hPutStrLn stderr ""
      hPutStrLn stderr "Commands:"
      hPutStrLn stderr "  eval FILE.nix          Evaluate a .nix file, print result"
      hPutStrLn stderr "  eval --expr 'EXPR'     Evaluate an inline expression"
      hPutStrLn stderr "  build FILE.nix         Build a derivation from a .nix file"
      hPutStrLn stderr ""
      hPutStrLn stderr "Flags:"
      hPutStrLn stderr "  --strict               Deep-force all thunks before printing (warning: OOM on large results)"
      hPutStrLn stderr "  --aterm                With eval --expr, print the derivation's .drv ATerm"
      hPutStrLn stderr "  --nix-path NAME=PATH   Add search path (repeatable, merged with NIX_PATH)"
      exitFailure

-- | Evaluate a .nix file and print the result.
--
-- The file argument is canonicalized first: relative path literals inside the
-- file resolve against the file's directory ('esBaseDir'), and a relative base
-- dir would be re-prefixed on every resolution (doubling it).
evalFile :: Bool -> [T.Text] -> FilePath -> FilePath -> IO ()
evalFile strict extraPaths dataDir rawFilePath = do
  filePath <- canonicalizePath rawFilePath
  source <- readFileAutoEncoding filePath
  case parseNix (T.pack filePath) source of
    Left err -> do
      hPutStrLn stderr ("parse error: " ++ show err)
      exitFailure
    Right expr -> do
      st0 <- newEvalState (takeDirectory filePath)
      let searchPaths = mergeSearchPaths extraPaths dataDir (esSearchPaths st0)
          st = st0 {esSearchPaths = searchPaths}
      result <-
        runEvalIO st $
          eval (builtinEnv (esTimestamp st) searchPaths) expr >>= finalize strict
      case result of
        Left err -> do
          TIO.hPutStrLn stderr ("error: " <> err)
          exitFailure
        Right forced -> TIO.putStrLn (prettyValue forced)

-- | Evaluate an inline expression and print the result.
evalExpr :: Bool -> [T.Text] -> FilePath -> T.Text -> IO ()
evalExpr strict extraPaths dataDir source = do
  case parseNix "<expr>" source of
    Left err -> do
      hPutStrLn stderr ("parse error: " ++ show err)
      exitFailure
    Right expr -> do
      cwd <- getCurrentDirectory
      st0 <- newEvalState cwd
      let searchPaths = mergeSearchPaths extraPaths dataDir (esSearchPaths st0)
          st = st0 {esSearchPaths = searchPaths}
      result <-
        runEvalIO st $
          eval (builtinEnv (esTimestamp st) searchPaths) expr >>= finalize strict
      case result of
        Left err -> do
          TIO.hPutStrLn stderr ("error: " <> err)
          exitFailure
        Right forced -> TIO.putStrLn (prettyValue forced)

-- | Evaluate an inline expression to a derivation and print its ATerm (.drv
-- contents), for diffing nova-nix's serialization against upstream Nix.
evalExprAterm :: [T.Text] -> FilePath -> T.Text -> IO ()
evalExprAterm extraPaths dataDir source =
  case parseNix "<expr>" source of
    Left err -> do
      hPutStrLn stderr ("parse error: " ++ show err)
      exitFailure
    Right expr -> do
      cwd <- getCurrentDirectory
      st0 <- newEvalState cwd
      let searchPaths = mergeSearchPaths extraPaths dataDir (esSearchPaths st0)
          st = st0 {esSearchPaths = searchPaths}
      result <- runEvalIO st $ do
        val <- eval (builtinEnv (esTimestamp st) searchPaths) expr
        case val of
          VAttrs attrs ->
            mapM_
              (\k -> maybe (pure ()) (void . force) (attrSetLookup k attrs))
              ["_derivation", "drvPath"]
          _ -> pure ()
        pure val
      case result of
        Left err -> do
          TIO.hPutStrLn stderr ("error: " <> err)
          exitFailure
        Right val -> do
          (drv, _) <- extractDerivation val
          TIO.putStrLn (toATerm drv)

-- | Parse, evaluate, extract derivation, build, and print result.
-- The file argument is canonicalized for the same reason as in 'evalFile'.
buildFile :: [T.Text] -> FilePath -> FilePath -> IO ()
buildFile extraPaths dataDir rawFilePath = do
  filePath <- canonicalizePath rawFilePath
  source <- readFileAutoEncoding filePath
  case parseNix (T.pack filePath) source of
    Left err -> do
      hPutStrLn stderr ("parse error: " ++ show err)
      exitFailure
    Right expr -> do
      st0 <- newEvalState (takeDirectory filePath)
      let searchPaths = mergeSearchPaths extraPaths dataDir (esSearchPaths st0)
          st = st0 {esSearchPaths = searchPaths}
      result <- runEvalIO st $ do
        val <- eval (builtinEnv (esTimestamp st) searchPaths) expr
        -- 'derivation' is a lazy wrapper now; force the attrs extractDerivation
        -- reads (a build legitimately needs the drvPath + closure).
        case val of
          VAttrs attrs ->
            mapM_
              (\k -> maybe (pure ()) (void . force) (attrSetLookup k attrs))
              ["_derivation", "drvPath"]
          _ -> pure ()
        pure val
      case result of
        Left err -> do
          TIO.hPutStrLn stderr ("eval error: " <> err)
          exitFailure
        Right val -> do
          (drv, drvSP) <- extractDerivation val
          -- The full .drv closure (root + every transitive input) recorded
          -- during evaluation; written to the store before building.
          drvClosure <- readIORef (esDrvClosure st)
          sourceCache <- readIORef (esSourcePathCache st)
          store <- openStore platformStoreDir
          -- Materialize eval-coerced source paths (src = ./file, path
          -- interpolation): evaluation computes their store paths as text
          -- only — the parity runner's store is not writable — so the build
          -- driver performs the copy and registration.
          materializeEvalSources store sourceCache
          buildResult <- buildAndRegister store drvClosure drv drvSP
          closeStore store
          case buildResult of
            BuildSuccess sp ->
              TIO.putStrLn (T.pack (storePathToFilePath platformStoreDir sp))
            BuildFailure msg code -> do
              TIO.hPutStrLn stderr ("build failed (exit " <> T.pack (show code) <> "): " <> msg)
              exitFailure

-- | Extract a Derivation and its store path from an evaluated value.
-- The value must be a VAttrs with type = "derivation", a _derivation key
-- holding the Derivation struct, and a drvPath key holding the .drv store path.
-- Both are computed by builtinDerivation during evaluation.
extractDerivation :: NixValue -> IO (Derivation, StorePath)
extractDerivation (VAttrs attrs) = do
  -- Check type = "derivation"
  case attrSetLookup "type" attrs of
    Just thunk | Just (VStr "derivation" _) <- readThunkValue thunk -> pure ()
    _ -> do
      hPutStrLn stderr "error: result is not a derivation (no type = \"derivation\")"
      exitFailure
  -- Extract the Derivation struct from _derivation
  drv <- case attrSetLookup "_derivation" attrs of
    Just thunk | Just (VDerivation d) <- readThunkValue thunk -> pure d
    _ -> do
      hPutStrLn stderr "error: derivation result missing _derivation field"
      exitFailure
  -- Extract drvPath — this is the store path of the .drv file itself,
  -- computed by hashing the ATerm serialization during evaluation.
  drvSP <- case attrSetLookup "drvPath" attrs of
    Just thunk | Just (VStr path _) <- readThunkValue thunk -> case parseStorePath defaultStoreDir path of
      Just sp -> pure sp
      Nothing -> do
        TIO.hPutStrLn stderr ("error: invalid drvPath: " <> path)
        exitFailure
    _ -> do
      hPutStrLn stderr "error: derivation result missing drvPath"
      exitFailure
  pure (drv, drvSP)
extractDerivation _ = do
  hPutStrLn stderr "error: result is not a derivation"
  exitFailure

-- | Write the .drv file to the store and build with dependency resolution.
-- The drvPath is the store path of the .drv file itself, extracted from
-- the evaluation result alongside the Derivation struct.
buildAndRegister :: Store -> Map.Map T.Text T.Text -> Derivation -> StorePath -> IO BuildResult
buildAndRegister store drvClosure drv drvSP = do
  -- Materialize the full input-.drv closure (every transitive dependency's
  -- recipe) to the store.  buildWithDeps reads these back to construct the
  -- dependency graph; without them it cannot realize any non-leaf derivation.
  writeDrvClosure store drvClosure
  -- Write the root .drv too (idempotent — it is also in the closure) so a build
  -- still works if the closure was not captured (e.g. a pre-built store drv).
  writeDrv store drv drvSP
  -- Build with dependency resolution
  tmpDir <- getTemporaryDirectory
  let config =
        (defaultBuildConfig platformStoreDir)
          { bcTmpDir = tmpDir
          }
  buildWithDeps config store drv drvSP

-- | Copy eval-coerced source paths into the store and register them.  The
-- evaluator's source-path cache maps each coerced filesystem path to its
-- @source@ fixed-output store path (text only — eval performs no store
-- writes).  Each entry not already valid is copied in, made read-only, and
-- registered with its real NAR hash.  A copied source carries no references.
materializeEvalSources :: Store -> Map.Map T.Text T.Text -> IO ()
materializeEvalSources store sourceCache = do
  regs <- catMaybes <$> mapM adopt (Map.toList sourceCache)
  registerPaths (stDB store) regs
  where
    adopt (rawPath, spText) =
      case parseStorePath defaultStoreDir spText of
        Nothing -> pure Nothing
        Just sp -> do
          valid <- isValid store sp
          if valid
            then pure Nothing
            else do
              let dest = storePathToFilePath platformStoreDir sp
              copyPathInto (T.unpack rawPath) dest
              setReadOnly dest
              Just <$> registrationFor store sp Nothing []

-- | Recursively copy a file or directory tree to a destination path.
copyPathInto :: FilePath -> FilePath -> IO ()
copyPathInto src dest = do
  isDir <- doesDirectoryExist src
  if isDir
    then do
      createDirectoryIfMissing True dest
      names <- listDirectory src
      mapM_ (\name -> copyPathInto (src FP.</> name) (dest FP.</> name)) names
    else copyFile src dest

-- | Write every recorded @.drv@ ATerm (keyed by its store-path text) to the
-- store.  Keys come from evaluation via 'storePathToText' so they always parse;
-- an unparseable key is skipped defensively.
writeDrvClosure :: Store -> Map.Map T.Text T.Text -> IO ()
writeDrvClosure store = mapM_ writeOne . Map.toList
  where
    writeOne (pathText, aterm) =
      case parseStorePath defaultStoreDir pathText of
        Just sp -> writeDrvAterm store sp aterm
        Nothing -> pure ()

-- ---------------------------------------------------------------------------
-- Output formatting
-- ---------------------------------------------------------------------------

-- | Optionally deep-force a value before printing.
-- With @--strict@, all thunks are recursively materialized.
-- Without it, thunks display as @«thunk»@ — safe for large results.
finalize :: (MonadEval m) => Bool -> NixValue -> m NixValue
finalize True = deepForceValue
finalize False = pure

-- ---------------------------------------------------------------------------
-- Deep-force and pretty-print
-- ---------------------------------------------------------------------------

-- | Recursively force all thunks in a value, returning the fully
-- materialized tree.  Unlike 'deepForce' (which returns @()@), this
-- rebuilds the value with all thunks replaced by computed C thunks.
deepForceValue :: (MonadEval m) => NixValue -> m NixValue
deepForceValue (VList cl) = do
  let thunks = map Thunk (clistThunks cl)
  forced <- mapM (force >=> deepForceValue) thunks
  pure (VList (clistFromThunks (map (thunkToCPtr . evaluated) forced)))
deepForceValue (VAttrs attrs) = do
  let m = attrSetToMap attrs
  forced <- mapM (force >=> deepForceValue) m
  pure (VAttrs (attrSetFromMap (Map.map evaluated forced)))
deepForceValue val = pure val

-- | Nix-style pretty-printing of a fully forced value.
prettyValue :: NixValue -> T.Text
prettyValue (VInt n) = T.pack (show n)
prettyValue (VFloat f) = T.pack (show f)
prettyValue (VBool True) = "true"
prettyValue (VBool False) = "false"
prettyValue VNull = "null"
prettyValue (VStr s _) = "\"" <> escapeNixString s <> "\""
prettyValue (VPath p) = p
prettyValue (VList cl) =
  "[ " <> T.intercalate " " (map (prettyThunk . Thunk) (clistThunks cl)) <> " ]"
prettyValue (VAttrs attrs) =
  let entries = attrSetToAscList attrs
      rendered = map (\(k, t) -> k <> " = " <> prettyThunk t <> ";") entries
   in "{ " <> T.intercalate " " rendered <> " }"
prettyValue (VLambda {}) = "«lambda»"
prettyValue (VBuiltin name _) = "«builtin " <> name <> "»"
prettyValue (VCompiledRegex _) = "«compiled-regex»"
prettyValue (VDerivation drv) =
  case drvOutputs drv of
    (out : _) -> "«derivation " <> T.pack (storePathToFilePath platformStoreDir (doPath out)) <> "»"
    [] -> "«derivation»"

-- | Pretty-print a thunk.  After deep-forcing, all thunks should be
-- computed thunks render their value; pending thunks render as a placeholder.
prettyThunk :: Thunk -> T.Text
prettyThunk thunk = maybe "«thunk»" prettyValue (readThunkValue thunk)

-- | Escape a string for Nix-style output (quotes, backslashes, newlines, tabs, carriage returns).
escapeNixString :: T.Text -> T.Text
escapeNixString = T.concatMap escapeChar
  where
    escapeChar '\\' = "\\\\"
    escapeChar '"' = "\\\""
    escapeChar '\n' = "\\n"
    escapeChar '\t' = "\\t"
    escapeChar '\r' = "\\r"
    escapeChar c = T.singleton c