Promote use of MonadIO to minimize embed occurrences (#2694)

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
+    llvmDistPath = liftIO $ do
-      p <- embed (lookupEnv llvmDistEnvironmentVar)
+      p <- lookupEnv llvmDistEnvironmentVar
-      embed (mapM parseAbsDir p)
+      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
+  DisplayVersion -> runDisplayVersion
-  DisplayNumericVersion -> embed runDisplayNumericVersion
+  DisplayNumericVersion -> runDisplayNumericVersion
-  DisplayHelp -> embed showHelpText
+  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
+    liftIO $ hFlush hout
-    s <- embed $ hGetLine hin
+    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 :: (MonadIO m) => m Text
-progName = pack . toUpperFirst <$> getProgName
+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

src/Juvix/Prelude/Base/Foundation.hs

@@ -132,7 +132,7 @@ import Data.Text qualified as Text
 import Data.Text.Encoding
 import Data.Text.IO hiding (appendFile, getContents, getLine, hGetContents, hGetLine, hPutStr, hPutStrLn, interact, putStr, putStrLn, readFile, writeFile)
 import Data.Text.IO qualified as Text
-import Data.Text.IO.Utf8 hiding (putStr, putStrLn, readFile, writeFile)
+import Data.Text.IO.Utf8 hiding (getLine, hPutStr, hPutStrLn, putStr, putStrLn, readFile, writeFile)
 import Data.Text.IO.Utf8 qualified as Utf8
 import Data.Traversable
 import Data.Tuple.Extra hiding (both)
@@ -154,7 +154,8 @@ import Path.IO qualified as Path hiding (getCurrentDir, setCurrentDir, withCurre
 import Prettyprinter (Doc, (<+>))
 import Safe.Exact
 import Safe.Foldable
-import System.Exit
+import System.Exit hiding (exitFailure, exitSuccess)
+import System.Exit qualified as IO
 import System.FilePath (FilePath, dropTrailingPathSeparator, normalise, (<.>), (</>))
 import System.IO hiding
   ( appendFile,
@@ -167,12 +168,14 @@ import System.IO hiding
     interact,
     openBinaryTempFile,
     openTempFile,
+    print,
     putStr,
     putStrLn,
     readFile,
     readFile',
     writeFile,
   )
+import System.IO qualified as IO
 import System.IO.Error
 import Text.Read qualified as Text
 import Text.Show (Show)
@@ -428,17 +431,35 @@ fromRightIO' :: (MonadIO m) => (e -> m ()) -> m (Either e r) -> m r
 fromRightIO' pp = do
   eitherM ifLeft return
   where
-    ifLeft e = pp e >> liftIO exitFailure
+    ifLeft e = pp e >> exitFailure
 
 fromRightIO :: (MonadIO m) => (e -> Text) -> m (Either e r) -> m r
 fromRightIO pp = fromRightIO' (putStrLn . pp)
 
+exitSuccess :: (MonadIO m) => m x
+exitSuccess = liftIO IO.exitSuccess
+
+exitFailure :: (MonadIO m) => m x
+exitFailure = liftIO IO.exitFailure
+
+print :: (MonadIO m, Show a) => a -> m ()
+print = liftIO . IO.print
+
 putStr :: (MonadIO m) => Text -> m ()
 putStr = liftIO . Text.putStr
 
 putStrLn :: (MonadIO m) => Text -> m ()
 putStrLn = liftIO . Text.putStrLn
 
+getLine :: (MonadIO m) => m Text
+getLine = liftIO Text.getLine
+
+hPutStr :: (MonadIO m) => Handle -> Text -> m ()
+hPutStr h = liftIO . Text.hPutStr h
+
+hPutStrLn :: (MonadIO m) => Handle -> Text -> m ()
+hPutStrLn h = liftIO . Text.hPutStrLn h
+
 optional_ :: (Alternative m) => m a -> m ()
 optional_ = void . optional
 

src/Juvix/Prelude/Prepath.hs

@@ -104,7 +104,7 @@ instance FromJSON (Prepath d) where
 instance Pretty (Prepath d) where
   pretty (Prepath p) = pretty p
 
-prepathToAbsFile :: Path Abs Dir -> Prepath File -> IO (Path Abs File)
+prepathToAbsFile :: (MonadIO m) => Path Abs Dir -> Prepath File -> m (Path Abs File)
 prepathToAbsFile root = fmap absFile . prepathToFilePath root
 
 prepathToAbsDir :: (MonadIO m) => Path Abs Dir -> Prepath Dir -> m (Path Abs Dir)
@@ -115,10 +115,10 @@ prepathToFilePath root pre = do
   expandedPre <- expandPrepath pre
   liftIO (System.canonicalizePath (toFilePath root </> expandedPre))
 
-fromPreFileOrDir :: Path Abs Dir -> Prepath FileOrDir -> IO (Either (Path Abs File) (Path Abs Dir))
+fromPreFileOrDir :: (MonadIO m, MonadThrow m) => Path Abs Dir -> Prepath FileOrDir -> m (Either (Path Abs File) (Path Abs Dir))
 fromPreFileOrDir cwd fp = do
   absPath <- prepathToFilePath cwd fp
-  isDirectory <- System.doesDirectoryExist absPath
+  isDirectory <- liftIO (System.doesDirectoryExist absPath)
   if
       | isDirectory -> Right <$> parseAbsDir absPath
       | otherwise -> Left <$> parseAbsFile absPath

src/Juvix/Prelude/Pretty.hs

@@ -109,13 +109,13 @@ instance Show AnsiText where
 instance Pretty AnsiText where
   pretty = pretty . ansiTextToText
 
-renderIO :: (HasAnsiBackend a, HasTextBackend a) => Bool -> a -> IO ()
+renderIO :: (MonadIO m, HasAnsiBackend a, HasTextBackend a) => Bool -> a -> m ()
 renderIO useColors = hRenderIO useColors stdout
 
-hRenderIO :: (HasAnsiBackend a, HasTextBackend a) => Bool -> Handle -> a -> IO ()
+hRenderIO :: (MonadIO m, HasAnsiBackend a, HasTextBackend a) => Bool -> Handle -> a -> m ()
 hRenderIO useColors h
-  | useColors = Ansi.renderIO h . toAnsiStream
+  | useColors = liftIO . Ansi.renderIO h . toAnsiStream
-  | otherwise = Text.renderIO h . toTextStream
+  | otherwise = liftIO . Text.renderIO h . toTextStream
 
 toAnsiText :: (HasAnsiBackend a, HasTextBackend a) => Bool -> a -> Text
 toAnsiText useColors

test/Base.hs

@@ -79,21 +79,23 @@ assertCmdExists cmd =
     . isJust
     =<< findExecutable cmd
 
-testTaggedLockedToIO :: Sem PipelineAppEffects a -> IO a
+testTaggedLockedToIO :: (MonadIO m) => Sem PipelineAppEffects a -> m a
 testTaggedLockedToIO =
-  runFinal
+  liftIO
+    . runFinal
     . resourceToIOFinal
     . embedToFinal @IO
     . runTaggedLock LockModeExclusive
 
 testRunIO ::
-  forall a.
+  forall a m.
+  (MonadIO m) =>
   EntryPoint ->
   Sem (PipelineEff PipelineAppEffects) a ->
-  IO (ResolverState, PipelineResult a)
+  m (ResolverState, PipelineResult a)
 testRunIO e = testTaggedLockedToIO . runIO defaultGenericOptions e
 
-testDefaultEntryPointIO :: Path Abs Dir -> Path Abs File -> IO EntryPoint
+testDefaultEntryPointIO :: (MonadIO m) => Path Abs Dir -> Path Abs File -> m EntryPoint
 testDefaultEntryPointIO cwd mainFile = testTaggedLockedToIO (defaultEntryPointIO cwd mainFile)
 
 testDefaultEntryPointNoFileIO :: Path Abs Dir -> IO EntryPoint

test/Formatter/Positive.hs

@@ -8,10 +8,10 @@ import Scope.Positive qualified as Scope
 runScopeEffIO :: (Member EmbedIO r) => Path Abs Dir -> Sem (ScopeEff ': r) a -> Sem r a
 runScopeEffIO root = interpret $ \case
   ScopeFile p -> do
-    entry <- embed (testDefaultEntryPointIO root p)
+    entry <- testDefaultEntryPointIO root p
-    embed ((^. pipelineResult) . snd <$> testRunIO entry upToScoping)
+    ((^. pipelineResult) . snd <$> testRunIO entry upToScoping)
   ScopeStdin entry -> do
-    embed ((^. pipelineResult) . snd <$> testRunIO entry upToScoping)
+    ((^. pipelineResult) . snd <$> testRunIO entry upToScoping)
 
 makeFormatTest' :: Scope.PosTest -> TestDescr
 makeFormatTest' Scope.PosTest {..} =

test/Nockma/Compile/Tree/Positive.hs

@@ -21,7 +21,7 @@ runNockmaAssertion hout _main tab = do
   res <-
     runM
       . runOutputSem @(Term Natural)
-        (embed . hPutStrLn hout . Nockma.ppPrint)
+        (hPutStrLn hout . Nockma.ppPrint)
       . runReader NockmaEval.defaultEvalOptions
       . evalCompiledNock' nockSubject
       $ nockMain

test/Repl/Positive.hs

@@ -24,7 +24,7 @@ loadPrelude rootDir = runTaggedLockIO' $ do
   runReader rootDir writeStdlib
   pkg <- readPackageRootIO root
   let ep = defaultEntryPoint pkg root (rootDir <//> preludePath)
-  artif <- embed (runReplPipelineIO ep)
+  artif <- runReplPipelineIO ep
   return (artif, ep)
   where
     root :: Root