Logger (#2908)

1. Adds the `--log-level LOG_LEVEL` flag to the CLI. This flag can be
given `error`, `warn`, `info`, `progress`, `debug` as argument to filter
the logged messages.
2. Removes the `--only-errors` flag.
3. Adds the `--ide-end-error-char CHAR`, which receives a character as
an argument, which is appended to the end of error messages. This is
handy to facilitate parsing of errors messages from the ide. This
functionality was previously embeded in the old `--only-errors` flag.

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:

app/App.hs

@@ -37,8 +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 ()
-  Say :: Text -> App m ()
-  SayRaw :: ByteString -> App m ()
+  RenderStdOutRaw :: ByteString -> App m ()
 
 data RunAppIOArgs = RunAppIOArgs
   { _runAppIOArgsGlobalOptions :: GlobalOptions,
@@ -48,9 +47,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
@@ -60,7 +61,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
@@ -74,39 +75,36 @@ 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
+    RenderStdOutRaw b -> liftIO (ByteString.putStr b)
     AskGlobalOptions -> return _runAppIOArgsGlobalOptions
     AskPackage -> getPkg
     AskArgs -> return args
     AskRoot -> return _runAppIOArgsRoot
     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
       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))
@@ -126,25 +124,30 @@ 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
         ( "A path to the main file must be given in the CLI or specified in the `main` field of the "
             <> 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
+        $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalIdeEndErrorChar) e
 
 getEntryPoint' ::
   (Members '[App, EmbedIO, TaggedLock] r) =>
@@ -162,7 +165,7 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do
   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 ->
@@ -220,69 +223,55 @@ 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)
-runPipelineTermination input_ p = ignoreProgressLog $ do
+runPipelineTermination input_ p = silenceProgressLog $ 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,23 +282,26 @@ 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
+runPipelineSetup p = do
   args <- askArgs
   entry <- getEntryPointStdin' args
   r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError
   return (snd r)
 
+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

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

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
 

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)

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

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

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

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

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

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

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 ()

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

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