From 11858284c5d0b948c08aa95e586db5526e42b3d2 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Wed, 17 Jul 2024 11:48:34 +0200 Subject: [PATCH 01/23] define Logger effect --- src/Juvix/Data.hs | 2 + src/Juvix/Data/Logger.hs | 102 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 src/Juvix/Data/Logger.hs diff --git a/src/Juvix/Data.hs b/src/Juvix/Data.hs index 322280be72..0528b976cf 100644 --- a/src/Juvix/Data.hs +++ b/src/Juvix/Data.hs @@ -14,6 +14,7 @@ module Juvix.Data module Juvix.Data.Pragmas, module Juvix.Data.Processed, module Juvix.Data.Uid, + module Juvix.Data.Logger, module Juvix.Data.Universe, module Juvix.Data.Wildcard, module Juvix.Data.WithLoc, @@ -36,6 +37,7 @@ import Juvix.Data.Irrelevant import Juvix.Data.IsImplicit import Juvix.Data.Keyword import Juvix.Data.Loc +import Juvix.Data.Logger import Juvix.Data.NameId qualified import Juvix.Data.NumThreads import Juvix.Data.Pragmas diff --git a/src/Juvix/Data/Logger.hs b/src/Juvix/Data/Logger.hs new file mode 100644 index 0000000000..a90f11938d --- /dev/null +++ b/src/Juvix/Data/Logger.hs @@ -0,0 +1,102 @@ +module Juvix.Data.Logger + ( defaultLoggerOptions, + defaultLoggerLevel, + Logger, + LoggerOptions (..), + LogLevel (..), + logError, + logProgress, + logInfo, + logWarn, + logDebug, + runLoggerIO, + localLogger, + loggerUseColors, + loggerLevel, + ) +where + +import Juvix.Prelude.Base.Foundation +import Juvix.Prelude.Effects.Base +import Juvix.Prelude.Effects.Output +import Juvix.Prelude.Pretty +import Prelude (show) + +data LogLevel + = LogLevelError + | LogLevelWarn + | LogLevelInfo + | LogLevelProgress + | LogLevelDebug + deriving stock (Eq, Ord, Enum, Bounded) + +instance Show LogLevel where + show = \case + LogLevelError -> "error" + LogLevelWarn -> "warn" + LogLevelInfo -> "info" + LogLevelProgress -> "progress" + LogLevelDebug -> "debug" + +instance Pretty LogLevel where + pretty = pretty . Prelude.show + +data Logger :: Effect where + LogMessage :: LogLevel -> AnsiText -> Logger m () + LocalLogger :: LogLevel -> m () -> Logger m () + +data LoggerOptions = LoggerOptions + { _loggerUseColors :: Bool, + _loggerLevel :: LogLevel + } + +defaultLoggerLevel :: LogLevel +defaultLoggerLevel = LogLevelProgress + +defaultLoggerOptions :: LoggerOptions +defaultLoggerOptions = + LoggerOptions + { _loggerUseColors = True, + _loggerLevel = defaultLoggerLevel + } + +makeSem ''Logger +makeLenses ''LoggerOptions + +logError :: (Members '[Logger] r) => AnsiText -> Sem r () +logError = logMessage LogLevelError + +logWarn :: (Members '[Logger] r) => AnsiText -> Sem r () +logWarn = logMessage LogLevelWarn + +logInfo :: (Members '[Logger] r) => AnsiText -> Sem r () +logInfo = logMessage LogLevelInfo + +logProgress :: (Members '[Logger] r) => AnsiText -> Sem r () +logProgress = logMessage LogLevelProgress + +logDebug :: (Members '[Logger] r) => AnsiText -> Sem r () +logDebug = logMessage LogLevelDebug + +runLoggerIO :: forall r a. (Members '[EmbedIO] r) => LoggerOptions -> Sem (Logger ': r) a -> Sem r a +runLoggerIO opts = interp . re + where + interp :: Sem (Output AnsiText ': Reader LogLevel ': r) a -> Sem r a + interp = runReader (opts ^. loggerLevel) . runOutputSem printMsg + + printMsg :: forall r'. (Members '[EmbedIO] r') => AnsiText -> Sem r' () + printMsg = hRenderIO (opts ^. loggerUseColors) stderr + +re :: Sem (Logger ': r) a -> Sem (Output AnsiText ': Reader LogLevel ': r) a +re = interpretTop2H handler + +handler :: + EffectHandler Logger (Output AnsiText ': Reader LogLevel ': r) +handler localEnv = + \case + LocalLogger localLevel localLog -> + localSeqUnlift localEnv $ \unlift -> + local (const localLevel) (unlift localLog) + LogMessage lvl msg -> do + loggerLvl <- ask + when (lvl <= loggerLvl) (output msg) From 09badde290d78b31b8e82d58c08f3e3ada644feb Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Wed, 17 Jul 2024 15:14:11 +0200 Subject: [PATCH 02/23] use AppEffects --- app/App.hs | 64 +++++++++-------------- app/Commands/Compile.hs | 2 +- app/Commands/Compile/Anoma.hs | 5 +- app/Commands/Compile/Cairo.hs | 5 +- app/Commands/Compile/Native.hs | 2 +- app/Commands/Compile/NativeWasiHelper.hs | 4 +- app/Commands/Compile/RiscZeroRust.hs | 2 +- app/Commands/Compile/Vampir.hs | 5 +- app/Commands/Compile/Wasi.hs | 2 +- app/Commands/Dependencies.hs | 2 +- app/Commands/Dependencies/Update.hs | 2 +- app/Commands/Dev/Core/FromConcrete.hs | 10 ++-- app/Commands/Dev/DevCompile.hs | 2 +- app/Commands/Dev/DevCompile/Asm.hs | 2 +- app/Commands/Dev/DevCompile/Casm.hs | 2 +- app/Commands/Dev/DevCompile/Core.hs | 2 +- app/Commands/Dev/DevCompile/NativeRust.hs | 6 +-- app/Commands/Dev/DevCompile/Reg.hs | 2 +- app/Commands/Dev/DevCompile/Rust.hs | 2 +- app/Commands/Dev/DevCompile/Tree.hs | 2 +- app/Commands/Dev/Highlight.hs | 2 +- app/Commands/Dev/ImportTree.hs | 2 +- app/Commands/Dev/ImportTree/Print.hs | 2 +- app/Commands/Dev/Internal.hs | 2 +- app/Commands/Dev/Internal/Pretty.hs | 2 +- app/Commands/Dev/Internal/Typecheck.hs | 2 +- app/Commands/Dev/Parse.hs | 2 +- app/Commands/Dev/Scope.hs | 10 ++-- app/Commands/Dev/Termination.hs | 2 +- app/Commands/Dev/Termination/CallGraph.hs | 22 ++++---- app/Commands/Dev/Termination/Calls.hs | 2 +- app/Commands/Eval.hs | 4 +- app/Commands/Extra/NewCompile.hs | 6 +-- app/Commands/Format.hs | 24 ++++----- app/Commands/Html.hs | 8 +-- app/Commands/Isabelle.hs | 30 +++++------ app/Commands/Markdown.hs | 8 +-- app/Commands/Typecheck.hs | 2 +- app/TopCommand.hs | 6 +-- src/Juvix/Compiler/Pipeline.hs | 3 +- src/Juvix/Compiler/Pipeline/Run.hs | 51 +++++++++--------- src/Parallel/ProgressLog.hs | 18 ++++--- 42 files changed, 168 insertions(+), 167 deletions(-) diff --git a/app/App.hs b/app/App.hs index 8ecb788a36..17a2c58dee 100644 --- a/app/App.hs +++ b/app/App.hs @@ -48,9 +48,11 @@ data RunAppIOArgs = RunAppIOArgs makeSem ''App makeLenses ''RunAppIOArgs +type AppEffects = '[Logger, TaggedLock, Files, App, EmbedIO] + runAppIO :: forall r a. - (Members '[EmbedIO, TaggedLock] r) => + (Members '[EmbedIO, Logger, TaggedLock] r) => RunAppIOArgs -> Sem (App ': r) a -> Sem r a @@ -156,13 +158,13 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do root = _runAppIOArgsRoot estdin <- if - | opts ^. globalStdin -> Just <$> liftIO getContents - | otherwise -> return Nothing + | opts ^. globalStdin -> Just <$> liftIO getContents + | otherwise -> return Nothing mainFile <- getMainAppFileMaybe inputFile set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root ((^. pathPath) <$> mainFile) opts runPipelineEither :: - (Members '[EmbedIO, TaggedLock, ProgressLog, App] r, EntryPointOptions opts) => + (Members '[EmbedIO, TaggedLock, Logger, App] r, EntryPointOptions opts) => opts -> Maybe (AppPath File) -> Sem (PipelineEff r) a -> @@ -178,8 +180,8 @@ getEntryPointStdin' RunAppIOArgs {..} = do root = _runAppIOArgsRoot estdin <- if - | opts ^. globalStdin -> Just <$> liftIO getContents - | otherwise -> return Nothing + | opts ^. globalStdin -> Just <$> liftIO getContents + | otherwise -> return Nothing set entryPointStdin estdin <$> entryPointFromGlobalOptionsNoFile root opts fromRightGenericError :: (Members '[App] r, ToGenericError err, Typeable err) => Either err a -> Sem r a @@ -220,7 +222,7 @@ getEntryPointStdin = do getEntryPointStdin' RunAppIOArgs {..} runPipelineTermination :: - (Members '[EmbedIO, App, TaggedLock] r) => + (Members '[EmbedIO, App, Logger, TaggedLock] r) => Maybe (AppPath File) -> Sem (Termination ': PipelineEff r) a -> Sem r (PipelineResult a) @@ -228,61 +230,47 @@ runPipelineTermination input_ p = ignoreProgressLog $ do r <- runPipelineEither () input_ (evalTermination iniTerminationState (inject p)) >>= fromRightJuvixError return (snd r) -appRunProgressLog :: (Members '[EmbedIO, App] r) => Sem (ProgressLog ': r) a -> Sem r a -appRunProgressLog m = do - g <- askGlobalOptions - let opts = - ProgressLogOptions - { _progressLogOptionsUseColors = not (g ^. globalNoColors), - _progressLogOptionsShowThreadId = g ^. globalDevShowThreadIds - } - if - | g ^. globalOnlyErrors -> ignoreProgressLog m - | otherwise -> runProgressLogIO opts m - runPipelineNoOptions :: - (Members '[App, EmbedIO, TaggedLock] r) => + (Members '[App, EmbedIO, Logger, TaggedLock] r) => Maybe (AppPath File) -> Sem (PipelineEff r) a -> Sem r a runPipelineNoOptions = runPipeline () -runPipelineProgress :: - (Members '[App, EmbedIO, ProgressLog, TaggedLock] r, EntryPointOptions opts) => +runPipelineLogger :: + (Members '[App, EmbedIO, Logger, TaggedLock] r, EntryPointOptions opts) => opts -> Maybe (AppPath File) -> Sem (PipelineEff r) a -> Sem r a -runPipelineProgress opts input_ p = do +runPipelineLogger opts input_ p = do r <- runPipelineEither opts input_ (inject p) >>= fromRightJuvixError return (snd r ^. pipelineResult) runPipeline :: - (Members '[App, EmbedIO, TaggedLock] r, EntryPointOptions opts) => + (Members '[App, EmbedIO, Logger, TaggedLock] r, EntryPointOptions opts) => opts -> Maybe (AppPath File) -> Sem (PipelineEff r) a -> Sem r a runPipeline opts input_ = - appRunProgressLog - . runPipelineProgress opts input_ + runPipelineLogger opts input_ . inject runPipelineHtml :: - (Members '[App, EmbedIO, TaggedLock] r) => + (Members '[App, EmbedIO, Logger, TaggedLock] r) => Bool -> Maybe (AppPath File) -> Sem r (InternalTypedResult, [InternalTypedResult]) runPipelineHtml bNonRecursive input_ = - appRunProgressLog $ - if - | bNonRecursive -> do - r <- runPipelineNoOptions input_ upToInternalTyped - return (r, []) - | otherwise -> do - args <- askArgs - entry <- getEntryPoint' args input_ - runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError + if + | bNonRecursive -> do + r <- runPipelineNoOptions input_ upToInternalTyped + return (r, []) + | otherwise -> do + args <- askArgs + entry <- getEntryPoint' args input_ + runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError runPipelineOptions :: (Members '[App] r) => Sem (Reader PipelineOptions ': r) a -> Sem r a runPipelineOptions m = do @@ -293,13 +281,13 @@ runPipelineOptions m = do } runReader opt m -runPipelineEntry :: (Members '[App, ProgressLog, EmbedIO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a +runPipelineEntry :: (Members '[App, Logger, EmbedIO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a runPipelineEntry entry p = runPipelineOptions $ do r <- runIOEither entry (inject p) >>= fromRightJuvixError return (snd r ^. pipelineResult) runPipelineSetup :: - (Members '[App, EmbedIO, Reader PipelineOptions, TaggedLock] r) => + (Members '[App, EmbedIO, Logger, Reader PipelineOptions, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a runPipelineSetup p = ignoreProgressLog $ do diff --git a/app/Commands/Compile.hs b/app/Commands/Compile.hs index 7d96dacc9a..1d6cb9cf79 100644 --- a/app/Commands/Compile.hs +++ b/app/Commands/Compile.hs @@ -13,7 +13,7 @@ import Commands.Compile.RiscZeroRust qualified as RiscZeroRust import Commands.Compile.Vampir qualified as Vampir import Commands.Compile.Wasi qualified as Wasi -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => CompileCommand -> Sem r () +runCommand :: (Members AppEffects r) => CompileCommand -> Sem r () runCommand = \case Native opts -> Native.runCommand opts Wasi opts -> Wasi.runCommand opts diff --git a/app/Commands/Compile/Anoma.hs b/app/Commands/Compile/Anoma.hs index f8147e3e59..d5757aa88d 100644 --- a/app/Commands/Compile/Anoma.hs +++ b/app/Commands/Compile/Anoma.hs @@ -6,7 +6,7 @@ import Commands.Extra.NewCompile import Juvix.Compiler.Nockma.Pretty qualified as Nockma import Juvix.Compiler.Nockma.Translation.FromTree qualified as Nockma -runCommand :: (Members '[App, EmbedIO, TaggedLock] r) => AnomaOptions 'InputMain -> Sem r () +runCommand :: (Members AppEffects r) => AnomaOptions 'InputMain -> Sem r () runCommand opts = do let opts' = opts ^. anomaCompileCommonOptions inputFile = opts' ^. compileInputFile @@ -20,7 +20,8 @@ runCommand opts = do runReader entryPoint . runError @JuvixError . coreToAnoma - $ coreRes ^. coreResultModule + $ coreRes + ^. coreResultModule res <- getRight r outputAnomaResult nockmaFile res diff --git a/app/Commands/Compile/Cairo.hs b/app/Commands/Compile/Cairo.hs index 31687fbec1..9f2e4d1d59 100644 --- a/app/Commands/Compile/Cairo.hs +++ b/app/Commands/Compile/Cairo.hs @@ -5,7 +5,7 @@ import Commands.Compile.Cairo.Options import Commands.Extra.NewCompile import Data.Aeson qualified as JSON -runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => CairoOptions 'InputMain -> Sem r () +runCommand :: (Members AppEffects r) => CairoOptions 'InputMain -> Sem r () runCommand opts = do let opts' = opts ^. cairoCompileCommonOptions inputFile = opts' ^. compileInputFile @@ -19,6 +19,7 @@ runCommand opts = do runReader entryPoint . runError @JuvixError . coreToCairo - $ coreRes ^. coreResultModule + $ coreRes + ^. coreResultModule res <- getRight r liftIO (JSON.encodeFile (toFilePath cairoFile) res) diff --git a/app/Commands/Compile/Native.hs b/app/Commands/Compile/Native.hs index 2321899104..2c4879d15f 100644 --- a/app/Commands/Compile/Native.hs +++ b/app/Commands/Compile/Native.hs @@ -6,7 +6,7 @@ import Commands.Compile.NativeWasiHelper as Helper runCommand :: forall r. - (Members '[App, TaggedLock, EmbedIO] r) => + (Members AppEffects r) => NativeOptions 'InputMain -> Sem r () runCommand = Helper.runCommand . nativeHelperOptions diff --git a/app/Commands/Compile/NativeWasiHelper.hs b/app/Commands/Compile/NativeWasiHelper.hs index b76924d424..ab47bda4bd 100644 --- a/app/Commands/Compile/NativeWasiHelper.hs +++ b/app/Commands/Compile/NativeWasiHelper.hs @@ -36,12 +36,12 @@ helperOutputFile opts = let baseOutputFile = invokeDir filename inputFile return ((opts ^. helperDefaultOutputFile) inputFile baseOutputFile) -runCommand :: forall r. (Members '[App, TaggedLock, EmbedIO] r) => HelperOptions 'InputMain -> Sem r () +runCommand :: forall r. (Members AppEffects r) => HelperOptions 'InputMain -> Sem r () runCommand opts = concreteToC opts >>= fromC opts concreteToC :: forall r. - (Members '[App, TaggedLock, EmbedIO] r) => + (Members AppEffects r) => HelperOptions 'InputMain -> Sem r C.MiniCResult concreteToC opts = do diff --git a/app/Commands/Compile/RiscZeroRust.hs b/app/Commands/Compile/RiscZeroRust.hs index ee7667bda4..f8f38bcbb3 100644 --- a/app/Commands/Compile/RiscZeroRust.hs +++ b/app/Commands/Compile/RiscZeroRust.hs @@ -6,7 +6,7 @@ import Commands.Extra.NewCompile import Data.FileEmbed qualified as FE import Juvix.Compiler.Backend.Rust.Data.Result -runCommand :: forall r. (Members '[App, TaggedLock, EmbedIO] r) => RiscZeroRustOptions 'InputMain -> Sem r () +runCommand :: forall r. (Members AppEffects r) => RiscZeroRustOptions 'InputMain -> Sem r () runCommand opts = do let opts' = opts ^. riscZeroRustCompileCommonOptions inputFile = opts' ^. compileInputFile diff --git a/app/Commands/Compile/Vampir.hs b/app/Commands/Compile/Vampir.hs index 393037d905..38b83e48b6 100644 --- a/app/Commands/Compile/Vampir.hs +++ b/app/Commands/Compile/Vampir.hs @@ -5,7 +5,7 @@ import Commands.Compile.Vampir.Options import Commands.Extra.NewCompile import Juvix.Compiler.Backend.VampIR.Translation qualified as VampIR -runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => VampirOptions 'InputMain -> Sem r () +runCommand :: (Members AppEffects r) => VampirOptions 'InputMain -> Sem r () runCommand opts = do let opts' = opts ^. vampirCompileCommonOptions inputFile = opts' ^. compileInputFile @@ -19,6 +19,7 @@ runCommand opts = do runReader entryPoint . runError @JuvixError . coreToVampIR - $ coreRes ^. coreResultModule + $ coreRes + ^. coreResultModule VampIR.Result {..} <- getRight r writeFileEnsureLn vampirFile _resultCode diff --git a/app/Commands/Compile/Wasi.hs b/app/Commands/Compile/Wasi.hs index c548befe11..4d13fe00e1 100644 --- a/app/Commands/Compile/Wasi.hs +++ b/app/Commands/Compile/Wasi.hs @@ -6,7 +6,7 @@ import Commands.Compile.Wasi.Options runCommand :: forall r. - (Members '[App, TaggedLock, EmbedIO] r) => + (Members AppEffects r) => WasiOptions 'InputMain -> Sem r () runCommand = Helper.runCommand . wasiHelperOptions diff --git a/app/Commands/Dependencies.hs b/app/Commands/Dependencies.hs index 3375df48c2..4bf713c99e 100644 --- a/app/Commands/Dependencies.hs +++ b/app/Commands/Dependencies.hs @@ -8,6 +8,6 @@ import Commands.Base import Commands.Dependencies.Options import Commands.Dependencies.Update qualified as Update -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => DependenciesCommand -> Sem r () +runCommand :: (Members AppEffects r) => DependenciesCommand -> Sem r () runCommand = \case Update -> Update.runCommand diff --git a/app/Commands/Dependencies/Update.hs b/app/Commands/Dependencies/Update.hs index 23a4909b1c..40a9a059dd 100644 --- a/app/Commands/Dependencies/Update.hs +++ b/app/Commands/Dependencies/Update.hs @@ -3,7 +3,7 @@ module Commands.Dependencies.Update where import Commands.Base import Juvix.Compiler.Pipeline.Loader.PathResolver -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => Sem r () +runCommand :: (Members AppEffects r) => Sem r () runCommand = do let opts = set (pipelineDependenciesConfig . dependenciesConfigForceUpdateLockfile) True defaultPipelineOptions runReader opts . runPipelineSetup $ return () diff --git a/app/Commands/Dev/Core/FromConcrete.hs b/app/Commands/Dev/Core/FromConcrete.hs index a7624e2e8f..e63b31f67d 100644 --- a/app/Commands/Dev/Core/FromConcrete.hs +++ b/app/Commands/Dev/Core/FromConcrete.hs @@ -11,10 +11,10 @@ import Juvix.Compiler.Core.Transformation qualified as Core import Juvix.Compiler.Core.Transformation.DisambiguateNames (disambiguateNames') import Juvix.Compiler.Core.Translation -runCommand :: forall r. (Members '[EmbedIO, TaggedLock, App] r) => CoreFromConcreteOptions -> Sem r () +runCommand :: forall r. (Members AppEffects r) => CoreFromConcreteOptions -> Sem r () runCommand coreOpts = do gopts <- askGlobalOptions - md <- (^. coreResultModule) <$> ignoreProgressLog (runPipelineProgress () (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore) + md <- (^. coreResultModule) <$> silenceLogger (runPipelineLogger () (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore) path :: Path Abs File <- fromAppPathFile (coreOpts ^. coreFromConcreteInputFile) let r = run @@ -86,6 +86,6 @@ runCommand coreOpts = do err = error "function not found" if - | coreOpts ^. coreFromConcreteEval -> goEval - | coreOpts ^. coreFromConcreteNormalize -> goNormalize - | otherwise -> goPrint + | coreOpts ^. coreFromConcreteEval -> goEval + | coreOpts ^. coreFromConcreteNormalize -> goNormalize + | otherwise -> goPrint diff --git a/app/Commands/Dev/DevCompile.hs b/app/Commands/Dev/DevCompile.hs index dd5da1471d..117274b475 100644 --- a/app/Commands/Dev/DevCompile.hs +++ b/app/Commands/Dev/DevCompile.hs @@ -10,7 +10,7 @@ import Commands.Dev.DevCompile.Reg qualified as Reg import Commands.Dev.DevCompile.Rust qualified as Rust import Commands.Dev.DevCompile.Tree qualified as Tree -runCommand :: (Members '[App, EmbedIO, TaggedLock] r) => DevCompileCommand -> Sem r () +runCommand :: (Members AppEffects r) => DevCompileCommand -> Sem r () runCommand = \case Core opts -> Core.runCommand opts Reg opts -> Reg.runCommand opts diff --git a/app/Commands/Dev/DevCompile/Asm.hs b/app/Commands/Dev/DevCompile/Asm.hs index e06605dd37..b8f256942b 100644 --- a/app/Commands/Dev/DevCompile/Asm.hs +++ b/app/Commands/Dev/DevCompile/Asm.hs @@ -6,7 +6,7 @@ import Commands.Extra.NewCompile import Juvix.Compiler.Asm.Data.InfoTable import Juvix.Compiler.Asm.Pretty -runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => AsmOptions 'InputMain -> Sem r () +runCommand :: (Members AppEffects r) => AsmOptions 'InputMain -> Sem r () runCommand opts = do let inputFile = opts ^. asmCompileCommonOptions . compileInputFile moutputFile = opts ^. asmCompileCommonOptions . compileOutputFile diff --git a/app/Commands/Dev/DevCompile/Casm.hs b/app/Commands/Dev/DevCompile/Casm.hs index 6386160a55..49a81d0714 100644 --- a/app/Commands/Dev/DevCompile/Casm.hs +++ b/app/Commands/Dev/DevCompile/Casm.hs @@ -6,7 +6,7 @@ import Commands.Extra.NewCompile import Juvix.Compiler.Casm.Data.Result import Juvix.Compiler.Casm.Pretty -runCommand :: (Members '[App, TaggedLock, EmbedIO] r) => CasmOptions 'InputMain -> Sem r () +runCommand :: (Members AppEffects r) => CasmOptions 'InputMain -> Sem r () runCommand opts = do let inputFile = opts ^. casmCompileCommonOptions . compileInputFile moutputFile = opts ^. casmCompileCommonOptions . compileOutputFile diff --git a/app/Commands/Dev/DevCompile/Core.hs b/app/Commands/Dev/DevCompile/Core.hs index 89e991a68f..d77c1d3239 100644 --- a/app/Commands/Dev/DevCompile/Core.hs +++ b/app/Commands/Dev/DevCompile/Core.hs @@ -12,7 +12,7 @@ compileTransformations = [Core.CombineInfoTables, Core.FilterUnreachable, Core.D runCommand :: forall r. - (Members '[App, TaggedLock, EmbedIO] r) => + (Members AppEffects r) => CoreOptions 'InputMain -> Sem r () runCommand opts = do diff --git a/app/Commands/Dev/DevCompile/NativeRust.hs b/app/Commands/Dev/DevCompile/NativeRust.hs index 2184da278c..efeedb3555 100644 --- a/app/Commands/Dev/DevCompile/NativeRust.hs +++ b/app/Commands/Dev/DevCompile/NativeRust.hs @@ -8,7 +8,7 @@ import Data.FileEmbed qualified as FE import Juvix.Compiler.Backend.Rust.Data.Result runCommand :: - (Members '[App, EmbedIO, TaggedLock] r) => + (Members AppEffects r) => NativeRustOptions 'InputMain -> Sem r () runCommand opts = do @@ -71,5 +71,5 @@ writeRuntime :: Sem r () writeRuntime runtime = do buildDir <- askBuildDir - liftIO $ - BS.writeFile (toFilePath (buildDir $(mkRelFile "libjuvix.rlib"))) runtime + liftIO + $ BS.writeFile (toFilePath (buildDir $(mkRelFile "libjuvix.rlib"))) runtime diff --git a/app/Commands/Dev/DevCompile/Reg.hs b/app/Commands/Dev/DevCompile/Reg.hs index 42bb076f45..3cddc4ac45 100644 --- a/app/Commands/Dev/DevCompile/Reg.hs +++ b/app/Commands/Dev/DevCompile/Reg.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Reg.Data.InfoTable import Juvix.Compiler.Reg.Pretty runCommand :: - (Members '[App, EmbedIO, TaggedLock] r) => + (Members AppEffects r) => RegOptions 'InputMain -> Sem r () runCommand opts = do diff --git a/app/Commands/Dev/DevCompile/Rust.hs b/app/Commands/Dev/DevCompile/Rust.hs index 1c27b2210a..5a8d2aab6e 100644 --- a/app/Commands/Dev/DevCompile/Rust.hs +++ b/app/Commands/Dev/DevCompile/Rust.hs @@ -6,7 +6,7 @@ import Commands.Extra.NewCompile import Juvix.Compiler.Backend.Rust.Data.Result runCommand :: - (Members '[App, EmbedIO, TaggedLock] r) => + (Members AppEffects r) => RustOptions 'InputMain -> Sem r () runCommand opts = do diff --git a/app/Commands/Dev/DevCompile/Tree.hs b/app/Commands/Dev/DevCompile/Tree.hs index 4733222734..e1bcb0ebee 100644 --- a/app/Commands/Dev/DevCompile/Tree.hs +++ b/app/Commands/Dev/DevCompile/Tree.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Tree.Data.InfoTable import Juvix.Compiler.Tree.Pretty runCommand :: - (Members '[App, TaggedLock, EmbedIO] r) => + (Members AppEffects r) => TreeOptions 'InputMain -> Sem r () runCommand opts = do diff --git a/app/Commands/Dev/Highlight.hs b/app/Commands/Dev/Highlight.hs index 006e422576..c1a526eefb 100644 --- a/app/Commands/Dev/Highlight.hs +++ b/app/Commands/Dev/Highlight.hs @@ -4,7 +4,7 @@ import Commands.Base import Commands.Dev.Highlight.Options import Juvix.Compiler.Concrete.Data.Highlight qualified as Highlight -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => HighlightOptions -> Sem r () +runCommand :: (Members AppEffects r) => HighlightOptions -> Sem r () runCommand HighlightOptions {..} = ignoreProgressLog . runPipelineOptions $ do entry <- getEntryPoint (Just _highlightInputFile) inputFile <- fromAppPathFile _highlightInputFile diff --git a/app/Commands/Dev/ImportTree.hs b/app/Commands/Dev/ImportTree.hs index e2407ae241..88d3ffc662 100644 --- a/app/Commands/Dev/ImportTree.hs +++ b/app/Commands/Dev/ImportTree.hs @@ -5,7 +5,7 @@ import Commands.Dev.ImportTree.Options import Commands.Dev.ImportTree.Print qualified as Print import Commands.Dev.ImportTree.ScanFile qualified as ScanFile -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => ImportTreeCommand -> Sem r () +runCommand :: (Members AppEffects r) => ImportTreeCommand -> Sem r () runCommand = \case Print opts -> Print.runCommand opts ScanFile opts -> ScanFile.runCommand opts diff --git a/app/Commands/Dev/ImportTree/Print.hs b/app/Commands/Dev/ImportTree/Print.hs index 67fe38a264..b412a1356b 100644 --- a/app/Commands/Dev/ImportTree/Print.hs +++ b/app/Commands/Dev/ImportTree/Print.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Concrete.Print import Juvix.Compiler.Pipeline.Loader.PathResolver import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => PrintOptions -> Sem r () +runCommand :: (Members AppEffects r) => PrintOptions -> Sem r () runCommand PrintOptions {..} = runReader opts . runPipelineSetup $ do tree <- case _printInputFile of Nothing -> ask diff --git a/app/Commands/Dev/Internal.hs b/app/Commands/Dev/Internal.hs index 30e3910559..ed50b16abf 100644 --- a/app/Commands/Dev/Internal.hs +++ b/app/Commands/Dev/Internal.hs @@ -5,7 +5,7 @@ import Commands.Dev.Internal.Options import Commands.Dev.Internal.Pretty qualified as Pretty import Commands.Dev.Internal.Typecheck qualified as Typecheck -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => InternalCommand -> Sem r () +runCommand :: (Members AppEffects r) => InternalCommand -> Sem r () runCommand = \case Pretty opts -> Pretty.runCommand opts TypeCheck opts -> Typecheck.runCommand opts diff --git a/app/Commands/Dev/Internal/Pretty.hs b/app/Commands/Dev/Internal/Pretty.hs index 481d604e58..b8c1c3f962 100644 --- a/app/Commands/Dev/Internal/Pretty.hs +++ b/app/Commands/Dev/Internal/Pretty.hs @@ -5,7 +5,7 @@ import Commands.Dev.Internal.Pretty.Options import Juvix.Compiler.Internal.Pretty qualified as Internal import Juvix.Compiler.Internal.Translation.FromConcrete qualified as Internal -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => InternalPrettyOptions -> Sem r () +runCommand :: (Members AppEffects r) => InternalPrettyOptions -> Sem r () runCommand opts = do globalOpts <- askGlobalOptions intern <- (^. pipelineResult . Internal.resultModule) <$> runPipelineTermination (opts ^. internalPrettyInputFile) upToInternal diff --git a/app/Commands/Dev/Internal/Typecheck.hs b/app/Commands/Dev/Internal/Typecheck.hs index 9130369c7c..59c9255ce9 100644 --- a/app/Commands/Dev/Internal/Typecheck.hs +++ b/app/Commands/Dev/Internal/Typecheck.hs @@ -5,7 +5,7 @@ import Commands.Dev.Internal.Typecheck.Options import Juvix.Compiler.Internal.Pretty qualified as Internal import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qualified as InternalTyped -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => InternalTypeOptions -> Sem r () +runCommand :: (Members AppEffects r) => InternalTypeOptions -> Sem r () runCommand localOpts = do globalOpts <- askGlobalOptions res <- runPipelineNoOptions (localOpts ^. internalTypeInputFile) upToInternalTyped diff --git a/app/Commands/Dev/Parse.hs b/app/Commands/Dev/Parse.hs index 466da9a25b..0fda7175f0 100644 --- a/app/Commands/Dev/Parse.hs +++ b/app/Commands/Dev/Parse.hs @@ -5,7 +5,7 @@ import Commands.Dev.Parse.Options import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser import Text.Show.Pretty (ppShow) -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => ParseOptions -> Sem r () +runCommand :: (Members AppEffects r) => ParseOptions -> Sem r () runCommand opts = do m <- (^. Parser.resultModule) diff --git a/app/Commands/Dev/Scope.hs b/app/Commands/Dev/Scope.hs index 5dfe07bc2d..5264bdba40 100644 --- a/app/Commands/Dev/Scope.hs +++ b/app/Commands/Dev/Scope.hs @@ -7,16 +7,16 @@ import Juvix.Compiler.Concrete.Print qualified as Print import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper import Juvix.Prelude.Pretty -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => ScopeOptions -> Sem r () +runCommand :: (Members AppEffects r) => ScopeOptions -> Sem r () runCommand opts = do globalOpts <- askGlobalOptions res :: Scoper.ScoperResult <- runPipelineNoOptions (opts ^. scopeInputFile) upToScopingEntry let m :: Module 'Scoped 'ModuleTop = res ^. Scoper.resultModule if - | opts ^. scopeWithComments -> - renderStdOut (Print.ppOut (globalOpts, opts) (Scoper.getScoperResultComments res) m) - | otherwise -> - renderStdOut (Print.ppOutNoComments (globalOpts, opts) m) + | opts ^. scopeWithComments -> + renderStdOut (Print.ppOut (globalOpts, opts) (Scoper.getScoperResultComments res) m) + | otherwise -> + renderStdOut (Print.ppOutNoComments (globalOpts, opts) m) when (opts ^. scopeListComments) $ do newline newline diff --git a/app/Commands/Dev/Termination.hs b/app/Commands/Dev/Termination.hs index c02a40a6bf..80007aace3 100644 --- a/app/Commands/Dev/Termination.hs +++ b/app/Commands/Dev/Termination.hs @@ -5,7 +5,7 @@ import Commands.Dev.Termination.CallGraph qualified as CallGraph import Commands.Dev.Termination.Calls qualified as Calls import Commands.Dev.Termination.Options -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => TerminationCommand -> Sem r () +runCommand :: (Members AppEffects r) => TerminationCommand -> Sem r () runCommand = \case Calls opts -> Calls.runCommand opts CallGraph opts -> CallGraph.runCommand opts diff --git a/app/Commands/Dev/Termination/CallGraph.hs b/app/Commands/Dev/Termination/CallGraph.hs index 2f4077dd2b..3571bf69fa 100644 --- a/app/Commands/Dev/Termination/CallGraph.hs +++ b/app/Commands/Dev/Termination/CallGraph.hs @@ -9,7 +9,7 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Da import Juvix.Compiler.Store.Extra qualified as Stored import Juvix.Prelude.Pretty -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => CallGraphOptions -> Sem r () +runCommand :: (Members AppEffects r) => CallGraphOptions -> Sem r () runCommand CallGraphOptions {..} = do globalOpts <- askGlobalOptions PipelineResult {..} <- runPipelineTermination _graphInputFile upToInternalTyped @@ -18,7 +18,9 @@ runCommand CallGraphOptions {..} = do toAnsiText' = toAnsiText (not (globalOpts ^. globalNoColors)) infotable = Internal.computeCombinedInfoTable (Stored.getInternalModuleTable _pipelineResultImports) - <> _pipelineResult ^. Internal.resultInternalModule . Internal.internalModuleInfoTable + <> _pipelineResult + ^. Internal.resultInternalModule + . Internal.internalModuleInfoTable callMap = Termination.buildCallMap mainModule completeGraph = Termination.completeCallGraph callMap filteredGraph = @@ -42,11 +44,11 @@ runCommand CallGraphOptions {..} = do renderStdOut (Internal.ppOut globalOpts r) newline if - | markedTerminating -> - printSuccessExit (n <> " Terminates by assumption") - | otherwise -> - case Termination.findOrder r of - Nothing -> - exitFailMsg (n <> " Fails the termination checking") - Just (Termination.LexOrder k) -> - printSuccessExit (n <> " Terminates with order " <> show (toList k)) + | markedTerminating -> + printSuccessExit (n <> " Terminates by assumption") + | otherwise -> + case Termination.findOrder r of + Nothing -> + exitFailMsg (n <> " Fails the termination checking") + Just (Termination.LexOrder k) -> + printSuccessExit (n <> " Terminates with order " <> show (toList k)) diff --git a/app/Commands/Dev/Termination/Calls.hs b/app/Commands/Dev/Termination/Calls.hs index adfceb094e..2d40ba836c 100644 --- a/app/Commands/Dev/Termination/Calls.hs +++ b/app/Commands/Dev/Termination/Calls.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Internal.Pretty qualified as Internal import Juvix.Compiler.Internal.Translation.FromConcrete qualified as Internal import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination qualified as Termination -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => CallsOptions -> Sem r () +runCommand :: (Members AppEffects r) => CallsOptions -> Sem r () runCommand localOpts@CallsOptions {..} = do globalOpts <- askGlobalOptions PipelineResult {..} <- runPipelineTermination _callsInputFile upToInternal diff --git a/app/Commands/Eval.hs b/app/Commands/Eval.hs index e5758b3aa2..dce6be4d01 100644 --- a/app/Commands/Eval.hs +++ b/app/Commands/Eval.hs @@ -6,12 +6,12 @@ import Evaluator qualified as Eval import Juvix.Compiler.Core qualified as Core import Juvix.Extra.Strings qualified as Str -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => EvalOptions -> Sem r () +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 {..} <- ignoreProgressLog (runPipelineProgress () _evalInputFile upToCore) + Core.CoreResult {..} <- ignoreProgressLog (runPipelineLogger () _evalInputFile upToCore) let r = run . runReader entryPoint diff --git a/app/Commands/Extra/NewCompile.hs b/app/Commands/Extra/NewCompile.hs index 613a3e035d..ff37126023 100644 --- a/app/Commands/Extra/NewCompile.hs +++ b/app/Commands/Extra/NewCompile.hs @@ -42,7 +42,7 @@ getOutputDir ext inp = \case return $ pathFileToPathDir baseOutputDir compileToCore :: - (Members '[App, EmbedIO, TaggedLock] r) => + (Members '[App, EmbedIO, Logger, TaggedLock] r) => CompileCommonOptions ('InputExtension 'FileExtJuvix) -> Sem r CoreResult compileToCore opts = runPipeline opts (Just (opts ^. compileInputFile)) upToCore @@ -55,8 +55,8 @@ commandTargetHelper t parseCommand = commandTargetsHelper :: [(CompileTarget, Parser a)] -> Parser a commandTargetsHelper supportedTargets = - hsubparser $ - mconcat + hsubparser + $ mconcat [ commandTargetHelper backend parser | (backend, parser) <- supportedTargets ] diff --git a/app/Commands/Format.hs b/app/Commands/Format.hs index a9f8385df8..52c35c5336 100644 --- a/app/Commands/Format.hs +++ b/app/Commands/Format.hs @@ -37,19 +37,19 @@ targetFromOptions opts = do Nothing -> do isPackageGlobal <- askPackageGlobal if - | isStdin -> return TargetStdin - | not isPackageGlobal -> return TargetProject - | otherwise -> do - exitFailMsg $ - Text.unlines - [ "juvix format error: either 'JUVIX_FILE_OR_PROJECT' or '--stdin' option must be specified", - "Use the --help option to display more usage information." - ] + | isStdin -> return TargetStdin + | not isPackageGlobal -> return TargetProject + | otherwise -> do + exitFailMsg + $ Text.unlines + [ "juvix format error: either 'JUVIX_FILE_OR_PROJECT' or '--stdin' option must be specified", + "Use the --help option to display more usage information." + ] -- | Formats the project on the root formatProject :: forall r. - (Members '[App, EmbedIO, TaggedLock, Files, Output FormattedFileInfo] r) => + (Members '[App, EmbedIO, TaggedLock, Logger, Files, Output FormattedFileInfo] r) => Sem r FormatResult formatProject = runPipelineOptions . runPipelineSetup $ do pkg <- askPackage @@ -59,7 +59,7 @@ formatProject = runPipelineOptions . runPipelineSetup $ do return (node, src) formatProjectSourceCode res' -runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock, Files] r) => FormatOptions -> Sem r () +runCommand :: forall r. (Members AppEffects r) => FormatOptions -> Sem r () runCommand opts = do target <- targetFromOptions opts runOutputSem (renderFormattedOutput target opts) . runScopeFileApp $ do @@ -109,7 +109,7 @@ renderFormattedOutput target opts fInfo = do InputPath p -> say (pack (toFilePath p)) Silent -> return () -runScopeFileApp :: (Members '[App, EmbedIO, TaggedLock] r) => Sem (ScopeEff ': r) a -> Sem r a +runScopeFileApp :: (Members AppEffects r) => Sem (ScopeEff ': r) a -> Sem r a runScopeFileApp = interpret $ \case ScopeFile p -> do let appFile = @@ -117,5 +117,5 @@ runScopeFileApp = interpret $ \case { _pathPath = mkPrepath (toFilePath p), _pathIsInput = False } - ignoreProgressLog (runPipelineProgress () (Just appFile) upToScopingEntry) + ignoreProgressLog (runPipelineLogger () (Just appFile) upToScopingEntry) ScopeStdin e -> ignoreProgressLog (runPipelineEntry e upToScopingEntry) diff --git a/app/Commands/Html.hs b/app/Commands/Html.hs index 5491b0e26d..abe811171b 100644 --- a/app/Commands/Html.hs +++ b/app/Commands/Html.hs @@ -14,13 +14,13 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Da import Juvix.Extra.Process import System.Process qualified as Process -runGenOnlySourceHtml :: (Members '[EmbedIO, TaggedLock, App] r) => HtmlOptions -> Sem r () +runGenOnlySourceHtml :: (Members AppEffects r) => HtmlOptions -> Sem r () runGenOnlySourceHtml HtmlOptions {..} = do res <- runPipelineNoOptions _htmlInputFile upToScopingEntry let m = res ^. Scoper.resultModule outputDir <- fromAppPathDir _htmlOutputDir - liftIO $ - Html.genSourceHtml + liftIO + $ Html.genSourceHtml GenSourceHtmlArgs { _genSourceHtmlArgsAssetsDir = _htmlAssetsPrefix, _genSourceHtmlArgsHtmlKind = Html.HtmlOnly, @@ -50,7 +50,7 @@ resultToJudocCtx res = where sres = res ^. resultInternal . resultScoper -runCommand :: forall r. (Members '[EmbedIO, TaggedLock, App] r) => HtmlOptions -> Sem r () +runCommand :: forall r. (Members AppEffects r) => HtmlOptions -> Sem r () runCommand HtmlOptions {..} | _htmlOnlySource = runGenOnlySourceHtml HtmlOptions {..} | otherwise = do diff --git a/app/Commands/Isabelle.hs b/app/Commands/Isabelle.hs index 98ab281ad0..5882722b07 100644 --- a/app/Commands/Isabelle.hs +++ b/app/Commands/Isabelle.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Backend.Isabelle.Language import Juvix.Compiler.Backend.Isabelle.Pretty runCommand :: - (Members '[EmbedIO, TaggedLock, App] r) => + (Members AppEffects r) => IsabelleOptions -> Sem r () runCommand opts = do @@ -16,17 +16,17 @@ runCommand opts = do let thy = res ^. resultTheory outputDir <- fromAppPathDir (opts ^. isabelleOutputDir) if - | opts ^. isabelleStdout -> do - renderStdOut (ppOutDefault thy) - putStrLn "" - | otherwise -> do - ensureDir outputDir - let file :: Path Rel File - file = - relFile - ( unpack (thy ^. theoryName . namePretty) - <.> isabelleFileExt - ) - absPath :: Path Abs File - absPath = outputDir file - writeFileEnsureLn absPath (ppPrint thy <> "\n") + | opts ^. isabelleStdout -> do + renderStdOut (ppOutDefault thy) + putStrLn "" + | otherwise -> do + ensureDir outputDir + let file :: Path Rel File + file = + relFile + ( unpack (thy ^. theoryName . namePretty) + <.> isabelleFileExt + ) + absPath :: Path Abs File + absPath = outputDir file + writeFileEnsureLn absPath (ppPrint thy <> "\n") diff --git a/app/Commands/Markdown.hs b/app/Commands/Markdown.hs index 4172226630..f63eb2da74 100644 --- a/app/Commands/Markdown.hs +++ b/app/Commands/Markdown.hs @@ -12,7 +12,7 @@ import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified import Juvix.Extra.Assets (writeAssets) runCommand :: - (Members '[EmbedIO, TaggedLock, App] r) => + (Members AppEffects r) => MarkdownOptions -> Sem r () runCommand opts = do @@ -45,9 +45,9 @@ runCommand opts = do | opts ^. markdownStdout -> liftIO . putStrLn $ md | otherwise -> do ensureDir outputDir - when (opts ^. markdownWriteAssets) $ - liftIO $ - writeAssets outputDir + when (opts ^. markdownWriteAssets) + $ liftIO + $ writeAssets outputDir let mdFile :: Path Rel File mdFile = diff --git a/app/Commands/Typecheck.hs b/app/Commands/Typecheck.hs index 4a8d818902..648b823807 100644 --- a/app/Commands/Typecheck.hs +++ b/app/Commands/Typecheck.hs @@ -3,7 +3,7 @@ module Commands.Typecheck where import Commands.Base import Commands.Typecheck.Options -runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => TypecheckOptions -> Sem r () +runCommand :: (Members AppEffects r) => TypecheckOptions -> Sem r () runCommand localOpts = do case localOpts ^. typecheckInputFile of Just _inputFile -> void (runPipelineNoOptions (localOpts ^. typecheckInputFile) upToCoreTypecheck) diff --git a/app/TopCommand.hs b/app/TopCommand.hs index 5c7ab1c89d..9e1a5cd6fe 100644 --- a/app/TopCommand.hs +++ b/app/TopCommand.hs @@ -28,7 +28,7 @@ showHelpText = do runTopCommand :: forall r. - (Members '[EmbedIO, App, TaggedLock] r) => + (Members AppEffects r) => TopCommand -> Sem r () runTopCommand = \case @@ -41,10 +41,10 @@ runTopCommand = \case Dev opts -> Dev.runCommand opts Typecheck opts -> Typecheck.runCommand opts Compile opts -> Compile.runCommand opts - Clean opts -> runFilesIO (Clean.runCommand opts) + Clean opts -> Clean.runCommand opts Eval opts -> Eval.runCommand opts Html opts -> Html.runCommand opts Markdown opts -> Markdown.runCommand opts JuvixRepl opts -> Repl.runCommand opts - JuvixFormat opts -> runFilesIO (Format.runCommand opts) + JuvixFormat opts -> Format.runCommand opts Dependencies opts -> Dependencies.runCommand opts diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index 14d05918b0..46f5e82b74 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -56,7 +56,7 @@ import Juvix.Data.Effect.Process import Juvix.Data.Field import Parallel.ProgressLog (ProgressLog) -type PipelineAppEffects = '[TaggedLock, Reader PipelineOptions, ProgressLog, EmbedIO] +type PipelineAppEffects = '[TaggedLock, Reader PipelineOptions, Logger, EmbedIO] type PipelineLocalEff = '[ ModuleInfoCache, @@ -74,6 +74,7 @@ type PipelineLocalEff = Error GitProcessError, Process, Log, + ProgressLog, Reader EntryPoint, Files, Error JuvixError, diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index 3967b36554..12660e3ad0 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -101,12 +101,12 @@ runPathResolverInput :: runPathResolverInput m = do entry <- ask if - | mainIsPackageFile entry -> runPackagePathResolver' (entry ^. entryPointResolverRoot) m - | otherwise -> runPathResolverPipe m + | mainIsPackageFile entry -> runPackagePathResolver' (entry ^. entryPointResolverRoot) m + | otherwise -> runPathResolverPipe m runIOEitherPipeline' :: forall a r. - (Members '[Reader PipelineOptions, ProgressLog, TaggedLock, EmbedIO] r) => + (Members '[Reader PipelineOptions, Logger, TaggedLock, EmbedIO] r) => EntryPoint -> Sem (PipelineEff' r) a -> Sem r (HighlightInput, (Either JuvixError (ResolverState, a))) @@ -120,6 +120,7 @@ runIOEitherPipeline' entry a = do . runJuvixError . runFilesIO . runReader entry + . runProgressLog defaultProgressLogOptions . runLogIO . runProcessIO . mapError (JuvixError @GitProcessError) @@ -160,8 +161,8 @@ evalModuleInfoCacheHelper m = do b <- supportsParallel threads <- ask >>= numThreads if - | b && threads > 1 -> DriverPar.evalModuleInfoCache m - | otherwise -> evalModuleInfoCache m + | b && threads > 1 -> DriverPar.evalModuleInfoCache m + | otherwise -> evalModuleInfoCache m mainIsPackageFile :: EntryPoint -> Bool mainIsPackageFile entry = case entry ^. entryPointModulePath of @@ -280,26 +281,26 @@ runReplPipelineIOEither' lockMode entry = do resultScoperTable :: InfoTable resultScoperTable = Scoped.getCombinedInfoTable (scopedResult ^. Scoped.resultScopedModule) - in Right $ - appendArtifactsModuleTable _pipelineResultImports $ - Artifacts - { _artifactMainModuleScope = Just $ scopedResult ^. Scoped.resultScope, - _artifactParsing = parserResult ^. P.resultParserState, - _artifactInternalTypedTable = typedTable, - _artifactTerminationState = typedResult ^. Typed.resultTermination, - _artifactCoreModule = coreModule, - _artifactScopeTable = resultScoperTable, - _artifactScopeExports = scopedResult ^. Scoped.resultExports, - _artifactTypes = typesTable, - _artifactFunctions = functionsTable, - _artifactInstances = instanceTable, - _artifactCoercions = coercionTable, - _artifactScoperState = scopedResult ^. Scoped.resultScoperState, - _artifactResolver = art ^. artifactResolver, - _artifactBuiltins = art ^. artifactBuiltins, - _artifactNameIdState = art ^. artifactNameIdState, - _artifactModuleTable = mempty - } + in Right + $ appendArtifactsModuleTable _pipelineResultImports + $ Artifacts + { _artifactMainModuleScope = Just $ scopedResult ^. Scoped.resultScope, + _artifactParsing = parserResult ^. P.resultParserState, + _artifactInternalTypedTable = typedTable, + _artifactTerminationState = typedResult ^. Typed.resultTermination, + _artifactCoreModule = coreModule, + _artifactScopeTable = resultScoperTable, + _artifactScopeExports = scopedResult ^. Scoped.resultExports, + _artifactTypes = typesTable, + _artifactFunctions = functionsTable, + _artifactInstances = instanceTable, + _artifactCoercions = coercionTable, + _artifactScoperState = scopedResult ^. Scoped.resultScoperState, + _artifactResolver = art ^. artifactResolver, + _artifactBuiltins = art ^. artifactBuiltins, + _artifactNameIdState = art ^. artifactNameIdState, + _artifactModuleTable = mempty + } where initialArtifacts :: Artifacts initialArtifacts = diff --git a/src/Parallel/ProgressLog.hs b/src/Parallel/ProgressLog.hs index 2a5c873dc0..3bd80ddc80 100644 --- a/src/Parallel/ProgressLog.hs +++ b/src/Parallel/ProgressLog.hs @@ -2,14 +2,14 @@ module Parallel.ProgressLog where import GHC.Conc (ThreadId) import Juvix.Data.CodeAnn +import Juvix.Data.Logger import Juvix.Prelude.Base data ProgressLog :: Effect where ProgressLog :: LogItem -> ProgressLog m () -data ProgressLogOptions = ProgressLogOptions - { _progressLogOptionsUseColors :: Bool, - _progressLogOptionsShowThreadId :: Bool +newtype ProgressLogOptions = ProgressLogOptions + { _progressLogOptionsShowThreadId :: Bool } data LogItem = LogItem @@ -21,13 +21,19 @@ makeSem ''ProgressLog makeLenses ''ProgressLogOptions makeLenses ''LogItem -runProgressLogIO :: (Members '[EmbedIO] r) => ProgressLogOptions -> Sem (ProgressLog ': r) a -> Sem r a -runProgressLogIO ProgressLogOptions {..} = interpret $ \case +defaultProgressLogOptions :: ProgressLogOptions +defaultProgressLogOptions = + ProgressLogOptions + { _progressLogOptionsShowThreadId = False + } + +runProgressLog :: (Members '[Logger] r) => ProgressLogOptions -> Sem (ProgressLog ': r) a -> Sem r a +runProgressLog ProgressLogOptions {..} = interpret $ \case ProgressLog LogItem {..} -> do let threadDoc :: Maybe (Doc CodeAnn) = do guard _progressLogOptionsShowThreadId return (kwBracketL <> show _logItemThreadId <> kwBracketR) - hRenderIO _progressLogOptionsUseColors stderr (threadDoc _logItemMessage <> hardline) + logProgress (mkAnsiText (threadDoc _logItemMessage <> hardline)) ignoreProgressLog :: Sem (ProgressLog ': r) a -> Sem r a ignoreProgressLog = interpret $ \case From 040c9494ec23d48f1cdc81e460a18001066551c5 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 18 Jul 2024 09:12:34 +0200 Subject: [PATCH 03/23] add Logger effect to pipeline --- app/App.hs | 4 ++-- app/Commands/Dev.hs | 2 +- app/Commands/Dev/Core.hs | 2 +- app/Commands/Dev/Core/FromConcrete.hs | 2 +- app/Commands/Dev/Highlight.hs | 2 +- app/Commands/Eval.hs | 2 +- app/Commands/Format.hs | 4 ++-- app/GlobalOptions.hs | 11 +++++++++++ app/Main.hs | 7 +++++++ src/Juvix/Compiler/Pipeline/Repl.hs | 14 +++++++++----- src/Juvix/Compiler/Pipeline/Run.hs | 4 +++- src/Juvix/Data/Logger.hs | 28 +++++++++++++++------------ src/Parallel/ProgressLog.hs | 4 ++-- 13 files changed, 57 insertions(+), 29 deletions(-) diff --git a/app/App.hs b/app/App.hs index 17a2c58dee..f38e54a3c8 100644 --- a/app/App.hs +++ b/app/App.hs @@ -226,7 +226,7 @@ runPipelineTermination :: Maybe (AppPath File) -> Sem (Termination ': PipelineEff r) a -> Sem r (PipelineResult a) -runPipelineTermination input_ p = ignoreProgressLog $ do +runPipelineTermination input_ p = silenceProgressLog $ do r <- runPipelineEither () input_ (evalTermination iniTerminationState (inject p)) >>= fromRightJuvixError return (snd r) @@ -290,7 +290,7 @@ runPipelineSetup :: (Members '[App, EmbedIO, Logger, Reader PipelineOptions, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a -runPipelineSetup p = ignoreProgressLog $ do +runPipelineSetup p = silenceProgressLog $ do args <- askArgs entry <- getEntryPointStdin' args r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError diff --git a/app/Commands/Dev.hs b/app/Commands/Dev.hs index 04ae4e40eb..759638f3cd 100644 --- a/app/Commands/Dev.hs +++ b/app/Commands/Dev.hs @@ -24,7 +24,7 @@ import Commands.Dev.Termination qualified as Termination import Commands.Dev.Tree qualified as Tree import Commands.Repl qualified as Repl -runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => DevCommand -> Sem r () +runCommand :: (Members AppEffects r) => DevCommand -> Sem r () runCommand = \case ImportTree opts -> ImportTree.runCommand opts Highlight opts -> Highlight.runCommand opts diff --git a/app/Commands/Dev/Core.hs b/app/Commands/Dev/Core.hs index 9aa3c34af8..01fb3e8ea0 100644 --- a/app/Commands/Dev/Core.hs +++ b/app/Commands/Dev/Core.hs @@ -11,7 +11,7 @@ import Commands.Dev.Core.Read as Read import Commands.Dev.Core.Repl as Repl import Commands.Dev.Core.Strip as Strip -runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CoreCommand -> Sem r () +runCommand :: forall r. (Members AppEffects r) => CoreCommand -> Sem r () runCommand = \case Repl opts -> Repl.runCommand opts Eval opts -> Eval.runCommand opts diff --git a/app/Commands/Dev/Core/FromConcrete.hs b/app/Commands/Dev/Core/FromConcrete.hs index e63b31f67d..41e9191ed5 100644 --- a/app/Commands/Dev/Core/FromConcrete.hs +++ b/app/Commands/Dev/Core/FromConcrete.hs @@ -14,7 +14,7 @@ import Juvix.Compiler.Core.Translation runCommand :: forall r. (Members AppEffects r) => CoreFromConcreteOptions -> Sem r () runCommand coreOpts = do gopts <- askGlobalOptions - md <- (^. coreResultModule) <$> silenceLogger (runPipelineLogger () (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore) + md <- (^. coreResultModule) <$> silenceProgressLog (runPipelineLogger () (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore) path :: Path Abs File <- fromAppPathFile (coreOpts ^. coreFromConcreteInputFile) let r = run diff --git a/app/Commands/Dev/Highlight.hs b/app/Commands/Dev/Highlight.hs index c1a526eefb..d1e5ddfcde 100644 --- a/app/Commands/Dev/Highlight.hs +++ b/app/Commands/Dev/Highlight.hs @@ -5,7 +5,7 @@ import Commands.Dev.Highlight.Options import Juvix.Compiler.Concrete.Data.Highlight qualified as Highlight runCommand :: (Members AppEffects r) => HighlightOptions -> Sem r () -runCommand HighlightOptions {..} = ignoreProgressLog . runPipelineOptions $ do +runCommand HighlightOptions {..} = silenceProgressLog . runPipelineOptions $ do entry <- getEntryPoint (Just _highlightInputFile) inputFile <- fromAppPathFile _highlightInputFile hinput <- diff --git a/app/Commands/Eval.hs b/app/Commands/Eval.hs index dce6be4d01..4134f58f4b 100644 --- a/app/Commands/Eval.hs +++ b/app/Commands/Eval.hs @@ -11,7 +11,7 @@ runCommand opts@EvalOptions {..} = do gopts <- askGlobalOptions root <- askRoot entryPoint <- maybe (entryPointFromGlobalOptionsNoFile root gopts) (fromAppPathFile >=> \f -> entryPointFromGlobalOptions root (Just f) gopts) _evalInputFile - Core.CoreResult {..} <- ignoreProgressLog (runPipelineLogger () _evalInputFile upToCore) + Core.CoreResult {..} <- silenceProgressLog (runPipelineLogger () _evalInputFile upToCore) let r = run . runReader entryPoint diff --git a/app/Commands/Format.hs b/app/Commands/Format.hs index 52c35c5336..08b7c675c5 100644 --- a/app/Commands/Format.hs +++ b/app/Commands/Format.hs @@ -117,5 +117,5 @@ runScopeFileApp = interpret $ \case { _pathPath = mkPrepath (toFilePath p), _pathIsInput = False } - ignoreProgressLog (runPipelineLogger () (Just appFile) upToScopingEntry) - ScopeStdin e -> ignoreProgressLog (runPipelineEntry e upToScopingEntry) + silenceProgressLog (runPipelineLogger () (Just appFile) upToScopingEntry) + ScopeStdin e -> silenceProgressLog (runPipelineEntry e upToScopingEntry) diff --git a/app/GlobalOptions.hs b/app/GlobalOptions.hs index a797cba5dc..b179d2fe4d 100644 --- a/app/GlobalOptions.hs +++ b/app/GlobalOptions.hs @@ -27,6 +27,7 @@ data GlobalOptions = GlobalOptions _globalNumThreads :: NumThreads, _globalFieldSize :: Maybe Natural, _globalOffline :: Bool, + _globalLogLevel :: LogLevel, _globalDevShowThreadIds :: Bool } deriving stock (Eq, Show) @@ -66,6 +67,7 @@ defaultGlobalOptions = _globalBuildDir = Nothing, _globalStdin = False, _globalNoPositivity = False, + _globalLogLevel = LogLevelProgress, _globalNoCoverage = False, _globalNoStdlib = False, _globalUnrollLimit = defaultUnrollLimit, @@ -139,6 +141,15 @@ parseGlobalFlags = do ( long "offline" <> help "Disable access to network resources" ) + _globalLogLevel <- + option + (enumReader Proxy) + ( long "log-level" + <> metavar "LOG_LEVEL" + <> completer (enumCompleter @LogLevel Proxy) + <> value defaultLogLevel + <> help "Determines how much log the compiler produces" + ) _globalShowNameIds <- switch ( long "show-name-ids" diff --git a/app/Main.hs b/app/Main.hs index de4e5a583b..6bdc93cdb1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -18,8 +18,15 @@ main = do mbuildDir <- mapM (prepathToAbsDir invokeDir) (_runAppIOArgsGlobalOptions ^? globalBuildDir . _Just . pathPath) mainFile <- topCommandInputPath cli mapM_ checkMainFile mainFile + let loggerOpts = + LoggerOptions + { _loggerLevel = _runAppIOArgsGlobalOptions ^. globalLogLevel, + _loggerUseColors = not (_runAppIOArgsGlobalOptions ^. globalNoColors) + } runM . runTaggedLockPermissive + . runLoggerIO loggerOpts + . runFilesIO $ do _runAppIOArgsRoot <- findRootAndChangeDir (containingDir <$> mainFile) mbuildDir invokeDir runAppIO RunAppIOArgs {..} (runTopCommand cli) diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs index 9569b9e07c..28ff3a10f1 100644 --- a/src/Juvix/Compiler/Pipeline/Repl.hs +++ b/src/Juvix/Compiler/Pipeline/Repl.hs @@ -44,7 +44,9 @@ upToInternalExpression p = do . runStateArtifacts artifactScoperState . runReader pkg $ runNameIdGenArtifacts (Scoper.scopeCheckExpression (Store.getScopedModuleTable mtab) scopeTable p) - >>= runNameIdGenArtifacts . runReader scopeTable . Internal.fromConcreteExpression + >>= runNameIdGenArtifacts + . runReader scopeTable + . Internal.fromConcreteExpression expressionUpToAtomsParsed :: (Members '[State Artifacts, Error JuvixError] r) => @@ -71,7 +73,7 @@ expressionUpToAtomsScoped fp txt = do . runNameIdGenArtifacts . runReader pkg $ Parser.expressionFromTextSource fp txt - >>= Scoper.scopeCheckExpressionAtoms (Store.getScopedModuleTable mtab) scopeTable + >>= Scoper.scopeCheckExpressionAtoms (Store.getScopedModuleTable mtab) scopeTable scopeCheckExpression :: (Members '[Reader EntryPoint, Error JuvixError, State Artifacts] r) => @@ -167,6 +169,7 @@ compileReplInputIO fp txt = do hasInternet <- not <$> asks (^. entryPointOffline) runError . runConcurrent + . runLoggerIO defaultLoggerOptions . runReader defaultNumThreads . evalInternet hasInternet . runTaggedLockPermissive @@ -184,7 +187,8 @@ compileReplInputIO fp txt = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (Just fp) - . ignoreProgressLog + . silenceProgressLog + . runProgressLog defaultProgressLogOptions . evalModuleInfoCacheHelper $ do p <- parseReplInput fp txt @@ -234,8 +238,8 @@ runTransformations shouldDisambiguate ts n = runCoreInfoTableBuilderArtifacts $ md' <- mapReader Core.fromEntryPoint $ Core.applyTransformations ts' md let md'' = if - | shouldDisambiguate' -> disambiguateNames md' - | otherwise -> md' + | shouldDisambiguate' -> disambiguateNames md' + | otherwise -> md' Core.setModule md'' getNode :: Core.Symbol -> Sem (Core.InfoTableBuilder ': r) Core.Node diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index 12660e3ad0..d255187aaa 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -214,6 +214,7 @@ runReplPipelineIOEither' lockMode entry = do eith <- runM . runConcurrent + . runLoggerIO defaultLoggerOptions . runReader defaultNumThreads . evalInternet hasInternet . ignoreHighlightBuilder @@ -237,7 +238,8 @@ runReplPipelineIOEither' lockMode entry = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (entry ^. entryPointModulePath) - . ignoreProgressLog + . silenceProgressLog + . runProgressLog defaultProgressLogOptions . evalModuleInfoCacheHelper $ processFileToStoredCore entry return $ case eith of diff --git a/src/Juvix/Data/Logger.hs b/src/Juvix/Data/Logger.hs index a90f11938d..1bee71bff2 100644 --- a/src/Juvix/Data/Logger.hs +++ b/src/Juvix/Data/Logger.hs @@ -1,6 +1,6 @@ module Juvix.Data.Logger ( defaultLoggerOptions, - defaultLoggerLevel, + defaultLogLevel, Logger, LoggerOptions (..), LogLevel (..), @@ -13,6 +13,7 @@ module Juvix.Data.Logger localLogger, loggerUseColors, loggerLevel, + silenceProgressLog, ) where @@ -43,21 +44,21 @@ instance Pretty LogLevel where data Logger :: Effect where LogMessage :: LogLevel -> AnsiText -> Logger m () - LocalLogger :: LogLevel -> m () -> Logger m () + LocalLogger :: ((LogLevel -> Bool) -> LogLevel -> Bool) -> m a -> Logger m a data LoggerOptions = LoggerOptions { _loggerUseColors :: Bool, _loggerLevel :: LogLevel } -defaultLoggerLevel :: LogLevel -defaultLoggerLevel = LogLevelProgress +defaultLogLevel :: LogLevel +defaultLogLevel = LogLevelProgress defaultLoggerOptions :: LoggerOptions defaultLoggerOptions = LoggerOptions { _loggerUseColors = True, - _loggerLevel = defaultLoggerLevel + _loggerLevel = defaultLogLevel } makeSem ''Logger @@ -78,25 +79,28 @@ logProgress = logMessage LogLevelProgress logDebug :: (Members '[Logger] r) => AnsiText -> Sem r () logDebug = logMessage LogLevelDebug +silenceProgressLog :: (Members '[Logger] r) => Sem r a -> Sem r a +silenceProgressLog = localLogger (\f -> f .||. (/= LogLevelProgress)) + runLoggerIO :: forall r a. (Members '[EmbedIO] r) => LoggerOptions -> Sem (Logger ': r) a -> Sem r a runLoggerIO opts = interp . re where - interp :: Sem (Output AnsiText ': Reader LogLevel ': r) a -> Sem r a - interp = runReader (opts ^. loggerLevel) . runOutputSem printMsg + interp :: Sem (Output AnsiText ': Reader (LogLevel -> Bool) ': r) a -> Sem r a + interp = runReader (<= (opts ^. loggerLevel)) . runOutputSem printMsg printMsg :: forall r'. (Members '[EmbedIO] r') => AnsiText -> Sem r' () printMsg = hRenderIO (opts ^. loggerUseColors) stderr -re :: Sem (Logger ': r) a -> Sem (Output AnsiText ': Reader LogLevel ': r) a +re :: Sem (Logger ': r) a -> Sem (Output AnsiText ': Reader (LogLevel -> Bool) ': r) a re = interpretTop2H handler handler :: - EffectHandler Logger (Output AnsiText ': Reader LogLevel ': r) + EffectHandler Logger (Output AnsiText ': Reader (LogLevel -> Bool) ': r) handler localEnv = \case - LocalLogger localLevel localLog -> + LocalLogger adjustPred localLog -> localSeqUnlift localEnv $ \unlift -> - local (const localLevel) (unlift localLog) + local adjustPred (unlift localLog) LogMessage lvl msg -> do loggerLvl <- ask - when (lvl <= loggerLvl) (output msg) + when (loggerLvl lvl) (output msg) diff --git a/src/Parallel/ProgressLog.hs b/src/Parallel/ProgressLog.hs index 3bd80ddc80..49f323a253 100644 --- a/src/Parallel/ProgressLog.hs +++ b/src/Parallel/ProgressLog.hs @@ -35,6 +35,6 @@ runProgressLog ProgressLogOptions {..} = interpret $ \case return (kwBracketL <> show _logItemThreadId <> kwBracketR) logProgress (mkAnsiText (threadDoc _logItemMessage <> hardline)) -ignoreProgressLog :: Sem (ProgressLog ': r) a -> Sem r a -ignoreProgressLog = interpret $ \case +ignoreProgressLog2 :: Sem (ProgressLog ': r) a -> Sem r a +ignoreProgressLog2 = interpret $ \case ProgressLog {} -> return () From cab7991eff6094cf04a3c2b11bee2d81bdc5095b Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 18 Jul 2024 13:25:23 +0200 Subject: [PATCH 04/23] fix localLogger --- app/App.hs | 9 +++++++-- app/Main.hs | 11 ++++++----- src/Juvix/Compiler/Pipeline/Run.hs | 4 +--- src/Juvix/Data/Logger.hs | 6 +++--- src/Parallel/ProgressLog.hs | 4 ++-- 5 files changed, 19 insertions(+), 15 deletions(-) diff --git a/app/App.hs b/app/App.hs index f38e54a3c8..dc6f64068c 100644 --- a/app/App.hs +++ b/app/App.hs @@ -62,7 +62,7 @@ runAppIO args = evalSingletonCache (readPackageRootIO root) . reAppIO args reAppIO :: forall r a. - (Members '[EmbedIO, TaggedLock] r) => + (Members '[EmbedIO, TaggedLock, Logger] r) => RunAppIOArgs -> Sem (App ': r) a -> Sem (SCache Package ': r) a @@ -139,11 +139,16 @@ reAppIO args@RunAppIOArgs {..} = <> pack (toFilePath juvixYamlFile) <> " file" ) + invDir = _runAppIOArgsRoot ^. rootInvokeDir + g :: GlobalOptions g = _runAppIOArgsGlobalOptions + + printErr :: forall r'. (Members '[Logger] r') => JuvixError -> Sem r' () printErr e = - hPutStrLn stderr + logError + . mkAnsiText . run . runReader (project' @GenericOptions g) $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e diff --git a/app/Main.hs b/app/Main.hs index 6bdc93cdb1..b1c8176d9d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,6 +6,7 @@ import Data.String.Interpolate (i) import GHC.Conc qualified as GHC import GlobalOptions import Juvix.Compiler.Pipeline.Root +import Juvix.Prelude.Pretty (mkAnsiText) import TopCommand import TopCommand.Options @@ -17,7 +18,6 @@ main = do numThreads (_runAppIOArgsGlobalOptions ^. globalNumThreads) >>= GHC.setNumCapabilities mbuildDir <- mapM (prepathToAbsDir invokeDir) (_runAppIOArgsGlobalOptions ^? globalBuildDir . _Just . pathPath) mainFile <- topCommandInputPath cli - mapM_ checkMainFile mainFile let loggerOpts = LoggerOptions { _loggerLevel = _runAppIOArgsGlobalOptions ^. globalLogLevel, @@ -28,13 +28,14 @@ main = do . runLoggerIO loggerOpts . runFilesIO $ do + mapM_ checkMainFile mainFile _runAppIOArgsRoot <- findRootAndChangeDir (containingDir <$> mainFile) mbuildDir invokeDir runAppIO RunAppIOArgs {..} (runTopCommand cli) where - checkMainFile :: SomePath b -> IO () - checkMainFile p = unlessM (doesSomePathExist p) err + checkMainFile :: forall r b. (Members '[Logger, EmbedIO] r) => SomePath b -> Sem r () + checkMainFile p = unlessM (liftIO (doesSomePathExist p)) err where - err :: IO () + err :: Sem r () err = do - hPutStrLn stderr [i|The input path #{p} does not exist|] + logError (mkAnsiText @Text [i|The input path #{p} does not exist|]) exitFailure diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index d255187aaa..12660e3ad0 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -214,7 +214,6 @@ runReplPipelineIOEither' lockMode entry = do eith <- runM . runConcurrent - . runLoggerIO defaultLoggerOptions . runReader defaultNumThreads . evalInternet hasInternet . ignoreHighlightBuilder @@ -238,8 +237,7 @@ runReplPipelineIOEither' lockMode entry = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (entry ^. entryPointModulePath) - . silenceProgressLog - . runProgressLog defaultProgressLogOptions + . ignoreProgressLog . evalModuleInfoCacheHelper $ processFileToStoredCore entry return $ case eith of diff --git a/src/Juvix/Data/Logger.hs b/src/Juvix/Data/Logger.hs index 1bee71bff2..3d8a66fd66 100644 --- a/src/Juvix/Data/Logger.hs +++ b/src/Juvix/Data/Logger.hs @@ -80,7 +80,7 @@ logDebug :: (Members '[Logger] r) => AnsiText -> Sem r () logDebug = logMessage LogLevelDebug silenceProgressLog :: (Members '[Logger] r) => Sem r a -> Sem r a -silenceProgressLog = localLogger (\f -> f .||. (/= LogLevelProgress)) +silenceProgressLog = localLogger (\f -> f .&&. (/= LogLevelProgress)) runLoggerIO :: forall r a. (Members '[EmbedIO] r) => LoggerOptions -> Sem (Logger ': r) a -> Sem r a runLoggerIO opts = interp . re @@ -102,5 +102,5 @@ handler localEnv = localSeqUnlift localEnv $ \unlift -> local adjustPred (unlift localLog) LogMessage lvl msg -> do - loggerLvl <- ask - when (loggerLvl lvl) (output msg) + loggerPredicate <- ask + when (loggerPredicate lvl) (output msg) diff --git a/src/Parallel/ProgressLog.hs b/src/Parallel/ProgressLog.hs index 49f323a253..3bd80ddc80 100644 --- a/src/Parallel/ProgressLog.hs +++ b/src/Parallel/ProgressLog.hs @@ -35,6 +35,6 @@ runProgressLog ProgressLogOptions {..} = interpret $ \case return (kwBracketL <> show _logItemThreadId <> kwBracketR) logProgress (mkAnsiText (threadDoc _logItemMessage <> hardline)) -ignoreProgressLog2 :: Sem (ProgressLog ': r) a -> Sem r a -ignoreProgressLog2 = interpret $ \case +ignoreProgressLog :: Sem (ProgressLog ': r) a -> Sem r a +ignoreProgressLog = interpret $ \case ProgressLog {} -> return () From cdbb632f5ec168653c3f118afed01f4abf50c566 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 18 Jul 2024 13:28:26 +0200 Subject: [PATCH 05/23] ormolu --- app/App.hs | 22 +++++------ app/Commands/Compile/Anoma.hs | 2 +- app/Commands/Compile/Cairo.hs | 2 +- app/Commands/Compile/Vampir.hs | 2 +- app/Commands/Dev/Core/FromConcrete.hs | 6 +-- app/Commands/Dev/DevCompile/NativeRust.hs | 4 +- app/Commands/Dev/Scope.hs | 8 ++-- app/Commands/Dev/Termination/CallGraph.hs | 20 +++++----- app/Commands/Extra/NewCompile.hs | 4 +- app/Commands/Format.hs | 16 ++++---- app/Commands/Html.hs | 4 +- app/Commands/Isabelle.hs | 28 ++++++------- app/Commands/Markdown.hs | 6 +-- src/Juvix/Compiler/Pipeline/Repl.hs | 12 +++--- src/Juvix/Compiler/Pipeline/Run.hs | 48 +++++++++++------------ 15 files changed, 92 insertions(+), 92 deletions(-) diff --git a/app/App.hs b/app/App.hs index dc6f64068c..7df4cf96c2 100644 --- a/app/App.hs +++ b/app/App.hs @@ -163,8 +163,8 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do root = _runAppIOArgsRoot estdin <- if - | opts ^. globalStdin -> Just <$> liftIO getContents - | otherwise -> return Nothing + | opts ^. globalStdin -> Just <$> liftIO getContents + | otherwise -> return Nothing mainFile <- getMainAppFileMaybe inputFile set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root ((^. pathPath) <$> mainFile) opts @@ -185,8 +185,8 @@ getEntryPointStdin' RunAppIOArgs {..} = do root = _runAppIOArgsRoot estdin <- if - | opts ^. globalStdin -> Just <$> liftIO getContents - | otherwise -> return Nothing + | opts ^. globalStdin -> Just <$> liftIO getContents + | otherwise -> return Nothing set entryPointStdin estdin <$> entryPointFromGlobalOptionsNoFile root opts fromRightGenericError :: (Members '[App] r, ToGenericError err, Typeable err) => Either err a -> Sem r a @@ -269,13 +269,13 @@ runPipelineHtml :: Sem r (InternalTypedResult, [InternalTypedResult]) runPipelineHtml bNonRecursive input_ = if - | bNonRecursive -> do - r <- runPipelineNoOptions input_ upToInternalTyped - return (r, []) - | otherwise -> do - args <- askArgs - entry <- getEntryPoint' args input_ - runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError + | bNonRecursive -> do + r <- runPipelineNoOptions input_ upToInternalTyped + return (r, []) + | otherwise -> do + args <- askArgs + entry <- getEntryPoint' args input_ + runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError runPipelineOptions :: (Members '[App] r) => Sem (Reader PipelineOptions ': r) a -> Sem r a runPipelineOptions m = do diff --git a/app/Commands/Compile/Anoma.hs b/app/Commands/Compile/Anoma.hs index d5757aa88d..3a0547bdd5 100644 --- a/app/Commands/Compile/Anoma.hs +++ b/app/Commands/Compile/Anoma.hs @@ -21,7 +21,7 @@ runCommand opts = do . runError @JuvixError . coreToAnoma $ coreRes - ^. coreResultModule + ^. coreResultModule res <- getRight r outputAnomaResult nockmaFile res diff --git a/app/Commands/Compile/Cairo.hs b/app/Commands/Compile/Cairo.hs index 9f2e4d1d59..1cdec4f10e 100644 --- a/app/Commands/Compile/Cairo.hs +++ b/app/Commands/Compile/Cairo.hs @@ -20,6 +20,6 @@ runCommand opts = do . runError @JuvixError . coreToCairo $ coreRes - ^. coreResultModule + ^. coreResultModule res <- getRight r liftIO (JSON.encodeFile (toFilePath cairoFile) res) diff --git a/app/Commands/Compile/Vampir.hs b/app/Commands/Compile/Vampir.hs index 38b83e48b6..4a08e45aa6 100644 --- a/app/Commands/Compile/Vampir.hs +++ b/app/Commands/Compile/Vampir.hs @@ -20,6 +20,6 @@ runCommand opts = do . runError @JuvixError . coreToVampIR $ coreRes - ^. coreResultModule + ^. coreResultModule VampIR.Result {..} <- getRight r writeFileEnsureLn vampirFile _resultCode diff --git a/app/Commands/Dev/Core/FromConcrete.hs b/app/Commands/Dev/Core/FromConcrete.hs index 41e9191ed5..bd27912c88 100644 --- a/app/Commands/Dev/Core/FromConcrete.hs +++ b/app/Commands/Dev/Core/FromConcrete.hs @@ -86,6 +86,6 @@ runCommand coreOpts = do err = error "function not found" if - | coreOpts ^. coreFromConcreteEval -> goEval - | coreOpts ^. coreFromConcreteNormalize -> goNormalize - | otherwise -> goPrint + | coreOpts ^. coreFromConcreteEval -> goEval + | coreOpts ^. coreFromConcreteNormalize -> goNormalize + | otherwise -> goPrint diff --git a/app/Commands/Dev/DevCompile/NativeRust.hs b/app/Commands/Dev/DevCompile/NativeRust.hs index efeedb3555..27ee0233f4 100644 --- a/app/Commands/Dev/DevCompile/NativeRust.hs +++ b/app/Commands/Dev/DevCompile/NativeRust.hs @@ -71,5 +71,5 @@ writeRuntime :: Sem r () writeRuntime runtime = do buildDir <- askBuildDir - liftIO - $ BS.writeFile (toFilePath (buildDir $(mkRelFile "libjuvix.rlib"))) runtime + liftIO $ + BS.writeFile (toFilePath (buildDir $(mkRelFile "libjuvix.rlib"))) runtime diff --git a/app/Commands/Dev/Scope.hs b/app/Commands/Dev/Scope.hs index 5264bdba40..e8145920f7 100644 --- a/app/Commands/Dev/Scope.hs +++ b/app/Commands/Dev/Scope.hs @@ -13,10 +13,10 @@ runCommand opts = do res :: Scoper.ScoperResult <- runPipelineNoOptions (opts ^. scopeInputFile) upToScopingEntry let m :: Module 'Scoped 'ModuleTop = res ^. Scoper.resultModule if - | opts ^. scopeWithComments -> - renderStdOut (Print.ppOut (globalOpts, opts) (Scoper.getScoperResultComments res) m) - | otherwise -> - renderStdOut (Print.ppOutNoComments (globalOpts, opts) m) + | opts ^. scopeWithComments -> + renderStdOut (Print.ppOut (globalOpts, opts) (Scoper.getScoperResultComments res) m) + | otherwise -> + renderStdOut (Print.ppOutNoComments (globalOpts, opts) m) when (opts ^. scopeListComments) $ do newline newline diff --git a/app/Commands/Dev/Termination/CallGraph.hs b/app/Commands/Dev/Termination/CallGraph.hs index 3571bf69fa..16864fd74a 100644 --- a/app/Commands/Dev/Termination/CallGraph.hs +++ b/app/Commands/Dev/Termination/CallGraph.hs @@ -19,8 +19,8 @@ runCommand CallGraphOptions {..} = do infotable = Internal.computeCombinedInfoTable (Stored.getInternalModuleTable _pipelineResultImports) <> _pipelineResult - ^. Internal.resultInternalModule - . Internal.internalModuleInfoTable + ^. Internal.resultInternalModule + . Internal.internalModuleInfoTable callMap = Termination.buildCallMap mainModule completeGraph = Termination.completeCallGraph callMap filteredGraph = @@ -44,11 +44,11 @@ runCommand CallGraphOptions {..} = do renderStdOut (Internal.ppOut globalOpts r) newline if - | markedTerminating -> - printSuccessExit (n <> " Terminates by assumption") - | otherwise -> - case Termination.findOrder r of - Nothing -> - exitFailMsg (n <> " Fails the termination checking") - Just (Termination.LexOrder k) -> - printSuccessExit (n <> " Terminates with order " <> show (toList k)) + | markedTerminating -> + printSuccessExit (n <> " Terminates by assumption") + | otherwise -> + case Termination.findOrder r of + Nothing -> + exitFailMsg (n <> " Fails the termination checking") + Just (Termination.LexOrder k) -> + printSuccessExit (n <> " Terminates with order " <> show (toList k)) diff --git a/app/Commands/Extra/NewCompile.hs b/app/Commands/Extra/NewCompile.hs index ff37126023..243b44a43a 100644 --- a/app/Commands/Extra/NewCompile.hs +++ b/app/Commands/Extra/NewCompile.hs @@ -55,8 +55,8 @@ commandTargetHelper t parseCommand = commandTargetsHelper :: [(CompileTarget, Parser a)] -> Parser a commandTargetsHelper supportedTargets = - hsubparser - $ mconcat + hsubparser $ + mconcat [ commandTargetHelper backend parser | (backend, parser) <- supportedTargets ] diff --git a/app/Commands/Format.hs b/app/Commands/Format.hs index 08b7c675c5..bdfd15b7cc 100644 --- a/app/Commands/Format.hs +++ b/app/Commands/Format.hs @@ -37,14 +37,14 @@ targetFromOptions opts = do Nothing -> do isPackageGlobal <- askPackageGlobal if - | isStdin -> return TargetStdin - | not isPackageGlobal -> return TargetProject - | otherwise -> do - exitFailMsg - $ Text.unlines - [ "juvix format error: either 'JUVIX_FILE_OR_PROJECT' or '--stdin' option must be specified", - "Use the --help option to display more usage information." - ] + | isStdin -> return TargetStdin + | not isPackageGlobal -> return TargetProject + | otherwise -> do + exitFailMsg $ + Text.unlines + [ "juvix format error: either 'JUVIX_FILE_OR_PROJECT' or '--stdin' option must be specified", + "Use the --help option to display more usage information." + ] -- | Formats the project on the root formatProject :: diff --git a/app/Commands/Html.hs b/app/Commands/Html.hs index abe811171b..0218a02de8 100644 --- a/app/Commands/Html.hs +++ b/app/Commands/Html.hs @@ -19,8 +19,8 @@ runGenOnlySourceHtml HtmlOptions {..} = do res <- runPipelineNoOptions _htmlInputFile upToScopingEntry let m = res ^. Scoper.resultModule outputDir <- fromAppPathDir _htmlOutputDir - liftIO - $ Html.genSourceHtml + liftIO $ + Html.genSourceHtml GenSourceHtmlArgs { _genSourceHtmlArgsAssetsDir = _htmlAssetsPrefix, _genSourceHtmlArgsHtmlKind = Html.HtmlOnly, diff --git a/app/Commands/Isabelle.hs b/app/Commands/Isabelle.hs index 5882722b07..c2731fc2a1 100644 --- a/app/Commands/Isabelle.hs +++ b/app/Commands/Isabelle.hs @@ -16,17 +16,17 @@ runCommand opts = do let thy = res ^. resultTheory outputDir <- fromAppPathDir (opts ^. isabelleOutputDir) if - | opts ^. isabelleStdout -> do - renderStdOut (ppOutDefault thy) - putStrLn "" - | otherwise -> do - ensureDir outputDir - let file :: Path Rel File - file = - relFile - ( unpack (thy ^. theoryName . namePretty) - <.> isabelleFileExt - ) - absPath :: Path Abs File - absPath = outputDir file - writeFileEnsureLn absPath (ppPrint thy <> "\n") + | opts ^. isabelleStdout -> do + renderStdOut (ppOutDefault thy) + putStrLn "" + | otherwise -> do + ensureDir outputDir + let file :: Path Rel File + file = + relFile + ( unpack (thy ^. theoryName . namePretty) + <.> isabelleFileExt + ) + absPath :: Path Abs File + absPath = outputDir file + writeFileEnsureLn absPath (ppPrint thy <> "\n") diff --git a/app/Commands/Markdown.hs b/app/Commands/Markdown.hs index f63eb2da74..3d83b67f11 100644 --- a/app/Commands/Markdown.hs +++ b/app/Commands/Markdown.hs @@ -45,9 +45,9 @@ runCommand opts = do | opts ^. markdownStdout -> liftIO . putStrLn $ md | otherwise -> do ensureDir outputDir - when (opts ^. markdownWriteAssets) - $ liftIO - $ writeAssets outputDir + when (opts ^. markdownWriteAssets) $ + liftIO $ + writeAssets outputDir let mdFile :: Path Rel File mdFile = diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs index 28ff3a10f1..d77b186a50 100644 --- a/src/Juvix/Compiler/Pipeline/Repl.hs +++ b/src/Juvix/Compiler/Pipeline/Repl.hs @@ -44,9 +44,9 @@ upToInternalExpression p = do . runStateArtifacts artifactScoperState . runReader pkg $ runNameIdGenArtifacts (Scoper.scopeCheckExpression (Store.getScopedModuleTable mtab) scopeTable p) - >>= runNameIdGenArtifacts - . runReader scopeTable - . Internal.fromConcreteExpression + >>= runNameIdGenArtifacts + . runReader scopeTable + . Internal.fromConcreteExpression expressionUpToAtomsParsed :: (Members '[State Artifacts, Error JuvixError] r) => @@ -73,7 +73,7 @@ expressionUpToAtomsScoped fp txt = do . runNameIdGenArtifacts . runReader pkg $ Parser.expressionFromTextSource fp txt - >>= Scoper.scopeCheckExpressionAtoms (Store.getScopedModuleTable mtab) scopeTable + >>= Scoper.scopeCheckExpressionAtoms (Store.getScopedModuleTable mtab) scopeTable scopeCheckExpression :: (Members '[Reader EntryPoint, Error JuvixError, State Artifacts] r) => @@ -238,8 +238,8 @@ runTransformations shouldDisambiguate ts n = runCoreInfoTableBuilderArtifacts $ md' <- mapReader Core.fromEntryPoint $ Core.applyTransformations ts' md let md'' = if - | shouldDisambiguate' -> disambiguateNames md' - | otherwise -> md' + | shouldDisambiguate' -> disambiguateNames md' + | otherwise -> md' Core.setModule md'' getNode :: Core.Symbol -> Sem (Core.InfoTableBuilder ': r) Core.Node diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index 12660e3ad0..6b4155ba9e 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -101,8 +101,8 @@ runPathResolverInput :: runPathResolverInput m = do entry <- ask if - | mainIsPackageFile entry -> runPackagePathResolver' (entry ^. entryPointResolverRoot) m - | otherwise -> runPathResolverPipe m + | mainIsPackageFile entry -> runPackagePathResolver' (entry ^. entryPointResolverRoot) m + | otherwise -> runPathResolverPipe m runIOEitherPipeline' :: forall a r. @@ -161,8 +161,8 @@ evalModuleInfoCacheHelper m = do b <- supportsParallel threads <- ask >>= numThreads if - | b && threads > 1 -> DriverPar.evalModuleInfoCache m - | otherwise -> evalModuleInfoCache m + | b && threads > 1 -> DriverPar.evalModuleInfoCache m + | otherwise -> evalModuleInfoCache m mainIsPackageFile :: EntryPoint -> Bool mainIsPackageFile entry = case entry ^. entryPointModulePath of @@ -281,26 +281,26 @@ runReplPipelineIOEither' lockMode entry = do resultScoperTable :: InfoTable resultScoperTable = Scoped.getCombinedInfoTable (scopedResult ^. Scoped.resultScopedModule) - in Right - $ appendArtifactsModuleTable _pipelineResultImports - $ Artifacts - { _artifactMainModuleScope = Just $ scopedResult ^. Scoped.resultScope, - _artifactParsing = parserResult ^. P.resultParserState, - _artifactInternalTypedTable = typedTable, - _artifactTerminationState = typedResult ^. Typed.resultTermination, - _artifactCoreModule = coreModule, - _artifactScopeTable = resultScoperTable, - _artifactScopeExports = scopedResult ^. Scoped.resultExports, - _artifactTypes = typesTable, - _artifactFunctions = functionsTable, - _artifactInstances = instanceTable, - _artifactCoercions = coercionTable, - _artifactScoperState = scopedResult ^. Scoped.resultScoperState, - _artifactResolver = art ^. artifactResolver, - _artifactBuiltins = art ^. artifactBuiltins, - _artifactNameIdState = art ^. artifactNameIdState, - _artifactModuleTable = mempty - } + in Right $ + appendArtifactsModuleTable _pipelineResultImports $ + Artifacts + { _artifactMainModuleScope = Just $ scopedResult ^. Scoped.resultScope, + _artifactParsing = parserResult ^. P.resultParserState, + _artifactInternalTypedTable = typedTable, + _artifactTerminationState = typedResult ^. Typed.resultTermination, + _artifactCoreModule = coreModule, + _artifactScopeTable = resultScoperTable, + _artifactScopeExports = scopedResult ^. Scoped.resultExports, + _artifactTypes = typesTable, + _artifactFunctions = functionsTable, + _artifactInstances = instanceTable, + _artifactCoercions = coercionTable, + _artifactScoperState = scopedResult ^. Scoped.resultScoperState, + _artifactResolver = art ^. artifactResolver, + _artifactBuiltins = art ^. artifactBuiltins, + _artifactNameIdState = art ^. artifactNameIdState, + _artifactModuleTable = mempty + } where initialArtifacts :: Artifacts initialArtifacts = From 02196f285b32f3dc27c93492cb31fb2661cd2bb7 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 18 Jul 2024 13:33:38 +0200 Subject: [PATCH 06/23] derive say --- app/App.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/app/App.hs b/app/App.hs index 7df4cf96c2..2536a3c785 100644 --- a/app/App.hs +++ b/app/App.hs @@ -37,7 +37,6 @@ data App :: Effect where GetMainFileMaybe :: Maybe (AppPath File) -> App m (Maybe (Path Abs File)) FromAppPathDir :: AppPath Dir -> App m (Path Abs Dir) RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m () - Say :: Text -> App m () SayRaw :: ByteString -> App m () data RunAppIOArgs = RunAppIOArgs @@ -88,9 +87,6 @@ reAppIO args@RunAppIOArgs {..} = AskInvokeDir -> return invDir AskPkgDir -> return (_runAppIOArgsRoot ^. rootRootDir) AskBuildDir -> return (resolveAbsBuildDir (_runAppIOArgsRoot ^. rootRootDir) (_runAppIOArgsRoot ^. rootBuildDir)) - Say t - | g ^. globalOnlyErrors -> return () - | otherwise -> putStrLn t PrintJuvixError e -> printErr e ExitJuvixError e -> do printErr e @@ -301,6 +297,9 @@ runPipelineSetup p = silenceProgressLog $ do r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError return (snd r) +say :: (Member App r) => Text -> Sem r () +say = renderStdOut + newline :: (Member App r) => Sem r () newline = say "" From 3cbef3fbe986e466a647b930701af3e020eb7f35 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 18 Jul 2024 16:29:13 +0200 Subject: [PATCH 07/23] remove --only-errors and introduce --ide-end-error-char --- app/App.hs | 10 ++++------ app/Commands/Repl.hs | 2 +- app/CommonOptions.hs | 8 ++++++++ app/GlobalOptions.hs | 21 +++++++++++++-------- src/Juvix/Data/Error/GenericError.hs | 10 ++++------ 5 files changed, 30 insertions(+), 21 deletions(-) diff --git a/app/App.hs b/app/App.hs index 2536a3c785..9566a31af6 100644 --- a/app/App.hs +++ b/app/App.hs @@ -75,11 +75,9 @@ reAppIO args@RunAppIOArgs {..} = GetMainFile m -> getMainFile' m GetMainFileMaybe m -> getMainFileMaybe' m FromAppPathDir p -> liftIO (prepathToAbsDir invDir (p ^. pathPath)) - RenderStdOut t - | _runAppIOArgsGlobalOptions ^. globalOnlyErrors -> return () - | otherwise -> do - sup <- liftIO (Ansi.hSupportsANSIColor stdout) - renderIO (not (_runAppIOArgsGlobalOptions ^. globalNoColors) && sup) t + RenderStdOut t -> do + sup <- liftIO (Ansi.hSupportsANSIColor stdout) + renderIO (not (_runAppIOArgsGlobalOptions ^. globalNoColors) && sup) t AskGlobalOptions -> return _runAppIOArgsGlobalOptions AskPackage -> getPkg AskArgs -> return args @@ -147,7 +145,7 @@ reAppIO args@RunAppIOArgs {..} = . mkAnsiText . run . runReader (project' @GenericOptions g) - $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e + $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalIdeEndErrorChar) e getEntryPoint' :: (Members '[App, EmbedIO, TaggedLock] r) => diff --git a/app/Commands/Repl.hs b/app/Commands/Repl.hs index 1da191a99d..296b723550 100644 --- a/app/Commands/Repl.hs +++ b/app/Commands/Repl.hs @@ -428,7 +428,7 @@ catchAll = Repline.dontCrash . catchJuvixError . hPutStrLn stderr . run . runReader (project' @GenericOptions opts) - $ Error.render (not (opts ^. globalNoColors) && hasAnsi) False e + $ Error.render (not (opts ^. globalNoColors) && hasAnsi) Nothing e catchErrorS :: ReplS () -> ReplS () catchErrorS = (`Except.catchError` printErrorS) diff --git a/app/CommonOptions.hs b/app/CommonOptions.hs index e1f1c33003..ce44903665 100644 --- a/app/CommonOptions.hs +++ b/app/CommonOptions.hs @@ -136,6 +136,14 @@ somePreFileOrDirOpt = mkPrepath <$> str somePreFileOpt :: ReadM (Prepath File) somePreFileOpt = mkPrepath <$> str +readMChar :: ReadM Char +readMChar = eitherReader aux + where + aux :: String -> Either String Char + aux = \case + [c] -> Right c + s -> Left $ s <> " is not a single character" + someFileOpt :: ReadM (SomeBase File) someFileOpt = eitherReader aux where diff --git a/app/GlobalOptions.hs b/app/GlobalOptions.hs index b179d2fe4d..b7d67ac2be 100644 --- a/app/GlobalOptions.hs +++ b/app/GlobalOptions.hs @@ -17,7 +17,7 @@ data GlobalOptions = GlobalOptions { _globalNoColors :: Bool, _globalShowNameIds :: Bool, _globalBuildDir :: Maybe (AppPath Dir), - _globalOnlyErrors :: Bool, + _globalIdeEndErrorChar :: Maybe Char, _globalStdin :: Bool, _globalNoTermination :: Bool, _globalNoPositivity :: Bool, @@ -62,7 +62,7 @@ defaultGlobalOptions = { _globalNoColors = False, _globalNumThreads = defaultNumThreads, _globalShowNameIds = False, - _globalOnlyErrors = False, + _globalIdeEndErrorChar = Nothing, _globalNoTermination = False, _globalBuildDir = Nothing, _globalStdin = False, @@ -97,11 +97,13 @@ parseGlobalFlags = do ( long "stdin" <> help "Read from Stdin" ) - _globalOnlyErrors <- - switch - ( long "only-errors" - <> help "Only print errors in a uniform format (used by juvix-mode)" - ) + _globalIdeEndErrorChar <- + optional $ + option + readMChar + ( long "ide-end-error-char" + <> help "End error message with the given character in order to facilitate parsing" + ) _globalNoTermination <- switch ( long "no-termination" @@ -148,7 +150,10 @@ parseGlobalFlags = do <> metavar "LOG_LEVEL" <> completer (enumCompleter @LogLevel Proxy) <> value defaultLogLevel - <> help "Determines how much log the compiler produces" + <> help + ( "Determines how much log the compiler produces." + <> intercalate " < " [show l | l <- allElements @LogLevel] + ) ) _globalShowNameIds <- switch diff --git a/src/Juvix/Data/Error/GenericError.hs b/src/Juvix/Data/Error/GenericError.hs index d643118a33..2b27218dd3 100644 --- a/src/Juvix/Data/Error/GenericError.hs +++ b/src/Juvix/Data/Error/GenericError.hs @@ -55,7 +55,7 @@ errorIntervals e = do e' <- genericError e return (e' ^. genericErrorIntervals) -render :: (ToGenericError e, Member (Reader GenericOptions) r) => Bool -> Bool -> e -> Sem r Text +render :: (ToGenericError e, Member (Reader GenericOptions) r) => Bool -> Maybe Char -> e -> Sem r Text render ansi endChar err = do g <- genericError err let gMsg = g ^. genericErrorMessage @@ -66,20 +66,18 @@ render ansi endChar err = do | otherwise -> return $ helper renderStrict (toTextDoc gMsg) where lastChar :: Doc a - lastChar - | endChar = "ת" - | otherwise = "" + lastChar = maybe "" pretty endChar -- | Render the error to Text. renderText :: (ToGenericError e, Member (Reader GenericOptions) r) => e -> Sem r Text -renderText = render False False +renderText = render False Nothing renderTextDefault :: (ToGenericError e) => e -> Text renderTextDefault = run . runReader defaultGenericOptions . renderText -- | Render the error with Ansi formatting (if any). renderAnsiText :: (ToGenericError e, Member (Reader GenericOptions) r) => e -> Sem r Text -renderAnsiText = render True False +renderAnsiText = render True Nothing printErrorAnsi :: (ToGenericError e, Members '[EmbedIO, Reader GenericOptions] r) => e -> Sem r () printErrorAnsi e = renderAnsiText e >>= \txt -> hPutStrLn stderr txt From 839df3fe53c98eaf8d7e896850a473b5a5c872f9 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 18 Jul 2024 23:59:49 +0200 Subject: [PATCH 08/23] replace sayRaw --- app/App.hs | 16 +++++++------ app/Commands/Dev/Highlight.hs | 2 +- app/Commands/Init.hs | 44 +++++++++++++++++------------------ app/TopCommand.hs | 2 +- 4 files changed, 32 insertions(+), 32 deletions(-) diff --git a/app/App.hs b/app/App.hs index 9566a31af6..99fe4ecf5c 100644 --- a/app/App.hs +++ b/app/App.hs @@ -37,7 +37,7 @@ data App :: Effect where GetMainFileMaybe :: Maybe (AppPath File) -> App m (Maybe (Path Abs File)) FromAppPathDir :: AppPath Dir -> App m (Path Abs Dir) RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m () - SayRaw :: ByteString -> App m () + RenderStdOutRaw :: ByteString -> App m () data RunAppIOArgs = RunAppIOArgs { _runAppIOArgsGlobalOptions :: GlobalOptions, @@ -78,6 +78,7 @@ reAppIO args@RunAppIOArgs {..} = RenderStdOut t -> do sup <- liftIO (Ansi.hSupportsANSIColor stdout) renderIO (not (_runAppIOArgsGlobalOptions ^. globalNoColors) && sup) t + RenderStdOutRaw b -> liftIO (ByteString.putStr b) AskGlobalOptions -> return _runAppIOArgsGlobalOptions AskPackage -> getPkg AskArgs -> return args @@ -91,18 +92,19 @@ reAppIO args@RunAppIOArgs {..} = exitFailure ExitMsg exitCode t -> exitMsg' (exitWith exitCode) t ExitFailMsg t -> exitMsg' exitFailure t - SayRaw b -> liftIO (ByteString.putStr b) where getPkg :: (Members '[SCache Package] r') => Sem r' Package getPkg = cacheSingletonGet - exitMsg' :: (Members '[EmbedIO] r') => IO x -> Text -> Sem r' x - exitMsg' onExit t = liftIO (putStrLn t >> hFlush stdout >> onExit) + exitMsg' :: forall r' x. (Members '[EmbedIO, Logger] r') => IO x -> Text -> Sem r' x + exitMsg' onExit t = do + logError (mkAnsiText t) + liftIO (hFlush stderr >> onExit) fromAppFile' :: (Members '[EmbedIO] r') => AppPath File -> Sem r' (Path Abs File) fromAppFile' f = prepathToAbsFile invDir (f ^. pathPath) - getMainFile' :: (Members '[SCache Package, EmbedIO] r') => Maybe (AppPath File) -> Sem r' (Path Abs File) + getMainFile' :: (Members '[Logger, SCache Package, EmbedIO] r') => Maybe (AppPath File) -> Sem r' (Path Abs File) getMainFile' = getMainAppFile' >=> fromAppFile' getMainFileMaybe' :: (Members '[SCache Package, EmbedIO] r') => Maybe (AppPath File) -> Sem r' (Maybe (Path Abs File)) @@ -122,10 +124,10 @@ reAppIO args@RunAppIOArgs {..} = } Nothing -> Nothing - getMainAppFile' :: (Members '[SCache Package, EmbedIO] r') => Maybe (AppPath File) -> Sem r' (AppPath File) + getMainAppFile' :: (Members '[SCache Package, EmbedIO, Logger] r') => Maybe (AppPath File) -> Sem r' (AppPath File) getMainAppFile' = fromMaybeM missingMainErr . getMainAppFileMaybe' - missingMainErr :: (Members '[EmbedIO] r') => Sem r' x + missingMainErr :: (Members '[EmbedIO, Logger] r') => Sem r' x missingMainErr = exitMsg' exitFailure diff --git a/app/Commands/Dev/Highlight.hs b/app/Commands/Dev/Highlight.hs index d1e5ddfcde..e8faa4f018 100644 --- a/app/Commands/Dev/Highlight.hs +++ b/app/Commands/Dev/Highlight.hs @@ -12,4 +12,4 @@ runCommand HighlightOptions {..} = silenceProgressLog . runPipelineOptions $ do Highlight.filterInput inputFile <$> runPipelineHighlight entry upToInternalTyped - sayRaw (Highlight.highlight _highlightBackend hinput) + renderStdOutRaw (Highlight.highlight _highlightBackend hinput) diff --git a/app/Commands/Init.hs b/app/Commands/Init.hs index 08a9be4d14..fa7bcb5a75 100644 --- a/app/Commands/Init.hs +++ b/app/Commands/Init.hs @@ -1,5 +1,6 @@ module Commands.Init where +import App import Commands.Extra.Package import Commands.Init.Options import Data.Text qualified as Text @@ -23,19 +24,19 @@ parse p t = mapLeft ppErr (P.runParser p "" t) ppErr :: P.ParseErrorBundle Text Void -> Text ppErr = pack . errorBundlePretty -init :: forall r. (Members '[EmbedIO] r) => InitOptions -> Sem r () +init :: forall r. (Members '[EmbedIO, App] r) => InitOptions -> Sem r () init opts = do checkNotInProject cwd <- getCurrentDir - when isInteractive (say ("creating " <> pack (toFilePath packageFilePath))) + when isInteractive (renderStdOut ("creating " <> pack (toFilePath packageFilePath))) if | opts ^. initOptionsBasic -> writeBasicPackage cwd | otherwise -> do pkg <- if | isInteractive -> do - say "✨ Your next Juvix adventure is about to begin! ✨" - say "I will help you set it up" + renderStdOut @Text "✨ Your next Juvix adventure is about to begin! ✨" + renderStdOut @Text "I will help you set it up" getPackage | otherwise -> do projectName <- getDefaultProjectName @@ -45,34 +46,34 @@ init opts = do Just n -> emptyPkg {_packageName = n} writePackageFile cwd pkg checkPackage - when isInteractive (say "you are all set") + when isInteractive (renderStdOut @Text "you are all set") where isInteractive :: Bool isInteractive = not (opts ^. initOptionsNonInteractive) && not (opts ^. initOptionsBasic) -checkNotInProject :: forall r. (Members '[EmbedIO] r) => Sem r () +checkNotInProject :: forall r. (Members '[EmbedIO, App] r) => Sem r () checkNotInProject = whenM (orM [doesFileExist juvixYamlFile, doesFileExist packageFilePath]) err where err :: Sem r () err = do - say "You are already in a Juvix project" + renderStdOut @Text "You are already in a Juvix project" exitFailure -checkPackage :: forall r. (Members '[EmbedIO] r) => Sem r () +checkPackage :: forall r. (Members '[EmbedIO, App] r) => Sem r () checkPackage = do cwd <- getCurrentDir ep <- runError @JuvixError (runTaggedLockPermissive (loadPackageFileIO cwd DefaultBuildDir)) case ep of Left {} -> do - say "Package.juvix is invalid. Please raise an issue at https://github.com/anoma/juvix/issues" + renderStdOut @Text "Package.juvix is invalid. Please raise an issue at https://github.com/anoma/juvix/issues" exitFailure Right {} -> return () -getPackage :: forall r. (Members '[EmbedIO] r) => Sem r Package +getPackage :: forall r. (Members '[EmbedIO, App] r) => Sem r Package getPackage = do tproj <- getProjName - say "Write the version of your project [leave empty for 0.0.0]" + renderStdOut @Text "Write the version of your project [leave empty for 0.0.0]" tversion :: SemVer <- getVersion cwd <- getCurrentDir return @@ -91,14 +92,14 @@ getDefaultProjectName = runFail $ do dir <- map toLower . dropTrailingPathSeparator . toFilePath . dirname <$> getCurrentDir Fail.fromRight (parse projectNameParser (pack dir)) -getProjName :: forall r. (Members '[EmbedIO] r) => Sem r Text +getProjName :: forall r. (Members '[EmbedIO, App] r) => Sem r Text getProjName = do d <- getDefaultProjectName let defMsg :: Text defMsg = case d of Nothing -> mempty Just d' -> " [leave empty for '" <> d' <> "']" - say + renderStdOut ( "Write the name of your project" <> defMsg <> " (lower case letters, numbers and dashes are allowed): " @@ -118,10 +119,10 @@ getProjName = do Right p | Text.length p <= projextNameMaxLength -> return p | otherwise -> do - say ("The project name cannot exceed " <> prettyText projextNameMaxLength <> " characters") + renderStdOut ("The project name cannot exceed " <> prettyText projextNameMaxLength <> " characters") retry Left err -> do - say err + renderStdOut err retry where retry :: Sem r Text @@ -129,13 +130,10 @@ getProjName = do tryAgain go -say :: (Members '[EmbedIO] r) => Text -> Sem r () -say = putStrLn +tryAgain :: (Members '[App] r) => Sem r () +tryAgain = renderStdOut @Text "Please, try again:" -tryAgain :: (Members '[EmbedIO] r) => Sem r () -tryAgain = say "Please, try again:" - -getVersion :: forall r. (Members '[EmbedIO] r) => Sem r SemVer +getVersion :: forall r. (Members '[App, EmbedIO] r) => Sem r SemVer getVersion = do txt <- getLine if @@ -143,8 +141,8 @@ getVersion = do | otherwise -> case parse semver' txt of Right r -> return r Left err -> do - say err - say "The version must follow the 'Semantic Versioning 2.0.0' specification" + renderStdOut err + renderStdOut @Text "The version must follow the 'Semantic Versioning 2.0.0' specification" retry where retry :: Sem r SemVer diff --git a/app/TopCommand.hs b/app/TopCommand.hs index 9e1a5cd6fe..5b0ea29942 100644 --- a/app/TopCommand.hs +++ b/app/TopCommand.hs @@ -37,7 +37,7 @@ runTopCommand = \case DisplayHelp -> showHelpText Doctor opts -> runLogIO (Doctor.runCommand opts) Isabelle opts -> Isabelle.runCommand opts - Init opts -> runLogIO (Init.init opts) + Init opts -> Init.init opts Dev opts -> Dev.runCommand opts Typecheck opts -> Typecheck.runCommand opts Compile opts -> Compile.runCommand opts From ad8f1edc00a33e7aec96a1d4aabf462c1f2887ea Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 19 Jul 2024 00:20:38 +0200 Subject: [PATCH 09/23] replace --only-errors in tests and Makefile --- Makefile | 2 +- tests/smoke/Commands/clean.smoke.yaml | 8 ++-- ...pile-dependencies-package-juvix.smoke.yaml | 42 ++++++++-------- .../Commands/compile-dependencies.smoke.yaml | 48 +++++++++---------- tests/smoke/Commands/compile.smoke.yaml | 24 +++++----- tests/smoke/Commands/dev/internal.smoke.yaml | 2 +- tests/smoke/Commands/markdown.smoke.yaml | 12 ++--- tests/smoke/Commands/typecheck.smoke.yaml | 2 +- 8 files changed, 70 insertions(+), 70 deletions(-) diff --git a/Makefile b/Makefile index 87e1a562c0..a9fdfe15bc 100644 --- a/Makefile +++ b/Makefile @@ -111,7 +111,7 @@ JUVIX_PACKAGES_IN_REPO=$(shell find \ | awk -F'/Package.juvix' '{print $$1}' | sort -u) JUVIXFORMATFLAGS?=--in-place -JUVIXTYPECHECKFLAGS?=--only-errors +JUVIXTYPECHECKFLAGS?=--log-level warn .PHONY: format-juvix-files format-juvix-files: diff --git a/tests/smoke/Commands/clean.smoke.yaml b/tests/smoke/Commands/clean.smoke.yaml index 2084301f57..9440ff5534 100644 --- a/tests/smoke/Commands/clean.smoke.yaml +++ b/tests/smoke/Commands/clean.smoke.yaml @@ -42,7 +42,7 @@ tests: configDir="$config/juvix/$version" cd $temp cp "$baseDir/examples/milestone/HelloWorld/HelloWorld.juvix" . - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix [ -d $configDir ] juvix clean [ -d $configDir ] @@ -59,7 +59,7 @@ tests: temp=$(mktemp -d) trap 'rm -rf -- "$temp"' EXIT cd ./examples/milestone/HelloWorld - juvix --only-errors compile native -o $temp/Hello HelloWorld.juvix + juvix --log-level error compile native -o $temp/Hello HelloWorld.juvix juvix clean [ -d $temp/.juvix-build ] stdout: "" @@ -75,7 +75,7 @@ tests: temp_build_dir=$(mktemp -d) trap 'rm -rf -- "$temp_build_dir"' EXIT cd ./examples/milestone/HelloWorld - juvix --only-errors compile native -o $temp/Hello HelloWorld.juvix --internal-build-dir "$temp_build_dir" + juvix --log-level error compile native -o $temp/Hello HelloWorld.juvix --internal-build-dir "$temp_build_dir" juvix --internal-build-dir "$temp_build_dir" clean [ -d $temp_build_dir ] stdout: "" @@ -92,7 +92,7 @@ tests: trap 'rm -rf -- "$temp_build_dir"' EXIT cp -r ./examples/milestone/HelloWorld/. $temp cd $temp - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix juvix --internal-build-dir "$temp_build_dir" clean [ -d $temp/.juvix-build ] stdout: "" diff --git a/tests/smoke/Commands/compile-dependencies-package-juvix.smoke.yaml b/tests/smoke/Commands/compile-dependencies-package-juvix.smoke.yaml index 50821a38e9..8f94b6e903 100644 --- a/tests/smoke/Commands/compile-dependencies-package-juvix.smoke.yaml +++ b/tests/smoke/Commands/compile-dependencies-package-juvix.smoke.yaml @@ -57,7 +57,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix if [ ! -f "juvix.lock.yaml" ]; then exit 1 fi @@ -122,14 +122,14 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # Delete the dependency rm -rf $temp/dep rm HelloWorld # Compile using the offline clone - juvix --only-errors --offline compile native HelloWorld.juvix + juvix --log-level error --offline compile native HelloWorld.juvix ./HelloWorld stdout: contains: Hello from dep @@ -191,7 +191,7 @@ tests: EOF # compile project the first time - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # update the dependency cd $temp/dep @@ -228,7 +228,7 @@ tests: # compile with the new hash rm juvix.lock.yaml - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: This is from the second commit @@ -375,7 +375,7 @@ tests: cd $temp/base # compile with the new hash - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: "Hello from dep1\nHello from dep2" @@ -437,7 +437,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # update dependency cd $temp/dep @@ -456,7 +456,7 @@ tests: cd $temp/base juvix clean - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: Hello from dep @@ -532,7 +532,7 @@ tests: # compile project and generate the lockfile # that uses $dep1hash1 - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix cd $temp/base @@ -556,7 +556,7 @@ tests: juvix dependencies update # compile should now use $dep1hash2 - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: Hello from commit 2 @@ -674,7 +674,7 @@ tests: EOF # compile and run the project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: "Hello from dep1\nHello from dep2" @@ -750,7 +750,7 @@ tests: # compile project the first time # It should use code from the first commit - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix output=$(./HelloWorld) if [ "$output" != "Hello from dep" ]; then @@ -776,7 +776,7 @@ tests: EOF rm juvix.lock.yaml - juvix --only-errors --offline compile native HelloWorld.juvix + juvix --log-level error --offline compile native HelloWorld.juvix ./HelloWorld stdout: contains: This is from the second commit @@ -836,7 +836,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: contains: invalid-ref stdout: @@ -882,7 +882,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: contains: Error stdout: @@ -928,7 +928,7 @@ tests: EOF # compile project - juvix --only-errors --offline compile native HelloWorld.juvix + juvix --log-level error --offline compile native HelloWorld.juvix stderr: contains: Failed to obtain remote dependencies stdout: @@ -999,13 +999,13 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # corrupt the clone find $XDG_CONFIG_HOME -type d -name '.git' -exec rm -rf {} + # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: contains: juvix clean stdout: @@ -1052,7 +1052,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stdout: contains: "" stderr: @@ -1115,13 +1115,13 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # delete the dependency to check that it's not required rm -rf $temp/dep # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: "" stdout: contains: Cloning diff --git a/tests/smoke/Commands/compile-dependencies.smoke.yaml b/tests/smoke/Commands/compile-dependencies.smoke.yaml index d61a8f9875..87e5b57a2d 100644 --- a/tests/smoke/Commands/compile-dependencies.smoke.yaml +++ b/tests/smoke/Commands/compile-dependencies.smoke.yaml @@ -53,7 +53,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix if [ ! -f "juvix.lock.yaml" ]; then exit 1 fi @@ -114,14 +114,14 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # Delete the dependency rm -rf $temp/dep rm HelloWorld # Compile using the offline clone - juvix --only-errors --offline compile native HelloWorld.juvix + juvix --log-level error --offline compile native HelloWorld.juvix ./HelloWorld stdout: contains: Hello from dep @@ -179,7 +179,7 @@ tests: EOF # compile project the first time - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # update the dependency cd $temp/dep @@ -212,7 +212,7 @@ tests: # compile with the new hash rm juvix.lock.yaml - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: This is from the second commit @@ -351,7 +351,7 @@ tests: cd $temp/base # compile with the new hash - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: "Hello from dep1\nHello from dep2" @@ -409,7 +409,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # update dependency cd $temp/dep @@ -428,7 +428,7 @@ tests: cd $temp/base juvix clean - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: Hello from dep @@ -500,7 +500,7 @@ tests: # compile project and generate the lockfile # that uses $dep1hash1 - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix cd $temp/base @@ -520,7 +520,7 @@ tests: juvix dependencies update # compile should now use $dep1hash2 - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: Hello from commit 2 @@ -630,7 +630,7 @@ tests: EOF # compile and run the project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stdout: contains: "Hello from dep1\nHello from dep2" @@ -702,7 +702,7 @@ tests: # compile project the first time # It should use code from the first commit - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix output=$(./HelloWorld) if [ "$output" != "Hello from dep" ]; then @@ -724,7 +724,7 @@ tests: EOF rm juvix.lock.yaml - juvix --only-errors --offline compile native HelloWorld.juvix + juvix --log-level error --offline compile native HelloWorld.juvix ./HelloWorld stdout: contains: This is from the second commit @@ -780,7 +780,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: contains: invalid-ref stdout: @@ -822,7 +822,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: contains: Error stdout: @@ -864,7 +864,7 @@ tests: EOF # compile project - juvix --only-errors --offline compile native HelloWorld.juvix + juvix --log-level error --offline compile native HelloWorld.juvix stderr: contains: Failed to obtain remote dependencies stdout: @@ -931,13 +931,13 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # corrupt the clone find $XDG_CONFIG_HOME -type d -name '.git' -exec rm -rf {} + # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: contains: juvix clean stdout: @@ -983,7 +983,7 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stdout: contains: "" stderr: @@ -1039,7 +1039,7 @@ tests: EOF # compile project to create lock file - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix cd $temp/dep cat <<-EOF > HelloDep.juvix @@ -1053,14 +1053,14 @@ tests: cd $temp/base juvix clean --global - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld # Update the Package file and recompile # it should use the latest commit echo "-- comment" >> Package.juvix juvix clean --global - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld stderr: "" @@ -1123,13 +1123,13 @@ tests: EOF # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix # delete the dependency to check that it's not required rm -rf $temp/dep # compile project - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix stderr: "" stdout: contains: Cloning diff --git a/tests/smoke/Commands/compile.smoke.yaml b/tests/smoke/Commands/compile.smoke.yaml index 4b465c84b8..4935f2ffe7 100644 --- a/tests/smoke/Commands/compile.smoke.yaml +++ b/tests/smoke/Commands/compile.smoke.yaml @@ -18,7 +18,7 @@ tests: - bash script: | cd ./examples/milestone/HelloWorld - juvix --only-errors compile native + juvix --log-level error compile native ./HelloWorld exit-status: 0 stdout: | @@ -35,7 +35,7 @@ tests: cp -r HelloWorld "$temp" cd "$temp/HelloWorld" sed -i'.bak' 's/just \"HelloWorld.juvix\"/nothing/' Package.juvix - juvix --only-errors compile native + juvix --log-level error compile native exit-status: 1 stdout: | A path to the main file must be given in the CLI or specified in the `main` field of the juvix.yaml file @@ -46,7 +46,7 @@ tests: - bash script: | cd ./examples/milestone/HelloWorld - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld exit-status: 0 stdout: | @@ -60,7 +60,7 @@ tests: temp=$(mktemp -d) trap 'rm -rf -- "$temp"' EXIT cd ./examples/milestone/HelloWorld - juvix --only-errors compile native -o $temp/Hello HelloWorld.juvix + juvix --log-level error compile native -o $temp/Hello HelloWorld.juvix $temp/Hello exit-status: 0 stdout: | @@ -80,7 +80,7 @@ tests: touch "$rootDir/juvix.yaml" cd "$rootDir" - juvix --only-errors compile native HelloWorld.juvix --internal-build-dir "$buildDir" + juvix --log-level error compile native HelloWorld.juvix --internal-build-dir "$buildDir" num_files=$(ls -1qA "$buildDir" | wc -l) if [ $num_files -le 0 ]; then @@ -106,7 +106,7 @@ tests: echo "dependencies: [.juvix-build/stdlib]" >> "$rootDir/juvix.yaml" cd "$rootDir" - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix if [ ! -d "$rootDir/.juvix-build" ]; then exit 1 @@ -123,7 +123,7 @@ tests: trap 'rm -rf -- "$temp"' EXIT testdir=$PWD/examples/milestone/HelloWorld cd $temp - juvix --only-errors compile native $testdir/HelloWorld.juvix + juvix --log-level error compile native $testdir/HelloWorld.juvix ./HelloWorld stdout: | hello world! @@ -138,7 +138,7 @@ tests: trap 'rm -rf -- "$temp"' EXIT testdir=$PWD/examples/milestone/HelloWorld cd $temp - juvix --only-errors compile wasi $testdir/HelloWorld.juvix + juvix --log-level error compile wasi $testdir/HelloWorld.juvix [ -f HelloWorld.wasm ] stdout: "" exit-status: 0 @@ -152,7 +152,7 @@ tests: trap 'rm -rf -- "$temp"' EXIT testdir=$PWD/tests/Anoma/Compilation/positive cd $temp - juvix --only-errors compile anoma $testdir/test001.juvix + juvix --log-level error compile anoma $testdir/test001.juvix [ -f test001.nockma ] juvix dev nockma repl test001.nockma stdout: @@ -170,7 +170,7 @@ tests: trap 'rm -rf -- "$temp"' EXIT testdir=$PWD/tests/VampIR/positive/Compilation cd $temp - juvix --only-errors compile vampir $testdir/test001.juvix + juvix --log-level error compile vampir $testdir/test001.juvix grep -q 'VampIR runtime for Juvix (safe version)' test001.pir stdout: "" exit-status: 0 @@ -184,7 +184,7 @@ tests: trap 'rm -rf -- "$temp"' EXIT testdir=$PWD/tests/VampIR/positive/Compilation cd $temp - juvix --only-errors compile vampir $testdir/test001.juvix --unsafe + juvix --log-level error compile vampir $testdir/test001.juvix --unsafe grep -q 'VampIR runtime for Juvix (unsafe version)' test001.pir stdout: "" exit-status: 0 @@ -215,7 +215,7 @@ tests: cd $temp cp "$base"/examples/milestone/HelloWorld/HelloWorld.juvix . export XDG_CONFIG_HOME="$config/symlink" - juvix --only-errors compile native HelloWorld.juvix + juvix --log-level error compile native HelloWorld.juvix ./HelloWorld exit-status: 0 stdout: | diff --git a/tests/smoke/Commands/dev/internal.smoke.yaml b/tests/smoke/Commands/dev/internal.smoke.yaml index 848888d1f6..2e74129780 100644 --- a/tests/smoke/Commands/dev/internal.smoke.yaml +++ b/tests/smoke/Commands/dev/internal.smoke.yaml @@ -27,7 +27,7 @@ tests: - name: internal-typecheck-only-errors command: - juvix - - --only-errors + - --log-level error - dev - internal - typecheck diff --git a/tests/smoke/Commands/markdown.smoke.yaml b/tests/smoke/Commands/markdown.smoke.yaml index 6b638ca7ed..7dd194ea90 100644 --- a/tests/smoke/Commands/markdown.smoke.yaml +++ b/tests/smoke/Commands/markdown.smoke.yaml @@ -4,7 +4,7 @@ tests: - name: markdown-help-theme command: - juvix - - --only-errors + - --log-level error - markdown - --help stdout: @@ -21,7 +21,7 @@ tests: cp Test.juvix.md $temp cd $temp touch juvix.yaml - juvix --only-errors markdown Test.juvix.md --stdout + juvix --log-level error markdown Test.juvix.md --stdout stdout: contains: 

@@ -37,7 +37,7 @@ tests:
         cp Test.juvix.md $temp
         cd $temp
         touch juvix.yaml
-        juvix --only-errors markdown Test.juvix.md --output-dir=OUT
+        juvix --log-level error markdown Test.juvix.md --output-dir=OUT
         [ -d OUT ]
         [ -f OUT/Test.md ]
     stdout: ''
@@ -53,7 +53,7 @@ tests:
         cp Test.juvix.md $temp
         cd $temp
         touch juvix.yaml
-        juvix --only-errors markdown Test.juvix.md --prefix-id="XYZ"
+        juvix --log-level error markdown Test.juvix.md --prefix-id="XYZ"
         cat markdown/Test.md
     stdout:
       matches: |
@@ -70,7 +70,7 @@ tests:
         cp Test.juvix.md $temp
         cd $temp
         touch juvix.yaml
-        juvix --only-errors markdown Test.juvix.md --no-path --stdout
+        juvix --log-level error markdown Test.juvix.md --no-path --stdout
     stdout:
       matches: |
         .*href="#Test:[0-9]+".*
@@ -86,7 +86,7 @@ tests:
         cp Test.juvix.md $temp
         cd $temp
         touch juvix.yaml
-        juvix --only-errors markdown Test.juvix.md --no-path --prefix-url Y --prefix-id X --stdout
+        juvix --log-level error markdown Test.juvix.md --no-path --prefix-url Y --prefix-id X --stdout
     stdout:
       matches: |
         .*href="Y#XTest:[0-9]+".*
diff --git a/tests/smoke/Commands/typecheck.smoke.yaml b/tests/smoke/Commands/typecheck.smoke.yaml
index 782d3227b7..65fd350a2f 100644
--- a/tests/smoke/Commands/typecheck.smoke.yaml
+++ b/tests/smoke/Commands/typecheck.smoke.yaml
@@ -22,7 +22,7 @@ tests:
   - name: flag-only-errors
     command:
       - juvix
-      - --only-errors
+      - --log-level error
       - typecheck
     args:
       - positive/Internal/Simple.juvix

From c715dcbde1c0171c68606bf08a005feddc7dca10 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 00:21:43 +0200
Subject: [PATCH 10/23] manual ormolu....

---
 .../Concrete/Translation/FromParsed/Analysis/Scoping.hs       | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
index 38a81039b2..6e94de77ad 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
@@ -1563,8 +1563,8 @@ checkSections sec = topBindings helper
                                 failMaybe $
                                   mkRec
                                     ^? constructorRhs
-                                      . _ConstructorRhsRecord
-                                      . to mkRecordNameSignature
+                                    . _ConstructorRhsRecord
+                                    . to mkRecordNameSignature
                               let info =
                                     RecordInfo
                                       { _recordInfoSignature = fs,

From 9edca6d53d8b349a17b69a494027aa286a1cc3fb Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 09:41:38 +0200
Subject: [PATCH 11/23] fix some smoke tests

---
 tests/smoke/Commands/dev/internal.smoke.yaml | 3 ++-
 tests/smoke/Commands/markdown.smoke.yaml     | 3 ++-
 tests/smoke/Commands/typecheck.smoke.yaml    | 3 ++-
 3 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/tests/smoke/Commands/dev/internal.smoke.yaml b/tests/smoke/Commands/dev/internal.smoke.yaml
index 2e74129780..2747029917 100644
--- a/tests/smoke/Commands/dev/internal.smoke.yaml
+++ b/tests/smoke/Commands/dev/internal.smoke.yaml
@@ -27,7 +27,8 @@ tests:
   - name: internal-typecheck-only-errors
     command: 
       - juvix
-      - --log-level error 
+      - --log-level
+      - error
       - dev 
       - internal 
       - typecheck
diff --git a/tests/smoke/Commands/markdown.smoke.yaml b/tests/smoke/Commands/markdown.smoke.yaml
index 7dd194ea90..b4b1931465 100644
--- a/tests/smoke/Commands/markdown.smoke.yaml
+++ b/tests/smoke/Commands/markdown.smoke.yaml
@@ -4,7 +4,8 @@ tests:
   - name: markdown-help-theme
     command:
       - juvix
-      - --log-level error
+      - --log-level
+      - error
       - markdown
       - --help
     stdout:
diff --git a/tests/smoke/Commands/typecheck.smoke.yaml b/tests/smoke/Commands/typecheck.smoke.yaml
index 65fd350a2f..047022d445 100644
--- a/tests/smoke/Commands/typecheck.smoke.yaml
+++ b/tests/smoke/Commands/typecheck.smoke.yaml
@@ -22,7 +22,8 @@ tests:
   - name: flag-only-errors
     command:
       - juvix
-      - --log-level error
+      - --log-level
+      - error
       - typecheck
     args:
       - positive/Internal/Simple.juvix

From 341adc413db8f2c0215819d7683a635056017bf5 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 09:48:28 +0200
Subject: [PATCH 12/23] add newline after logMsg

---
 src/Juvix/Data/Logger.hs    | 9 ++++++++-
 src/Juvix/Prelude/Pretty.hs | 6 ++++++
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/src/Juvix/Data/Logger.hs b/src/Juvix/Data/Logger.hs
index 3d8a66fd66..558882a4bb 100644
--- a/src/Juvix/Data/Logger.hs
+++ b/src/Juvix/Data/Logger.hs
@@ -103,4 +103,11 @@ handler localEnv =
         local adjustPred (unlift localLog)
     LogMessage lvl msg -> do
       loggerPredicate <- ask
-      when (loggerPredicate lvl) (output msg)
+      when (loggerPredicate lvl) (output (msg <> ansiTextNewline))
+
+ignoreLogger :: forall r a. Sem (Logger ': r) a -> Sem r a
+ignoreLogger = interpretH $ \localEnv -> \case
+  LogMessage {} -> return ()
+  LocalLogger _ localLog ->
+    localSeqUnlift localEnv $ \unlift ->
+      unlift localLog
diff --git a/src/Juvix/Prelude/Pretty.hs b/src/Juvix/Prelude/Pretty.hs
index 29e98871bb..e5d205f2f8 100644
--- a/src/Juvix/Prelude/Pretty.hs
+++ b/src/Juvix/Prelude/Pretty.hs
@@ -58,6 +58,12 @@ mkAnsiText = AnsiText . pure . AnsiTextAtom
 
 makeLenses ''AnsiText
 
+ansiTextNewline :: AnsiText
+ansiTextNewline = mkAnsiText @Text "\n"
+
+instance IsString AnsiText where
+  fromString = mkAnsiText
+
 instance HasTextBackend String where
   toTextStream = toTextStream . pretty
   toTextDoc = toTextDoc . pretty

From 6a0305eea071779d45cb95f96b428cce1c585347 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 09:55:00 +0200
Subject: [PATCH 13/23] wip

---
 src/Juvix/Compiler/Pipeline/Repl.hs | 4 +---
 src/Parallel/ProgressLog.hs         | 2 +-
 2 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs
index d77b186a50..671afdb0d5 100644
--- a/src/Juvix/Compiler/Pipeline/Repl.hs
+++ b/src/Juvix/Compiler/Pipeline/Repl.hs
@@ -169,7 +169,6 @@ compileReplInputIO fp txt = do
   hasInternet <- not <$> asks (^. entryPointOffline)
   runError
     . runConcurrent
-    . runLoggerIO defaultLoggerOptions
     . runReader defaultNumThreads
     . evalInternet hasInternet
     . runTaggedLockPermissive
@@ -187,8 +186,7 @@ compileReplInputIO fp txt = do
     . runTopModuleNameChecker
     . runReader defaultImportScanStrategy
     . withImportTree (Just fp)
-    . silenceProgressLog
-    . runProgressLog defaultProgressLogOptions
+    . ignoreProgressLog
     . evalModuleInfoCacheHelper
     $ do
       p <- parseReplInput fp txt
diff --git a/src/Parallel/ProgressLog.hs b/src/Parallel/ProgressLog.hs
index 3bd80ddc80..ed9a74e3b3 100644
--- a/src/Parallel/ProgressLog.hs
+++ b/src/Parallel/ProgressLog.hs
@@ -33,7 +33,7 @@ runProgressLog ProgressLogOptions {..} = interpret $ \case
     let threadDoc :: Maybe (Doc CodeAnn) = do
           guard _progressLogOptionsShowThreadId
           return (kwBracketL <> show _logItemThreadId <> kwBracketR)
-    logProgress (mkAnsiText (threadDoc  _logItemMessage <> hardline))
+    logProgress (mkAnsiText (threadDoc  _logItemMessage))
 
 ignoreProgressLog :: Sem (ProgressLog ': r) a -> Sem r a
 ignoreProgressLog = interpret $ \case

From afe8565993c160bad19d738b044325602d3d54a1 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 12:47:02 +0200
Subject: [PATCH 14/23] update stdlib

---
 juvix-stdlib | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/juvix-stdlib b/juvix-stdlib
index 16211500dc..6999b0b35f 160000
--- a/juvix-stdlib
+++ b/juvix-stdlib
@@ -1 +1 @@
-Subproject commit 16211500dc59a944f851fbaeeef703fdd09163fa
+Subproject commit 6999b0b35fe946de28fc4061038ea4d8e4615265

From d0a51f4d8dcd7d3fcf72249bb187563818fc3208 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 13:27:55 +0200
Subject: [PATCH 15/23] fix some smoke tests

---
 tests/smoke/Commands/compile.smoke.yaml      | 2 +-
 tests/smoke/Commands/dev/internal.smoke.yaml | 2 +-
 tests/smoke/Commands/eval.smoke.yaml         | 2 +-
 tests/smoke/Commands/format.smoke.yaml       | 2 +-
 tests/smoke/Commands/init.smoke.yaml         | 4 ++--
 tests/smoke/Commands/typecheck.smoke.yaml    | 8 ++++----
 6 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/tests/smoke/Commands/compile.smoke.yaml b/tests/smoke/Commands/compile.smoke.yaml
index 4935f2ffe7..10db0acf7e 100644
--- a/tests/smoke/Commands/compile.smoke.yaml
+++ b/tests/smoke/Commands/compile.smoke.yaml
@@ -37,7 +37,7 @@ tests:
         sed -i'.bak' 's/just \"HelloWorld.juvix\"/nothing/' Package.juvix
         juvix --log-level error compile native
     exit-status: 1
-    stdout: |
+    stderr: |
      A path to the main file must be given in the CLI or specified in the `main` field of the juvix.yaml file
 
   - name: hello-world
diff --git a/tests/smoke/Commands/dev/internal.smoke.yaml b/tests/smoke/Commands/dev/internal.smoke.yaml
index 2747029917..b9fe649197 100644
--- a/tests/smoke/Commands/dev/internal.smoke.yaml
+++ b/tests/smoke/Commands/dev/internal.smoke.yaml
@@ -19,7 +19,7 @@ tests:
       - typecheck
     args:
       - positive/Internal/Simple.juvix
-    stdout:
+    stderr:
       contains: |
           Well done! It type checks
     exit-status: 0
diff --git a/tests/smoke/Commands/eval.smoke.yaml b/tests/smoke/Commands/eval.smoke.yaml
index 1a4051805e..30c4a06d1e 100644
--- a/tests/smoke/Commands/eval.smoke.yaml
+++ b/tests/smoke/Commands/eval.smoke.yaml
@@ -16,5 +16,5 @@ tests:
       - eval
       - positive/LambdaCalculus.juvix
     stdin: ""
-    stdout: "function not found: main\n"
+    stderr: "function not found: main\n"
     exit-status: 1
diff --git a/tests/smoke/Commands/format.smoke.yaml b/tests/smoke/Commands/format.smoke.yaml
index 22ec5b48a7..880fa76409 100644
--- a/tests/smoke/Commands/format.smoke.yaml
+++ b/tests/smoke/Commands/format.smoke.yaml
@@ -361,7 +361,7 @@ tests:
       - juvix
       - format
     stdin: 'module OtherFormat; import Stdlib.Prelude open; main : Nat := 5module OtherFormat; import Stdlib.Prelude open; main : Nat := 5;; '
-    stdout:
+    stderr:
       contains: juvix format error
     exit-status: 1
 
diff --git a/tests/smoke/Commands/init.smoke.yaml b/tests/smoke/Commands/init.smoke.yaml
index 1ac0444215..03971e06e0 100644
--- a/tests/smoke/Commands/init.smoke.yaml
+++ b/tests/smoke/Commands/init.smoke.yaml
@@ -11,8 +11,8 @@ tests:
         cd $temp
         echo -e 'abc\n\n\n' | juvix init
         juvix typecheck Package.juvix
-    stdout:
-      contains: type checks
+    stderr:
+      contains: Well done! It type checks
     exit-status: 0
   - name: init-non-interactive-name
     command:
diff --git a/tests/smoke/Commands/typecheck.smoke.yaml b/tests/smoke/Commands/typecheck.smoke.yaml
index 047022d445..153b33ed2e 100644
--- a/tests/smoke/Commands/typecheck.smoke.yaml
+++ b/tests/smoke/Commands/typecheck.smoke.yaml
@@ -15,7 +15,7 @@ tests:
       - typecheck
     args:
       - positive/Internal/Simple.juvix
-    stdout:
+    stderr:
       equals: "Well done! It type checks\n"
     exit-status: 0
 
@@ -52,7 +52,7 @@ tests:
         trap 'rm -rf -- "$temp"' EXIT
         export XDG_CONFIG_HOME="$temp"
         HOME="home" JUVIX_TEST_PATH="other dep" juvix typecheck positive/FancyPaths/Main.juvix
-    stdout:
+    stderr:
       equals: "Well done! It type checks\n"
     stderr:
       matches:
@@ -77,7 +77,7 @@ tests:
         cd $projDir
         echo 'module foo;' > foo.juvix
         juvix typecheck foo.juvix
-    stdout:
+    stderr:
       equals: "Well done! It type checks\n"
     exit-status: 0
 
@@ -101,7 +101,7 @@ tests:
         globalPackageDir=$(juvix dev root)
         packagePackageDir="$(dirname $globalPackageDir)"/package
         juvix typecheck "$packagePackageDir/PackageDescription/V2.juvix"
-    stdout:
+    stderr:
       equals: "Well done! It type checks\n"
     stderr:
       matches:

From ab9c021d0b4151773329c906e3f464c48045cd38 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 13:28:02 +0200
Subject: [PATCH 16/23] do not silence progress in runPipelineSetup

---
 app/App.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/app/App.hs b/app/App.hs
index 99fe4ecf5c..b1b4cf613b 100644
--- a/app/App.hs
+++ b/app/App.hs
@@ -291,7 +291,7 @@ runPipelineSetup ::
   (Members '[App, EmbedIO, Logger, Reader PipelineOptions, TaggedLock] r) =>
   Sem (PipelineEff' r) a ->
   Sem r a
-runPipelineSetup p = silenceProgressLog $ do
+runPipelineSetup p = do
   args <- askArgs
   entry <- getEntryPointStdin' args
   r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError

From 957da6370a0144ea7c08743f75e9fd862e646736 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Thu, 18 Jul 2024 15:42:11 +0200
Subject: [PATCH 17/23] remove say

---
 app/App.hs                             | 9 ++++++---
 app/Commands/Dev/DisplayRoot.hs        | 6 +++---
 app/Commands/Dev/Internal/Typecheck.hs | 2 +-
 app/Commands/Dev/Nockma.hs             | 2 +-
 app/Commands/Dev/Nockma/Eval.hs        | 4 ++--
 app/Commands/Dev/Nockma/Run.hs         | 4 ++--
 app/Commands/Dev/Parse.hs              | 2 +-
 app/Commands/Dev/Scope.hs              | 4 ++--
 app/Commands/Format.hs                 | 2 +-
 app/Commands/Html.hs                   | 2 +-
 app/Commands/Typecheck.hs              | 2 +-
 src/Juvix/Data/Logger.hs               | 1 +
 test/Base.hs                           | 3 +--
 13 files changed, 23 insertions(+), 20 deletions(-)

diff --git a/app/App.hs b/app/App.hs
index b1b4cf613b..d1a32c74cc 100644
--- a/app/App.hs
+++ b/app/App.hs
@@ -297,11 +297,14 @@ runPipelineSetup p = do
   r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError
   return (snd r)
 
-say :: (Member App r) => Text -> Sem r ()
-say = renderStdOut
+-- say :: (Member App r) => Text -> Sem r ()
+-- say = renderStdOut
+
+renderStdOutLn :: forall a r. (Member App r, HasAnsiBackend a, HasTextBackend a) => a -> Sem r ()
+renderStdOutLn txt = renderStdOut txt >> newline
 
 newline :: (Member App r) => Sem r ()
-newline = say ""
+newline = renderStdOut @Text "\n"
 
 printSuccessExit :: (Member App r) => Text -> Sem r a
 printSuccessExit = exitMsg ExitSuccess
diff --git a/app/Commands/Dev/DisplayRoot.hs b/app/Commands/Dev/DisplayRoot.hs
index eab4db4b3b..ea66586bf8 100644
--- a/app/Commands/Dev/DisplayRoot.hs
+++ b/app/Commands/Dev/DisplayRoot.hs
@@ -6,10 +6,10 @@ import Commands.Extra.Package
 
 runCommand :: forall r. (Members '[EmbedIO, App] r) => RootOptions -> Sem r ()
 runCommand RootOptions {..} = do
-  askPkgDir >>= say . pack . toFilePath
+  askPkgDir >>= renderStdOutLn . pack . toFilePath
   when _rootPrintPackage printPackage
   where
     printPackage :: Sem r ()
     printPackage = do
-      say "+----------------------------+"
-      askPackage >>= say . renderPackage
+      renderStdOutLn @Text "+----------------------------+"
+      askPackage >>= renderStdOutLn . renderPackage
diff --git a/app/Commands/Dev/Internal/Typecheck.hs b/app/Commands/Dev/Internal/Typecheck.hs
index 59c9255ce9..2e123785e0 100644
--- a/app/Commands/Dev/Internal/Typecheck.hs
+++ b/app/Commands/Dev/Internal/Typecheck.hs
@@ -9,7 +9,7 @@ runCommand :: (Members AppEffects r) => InternalTypeOptions -> Sem r ()
 runCommand localOpts = do
   globalOpts <- askGlobalOptions
   res <- runPipelineNoOptions (localOpts ^. internalTypeInputFile) upToInternalTyped
-  say "Well done! It type checks"
+  logInfo "Well done! It type checks"
   when (localOpts ^. internalTypePrint) $ do
     let checkedModule = res ^. InternalTyped.resultModule
     renderStdOut (Internal.ppOut globalOpts checkedModule)
diff --git a/app/Commands/Dev/Nockma.hs b/app/Commands/Dev/Nockma.hs
index 67e8dbe974..3157fc49b8 100644
--- a/app/Commands/Dev/Nockma.hs
+++ b/app/Commands/Dev/Nockma.hs
@@ -7,7 +7,7 @@ import Commands.Dev.Nockma.Options
 import Commands.Dev.Nockma.Repl as Repl
 import Commands.Dev.Nockma.Run as Run
 
-runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaCommand -> Sem r ()
+runCommand :: forall r. (Members AppEffects r) => NockmaCommand -> Sem r ()
 runCommand = \case
   NockmaRepl opts -> Repl.runCommand opts
   NockmaEval opts -> Eval.runCommand opts
diff --git a/app/Commands/Dev/Nockma/Eval.hs b/app/Commands/Dev/Nockma/Eval.hs
index e196fa373f..961d604cfe 100644
--- a/app/Commands/Dev/Nockma/Eval.hs
+++ b/app/Commands/Dev/Nockma/Eval.hs
@@ -7,7 +7,7 @@ import Juvix.Compiler.Nockma.Evaluator
 import Juvix.Compiler.Nockma.Pretty
 import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
 
-runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaEvalOptions -> Sem r ()
+runCommand :: forall r. (Members AppEffects r) => NockmaEvalOptions -> Sem r ()
 runCommand opts = do
   afile <- fromAppPathFile file
   parsedTerm <- Nockma.parseTermFile afile
@@ -17,7 +17,7 @@ runCommand opts = do
       (counts, res) <-
         runOpCounts
           . runReader defaultEvalOptions
-          . runOutputSem @(Term Natural) (say . ppTrace)
+          . runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace)
           $ evalCompiledNock' (c ^. cellLeft) (c ^. cellRight)
       putStrLn (ppPrint res)
       let statsFile = replaceExtension' ".profile" afile
diff --git a/app/Commands/Dev/Nockma/Run.hs b/app/Commands/Dev/Nockma/Run.hs
index 7fa7299c98..de1797a526 100644
--- a/app/Commands/Dev/Nockma/Run.hs
+++ b/app/Commands/Dev/Nockma/Run.hs
@@ -9,7 +9,7 @@ import Juvix.Compiler.Nockma.Pretty
 import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
 import Juvix.Parser.Error
 
-runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaRunOptions -> Sem r ()
+runCommand :: forall r. (Members AppEffects r) => NockmaRunOptions -> Sem r ()
 runCommand opts = do
   afile <- fromAppPathFile inputFile
   argsFile <- mapM fromAppPathFile (opts ^. nockmaRunArgs)
@@ -21,7 +21,7 @@ runCommand opts = do
       (counts, res) <-
         runOpCounts
           . runReader defaultEvalOptions
-          . runOutputSem @(Term Natural) (say . ppTrace)
+          . runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace)
           $ evalCompiledNock' t formula
       putStrLn (ppPrint res)
       let statsFile = replaceExtension' ".profile" afile
diff --git a/app/Commands/Dev/Parse.hs b/app/Commands/Dev/Parse.hs
index 0fda7175f0..8977b36632 100644
--- a/app/Commands/Dev/Parse.hs
+++ b/app/Commands/Dev/Parse.hs
@@ -10,4 +10,4 @@ runCommand opts = do
   m <-
     (^. Parser.resultModule)
       <$> runPipelineNoOptions (opts ^. parseOptionsInputFile) upToParsing
-  if opts ^. parseOptionsNoPrettyShow then say (show m) else say (pack (ppShow m))
+  if opts ^. parseOptionsNoPrettyShow then renderStdOutLn @String (show m) else renderStdOut (pack (ppShow m))
diff --git a/app/Commands/Dev/Scope.hs b/app/Commands/Dev/Scope.hs
index e8145920f7..8ee8090d5d 100644
--- a/app/Commands/Dev/Scope.hs
+++ b/app/Commands/Dev/Scope.hs
@@ -20,5 +20,5 @@ runCommand opts = do
   when (opts ^. scopeListComments) $ do
     newline
     newline
-    say "Comments:"
-    say (prettyText (Scoper.getScoperResultComments res))
+    renderStdOutLn @Text "Comments:"
+    renderStdOutLn (prettyText (Scoper.getScoperResultComments res))
diff --git a/app/Commands/Format.hs b/app/Commands/Format.hs
index bdfd15b7cc..5e86faacf7 100644
--- a/app/Commands/Format.hs
+++ b/app/Commands/Format.hs
@@ -106,7 +106,7 @@ renderFormattedOutput target opts fInfo = do
           $ writeFileEnsureLn' _formattedFileInfoPath (i ^. formattedFileInfoContents)
       NoEdit m -> case m of
         ReformattedFile ts -> renderStdOut ts
-        InputPath p -> say (pack (toFilePath p))
+        InputPath p -> renderStdOutLn @String (toFilePath p)
         Silent -> return ()
 
 runScopeFileApp :: (Members AppEffects r) => Sem (ScopeEff ': r) a -> Sem r a
diff --git a/app/Commands/Html.hs b/app/Commands/Html.hs
index 0218a02de8..750f1b74c3 100644
--- a/app/Commands/Html.hs
+++ b/app/Commands/Html.hs
@@ -77,7 +77,7 @@ runCommand HtmlOptions {..}
             _judocArgsFolderStructure = _htmlFolderStructure
           }
       when _htmlOpen $ case openCmd of
-        Nothing -> say "Could not recognize the 'open' command for your OS"
+        Nothing -> logError "Could not recognize the 'open' command for your operating system"
         Just opencmd ->
           liftIO
             . void
diff --git a/app/Commands/Typecheck.hs b/app/Commands/Typecheck.hs
index 648b823807..5eeefa2043 100644
--- a/app/Commands/Typecheck.hs
+++ b/app/Commands/Typecheck.hs
@@ -8,4 +8,4 @@ runCommand localOpts = do
   case localOpts ^. typecheckInputFile of
     Just _inputFile -> void (runPipelineNoOptions (localOpts ^. typecheckInputFile) upToCoreTypecheck)
     Nothing -> void (runPipelineOptions . runPipelineSetup $ processProject)
-  say "Well done! It type checks"
+  logInfo "Well done! It type checks"
diff --git a/src/Juvix/Data/Logger.hs b/src/Juvix/Data/Logger.hs
index 558882a4bb..6fe9ec0370 100644
--- a/src/Juvix/Data/Logger.hs
+++ b/src/Juvix/Data/Logger.hs
@@ -10,6 +10,7 @@ module Juvix.Data.Logger
     logWarn,
     logDebug,
     runLoggerIO,
+    ignoreLogger,
     localLogger,
     loggerUseColors,
     loggerLevel,
diff --git a/test/Base.hs b/test/Base.hs
index 4d961d04ec..01758b7249 100644
--- a/test/Base.hs
+++ b/test/Base.hs
@@ -24,7 +24,6 @@ import Juvix.Extra.Paths hiding (rootBuildDir)
 import Juvix.Prelude hiding (assert)
 import Juvix.Prelude.Env
 import Juvix.Prelude.Pretty (prettyString)
-import Parallel.ProgressLog
 import System.Process qualified as P
 import Test.Tasty
 import Test.Tasty.HUnit hiding (assertFailure)
@@ -92,7 +91,7 @@ assertCmdExists cmd =
 testTaggedLockedToIO :: (MonadIO m) => Sem PipelineAppEffects a -> m a
 testTaggedLockedToIO =
   runM
-    . ignoreProgressLog
+    . ignoreLogger
     . runReader testPipelineOptions
     . runTaggedLock LockModeExclusive
 

From 8266534aee9aacf20d1e187cb8b6deb0617c9750 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 16:09:31 +0200
Subject: [PATCH 18/23] new ormolu

---
 .../Concrete/Translation/FromParsed/Analysis/Scoping.hs       | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
index 6e94de77ad..38a81039b2 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
@@ -1563,8 +1563,8 @@ checkSections sec = topBindings helper
                                 failMaybe $
                                   mkRec
                                     ^? constructorRhs
-                                    . _ConstructorRhsRecord
-                                    . to mkRecordNameSignature
+                                      . _ConstructorRhsRecord
+                                      . to mkRecordNameSignature
                               let info =
                                     RecordInfo
                                       { _recordInfoSignature = fs,

From 7bd65fc2c72b553b69504396847f8b46e23f4000 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 16:12:46 +0200
Subject: [PATCH 19/23] fix init and format

---
 app/Commands/Format.hs               |  2 +-
 app/Commands/Init.hs                 | 26 +++++++++++++-------------
 tests/smoke/Commands/init.smoke.yaml |  5 +++++
 3 files changed, 19 insertions(+), 14 deletions(-)

diff --git a/app/Commands/Format.hs b/app/Commands/Format.hs
index 5e86faacf7..e891956237 100644
--- a/app/Commands/Format.hs
+++ b/app/Commands/Format.hs
@@ -51,7 +51,7 @@ formatProject ::
   forall r.
   (Members '[App, EmbedIO, TaggedLock, Logger, Files, Output FormattedFileInfo] r) =>
   Sem r FormatResult
-formatProject = runPipelineOptions . runPipelineSetup $ do
+formatProject = silenceProgressLog . runPipelineOptions . runPipelineSetup $ do
   pkg <- askPackage
   res :: [(ImportNode, PipelineResult ModuleInfo)] <- processProject
   res' :: [(ImportNode, SourceCode)] <- runReader pkg . forM res $ \(node, nfo) -> do
diff --git a/app/Commands/Init.hs b/app/Commands/Init.hs
index fa7bcb5a75..f83f54f938 100644
--- a/app/Commands/Init.hs
+++ b/app/Commands/Init.hs
@@ -28,15 +28,15 @@ init :: forall r. (Members '[EmbedIO, App] r) => InitOptions -> Sem r ()
 init opts = do
   checkNotInProject
   cwd <- getCurrentDir
-  when isInteractive (renderStdOut ("creating " <> pack (toFilePath packageFilePath)))
+  when isInteractive (renderStdOutLn ("creating " <> pack (toFilePath packageFilePath)))
   if
       | opts ^. initOptionsBasic -> writeBasicPackage cwd
       | otherwise -> do
           pkg <-
             if
                 | isInteractive -> do
-                    renderStdOut @Text "✨ Your next Juvix adventure is about to begin! ✨"
-                    renderStdOut @Text "I will help you set it up"
+                    renderStdOutLn @Text "✨ Your next Juvix adventure is about to begin! ✨"
+                    renderStdOutLn @Text "I will help you set it up"
                     getPackage
                 | otherwise -> do
                     projectName <- getDefaultProjectName
@@ -46,7 +46,7 @@ init opts = do
                       Just n -> emptyPkg {_packageName = n}
           writePackageFile cwd pkg
   checkPackage
-  when isInteractive (renderStdOut @Text "you are all set")
+  when isInteractive (renderStdOutLn @Text "you are all set")
   where
     isInteractive :: Bool
     isInteractive = not (opts ^. initOptionsNonInteractive) && not (opts ^. initOptionsBasic)
@@ -57,7 +57,7 @@ checkNotInProject =
   where
     err :: Sem r ()
     err = do
-      renderStdOut @Text "You are already in a Juvix project"
+      renderStdOutLn @Text "You are already in a Juvix project"
       exitFailure
 
 checkPackage :: forall r. (Members '[EmbedIO, App] r) => Sem r ()
@@ -66,14 +66,14 @@ checkPackage = do
   ep <- runError @JuvixError (runTaggedLockPermissive (loadPackageFileIO cwd DefaultBuildDir))
   case ep of
     Left {} -> do
-      renderStdOut @Text "Package.juvix is invalid. Please raise an issue at https://github.com/anoma/juvix/issues"
+      renderStdOutLn @Text "Package.juvix is invalid. Please raise an issue at https://github.com/anoma/juvix/issues"
       exitFailure
     Right {} -> return ()
 
 getPackage :: forall r. (Members '[EmbedIO, App] r) => Sem r Package
 getPackage = do
   tproj <- getProjName
-  renderStdOut @Text "Write the version of your project [leave empty for 0.0.0]"
+  renderStdOutLn @Text "Write the version of your project [leave empty for 0.0.0]"
   tversion :: SemVer <- getVersion
   cwd <- getCurrentDir
   return
@@ -99,10 +99,10 @@ getProjName = do
       defMsg = case d of
         Nothing -> mempty
         Just d' -> " [leave empty for '" <> d' <> "']"
-  renderStdOut
+  renderStdOutLn
     ( "Write the name of your project"
         <> defMsg
-        <> " (lower case letters, numbers and dashes are allowed): "
+        <> " (lower case letters, numbers and dashes are allowed):"
     )
   readName d
   where
@@ -119,7 +119,7 @@ getProjName = do
                     Right p
                       | Text.length p <= projextNameMaxLength -> return p
                       | otherwise -> do
-                          renderStdOut ("The project name cannot exceed " <> prettyText projextNameMaxLength <> " characters")
+                          renderStdOutLn ("The project name cannot exceed " <> prettyText projextNameMaxLength <> " characters")
                           retry
                     Left err -> do
                       renderStdOut err
@@ -131,7 +131,7 @@ getProjName = do
               go
 
 tryAgain :: (Members '[App] r) => Sem r ()
-tryAgain = renderStdOut @Text "Please, try again:"
+tryAgain = renderStdOutLn @Text "Please, try again:"
 
 getVersion :: forall r. (Members '[App, EmbedIO] r) => Sem r SemVer
 getVersion = do
@@ -141,8 +141,8 @@ getVersion = do
       | otherwise -> case parse semver' txt of
           Right r -> return r
           Left err -> do
-            renderStdOut err
-            renderStdOut @Text "The version must follow the 'Semantic Versioning 2.0.0' specification"
+            renderStdOutLn err
+            renderStdOutLn @Text "The version must follow the 'Semantic Versioning 2.0.0' specification"
             retry
   where
     retry :: Sem r SemVer
diff --git a/tests/smoke/Commands/init.smoke.yaml b/tests/smoke/Commands/init.smoke.yaml
index 03971e06e0..da11a90254 100644
--- a/tests/smoke/Commands/init.smoke.yaml
+++ b/tests/smoke/Commands/init.smoke.yaml
@@ -13,6 +13,11 @@ tests:
         juvix typecheck Package.juvix
     stderr:
       contains: Well done! It type checks
+    stdout:
+      matches:
+        regex: .*
+        options:
+          - dot-all
     exit-status: 0
   - name: init-non-interactive-name
     command:

From 899842886e4d354a8e316bf093a5dd4b84a93f1a Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 16:33:43 +0200
Subject: [PATCH 20/23] fix duplicate key

---
 tests/smoke/Commands/typecheck.smoke.yaml | 10 ----------
 1 file changed, 10 deletions(-)

diff --git a/tests/smoke/Commands/typecheck.smoke.yaml b/tests/smoke/Commands/typecheck.smoke.yaml
index 153b33ed2e..ece163d2b6 100644
--- a/tests/smoke/Commands/typecheck.smoke.yaml
+++ b/tests/smoke/Commands/typecheck.smoke.yaml
@@ -54,11 +54,6 @@ tests:
         HOME="home" JUVIX_TEST_PATH="other dep" juvix typecheck positive/FancyPaths/Main.juvix
     stderr:
       equals: "Well done! It type checks\n"
-    stderr:
-      matches:
-        regex: .*
-        options:
-          - dot-all
     exit-status: 0
 
   - name: typecheck-global-package
@@ -103,11 +98,6 @@ tests:
         juvix typecheck "$packagePackageDir/PackageDescription/V2.juvix"
     stderr:
       equals: "Well done! It type checks\n"
-    stderr:
-      matches:
-        regex: .*
-        options:
-          - dot-all
     exit-status: 0
 
   - name: typecheck-stdin

From ee6ee305ee53db8f2a904971b106c235dcedb6af Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Fri, 19 Jul 2024 19:15:26 +0200
Subject: [PATCH 21/23] fix smoke

---
 tests/smoke/Commands/typecheck.smoke.yaml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/smoke/Commands/typecheck.smoke.yaml b/tests/smoke/Commands/typecheck.smoke.yaml
index ece163d2b6..656fd9927a 100644
--- a/tests/smoke/Commands/typecheck.smoke.yaml
+++ b/tests/smoke/Commands/typecheck.smoke.yaml
@@ -53,7 +53,7 @@ tests:
         export XDG_CONFIG_HOME="$temp"
         HOME="home" JUVIX_TEST_PATH="other dep" juvix typecheck positive/FancyPaths/Main.juvix
     stderr:
-      equals: "Well done! It type checks\n"
+      contains: "Well done! It type checks\n"
     exit-status: 0
 
   - name: typecheck-global-package
@@ -97,7 +97,7 @@ tests:
         packagePackageDir="$(dirname $globalPackageDir)"/package
         juvix typecheck "$packagePackageDir/PackageDescription/V2.juvix"
     stderr:
-      equals: "Well done! It type checks\n"
+      contains: "Well done! It type checks\n"
     exit-status: 0
 
   - name: typecheck-stdin

From b533a7536273eb8812c2d64a2f0c797cbdc98fc9 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Mon, 22 Jul 2024 13:18:48 +0200
Subject: [PATCH 22/23] remove old code

---
 app/App.hs | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/app/App.hs b/app/App.hs
index d1a32c74cc..21b05a56de 100644
--- a/app/App.hs
+++ b/app/App.hs
@@ -297,9 +297,6 @@ runPipelineSetup p = do
   r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError
   return (snd r)
 
--- say :: (Member App r) => Text -> Sem r ()
--- say = renderStdOut
-
 renderStdOutLn :: forall a r. (Member App r, HasAnsiBackend a, HasTextBackend a) => a -> Sem r ()
 renderStdOutLn txt = renderStdOut txt >> newline
 

From 99e67c90462c0fe823b921d22f5a94b149a332e2 Mon Sep 17 00:00:00 2001
From: Jan Mas Rovira 
Date: Mon, 22 Jul 2024 15:47:44 +0200
Subject: [PATCH 23/23] add smoke test

---
 tests/smoke/global.smoke.yaml | 15 +++++++++++++++
 1 file changed, 15 insertions(+)
 create mode 100644 tests/smoke/global.smoke.yaml

diff --git a/tests/smoke/global.smoke.yaml b/tests/smoke/global.smoke.yaml
new file mode 100644
index 0000000000..279523d84a
--- /dev/null
+++ b/tests/smoke/global.smoke.yaml
@@ -0,0 +1,15 @@
+working-directory: ../../tests
+
+tests:
+  - name: ide-end-error-char
+    command:
+      - juvix
+      - --ide-end-error-char
+      - ת
+      - typecheck
+    args:
+      - negative/NoDependencies/InvalidImport.juvix
+    stderr:
+      contains: |
+        ת
+    exit-status: 1