Merge Log effect into Logger effect (#3220)

anoma · Dec 3, 2024 · af9679d · af9679d
1 parent 7db7444
commit af9679d
Show file tree

Hide file tree

Showing 14 changed files with 31 additions and 59 deletions.
diff --git a/app/Commands/Doctor.hs b/app/Commands/Doctor.hs
@@ -59,16 +59,19 @@ documentedMessage w = uncurry DocumentedMessage (first (baseUrl <>) warningInfo)
     baseUrl :: Text
     baseUrl = "https://docs.juvix.org/" <> V.versionDoc <> "/reference/tooling/doctor/#"
 
-heading :: (Member Log r) => Text -> Sem r ()
-heading = log . ("> " <>)
+logDoctor :: (Member Logger r) => Text -> Sem r ()
+logDoctor = logInfo . mkAnsiText
 
-warning :: (Member Log r) => Text -> Sem r ()
-warning = log . ("  ! " <>)
+heading :: (Member Logger r) => Text -> Sem r ()
+heading = logDoctor . ("> " <>)
 
-info :: (Member Log r) => Text -> Sem r ()
-info = log . ("  | " <>)
+warning :: (Member Logger r) => Text -> Sem r ()
+warning = logDoctor . ("  ! " <>)
 
-type DoctorEff = '[Log, EmbedIO, App]
+info :: (Member Logger r) => Text -> Sem r ()
+info = logDoctor . ("  | " <>)
+
+type DoctorEff = '[Logger, EmbedIO, App]
 
 checkCmdOnPath :: (Members DoctorEff r) => String -> [Text] -> Sem r ()
 checkCmdOnPath cmd errMsg =

diff --git a/app/TopCommand.hs b/app/TopCommand.hs
@@ -35,7 +35,7 @@ runTopCommand = \case
   DisplayVersion -> runDisplayVersion
   DisplayNumericVersion -> runDisplayNumericVersion
   DisplayHelp -> showHelpText
-  Doctor opts -> runLogIO (Doctor.runCommand opts)
+  Doctor opts -> Doctor.runCommand opts
   Isabelle opts -> Isabelle.runCommand opts
   Init opts -> Init.init opts
   Dev opts -> Dev.runCommand opts

diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs
@@ -74,7 +74,6 @@ type PipelineLocalEff =
      GitClone,
      Error GitProcessError,
      ProcessE,
-     Log,
      Reader EntryPoint,
      Files,
      Error JuvixError,

diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs
@@ -130,7 +130,6 @@ loadPackage' packagePath = do
     . runProcessIO
     . runFilesIO
     . evalTopNameIdGen defaultModuleId
-    . ignoreLog
     . mapError (JuvixError @GitProcessError)
     . runGitProcess
     . runEvalFileEffIO

diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs
@@ -169,7 +169,6 @@ compileReplInputIO fp txt = do
     . evalInternet hasInternet
     . ignoreHighlightBuilder
     . runTaggedLockPermissive
-    . runLogIO
     . runFilesIO
     . mapError (JuvixError @GitProcessError)
     . runProcessIO

diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs
@@ -117,7 +117,6 @@ runIOEitherPipeline' entry a = do
     . runJuvixError
     . runFilesIO
     . runReader entry
-    . runLogIO
     . runProcessIO
     . mapError (JuvixError @GitProcessError)
     . runGitProcess
@@ -223,7 +222,6 @@ runReplPipelineIOEither' lockMode entry = do
       . runFilesIO
       . runReader entry
       . runTaggedLock lockMode
-      . runLogIO
       . mapError (JuvixError @GitProcessError)
       . runProcessIO
       . runGitProcess

diff --git a/src/Juvix/Data.hs b/src/Juvix/Data.hs
@@ -15,7 +15,6 @@ 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,
@@ -40,7 +39,6 @@ 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.ParsedItem

diff --git a/src/Juvix/Data/Effect.hs b/src/Juvix/Data/Effect.hs
@@ -5,7 +5,7 @@ module Juvix.Data.Effect
     module Juvix.Data.Effect.Cache,
     module Juvix.Data.Effect.NameIdGen,
     module Juvix.Data.Effect.Visit,
-    module Juvix.Data.Effect.Log,
+    module Juvix.Data.Effect.Logger,
     module Juvix.Data.Effect.Internet,
     module Juvix.Data.Effect.Forcing,
     module Juvix.Data.Effect.TaggedLock,
@@ -17,7 +17,7 @@ import Juvix.Data.Effect.Fail
 import Juvix.Data.Effect.Files
 import Juvix.Data.Effect.Forcing
 import Juvix.Data.Effect.Internet
-import Juvix.Data.Effect.Log
+import Juvix.Data.Effect.Logger
 import Juvix.Data.Effect.NameIdGen
 import Juvix.Data.Effect.PartialDo
 import Juvix.Data.Effect.TaggedLock

diff --git a/src/Juvix/Data/Effect/Git/Process.hs b/src/Juvix/Data/Effect/Git/Process.hs
@@ -6,6 +6,7 @@ import Juvix.Data.Effect.Git.Process.Error
 import Juvix.Data.Effect.Process
 import Juvix.Data.Effect.TaggedLock
 import Juvix.Prelude
+import Juvix.Prelude.Pretty
 
 newtype CloneEnv = CloneEnv
   {_cloneEnvDir :: Path Abs Dir}
@@ -24,13 +25,12 @@ runGitCmd args = do
         ExitFailure {} ->
           throw
             ( GitCmdError
-                ( GitCmdErrorDetails
-                    { _gitCmdErrorDetailsCmdPath = cmd,
-                      _gitCmdErrorDetailsArgs = args,
-                      _gitCmdErrorDetailsExitCode = res ^. processResultExitCode,
-                      _gitCmdErrorDetailsMessage = res ^. processResultStderr
-                    }
-                )
+                GitCmdErrorDetails
+                  { _gitCmdErrorDetailsCmdPath = cmd,
+                    _gitCmdErrorDetailsArgs = args,
+                    _gitCmdErrorDetailsExitCode = res ^. processResultExitCode,
+                    _gitCmdErrorDetailsMessage = res ^. processResultStderr
+                  }
             )
         ExitSuccess -> return (res ^. processResultStdout)
 
@@ -72,16 +72,16 @@ gitFetch = whenHasInternet gitFetchOnline
 gitFetchOnline :: (Members '[TaggedLock, Reader CloneEnv, Error GitProcessError, ProcessE, Online] r) => Sem r ()
 gitFetchOnline = withTaggedLockDir' (void (runGitCmdInDir ["fetch"]))
 
-gitCloneOnline :: (Members '[Log, Error GitProcessError, ProcessE, Online, Reader CloneEnv] r) => Text -> Sem r ()
+gitCloneOnline :: (Members '[Logger, Error GitProcessError, ProcessE, Online, Reader CloneEnv] r) => Text -> Sem r ()
 gitCloneOnline url = do
   p <- asks (^. cloneEnvDir)
-  log ("Cloning " <> url <> " to " <> pack (toFilePath p))
+  logInfo (mkAnsiText ("Cloning " <> url <> " to " <> pack (toFilePath p)))
   void (runGitCmd ["clone", url, T.pack (toFilePath p)])
 
-cloneGitRepo :: (Members '[Log, Files, ProcessE, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r ()
+cloneGitRepo :: (Members '[Logger, Files, ProcessE, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r ()
 cloneGitRepo = whenHasInternet . gitCloneOnline
 
-initGitRepo :: (Members '[TaggedLock, Log, Files, ProcessE, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r (Path Abs Dir)
+initGitRepo :: (Members '[TaggedLock, Logger, Files, ProcessE, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r (Path Abs Dir)
 initGitRepo url = do
   p <- asks (^. cloneEnvDir)
   withTaggedLockDir' (unlessM (directoryExists' p) (cloneGitRepo url))
@@ -112,7 +112,7 @@ withTaggedLockDir' ma = do
 
 runGitProcess ::
   forall r a.
-  (Members '[TaggedLock, Log, Files, ProcessE, Error GitProcessError, Internet] r) =>
+  (Members '[TaggedLock, Logger, Files, ProcessE, Error GitProcessError, Internet] r) =>
   Sem (GitClone ': r) a ->
   Sem r a
 runGitProcess = runProvider_ helper

diff --git a/src/Juvix/Data/Effect/Log.hs b/src/Juvix/Data/Effect/Log.hs
diff --git a/src/Juvix/Data/Logger.hs → src/Juvix/Data/Effect/Logger.hs b/src/Juvix/Data/Logger.hs → src/Juvix/Data/Effect/Logger.hs
@@ -1,4 +1,4 @@
-module Juvix.Data.Logger
+module Juvix.Data.Effect.Logger
   ( defaultLoggerOptions,
     replLoggerOptions,
     defaultLogLevel,

diff --git a/src/Parallel/ProgressLog.hs b/src/Parallel/ProgressLog.hs
@@ -10,7 +10,7 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree.Base
 import Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo
 import Juvix.Compiler.Pipeline.Options
 import Juvix.Data.CodeAnn
-import Juvix.Data.Logger
+import Juvix.Data.Effect.Logger
 import Juvix.Prelude
 
 data ProgressLog :: Effect where

diff --git a/tests/smoke/Commands/compile-dependencies-package-juvix.smoke.yaml b/tests/smoke/Commands/compile-dependencies-package-juvix.smoke.yaml
@@ -1115,13 +1115,13 @@ tests:
         EOF
 
         # compile project
-        juvix --log-level error compile native HelloWorld.juvix
+        juvix --log-level info compile native HelloWorld.juvix
 
         # delete the dependency to check that it's not required
         rm -rf $temp/dep
 
         # compile project
-        juvix --log-level error compile native HelloWorld.juvix
+        juvix --log-level info compile native HelloWorld.juvix
     stdout:
       contains: ""
     stderr:

diff --git a/tests/smoke/Commands/compile-dependencies.smoke.yaml b/tests/smoke/Commands/compile-dependencies.smoke.yaml
@@ -1156,13 +1156,13 @@ tests:
         EOF
 
         # compile project
-        juvix --log-level error compile native HelloWorld.juvix
+        juvix --log-level info compile native HelloWorld.juvix
 
         # delete the dependency to check that it's not required
         rm -rf $temp/dep
 
         # compile project
-        juvix --log-level error compile native HelloWorld.juvix
+        juvix --log-level info compile native HelloWorld.juvix
     stdout:
       contains: ""
     stderr: