Improve compilation progress log

app/App.hs

@@ -274,7 +274,8 @@ runPipelineOptions m = do
   g <- askGlobalOptions
   let opt =
         defaultPipelineOptions
-          { _pipelineNumThreads = g ^. globalNumThreads
+          { _pipelineNumThreads = g ^. globalNumThreads,
+            _pipelineShowThreadId = g ^. globalDevShowThreadIds
           }
   runReader opt m
 

app/Commands/Dev/ImportTree/Print.hs

@@ -7,18 +7,16 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver
 import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree
 
 runCommand :: (Members AppEffects r) => PrintOptions -> Sem r ()
-runCommand PrintOptions {..} = runReader opts . runPipelineSetup $ do
-  tree <- case _printInputFile of
-    Nothing -> ask
-    Just appInputFile -> do
-      inputFile <- fromAppPathFile appInputFile
-      mkImportTree (Just inputFile)
-  renderStdOut (ppOutDefaultNoComments tree)
-  when _printStats $ do
-    let stats = mkImportTreeStats tree
-    renderStdOut (ppOutDefaultNoComments stats)
-  where
-    opts =
-      defaultPipelineOptions
-        { _pipelineImportStrategy = _printScanStrategy
-        }
+runCommand PrintOptions {..} = runPipelineOptions
+  . local (set pipelineImportStrategy _printScanStrategy)
+  . runPipelineSetup
+  $ do
+    tree <- case _printInputFile of
+      Nothing -> ask
+      Just appInputFile -> do
+        inputFile <- fromAppPathFile appInputFile
+        mkImportTree (Just inputFile)
+    renderStdOut (ppOutDefaultNoComments tree)
+    when _printStats $ do
+      let stats = mkImportTreeStats tree
+      renderStdOut (ppOutDefaultNoComments stats)

app/Commands/Typecheck.hs

@@ -6,6 +6,6 @@ import Commands.Typecheck.Options
 runCommand :: (Members AppEffects r) => TypecheckOptions -> Sem r ()
 runCommand localOpts = do
   case localOpts ^. typecheckInputFile of
-    Just _inputFile -> void (runPipelineNoOptions (localOpts ^. typecheckInputFile) upToCoreTypecheck)
+    Just inputFile -> void (runPipelineNoOptions (Just inputFile) upToCoreTypecheck)
     Nothing -> void (runPipelineOptions . runPipelineSetup $ processProject)
   logInfo "Well done! It type checks"

app/CommonOptions.hs

@@ -3,7 +3,6 @@ module CommonOptions
   ( module CommonOptions,
     module Juvix.Prelude,
     module Juvix.Prelude.Pretty,
-    module Parallel.ProgressLog,
     module Options.Applicative,
     module Prettyprinter.Render.Terminal,
   )
@@ -28,7 +27,6 @@ import Juvix.Prelude.Parsing qualified as P
 import Juvix.Prelude.Pretty hiding (group, list)
 import Options.Applicative hiding (helpDoc)
 import Options.Applicative qualified as Opt
-import Parallel.ProgressLog
 import Prettyprinter.Render.Terminal hiding (renderIO, renderStrict)
 import System.Process
 import Text.Read (readMaybe)

src/Juvix/Compiler/Asm/Interpreter/Base.hs

@@ -5,7 +5,7 @@ module Juvix.Compiler.Asm.Interpreter.Base
   )
 where
 
-import Juvix.Compiler.Asm.Language
+import Juvix.Compiler.Asm.Language hiding (logMessage)
 import Juvix.Compiler.Tree.Language.Value hiding (Value)
 import Juvix.Compiler.Tree.Language.Value qualified as Tree
 

src/Juvix/Compiler/Concrete/Print/Base.hs

@@ -71,6 +71,9 @@ instance PrettyPrint KeywordRef where
           $ p
       )
 
+docNoCommentsDefault :: (PrettyPrint c) => c -> Doc Ann
+docNoCommentsDefault = docHelper Nothing defaultOptions
+
 docNoComments :: (PrettyPrint c) => Options -> c -> Doc Ann
 docNoComments = docHelper Nothing
 

src/Juvix/Compiler/Pipeline.hs

@@ -54,12 +54,13 @@ import Juvix.Compiler.Tree qualified as Tree
 import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.Process
 import Juvix.Data.Field
-import Parallel.ProgressLog (ProgressLog)
+import Parallel.ProgressLog
 
 type PipelineAppEffects = '[TaggedLock, Reader PipelineOptions, Logger, EmbedIO]
 
 type PipelineLocalEff =
   '[ ModuleInfoCache,
+     ProgressLog,
      JvoCache,
      Reader ImportTree,
      Reader ImportScanStrategy,
@@ -74,7 +75,6 @@ type PipelineLocalEff =
      Error GitProcessError,
      Process,
      Log,
-     ProgressLog,
      Reader EntryPoint,
      Files,
      Error JuvixError,
@@ -93,8 +93,6 @@ type PipelineEff r =
    ]
     ++ PipelineEff' r
 
-makeLenses ''PipelineOptions
-
 --------------------------------------------------------------------------------
 -- Workflows from source
 --------------------------------------------------------------------------------