Promote use of MonadIO to minimize embed occurrences

app/App.hs

@@ -62,7 +62,7 @@ reAppIO ::
 reAppIO args@RunAppIOArgs {..} =
   reinterpret $ \case
     AskPackageGlobal -> return (_runAppIOArgsRoot ^. rootPackageType `elem` [GlobalStdlib, GlobalPackageDescription, GlobalPackageBase])
-    FromAppPathFile p -> embed (prepathToAbsFile invDir (p ^. pathPath))
+    FromAppPathFile p -> prepathToAbsFile invDir (p ^. pathPath)
     GetMainFile m -> getMainFile' m
     FromAppPathDir p -> liftIO (prepathToAbsDir invDir (p ^. pathPath))
     RenderStdOut t
@@ -84,7 +84,7 @@ reAppIO args@RunAppIOArgs {..} =
       printErr e
     ExitJuvixError e -> do
       printErr e
-      embed exitFailure
+      exitFailure
     ExitMsg exitCode t -> exitMsg' (exitWith exitCode) t
     ExitFailMsg t -> exitMsg' exitFailure t
     SayRaw b -> embed (ByteString.putStr b)
@@ -97,11 +97,11 @@ reAppIO args@RunAppIOArgs {..} =
 
     getMainFile' :: (Members '[SCache Package, EmbedIO] r') => Maybe (AppPath File) -> Sem r' (Path Abs File)
     getMainFile' = \case
-      Just p -> embed (prepathToAbsFile invDir (p ^. pathPath))
+      Just p -> prepathToAbsFile invDir (p ^. pathPath)
       Nothing -> do
         pkg <- getPkg
         case pkg ^. packageMain of
-          Just p -> embed (prepathToAbsFile invDir p)
+          Just p -> prepathToAbsFile invDir p
           Nothing -> missingMainErr
 
     missingMainErr :: (Members '[EmbedIO] r') => Sem r' x
@@ -116,7 +116,10 @@ reAppIO args@RunAppIOArgs {..} =
     g :: GlobalOptions
     g = _runAppIOArgsGlobalOptions
     printErr e =
