Logger

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,29 @@ 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)
 
+-- 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

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