mirror of
https://github.com/anoma/juvix.git
synced 2025-01-08 16:51:53 +03:00
138d9e545d
1. Adds the `--log-level LOG_LEVEL` flag to the CLI. This flag can be given `error`, `warn`, `info`, `progress`, `debug` as argument to filter the logged messages. 2. Removes the `--only-errors` flag. 3. Adds the `--ide-end-error-char CHAR`, which receives a character as an argument, which is appended to the end of error messages. This is handy to facilitate parsing of errors messages from the ide. This functionality was previously embeded in the old `--only-errors` flag.
44 lines
1.7 KiB
Haskell
44 lines
1.7 KiB
Haskell
module Commands.Eval where
|
|
|
|
import Commands.Base
|
|
import Commands.Eval.Options
|
|
import Evaluator qualified as Eval
|
|
import Juvix.Compiler.Core qualified as Core
|
|
import Juvix.Extra.Strings qualified as Str
|
|
|
|
runCommand :: (Members AppEffects r) => EvalOptions -> Sem r ()
|
|
runCommand opts@EvalOptions {..} = do
|
|
gopts <- askGlobalOptions
|
|
root <- askRoot
|
|
entryPoint <- maybe (entryPointFromGlobalOptionsNoFile root gopts) (fromAppPathFile >=> \f -> entryPointFromGlobalOptions root (Just f) gopts) _evalInputFile
|
|
Core.CoreResult {..} <- silenceProgressLog (runPipelineLogger () _evalInputFile upToCore)
|
|
let r =
|
|
run
|
|
. runReader entryPoint
|
|
. runError @JuvixError
|
|
$ (Core.toStored _coreResultModule :: Sem '[Error JuvixError, Reader EntryPoint] Core.Module)
|
|
tab <- Core.computeCombinedInfoTable <$> getRight r
|
|
let mevalNode
|
|
| isJust _evalSymbolName = getNode tab (selInfo tab)
|
|
| otherwise = getNode tab (mainInfo tab)
|
|
case mevalNode of
|
|
Just evalNode -> do
|
|
evopts <- evalOptionsToEvalOptions opts
|
|
Eval.evalAndPrint' (project gopts) (project opts) evopts tab evalNode
|
|
Nothing -> do
|
|
let name = fromMaybe Str.main _evalSymbolName
|
|
exitFailMsg ("function not found: " <> name)
|
|
where
|
|
mainInfo :: Core.InfoTable -> Maybe Core.IdentifierInfo
|
|
mainInfo tab = do
|
|
s <- tab ^. Core.infoMain
|
|
tab ^. Core.infoIdentifiers . at s
|
|
|
|
selInfo :: Core.InfoTable -> Maybe Core.IdentifierInfo
|
|
selInfo tab = do
|
|
s <- _evalSymbolName
|
|
find (^. Core.identifierName . to (== s)) (tab ^. Core.infoIdentifiers)
|
|
|
|
getNode :: Core.InfoTable -> Maybe Core.IdentifierInfo -> Maybe Core.Node
|
|
getNode tab m = m >>= \i -> tab ^. Core.identContext . at (i ^. Core.identifierSymbol)
|