-      embed $ hPutStrLn stderr $ run $ runReader (project' @GenericOptions g) $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e
+      hPutStrLn stderr
+        . run
+        . runReader (project' @GenericOptions g)
+        $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e
 
 getEntryPoint' :: (Members '[EmbedIO, TaggedLock] r) => RunAppIOArgs -> AppPath File -> Sem r EntryPoint
 getEntryPoint' RunAppIOArgs {..} inputFile = do

app/Commands/Dev/Casm/Run.hs

@@ -15,7 +15,7 @@ runCommand opts = do
     Right (labi, code) ->
       case Casm.validate labi code of
         Left err -> exitJuvixError (JuvixError err)
-        Right () -> embed $ print (Casm.runCode labi code)
+        Right () -> print (Casm.runCode labi code)
   where
     file :: AppPath File
     file = opts ^. casmRunInputFile

app/Commands/Dev/Core/Read.hs

@@ -27,7 +27,7 @@ runCommand opts = do
   let r = run $ runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.applyTransformations (project opts ^. coreReadTransformations) (Core.moduleFromInfoTable tab)
   tab0 <- getRight $ mapLeft JuvixError r
   let tab' = Core.computeCombinedInfoTable $ if project opts ^. coreReadNoDisambiguate then tab0 else Core.disambiguateNames tab0
-  embed (Scoper.scopeTrace tab')
+  Scoper.scopeTrace tab'
   unless (project opts ^. coreReadNoPrint) $ do
     renderStdOut (Pretty.ppOut opts tab')
   whenJust (tab' ^. Core.infoMain) $ \sym -> doEval gopts tab' (fromJust $ tab' ^. Core.identContext . at sym)

app/Commands/Dev/Core/Repl.hs

@@ -31,11 +31,11 @@ runRepl opts tab = do
   embed (hFlush stdout)
   done <- embed isEOF
   unless done $ do
-    s <- embed getLine
+    s <- getLine
     case fromText (strip s) of
       ":q" -> return ()
       ":h" -> do
-        embed showReplHelp
+        showReplHelp
         runRepl opts tab
       ':' : 'p' : ' ' : s' ->
         case parseText tab (fromString s') of
@@ -133,14 +133,14 @@ runRepl opts tab = do
       putStrLn ""
       runRepl opts tab'
 
-showReplWelcome :: (Members '[EmbedIO, App] r) => Sem r ()
+showReplWelcome :: (MonadIO m) => m ()
 showReplWelcome = do
   putStrLn "JuvixCore REPL"
   putStrLn ""
   putStrLn "Type \":h\" for help."
   putStrLn ""
 
-showReplHelp :: IO ()
+showReplHelp :: (MonadIO m) => m ()
 showReplHelp = do
   putStrLn ""
   putStrLn "JuvixCore REPL"

app/Commands/Dev/Geb/Repl.hs

@@ -296,7 +296,7 @@ printError e = do
             . runReader (project' @GenericOptions opts)
             $ Error.render useAnsi False e
         )
-  liftIO $ hPutStrLn stderr errorText
+  hPutStrLn stderr errorText
 
 printEvalResult :: Either JuvixError Geb.RunEvalResult -> Repl ()
 printEvalResult = \case

app/Commands/Extra/Compile.hs

@@ -242,9 +242,9 @@ findClangUsingEnvVar = do
     clangBinPath = fmap (<//> $(mkRelFile "bin/clang")) <$> llvmDistPath
 
     llvmDistPath :: Sem r (Maybe (Path Abs Dir))
-    llvmDistPath = do
-      p <- embed (lookupEnv llvmDistEnvironmentVar)
-      embed (mapM parseAbsDir p)
+    llvmDistPath = liftIO $ do
+      p <- lookupEnv llvmDistEnvironmentVar
+      mapM parseAbsDir p
 
 data ClangPath
   = ClangSystemPath (Path Abs File)

app/Commands/Format.hs

@@ -55,17 +55,14 @@ runCommand opts = do
       TargetStdin -> do
         entry <- getEntryPointStdin
         runReader entry formatStdin
-
-    let exitFail :: IO a
-        exitFail = exitWith (ExitFailure 1)
     case res of
-      FormatResultFail -> embed exitFail
+      FormatResultFail -> exitFailure
       FormatResultNotFormatted ->
         {- use exit code 1 for
          * unformatted files when using --check
          * when running the formatter on a Juvix project
         -}
-        when (opts ^. formatCheck || isTargetProject target) (embed exitFail)
+        when (opts ^. formatCheck || isTargetProject target) exitFailure
       FormatResultOK -> pure ()
 
 renderModeFromOptions :: FormatTarget -> FormatOptions -> FormattedFileInfo -> FormatRenderMode

app/Commands/Init.hs

@@ -57,7 +57,7 @@ checkNotInProject =
     err :: Sem r ()
     err = do
       say "You are already in a Juvix project"
-      embed exitFailure
+      exitFailure
 
 checkPackage :: forall r. (Members '[EmbedIO] r) => Sem r ()
 checkPackage = do
@@ -66,7 +66,7 @@ checkPackage = do
   case ep of
     Left {} -> do
       say "Package.juvix is invalid. Please raise an issue at https://github.com/anoma/juvix/issues"
-      embed exitFailure
+      exitFailure
     Right {} -> return ()
 
 getPackage :: forall r. (Members '[EmbedIO] r) => Sem r Package
@@ -110,7 +110,7 @@ getProjName = do
       where
         go :: Sem r Text
         go = do
-          txt <- embed getLine
+          txt <- getLine
           if
               | Text.null txt, Just def' <- def -> return def'
               | otherwise ->
@@ -137,7 +137,7 @@ tryAgain = say "Please, try again:"
 
 getVersion :: forall r. (Members '[EmbedIO] r) => Sem r SemVer
 getVersion = do
-  txt <- embed getLine
+  txt <- getLine
   if
       | Text.null txt -> return defaultVersion
       | otherwise -> case parse semver' txt of

app/TopCommand.hs

@@ -17,19 +17,19 @@ import Juvix.Extra.Version
 import System.Environment (getProgName)
 import TopCommand.Options
 
-showHelpText :: IO ()
+showHelpText :: (MonadIO m) => m ()
 showHelpText = do
   let p = prefs showHelpOnEmpty
-  progn <- getProgName
+  progn <- liftIO getProgName
   let helpText = parserFailure p descr (ShowHelpText Nothing) []
       (msg, _) = renderFailure helpText progn
   putStrLn (pack msg)
 
 runTopCommand :: forall r. (Members '[EmbedIO, App, Resource, TaggedLock] r) => TopCommand -> Sem r ()
 runTopCommand = \case
-  DisplayVersion -> embed runDisplayVersion
-  DisplayNumericVersion -> embed runDisplayNumericVersion
-  DisplayHelp -> embed showHelpText
+  DisplayVersion -> runDisplayVersion
+  DisplayNumericVersion -> runDisplayNumericVersion
+  DisplayHelp -> showHelpText
   Doctor opts -> runLogIO (Doctor.runCommand opts)
   Init opts -> runLogIO (Init.init opts)
   Dev opts -> Dev.runCommand opts

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

@@ -116,7 +116,7 @@ runRuntime tab = runState (RuntimeState (CallStack []) emptyFrame [] Nothing tab
 hEvalRuntime :: forall r a. (Member EmbedIO r) => Handle -> InfoTable -> Sem (Runtime ': r) a -> Sem r a
 hEvalRuntime h tab r = do
   (s, a) <- runRuntime tab r
-  mapM_ (embed . hPutStrLn h) (reverse (s ^. runtimeMessages))
+  mapM_ (hPutStrLn h) (reverse (s ^. runtimeMessages))
   return a
 
 evalRuntime :: forall r a. (Member EmbedIO r) => InfoTable -> Sem (Runtime ': r) a -> Sem r a

src/Juvix/Compiler/Casm/Translation/FromSource.hs

@@ -140,7 +140,7 @@ parseMemRef = do
   r <- register
   off <- parseOffset
   rbracket
-  return $ MemRef {_memRefReg = r, _memRefOff = off}
+  return MemRef {_memRefReg = r, _memRefOff = off}
 
 parseLabel :: (Member LabelInfoBuilder r) => ParsecS r LabelRef
 parseLabel = do

src/Juvix/Compiler/Core/Scoper.hs

@@ -26,5 +26,5 @@ scopeErr msg = do
   throw @ScopeError ("Scope error in the definition of " <> show sym <> "\n" <> msg)
 
 -- | prints the scope error without exiting
-scopeTrace :: InfoTable -> IO ()
+scopeTrace :: (MonadIO m) => InfoTable -> m ()
 scopeTrace i = whenJust (scopeCheck i) putStrLn

src/Juvix/Compiler/Nockma/Stdlib.hs

@@ -1,7 +1,7 @@
 module Juvix.Compiler.Nockma.Stdlib where
 
 import Juvix.Compiler.Nockma.Translation.FromSource.QQ
-import Juvix.Prelude
+import Juvix.Prelude.Base
 
 stdlib :: Term Natural
 stdlib =

src/Juvix/Compiler/Nockma/StdlibFunction.hs

@@ -1,7 +1,7 @@
 module Juvix.Compiler.Nockma.StdlibFunction where
 
 import Juvix.Compiler.Nockma.Translation.FromSource.QQ
-import Juvix.Prelude hiding (Path)
+import Juvix.Prelude.Base
 
 -- | The stdlib paths are obtained from the Urbit dojo
 -- * Load the stdlib file into the Urbit dojo

src/Juvix/Compiler/Pipeline/Run.hs

@@ -100,36 +100,40 @@ runIO opts entry = runIOEither entry >=> mayThrow
   where
     mayThrow :: (Members '[EmbedIO] r') => Either JuvixError x -> Sem r' x
     mayThrow = \case
-      Left err -> runReader opts $ printErrorAnsiSafe err >> embed exitFailure
+      Left err -> runReader opts $ printErrorAnsiSafe err >> exitFailure
       Right r -> return r
 
-runReplPipelineIO :: EntryPoint -> IO Artifacts
+runReplPipelineIO :: (MonadIO m) => EntryPoint -> m Artifacts
 runReplPipelineIO = runReplPipelineIO' defaultGenericOptions
 
-runReplPipelineIO' :: GenericOptions -> EntryPoint -> IO Artifacts
+runReplPipelineIO' :: forall m. (MonadIO m) => GenericOptions -> EntryPoint -> m Artifacts
 runReplPipelineIO' opts entry = runReplPipelineIOEither entry >>= mayThrow
   where
-    mayThrow :: Either JuvixError r -> IO r
+    mayThrow :: Either JuvixError r -> m r
     mayThrow = \case
-      Left err -> runM . runReader opts $ printErrorAnsiSafe err >> embed exitFailure
+      Left err -> liftIO . runM . runReader opts $ printErrorAnsiSafe err >> exitFailure
       Right r -> return r
 
 runReplPipelineIOEither ::
+  (MonadIO m) =>
   EntryPoint ->
-  IO (Either JuvixError Artifacts)
+  m (Either JuvixError Artifacts)
 runReplPipelineIOEither = runReplPipelineIOEither' LockModePermissive
 
 runReplPipelineIOEither' ::
+  forall m.
+  (MonadIO m) =>
   LockMode ->
   EntryPoint ->
-  IO (Either JuvixError Artifacts)
+  m (Either JuvixError Artifacts)
 runReplPipelineIOEither' lockMode entry = do
   let hasInternet = not (entry ^. entryPointOffline)
       runPathResolver'
         | mainIsPackageFile entry = runPackagePathResolverArtifacts (entry ^. entryPointResolverRoot)
         | otherwise = runPathResolverArtifacts
   eith <-
-    runFinal
+    liftIO
+      . runFinal
       . resourceToIOFinal
       . embedToFinal @IO
       . evalInternet hasInternet

src/Juvix/Compiler/Reg/Interpreter.hs

@@ -332,14 +332,14 @@ runIO hin hout infoTable = \case
               _regErrorLoc = Nothing
             }
   ValConstr (Constr (BuiltinTag TagWrite) [ValString s]) -> do
-    embed $ hPutStr hout s
+    hPutStr hout s
     return ValVoid
   ValConstr (Constr (BuiltinTag TagWrite) [arg]) -> do
-    embed $ hPutStr hout (ppPrint infoTable arg)
+    hPutStr hout (ppPrint infoTable arg)
     return ValVoid
   ValConstr (Constr (BuiltinTag TagReadLn) []) -> do
-    embed $ hFlush hout
-    s <- embed $ hGetLine hin
+    liftIO $ hFlush hout
+    s <- liftIO $ hGetLine hin
     return (ValString s)
   val ->
     return val

src/Juvix/Compiler/Tree/Evaluator.hs

@@ -257,10 +257,10 @@ hRunIO hin hout infoTable = \case
         !x'' = hEval hout infoTable code
     hRunIO hin hout infoTable x''
   ValConstr (Constr (BuiltinTag TagWrite) [ValString s]) -> do
-    liftIO $ hPutStr hout s
+    hPutStr hout s
     return ValVoid
   ValConstr (Constr (BuiltinTag TagWrite) [arg]) -> do
-    liftIO $ hPutStr hout (ppPrint infoTable arg)
+    hPutStr hout (ppPrint infoTable arg)
     return ValVoid
   ValConstr (Constr (BuiltinTag TagReadLn) []) -> do
     liftIO $ hFlush hout

src/Juvix/Compiler/Tree/EvaluatorEff.hs

@@ -279,7 +279,7 @@ hEvalIOEither hin hout infoTable funInfo = do
         v <- eval infoTable (funInfo ^. functionCode)
         hRunIO hin hout infoTable v
   let handleTrace :: forall q. (MonadIO q) => Value -> q ()
-      handleTrace = liftIO . hPutStrLn hout . printValue infoTable
+      handleTrace = hPutStrLn hout . printValue infoTable
   liftIO
     . runEff
     . runError @TreeError
@@ -303,10 +303,10 @@ hRunIO hin hout infoTable = \case
     res <- eval infoTable code
     hRunIO hin hout infoTable res
   ValConstr (Constr (BuiltinTag TagWrite) [ValString s]) -> do
-    liftIO $ hPutStr hout s
+    hPutStr hout s
     return ValVoid
   ValConstr (Constr (BuiltinTag TagWrite) [arg]) -> do
-    liftIO $ hPutStr hout (ppPrint infoTable arg)
+    hPutStr hout (ppPrint infoTable arg)
     return ValVoid
   ValConstr (Constr (BuiltinTag TagReadLn) []) -> do
     liftIO $ hFlush hout

src/Juvix/Extra/Version.hs

@@ -36,20 +36,20 @@ shortHash = projectOrUnknown (take 7 . giHash)
 versionTag :: Text
 versionTag = versionDoc <> "-" <> shortHash
 
-progName :: IO Text
-progName = pack . toUpperFirst <$> getProgName
+progName :: (MonadIO m) => m Text
+progName = pack . toUpperFirst <$> liftIO getProgName
 
-progNameVersion :: IO Text
+progNameVersion :: (MonadIO m) => m Text
 progNameVersion = do
   pName <- progName
   return (pName <> " version " <> versionDoc)
 
-progNameVersionTag :: IO Text
+progNameVersionTag :: (MonadIO m) => m Text
 progNameVersionTag = do
   progNameV <- progNameVersion
   return (progNameV <> "-" <> shortHash)
 
-infoVersionRepo :: IO (Doc a)
+infoVersionRepo :: (MonadIO m) => m (Doc a)
 infoVersionRepo = do
   pNameTag <- progNameVersionTag
   return
@@ -69,10 +69,10 @@ infoVersionRepo = do
           <> line
     )
 
-runDisplayVersion :: IO ()
+runDisplayVersion :: (MonadIO m) => m ()
 runDisplayVersion = do
   v <- layoutPretty defaultLayoutOptions <$> infoVersionRepo
-  renderIO stdout v
+  liftIO (renderIO stdout v)
 
-runDisplayNumericVersion :: IO ()
+runDisplayNumericVersion :: (MonadIO m) => m ()
 runDisplayNumericVersion = putStrLn versionDoc