From 97030f8cb44185d720d08fdee94bc5f67c169c19 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 13 Feb 2024 19:00:01 +0100 Subject: [PATCH] Use `EmbedIO` instead of `Embed IO` (#2645) - :warning: Depends on #2644 The `effectful` library does not support the `Embed` effect out of the box. However, it offers `IOE`, which is equivalent to `Embed IO` from polysemy. In preparation to a possible migration to `effectful`, this pr hides the general `Embed` effect from the prelude and it exports a specialized `EmbedIO` in its place. --- app/App.hs | 34 +++++++++---------- app/AsmInterpreter.hs | 2 +- app/Commands/Compile.hs | 4 +-- app/Commands/Dependencies.hs | 2 +- app/Commands/Dependencies/Update.hs | 2 +- app/Commands/Dev.hs | 2 +- app/Commands/Dev/Asm.hs | 2 +- app/Commands/Dev/Asm/Compile.hs | 2 +- app/Commands/Dev/Asm/Run.hs | 2 +- app/Commands/Dev/Asm/Validate.hs | 2 +- app/Commands/Dev/Casm.hs | 2 +- app/Commands/Dev/Casm/Read.hs | 2 +- app/Commands/Dev/Casm/Run.hs | 2 +- app/Commands/Dev/Core.hs | 2 +- app/Commands/Dev/Core/Asm.hs | 2 +- app/Commands/Dev/Core/Compile.hs | 2 +- app/Commands/Dev/Core/Compile/Base.hs | 16 ++++----- app/Commands/Dev/Core/Eval.hs | 2 +- app/Commands/Dev/Core/FromConcrete.hs | 2 +- app/Commands/Dev/Core/Normalize.hs | 2 +- app/Commands/Dev/Core/Read.hs | 2 +- app/Commands/Dev/Core/Repl.hs | 6 ++-- app/Commands/Dev/Core/Strip.hs | 2 +- app/Commands/Dev/DisplayRoot.hs | 2 +- app/Commands/Dev/Geb.hs | 2 +- app/Commands/Dev/Geb/Check.hs | 2 +- app/Commands/Dev/Geb/Eval.hs | 4 +-- app/Commands/Dev/Geb/Infer.hs | 2 +- app/Commands/Dev/Geb/Read.hs | 2 +- app/Commands/Dev/Geb/Repl.hs | 2 +- app/Commands/Dev/Highlight.hs | 2 +- app/Commands/Dev/Internal.hs | 2 +- app/Commands/Dev/Internal/Pretty.hs | 2 +- app/Commands/Dev/Internal/Typecheck.hs | 2 +- app/Commands/Dev/MigrateJuvixYaml.hs | 2 +- app/Commands/Dev/Nockma.hs | 2 +- app/Commands/Dev/Nockma/Eval.hs | 2 +- app/Commands/Dev/Nockma/Format.hs | 2 +- app/Commands/Dev/Nockma/Repl.hs | 2 +- app/Commands/Dev/Parse.hs | 2 +- app/Commands/Dev/Reg.hs | 2 +- app/Commands/Dev/Reg/Read.hs | 2 +- app/Commands/Dev/Runtime.hs | 2 +- app/Commands/Dev/Scope.hs | 2 +- app/Commands/Dev/Termination.hs | 2 +- app/Commands/Dev/Termination/CallGraph.hs | 2 +- app/Commands/Dev/Termination/Calls.hs | 2 +- app/Commands/Dev/Tree.hs | 2 +- app/Commands/Dev/Tree/Compile.hs | 2 +- app/Commands/Dev/Tree/Compile/Base.hs | 10 +++--- app/Commands/Dev/Tree/Eval.hs | 2 +- app/Commands/Dev/Tree/FromAsm.hs | 2 +- app/Commands/Dev/Tree/Read.hs | 2 +- app/Commands/Dev/Tree/Repl.hs | 2 +- app/Commands/Doctor.hs | 4 +-- app/Commands/Eval.hs | 2 +- app/Commands/Extra/Compile.hs | 22 ++++++------ app/Commands/Extra/Package.hs | 6 ++-- app/Commands/Format.hs | 8 ++--- app/Commands/Html.hs | 4 +-- app/Commands/Init.hs | 18 +++++----- app/Commands/Markdown.hs | 2 +- app/Commands/Repl.hs | 2 +- app/Commands/Typecheck.hs | 2 +- app/Evaluator.hs | 4 +-- app/GlobalOptions.hs | 6 ++-- app/TopCommand.hs | 2 +- app/TreeEvaluator.hs | 2 +- src/Juvix/Compiler/Asm/Interpreter/Runtime.hs | 4 +-- .../Backend/Html/Translation/FromTyped.hs | 10 +++--- src/Juvix/Compiler/Pipeline.hs | 2 +- src/Juvix/Compiler/Pipeline/EntryPoint/IO.hs | 4 +-- src/Juvix/Compiler/Pipeline/Package/IO.hs | 6 ++-- .../Pipeline/Package/Loader/EvalEff/IO.hs | 4 +-- src/Juvix/Compiler/Pipeline/Repl.hs | 2 +- src/Juvix/Compiler/Pipeline/Root.hs | 6 ++-- src/Juvix/Compiler/Pipeline/Run.hs | 18 +++++----- src/Juvix/Compiler/Tree/EvaluatorSem.hs | 2 +- src/Juvix/Data/Effect/Fail.hs | 2 +- src/Juvix/Data/Effect/FileLock/IO.hs | 2 +- src/Juvix/Data/Effect/Files/IO.hs | 4 +-- src/Juvix/Data/Effect/Log.hs | 2 +- src/Juvix/Data/Effect/Process/IO.hs | 2 +- src/Juvix/Data/Effect/TaggedLock.hs | 2 +- src/Juvix/Data/Effect/TaggedLock/IO.hs | 2 +- src/Juvix/Data/Error/GenericError.hs | 10 +++--- src/Juvix/Prelude/Base.hs | 10 ++++-- test/Formatter/Positive.hs | 2 +- test/Nockma/Eval/Positive.hs | 2 +- 89 files changed, 178 insertions(+), 174 deletions(-) diff --git a/app/App.hs b/app/App.hs index 3980567030..51683eac0c 100644 --- a/app/App.hs +++ b/app/App.hs @@ -45,7 +45,7 @@ makeLenses ''RunAppIOArgs runAppIO :: forall r a. - (Members '[Embed IO, TaggedLock] r) => + (Members '[EmbedIO, TaggedLock] r) => RunAppIOArgs -> Sem (App ': r) a -> Sem r a @@ -55,7 +55,7 @@ runAppIO args = evalSingletonCache (readPackageRootIO root) . reAppIO args reAppIO :: forall r a. - (Members '[Embed IO, TaggedLock] r) => + (Members '[EmbedIO, TaggedLock] r) => RunAppIOArgs -> Sem (App ': r) a -> Sem (SCache Package ': r) a @@ -92,10 +92,10 @@ reAppIO args@RunAppIOArgs {..} = getPkg :: (Members '[SCache Package] r') => Sem r' Package getPkg = cacheSingletonGet - exitMsg' :: (Members '[Embed IO] r') => IO x -> Text -> Sem r' x + exitMsg' :: (Members '[EmbedIO] r') => IO x -> Text -> Sem r' x exitMsg' onExit t = liftIO (putStrLn t >> hFlush stdout >> onExit) - getMainFile' :: (Members '[SCache Package, Embed IO] r') => Maybe (AppPath File) -> Sem r' (Path Abs File) + getMainFile' :: (Members '[SCache Package, EmbedIO] r') => Maybe (AppPath File) -> Sem r' (Path Abs File) getMainFile' = \case Just p -> embed (prepathToAbsFile invDir (p ^. pathPath)) Nothing -> do @@ -104,7 +104,7 @@ reAppIO args@RunAppIOArgs {..} = Just p -> embed (prepathToAbsFile invDir p) Nothing -> missingMainErr - missingMainErr :: (Members '[Embed IO] r') => Sem r' x + missingMainErr :: (Members '[EmbedIO] r') => Sem r' x missingMainErr = exitMsg' exitFailure @@ -118,7 +118,7 @@ reAppIO args@RunAppIOArgs {..} = printErr e = embed $ hPutStrLn stderr $ run $ runReader (project' @GenericOptions g) $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e -getEntryPoint' :: (Members '[Embed IO, TaggedLock] r) => RunAppIOArgs -> AppPath File -> Sem r EntryPoint +getEntryPoint' :: (Members '[EmbedIO, TaggedLock] r) => RunAppIOArgs -> AppPath File -> Sem r EntryPoint getEntryPoint' RunAppIOArgs {..} inputFile = do let opts = _runAppIOArgsGlobalOptions root = _runAppIOArgsRoot @@ -128,19 +128,19 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do | otherwise -> return Nothing set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root (inputFile ^. pathPath) opts -runPipelineEither :: (Members '[Embed IO, TaggedLock, App] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a)) +runPipelineEither :: (Members '[EmbedIO, TaggedLock, App] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a)) runPipelineEither input_ p = do args <- askArgs entry <- getEntryPoint' args input_ runIOEither entry p -runPipelineSetupEither :: (Members '[Embed IO, TaggedLock, App] r) => Sem (PipelineEff' r) a -> Sem r (Either JuvixError (ResolverState, a)) +runPipelineSetupEither :: (Members '[EmbedIO, TaggedLock, App] r) => Sem (PipelineEff' r) a -> Sem r (Either JuvixError (ResolverState, a)) runPipelineSetupEither p = do args <- askArgs entry <- getEntryPointStdin' args runIOEitherPipeline entry p -getEntryPointStdin' :: (Members '[Embed IO, TaggedLock] r) => RunAppIOArgs -> Sem r EntryPoint +getEntryPointStdin' :: (Members '[EmbedIO, TaggedLock] r) => RunAppIOArgs -> Sem r EntryPoint getEntryPointStdin' RunAppIOArgs {..} = do let opts = _runAppIOArgsGlobalOptions root = _runAppIOArgsRoot @@ -155,7 +155,7 @@ someBaseToAbs' f = do r <- askInvokeDir return (someBaseToAbs r f) -filePathToAbs :: (Members '[Embed IO, App] r) => Prepath FileOrDir -> Sem r (Either (Path Abs File) (Path Abs Dir)) +filePathToAbs :: (Members '[EmbedIO, App] r) => Prepath FileOrDir -> Sem r (Either (Path Abs File) (Path Abs Dir)) filePathToAbs fp = do invokeDir <- askInvokeDir embed (fromPreFileOrDir invokeDir fp) @@ -163,33 +163,33 @@ filePathToAbs fp = do askGenericOptions :: (Members '[App] r) => Sem r GenericOptions askGenericOptions = project <$> askGlobalOptions -getEntryPoint :: (Members '[Embed IO, App, TaggedLock] r) => AppPath File -> Sem r EntryPoint +getEntryPoint :: (Members '[EmbedIO, App, TaggedLock] r) => AppPath File -> Sem r EntryPoint getEntryPoint inputFile = do _runAppIOArgsGlobalOptions <- askGlobalOptions _runAppIOArgsRoot <- askRoot getEntryPoint' (RunAppIOArgs {..}) inputFile -getEntryPointStdin :: (Members '[Embed IO, App, TaggedLock] r) => Sem r EntryPoint +getEntryPointStdin :: (Members '[EmbedIO, App, TaggedLock] r) => Sem r EntryPoint getEntryPointStdin = do _runAppIOArgsGlobalOptions <- askGlobalOptions _runAppIOArgsRoot <- askRoot getEntryPointStdin' (RunAppIOArgs {..}) -runPipelineTermination :: (Members '[Embed IO, App, TaggedLock] r) => AppPath File -> Sem (Termination ': PipelineEff r) a -> Sem r (PipelineResult a) +runPipelineTermination :: (Members '[EmbedIO, App, TaggedLock] r) => AppPath File -> Sem (Termination ': PipelineEff r) a -> Sem r (PipelineResult a) runPipelineTermination input_ p = do r <- runPipelineEither input_ (evalTermination iniTerminationState p) case r of Left err -> exitJuvixError err Right res -> return (snd res) -runPipeline :: (Members '[App, Embed IO, TaggedLock] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r a +runPipeline :: (Members '[App, EmbedIO, TaggedLock] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r a runPipeline input_ p = do r <- runPipelineEither input_ p case r of Left err -> exitJuvixError err Right res -> return (snd res ^. pipelineResult) -runPipelineHtml :: (Members '[App, Embed IO, TaggedLock] r) => Bool -> AppPath File -> Sem r (InternalTypedResult, [InternalTypedResult]) +runPipelineHtml :: (Members '[App, EmbedIO, TaggedLock] r) => Bool -> AppPath File -> Sem r (InternalTypedResult, [InternalTypedResult]) runPipelineHtml bNonRecursive input_ | bNonRecursive = do r <- runPipeline input_ upToInternalTyped @@ -202,14 +202,14 @@ runPipelineHtml bNonRecursive input_ Left err -> exitJuvixError err Right res -> return res -runPipelineEntry :: (Members '[App, Embed IO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a +runPipelineEntry :: (Members '[App, EmbedIO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a runPipelineEntry entry p = do r <- runIOEither entry p case r of Left err -> exitJuvixError err Right res -> return (snd res ^. pipelineResult) -runPipelineSetup :: (Members '[App, Embed IO, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a +runPipelineSetup :: (Members '[App, EmbedIO, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a runPipelineSetup p = do r <- runPipelineSetupEither p case r of diff --git a/app/AsmInterpreter.hs b/app/AsmInterpreter.hs index 0c1176265a..0105e95492 100644 --- a/app/AsmInterpreter.hs +++ b/app/AsmInterpreter.hs @@ -8,7 +8,7 @@ import Juvix.Compiler.Asm.Interpreter qualified as Asm import Juvix.Compiler.Asm.Pretty qualified as Asm import Juvix.Compiler.Asm.Transformation.Validate qualified as Asm -runAsm :: forall r. (Members '[Embed IO, App] r) => Bool -> Asm.InfoTable -> Sem r () +runAsm :: forall r. (Members '[EmbedIO, App] r) => Bool -> Asm.InfoTable -> Sem r () runAsm bValidate tab = let v = if bValidate then Asm.validate' tab else Nothing in case v of diff --git a/app/Commands/Compile.hs b/app/Commands/Compile.hs index 56417d4339..3154c60ace 100644 --- a/app/Commands/Compile.hs +++ b/app/Commands/Compile.hs @@ -8,7 +8,7 @@ import Juvix.Compiler.Core qualified as Core import Juvix.Compiler.Core.Pretty qualified as Core import Juvix.Compiler.Core.Transformation.DisambiguateNames qualified as Core -runCommand :: (Members '[Embed IO, App, TaggedLock] r) => CompileOptions -> Sem r () +runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => CompileOptions -> Sem r () runCommand opts@CompileOptions {..} = do inputFile <- getMainFile _compileInputFile Core.CoreResult {..} <- runPipeline (AppPath (preFileFromAbs inputFile) True) upToCore @@ -29,7 +29,7 @@ runCommand opts@CompileOptions {..} = do TargetReg -> Compile.runRegPipeline arg TargetNockma -> Compile.runNockmaPipeline arg -writeCoreFile :: (Members '[Embed IO, App, TaggedLock] r) => Compile.PipelineArg -> Sem r () +writeCoreFile :: (Members '[EmbedIO, App, TaggedLock] r) => Compile.PipelineArg -> Sem r () writeCoreFile pa@Compile.PipelineArg {..} = do entryPoint <- Compile.getEntry pa coreFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile diff --git a/app/Commands/Dependencies.hs b/app/Commands/Dependencies.hs index 7df99cc17e..3375df48c2 100644 --- a/app/Commands/Dependencies.hs +++ b/app/Commands/Dependencies.hs @@ -8,6 +8,6 @@ import Commands.Base import Commands.Dependencies.Options import Commands.Dependencies.Update qualified as Update -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => DependenciesCommand -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => DependenciesCommand -> Sem r () runCommand = \case Update -> Update.runCommand diff --git a/app/Commands/Dependencies/Update.hs b/app/Commands/Dependencies/Update.hs index 04d05ea3e4..36ac5e2f9d 100644 --- a/app/Commands/Dependencies/Update.hs +++ b/app/Commands/Dependencies/Update.hs @@ -4,5 +4,5 @@ import Commands.Base import Juvix.Compiler.Pipeline.Loader.PathResolver import Juvix.Compiler.Pipeline.Setup -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => Sem r () runCommand = runPipelineSetup (entrySetup (set dependenciesConfigForceUpdateLockfile True defaultDependenciesConfig)) diff --git a/app/Commands/Dev.hs b/app/Commands/Dev.hs index 76fdacfe59..b9aefa09df 100644 --- a/app/Commands/Dev.hs +++ b/app/Commands/Dev.hs @@ -23,7 +23,7 @@ import Commands.Dev.Termination qualified as Termination import Commands.Dev.Tree qualified as Tree import Commands.Repl qualified as Repl -runCommand :: (Members '[Embed IO, App, TaggedLock] r) => DevCommand -> Sem r () +runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => DevCommand -> Sem r () runCommand = \case Highlight opts -> Highlight.runCommand opts Parse opts -> Parse.runCommand opts diff --git a/app/Commands/Dev/Asm.hs b/app/Commands/Dev/Asm.hs index 1945ec5bc7..d95f0d2ff7 100644 --- a/app/Commands/Dev/Asm.hs +++ b/app/Commands/Dev/Asm.hs @@ -6,7 +6,7 @@ import Commands.Dev.Asm.Options import Commands.Dev.Asm.Run as Run import Commands.Dev.Asm.Validate as Validate -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => AsmCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => AsmCommand -> Sem r () runCommand = \case Run opts -> Run.runCommand opts Validate opts -> Validate.runCommand opts diff --git a/app/Commands/Dev/Asm/Compile.hs b/app/Commands/Dev/Asm/Compile.hs index 3c01db6b7d..7d178284b9 100644 --- a/app/Commands/Dev/Asm/Compile.hs +++ b/app/Commands/Dev/Asm/Compile.hs @@ -8,7 +8,7 @@ import Juvix.Compiler.Backend qualified as Backend import Juvix.Compiler.Backend.C qualified as C import Juvix.Compiler.Reg.Pretty qualified as Reg -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => AsmCompileOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => AsmCompileOptions -> Sem r () runCommand opts = do file <- getFile s <- readFile (toFilePath file) diff --git a/app/Commands/Dev/Asm/Run.hs b/app/Commands/Dev/Asm/Run.hs index 56006bdbb5..a0aec556d5 100644 --- a/app/Commands/Dev/Asm/Run.hs +++ b/app/Commands/Dev/Asm/Run.hs @@ -5,7 +5,7 @@ import Commands.Base import Commands.Dev.Asm.Run.Options import Juvix.Compiler.Asm.Translation.FromSource qualified as Asm -runCommand :: forall r. (Members '[Embed IO, App] r) => AsmRunOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => AsmRunOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Asm/Validate.hs b/app/Commands/Dev/Asm/Validate.hs index f419b4d7bb..feea835f5b 100644 --- a/app/Commands/Dev/Asm/Validate.hs +++ b/app/Commands/Dev/Asm/Validate.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Asm.Pretty qualified as Asm import Juvix.Compiler.Asm.Transformation.Validate qualified as Asm import Juvix.Compiler.Asm.Translation.FromSource qualified as Asm -runCommand :: forall r. (Members '[Embed IO, App] r) => AsmValidateOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => AsmValidateOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Casm.hs b/app/Commands/Dev/Casm.hs index 85b2c68035..5f985ea378 100644 --- a/app/Commands/Dev/Casm.hs +++ b/app/Commands/Dev/Casm.hs @@ -5,7 +5,7 @@ import Commands.Dev.Casm.Options import Commands.Dev.Casm.Read as Read import Commands.Dev.Casm.Run as Run -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => CasmCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CasmCommand -> Sem r () runCommand = \case Run opts -> Run.runCommand opts Read opts -> Read.runCommand opts diff --git a/app/Commands/Dev/Casm/Read.hs b/app/Commands/Dev/Casm/Read.hs index e7df7f2e73..f240971b85 100644 --- a/app/Commands/Dev/Casm/Read.hs +++ b/app/Commands/Dev/Casm/Read.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Casm.Pretty qualified as Casm import Juvix.Compiler.Casm.Translation.FromSource qualified as Casm import Juvix.Compiler.Casm.Validate qualified as Casm -runCommand :: forall r. (Members '[Embed IO, App] r) => CasmReadOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => CasmReadOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Casm/Run.hs b/app/Commands/Dev/Casm/Run.hs index 7c168ae835..9095fddc04 100644 --- a/app/Commands/Dev/Casm/Run.hs +++ b/app/Commands/Dev/Casm/Run.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Casm.Interpreter qualified as Casm import Juvix.Compiler.Casm.Translation.FromSource qualified as Casm import Juvix.Compiler.Casm.Validate qualified as Casm -runCommand :: forall r. (Members '[Embed IO, App] r) => CasmRunOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => CasmRunOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Core.hs b/app/Commands/Dev/Core.hs index a3b8197f39..9aa3c34af8 100644 --- a/app/Commands/Dev/Core.hs +++ b/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 '[Embed IO, App, TaggedLock] r) => CoreCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CoreCommand -> Sem r () runCommand = \case Repl opts -> Repl.runCommand opts Eval opts -> Eval.runCommand opts diff --git a/app/Commands/Dev/Core/Asm.hs b/app/Commands/Dev/Core/Asm.hs index 16d77af866..e0128dbd4f 100644 --- a/app/Commands/Dev/Core/Asm.hs +++ b/app/Commands/Dev/Core/Asm.hs @@ -6,7 +6,7 @@ import Commands.Dev.Core.Asm.Options import Juvix.Compiler.Asm qualified as Asm import Juvix.Compiler.Core qualified as Core -runCommand :: forall r a. (Members '[Embed IO, App, TaggedLock] r, CanonicalProjection a CoreAsmOptions) => a -> Sem r () +runCommand :: forall r a. (Members '[EmbedIO, App, TaggedLock] r, CanonicalProjection a CoreAsmOptions) => a -> Sem r () runCommand opts = do inputFile :: Path Abs File <- fromAppPathFile sinputFile ep <- getEntryPoint sinputFile diff --git a/app/Commands/Dev/Core/Compile.hs b/app/Commands/Dev/Core/Compile.hs index 7d0910028e..32ecfc985d 100644 --- a/app/Commands/Dev/Core/Compile.hs +++ b/app/Commands/Dev/Core/Compile.hs @@ -6,7 +6,7 @@ import Commands.Dev.Core.Compile.Options import Juvix.Compiler.Core.Data.Module qualified as Core import Juvix.Compiler.Core.Translation.FromSource qualified as Core -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => CompileOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CompileOptions -> Sem r () runCommand opts = do file <- getFile s <- readFile (toFilePath file) diff --git a/app/Commands/Dev/Core/Compile/Base.hs b/app/Commands/Dev/Core/Compile/Base.hs index d0b306f60c..9aebe1ad9d 100644 --- a/app/Commands/Dev/Core/Compile/Base.hs +++ b/app/Commands/Dev/Core/Compile/Base.hs @@ -20,7 +20,7 @@ data PipelineArg = PipelineArg _pipelineArgModule :: Core.Module } -getEntry :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint +getEntry :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint getEntry PipelineArg {..} = do ep <- getEntryPoint (AppPath (preFileFromAbs _pipelineArgFile) True) return $ @@ -51,7 +51,7 @@ getEntry PipelineArg {..} = do runCPipeline :: forall r. - (Members '[Embed IO, App, TaggedLock] r) => + (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runCPipeline pa@PipelineArg {..} = do @@ -74,7 +74,7 @@ runCPipeline pa@PipelineArg {..} = do runGebPipeline :: forall r. - (Members '[Embed IO, App, TaggedLock] r) => + (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runGebPipeline pa@PipelineArg {..} = do @@ -93,7 +93,7 @@ runGebPipeline pa@PipelineArg {..} = do runVampIRPipeline :: forall r. - (Members '[Embed IO, App, TaggedLock] r) => + (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runVampIRPipeline pa@PipelineArg {..} = do @@ -102,7 +102,7 @@ runVampIRPipeline pa@PipelineArg {..} = do VampIR.Result {..} <- getRight (run (runReader entryPoint (runError (coreToVampIR _pipelineArgModule :: Sem '[Error JuvixError, Reader EntryPoint] VampIR.Result)))) writeFileEnsureLn vampirFile _resultCode -runAsmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runAsmPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runAsmPipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa asmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile @@ -115,7 +115,7 @@ runAsmPipeline pa@PipelineArg {..} = do let code = Asm.ppPrint tab' tab' writeFileEnsureLn asmFile code -runRegPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runRegPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runRegPipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa regFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile @@ -128,7 +128,7 @@ runRegPipeline pa@PipelineArg {..} = do let code = Reg.ppPrint tab' tab' writeFileEnsureLn regFile code -runTreePipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runTreePipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runTreePipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa treeFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile @@ -141,7 +141,7 @@ runTreePipeline pa@PipelineArg {..} = do let code = Tree.ppPrint tab' tab' writeFileEnsureLn treeFile code -runNockmaPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runNockmaPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runNockmaPipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa nockmaFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile diff --git a/app/Commands/Dev/Core/Eval.hs b/app/Commands/Dev/Core/Eval.hs index 16934f368f..bf2c70b522 100644 --- a/app/Commands/Dev/Core/Eval.hs +++ b/app/Commands/Dev/Core/Eval.hs @@ -5,7 +5,7 @@ import Commands.Dev.Core.Eval.Options import Evaluator import Juvix.Compiler.Core.Translation.FromSource qualified as Core -runCommand :: forall r. (Members '[Embed IO, App] r) => CoreEvalOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => CoreEvalOptions -> Sem r () runCommand opts = do f :: Path Abs File <- fromAppPathFile b s <- readFile (toFilePath f) diff --git a/app/Commands/Dev/Core/FromConcrete.hs b/app/Commands/Dev/Core/FromConcrete.hs index 9e5d5e0337..3885ce255c 100644 --- a/app/Commands/Dev/Core/FromConcrete.hs +++ b/app/Commands/Dev/Core/FromConcrete.hs @@ -11,7 +11,7 @@ import Juvix.Compiler.Core.Transformation qualified as Core import Juvix.Compiler.Core.Transformation.DisambiguateNames (disambiguateNames') import Juvix.Compiler.Core.Translation -runCommand :: forall r. (Members '[Embed IO, TaggedLock, App] r) => CoreFromConcreteOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, TaggedLock, App] r) => CoreFromConcreteOptions -> Sem r () runCommand localOpts = do gopts <- askGlobalOptions md <- (^. coreResultModule) <$> runPipeline (localOpts ^. coreFromConcreteInputFile) upToCore diff --git a/app/Commands/Dev/Core/Normalize.hs b/app/Commands/Dev/Core/Normalize.hs index 87a4df6742..44b6c48cf1 100644 --- a/app/Commands/Dev/Core/Normalize.hs +++ b/app/Commands/Dev/Core/Normalize.hs @@ -5,7 +5,7 @@ import Commands.Dev.Core.Normalize.Options import Evaluator import Juvix.Compiler.Core.Translation.FromSource qualified as Core -runCommand :: forall r. (Members '[Embed IO, App] r) => CoreNormalizeOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => CoreNormalizeOptions -> Sem r () runCommand opts = do f :: Path Abs File <- fromAppPathFile b s <- readFile (toFilePath f) diff --git a/app/Commands/Dev/Core/Read.hs b/app/Commands/Dev/Core/Read.hs index 3755871b0c..c556bbe761 100644 --- a/app/Commands/Dev/Core/Read.hs +++ b/app/Commands/Dev/Core/Read.hs @@ -12,7 +12,7 @@ import Juvix.Compiler.Core.Translation.FromSource qualified as Core runCommand :: forall r a. - ( Members '[Embed IO, App] r, + ( Members '[EmbedIO, App] r, CanonicalProjection a Eval.EvalOptions, CanonicalProjection a Pretty.Options, CanonicalProjection a CoreReadOptions diff --git a/app/Commands/Dev/Core/Repl.hs b/app/Commands/Dev/Core/Repl.hs index 06b39b5a2f..1007aed8c4 100644 --- a/app/Commands/Dev/Core/Repl.hs +++ b/app/Commands/Dev/Core/Repl.hs @@ -16,7 +16,7 @@ import Juvix.Compiler.Core.Transformation.DisambiguateNames qualified as Core import Juvix.Compiler.Core.Translation.FromSource qualified as Core import Juvix.Extra.Paths -runCommand :: forall r. (Members '[Embed IO, App] r) => CoreReplOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => CoreReplOptions -> Sem r () runCommand opts = do showReplWelcome runRepl opts mempty @@ -24,7 +24,7 @@ runCommand opts = do parseText :: Core.InfoTable -> Text -> Either Core.MegaparsecError (Core.InfoTable, Maybe Core.Node) parseText = Core.runParser replPath defaultModuleId -runRepl :: forall r. (Members '[Embed IO, App] r) => CoreReplOptions -> Core.InfoTable -> Sem r () +runRepl :: forall r. (Members '[EmbedIO, App] r) => CoreReplOptions -> Core.InfoTable -> Sem r () runRepl opts tab = do putStr "> " embed (hFlush stdout) @@ -132,7 +132,7 @@ runRepl opts tab = do putStrLn "" runRepl opts tab' -showReplWelcome :: (Members '[Embed IO, App] r) => Sem r () +showReplWelcome :: (Members '[EmbedIO, App] r) => Sem r () showReplWelcome = do putStrLn "JuvixCore REPL" putStrLn "" diff --git a/app/Commands/Dev/Core/Strip.hs b/app/Commands/Dev/Core/Strip.hs index 023880faac..986ae69eb5 100644 --- a/app/Commands/Dev/Core/Strip.hs +++ b/app/Commands/Dev/Core/Strip.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Core qualified as Core import Juvix.Compiler.Core.Pretty qualified as Core import Juvix.Compiler.Core.Translation.Stripped.FromCore qualified as Stripped -runCommand :: forall r a. (Members '[Embed IO, App] r, CanonicalProjection a Core.Options, CanonicalProjection a CoreStripOptions) => a -> Sem r () +runCommand :: forall r a. (Members '[EmbedIO, App] r, CanonicalProjection a Core.Options, CanonicalProjection a CoreStripOptions) => a -> Sem r () runCommand opts = do gopts <- askGlobalOptions inputFile :: Path Abs File <- fromAppPathFile sinputFile diff --git a/app/Commands/Dev/DisplayRoot.hs b/app/Commands/Dev/DisplayRoot.hs index bc6028fc3d..eab4db4b3b 100644 --- a/app/Commands/Dev/DisplayRoot.hs +++ b/app/Commands/Dev/DisplayRoot.hs @@ -4,7 +4,7 @@ import Commands.Base import Commands.Dev.DisplayRoot.Options import Commands.Extra.Package -runCommand :: forall r. (Members '[Embed IO, App] r) => RootOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => RootOptions -> Sem r () runCommand RootOptions {..} = do askPkgDir >>= say . pack . toFilePath when _rootPrintPackage printPackage diff --git a/app/Commands/Dev/Geb.hs b/app/Commands/Dev/Geb.hs index a701c88a3e..faec415833 100644 --- a/app/Commands/Dev/Geb.hs +++ b/app/Commands/Dev/Geb.hs @@ -12,7 +12,7 @@ import Commands.Dev.Geb.Options import Commands.Dev.Geb.Read as Read import Commands.Dev.Geb.Repl as Repl -runCommand :: forall r. (Members '[Embed IO, App] r) => GebCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => GebCommand -> Sem r () runCommand = \case GebCommandRepl opts -> Repl.runCommand opts GebCommandEval opts -> Eval.runCommand opts diff --git a/app/Commands/Dev/Geb/Check.hs b/app/Commands/Dev/Geb/Check.hs index b0dab8ed1d..8522a4212a 100644 --- a/app/Commands/Dev/Geb/Check.hs +++ b/app/Commands/Dev/Geb/Check.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Backend.Geb.Pretty runCommand :: forall r. - (Member App r, Member (Embed IO) r) => + (Member App r, Member EmbedIO r) => GebInferOptions -> Sem r () runCommand opts = do diff --git a/app/Commands/Dev/Geb/Eval.hs b/app/Commands/Dev/Geb/Eval.hs index 77a636364a..fe893a05f3 100644 --- a/app/Commands/Dev/Geb/Eval.hs +++ b/app/Commands/Dev/Geb/Eval.hs @@ -9,7 +9,7 @@ import Juvix.Compiler.Backend.Geb.Translation.FromSource qualified as Geb runCommand :: forall r a. - ( Members '[App, Embed IO] r, + ( Members '[App, EmbedIO] r, CanonicalProjection a Geb.EvaluatorOptions, CanonicalProjection a GebEvalOptions ) => @@ -28,7 +28,7 @@ runCommand opts = do evalAndPrint :: forall r a. - ( Members '[App, Embed IO] r, + ( Members '[App, EmbedIO] r, CanonicalProjection a Geb.EvaluatorOptions ) => a -> diff --git a/app/Commands/Dev/Geb/Infer.hs b/app/Commands/Dev/Geb/Infer.hs index b526ba6058..531607ef2c 100644 --- a/app/Commands/Dev/Geb/Infer.hs +++ b/app/Commands/Dev/Geb/Infer.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Backend.Geb qualified as Geb runCommand :: forall r. - (Member App r, Member (Embed IO) r) => + (Member App r, Member EmbedIO r) => GebInferOptions -> Sem r () runCommand opts = do diff --git a/app/Commands/Dev/Geb/Read.hs b/app/Commands/Dev/Geb/Read.hs index 941de5cbcf..501e87858e 100644 --- a/app/Commands/Dev/Geb/Read.hs +++ b/app/Commands/Dev/Geb/Read.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Backend.Geb.Translation.FromSource qualified as Geb runCommand :: forall r. - (Member App r, Member (Embed IO) r) => + (Member App r, Member EmbedIO r) => GebReadOptions -> Sem r () runCommand opts = do diff --git a/app/Commands/Dev/Geb/Repl.hs b/app/Commands/Dev/Geb/Repl.hs index 077da0a276..8331774cb7 100644 --- a/app/Commands/Dev/Geb/Repl.hs +++ b/app/Commands/Dev/Geb/Repl.hs @@ -31,7 +31,7 @@ data ReplState = ReplState makeLenses ''ReplState -runCommand :: (Members '[Embed IO, App] r) => GebReplOptions -> Sem r () +runCommand :: (Members '[EmbedIO, App] r) => GebReplOptions -> Sem r () runCommand replOpts = do invokeDir <- askInvokeDir root <- askRoot diff --git a/app/Commands/Dev/Highlight.hs b/app/Commands/Dev/Highlight.hs index bc3f386f0d..e6accaad07 100644 --- a/app/Commands/Dev/Highlight.hs +++ b/app/Commands/Dev/Highlight.hs @@ -5,7 +5,7 @@ import Commands.Dev.Highlight.Options import Juvix.Compiler.Concrete.Data.Highlight qualified as Highlight import Juvix.Compiler.Pipeline.Run -runCommand :: (Members '[Embed IO, App, TaggedLock] r) => HighlightOptions -> Sem r () +runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => HighlightOptions -> Sem r () runCommand HighlightOptions {..} = do entry <- getEntryPoint _highlightInputFile inputFile <- fromAppPathFile _highlightInputFile diff --git a/app/Commands/Dev/Internal.hs b/app/Commands/Dev/Internal.hs index 9ed0d2c340..30e3910559 100644 --- a/app/Commands/Dev/Internal.hs +++ b/app/Commands/Dev/Internal.hs @@ -5,7 +5,7 @@ import Commands.Dev.Internal.Options import Commands.Dev.Internal.Pretty qualified as Pretty import Commands.Dev.Internal.Typecheck qualified as Typecheck -runCommand :: (Members '[Embed IO, App, TaggedLock] r) => InternalCommand -> Sem r () +runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => InternalCommand -> Sem r () runCommand = \case Pretty opts -> Pretty.runCommand opts TypeCheck opts -> Typecheck.runCommand opts diff --git a/app/Commands/Dev/Internal/Pretty.hs b/app/Commands/Dev/Internal/Pretty.hs index f0a1522515..481d604e58 100644 --- a/app/Commands/Dev/Internal/Pretty.hs +++ b/app/Commands/Dev/Internal/Pretty.hs @@ -5,7 +5,7 @@ import Commands.Dev.Internal.Pretty.Options import Juvix.Compiler.Internal.Pretty qualified as Internal import Juvix.Compiler.Internal.Translation.FromConcrete qualified as Internal -runCommand :: (Members '[Embed IO, App, TaggedLock] r) => InternalPrettyOptions -> Sem r () +runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => InternalPrettyOptions -> Sem r () runCommand opts = do globalOpts <- askGlobalOptions intern <- (^. pipelineResult . Internal.resultModule) <$> runPipelineTermination (opts ^. internalPrettyInputFile) upToInternal diff --git a/app/Commands/Dev/Internal/Typecheck.hs b/app/Commands/Dev/Internal/Typecheck.hs index e8d3437e6a..7029633e2c 100644 --- a/app/Commands/Dev/Internal/Typecheck.hs +++ b/app/Commands/Dev/Internal/Typecheck.hs @@ -5,7 +5,7 @@ import Commands.Dev.Internal.Typecheck.Options import Juvix.Compiler.Internal.Pretty qualified as Internal import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qualified as InternalTyped -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => InternalTypeOptions -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => InternalTypeOptions -> Sem r () runCommand localOpts = do globalOpts <- askGlobalOptions res <- runPipeline (localOpts ^. internalTypeInputFile) upToInternalTyped diff --git a/app/Commands/Dev/MigrateJuvixYaml.hs b/app/Commands/Dev/MigrateJuvixYaml.hs index 71ba38ab39..05841d8fcf 100644 --- a/app/Commands/Dev/MigrateJuvixYaml.hs +++ b/app/Commands/Dev/MigrateJuvixYaml.hs @@ -5,7 +5,7 @@ import Commands.Dev.MigrateJuvixYaml.Options import Commands.Extra.Package import Juvix.Extra.Paths -runCommand :: forall r. (Members '[Embed IO, Files, App] r) => MigrateJuvixYamlOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, Files, App] r) => MigrateJuvixYamlOptions -> Sem r () runCommand MigrateJuvixYamlOptions {..} = do pkgDir <- askPkgDir isGlobalPackage <- askPackageGlobal diff --git a/app/Commands/Dev/Nockma.hs b/app/Commands/Dev/Nockma.hs index fedfd327b8..fba8fbb8e8 100644 --- a/app/Commands/Dev/Nockma.hs +++ b/app/Commands/Dev/Nockma.hs @@ -6,7 +6,7 @@ import Commands.Dev.Nockma.Format as Format import Commands.Dev.Nockma.Options import Commands.Dev.Nockma.Repl as Repl -runCommand :: forall r. (Members '[Embed IO, App] r) => NockmaCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaCommand -> Sem r () runCommand = \case NockmaRepl opts -> Repl.runCommand opts NockmaEval opts -> Eval.runCommand opts diff --git a/app/Commands/Dev/Nockma/Eval.hs b/app/Commands/Dev/Nockma/Eval.hs index cdaabf0fb6..64f4e05407 100644 --- a/app/Commands/Dev/Nockma/Eval.hs +++ b/app/Commands/Dev/Nockma/Eval.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Nockma.Evaluator.Options import Juvix.Compiler.Nockma.Pretty import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma -runCommand :: forall r. (Members '[Embed IO, App] r) => NockmaEvalOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaEvalOptions -> Sem r () runCommand opts = do afile <- fromAppPathFile file parsedTerm <- Nockma.parseTermFile (toFilePath afile) diff --git a/app/Commands/Dev/Nockma/Format.hs b/app/Commands/Dev/Nockma/Format.hs index 38c716ed52..a3150f548e 100644 --- a/app/Commands/Dev/Nockma/Format.hs +++ b/app/Commands/Dev/Nockma/Format.hs @@ -5,7 +5,7 @@ import Commands.Dev.Nockma.Format.Options import Juvix.Compiler.Nockma.Pretty import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma -runCommand :: forall r. (Members '[Embed IO, App] r) => NockmaFormatOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaFormatOptions -> Sem r () runCommand opts = do afile <- fromAppPathFile file parsedTerm <- Nockma.parseTermFile (toFilePath afile) diff --git a/app/Commands/Dev/Nockma/Repl.hs b/app/Commands/Dev/Nockma/Repl.hs index 5e2d387ed8..01751ef92d 100644 --- a/app/Commands/Dev/Nockma/Repl.hs +++ b/app/Commands/Dev/Nockma/Repl.hs @@ -167,7 +167,7 @@ replAction = banner } -runCommand :: forall r. (Members '[Embed IO, App] r) => NockmaReplOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaReplOptions -> Sem r () runCommand _ = embed . (`State.evalStateT` iniState) $ replAction where iniState :: ReplState diff --git a/app/Commands/Dev/Parse.hs b/app/Commands/Dev/Parse.hs index 1baeae5f29..22b7ce5eeb 100644 --- a/app/Commands/Dev/Parse.hs +++ b/app/Commands/Dev/Parse.hs @@ -5,7 +5,7 @@ import Commands.Dev.Parse.Options import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser import Text.Show.Pretty (ppShow) -runCommand :: (Members '[Embed IO, App, TaggedLock] r) => ParseOptions -> Sem r () +runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => ParseOptions -> Sem r () runCommand opts = do m <- (^. Parser.resultModule) diff --git a/app/Commands/Dev/Reg.hs b/app/Commands/Dev/Reg.hs index fb2b69d25d..6f47d7a4c7 100644 --- a/app/Commands/Dev/Reg.hs +++ b/app/Commands/Dev/Reg.hs @@ -4,6 +4,6 @@ import Commands.Base import Commands.Dev.Reg.Options import Commands.Dev.Reg.Read as Read -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => RegCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => RegCommand -> Sem r () runCommand = \case Read opts -> Read.runCommand opts diff --git a/app/Commands/Dev/Reg/Read.hs b/app/Commands/Dev/Reg/Read.hs index 6891082f7c..be14f7769f 100644 --- a/app/Commands/Dev/Reg/Read.hs +++ b/app/Commands/Dev/Reg/Read.hs @@ -5,7 +5,7 @@ import Commands.Dev.Reg.Read.Options import Juvix.Compiler.Reg.Pretty qualified as Reg import Juvix.Compiler.Reg.Translation.FromSource qualified as Reg -runCommand :: forall r. (Members '[Embed IO, App] r) => RegReadOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => RegReadOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Runtime.hs b/app/Commands/Dev/Runtime.hs index 9143327f93..0b0a61e516 100644 --- a/app/Commands/Dev/Runtime.hs +++ b/app/Commands/Dev/Runtime.hs @@ -4,6 +4,6 @@ import Commands.Base import Commands.Dev.Runtime.Compile as Compile import Commands.Dev.Runtime.Options -runCommand :: forall r. (Members '[Embed IO, App] r) => RuntimeCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => RuntimeCommand -> Sem r () runCommand = \case Compile opts -> Compile.runCommand opts diff --git a/app/Commands/Dev/Scope.hs b/app/Commands/Dev/Scope.hs index e51d0825cc..e73b081eb1 100644 --- a/app/Commands/Dev/Scope.hs +++ b/app/Commands/Dev/Scope.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Concrete.Print qualified as Print import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper import Juvix.Prelude.Pretty -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => ScopeOptions -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => ScopeOptions -> Sem r () runCommand opts = do globalOpts <- askGlobalOptions res :: Scoper.ScoperResult <- runPipeline (opts ^. scopeInputFile) upToScoping diff --git a/app/Commands/Dev/Termination.hs b/app/Commands/Dev/Termination.hs index 3c072f2326..c02a40a6bf 100644 --- a/app/Commands/Dev/Termination.hs +++ b/app/Commands/Dev/Termination.hs @@ -5,7 +5,7 @@ import Commands.Dev.Termination.CallGraph qualified as CallGraph import Commands.Dev.Termination.Calls qualified as Calls import Commands.Dev.Termination.Options -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => TerminationCommand -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => TerminationCommand -> Sem r () runCommand = \case Calls opts -> Calls.runCommand opts CallGraph opts -> CallGraph.runCommand opts diff --git a/app/Commands/Dev/Termination/CallGraph.hs b/app/Commands/Dev/Termination/CallGraph.hs index c580272066..473a38f52a 100644 --- a/app/Commands/Dev/Termination/CallGraph.hs +++ b/app/Commands/Dev/Termination/CallGraph.hs @@ -9,7 +9,7 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination qua import Juvix.Compiler.Store.Extra qualified as Stored import Juvix.Prelude.Pretty -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => CallGraphOptions -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => CallGraphOptions -> Sem r () runCommand CallGraphOptions {..} = do globalOpts <- askGlobalOptions PipelineResult {..} <- runPipelineTermination _graphInputFile upToInternal diff --git a/app/Commands/Dev/Termination/Calls.hs b/app/Commands/Dev/Termination/Calls.hs index a621400ded..adfceb094e 100644 --- a/app/Commands/Dev/Termination/Calls.hs +++ b/app/Commands/Dev/Termination/Calls.hs @@ -6,7 +6,7 @@ import Juvix.Compiler.Internal.Pretty qualified as Internal import Juvix.Compiler.Internal.Translation.FromConcrete qualified as Internal import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination qualified as Termination -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => CallsOptions -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => CallsOptions -> Sem r () runCommand localOpts@CallsOptions {..} = do globalOpts <- askGlobalOptions PipelineResult {..} <- runPipelineTermination _callsInputFile upToInternal diff --git a/app/Commands/Dev/Tree.hs b/app/Commands/Dev/Tree.hs index 696ec1e351..6aa36ce271 100644 --- a/app/Commands/Dev/Tree.hs +++ b/app/Commands/Dev/Tree.hs @@ -8,7 +8,7 @@ import Commands.Dev.Tree.Options import Commands.Dev.Tree.Read as Read import Commands.Dev.Tree.Repl as Repl -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => TreeCommand -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => TreeCommand -> Sem r () runCommand = \case Eval opts -> Eval.runCommand opts Compile opts -> Compile.runCommand opts diff --git a/app/Commands/Dev/Tree/Compile.hs b/app/Commands/Dev/Tree/Compile.hs index 2da5742745..dfdded0bc6 100644 --- a/app/Commands/Dev/Tree/Compile.hs +++ b/app/Commands/Dev/Tree/Compile.hs @@ -5,7 +5,7 @@ import Commands.Dev.Tree.Compile.Base import Commands.Dev.Tree.Compile.Options import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => CompileOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CompileOptions -> Sem r () runCommand opts = do file <- getFile s <- readFile (toFilePath file) diff --git a/app/Commands/Dev/Tree/Compile/Base.hs b/app/Commands/Dev/Tree/Compile/Base.hs index 2368d43866..f3977d6ec8 100644 --- a/app/Commands/Dev/Tree/Compile/Base.hs +++ b/app/Commands/Dev/Tree/Compile/Base.hs @@ -16,7 +16,7 @@ data PipelineArg = PipelineArg _pipelineArgTable :: Tree.InfoTable } -getEntry :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint +getEntry :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint getEntry PipelineArg {..} = do ep <- getEntryPoint (AppPath (preFileFromAbs _pipelineArgFile) True) return $ @@ -47,7 +47,7 @@ getEntry PipelineArg {..} = do runCPipeline :: forall r. - (Members '[Embed IO, App, TaggedLock] r) => + (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runCPipeline pa@PipelineArg {..} = do @@ -73,7 +73,7 @@ runCPipeline pa@PipelineArg {..} = do ensureDir buildDir return (buildDir replaceExtension' ".c" (filename inputFileCompile)) -runAsmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runAsmPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runAsmPipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa asmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile @@ -86,7 +86,7 @@ runAsmPipeline pa@PipelineArg {..} = do let code = Asm.ppPrint tab' tab' writeFileEnsureLn asmFile code -runRegPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runRegPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runRegPipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa regFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile @@ -99,7 +99,7 @@ runRegPipeline pa@PipelineArg {..} = do let code = Reg.ppPrint tab' tab' writeFileEnsureLn regFile code -runNockmaPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runNockmaPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r () runNockmaPipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa nockmaFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile diff --git a/app/Commands/Dev/Tree/Eval.hs b/app/Commands/Dev/Tree/Eval.hs index bb86374dab..b43f5a4baf 100644 --- a/app/Commands/Dev/Tree/Eval.hs +++ b/app/Commands/Dev/Tree/Eval.hs @@ -5,7 +5,7 @@ import Commands.Dev.Tree.Eval.Options import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree import TreeEvaluator -runCommand :: forall r. (Members '[Embed IO, App] r) => TreeEvalOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => TreeEvalOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Tree/FromAsm.hs b/app/Commands/Dev/Tree/FromAsm.hs index 16f0de6942..23f089737c 100644 --- a/app/Commands/Dev/Tree/FromAsm.hs +++ b/app/Commands/Dev/Tree/FromAsm.hs @@ -8,7 +8,7 @@ import Juvix.Compiler.Tree.Error (TreeError) import Juvix.Compiler.Tree.Pretty qualified as Tree import Juvix.Compiler.Tree.Translation.FromAsm qualified as Tree -runCommand :: forall r. (Members '[Embed IO, App] r) => TreeFromAsmOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => TreeFromAsmOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Tree/Read.hs b/app/Commands/Dev/Tree/Read.hs index 8b5fb45a86..05fec105be 100644 --- a/app/Commands/Dev/Tree/Read.hs +++ b/app/Commands/Dev/Tree/Read.hs @@ -8,7 +8,7 @@ import Juvix.Compiler.Tree.Transformation qualified as Tree import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree import TreeEvaluator qualified as Eval -runCommand :: forall r. (Members '[Embed IO, App] r) => TreeReadOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => TreeReadOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file s <- readFile (toFilePath afile) diff --git a/app/Commands/Dev/Tree/Repl.hs b/app/Commands/Dev/Tree/Repl.hs index d6141fb582..296eec39fb 100644 --- a/app/Commands/Dev/Tree/Repl.hs +++ b/app/Commands/Dev/Tree/Repl.hs @@ -127,7 +127,7 @@ replAction = banner } -runCommand :: forall r. (Members '[Embed IO, App] r) => TreeReplOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => TreeReplOptions -> Sem r () runCommand _ = embed . (`State.evalStateT` iniState) $ replAction where iniState :: ReplState diff --git a/app/Commands/Doctor.hs b/app/Commands/Doctor.hs index f771c60056..3255c6c668 100644 --- a/app/Commands/Doctor.hs +++ b/app/Commands/Doctor.hs @@ -68,7 +68,7 @@ warning = log . (" ! " <>) info :: (Member Log r) => Text -> Sem r () info = log . (" | " <>) -type DoctorEff = '[Log, Embed IO, App] +type DoctorEff = '[Log, EmbedIO, App] checkCmdOnPath :: (Members DoctorEff r) => String -> [Text] -> Sem r () checkCmdOnPath cmd errMsg = @@ -101,7 +101,7 @@ checkEnvVarSet :: (Members DoctorEff r) => String -> [Text] -> Sem r () checkEnvVarSet var errMsg = do whenM (isNothing <$> embed (E.lookupEnv var)) (mapM_ warning errMsg) -getLatestRelease :: (Members '[Embed IO, Fail] r) => Sem r GithubRelease +getLatestRelease :: (Members '[EmbedIO, Fail] r) => Sem r GithubRelease getLatestRelease = do request' <- failFromException (parseRequest "https://api.github.com/repos/anoma/juvix/releases/latest") let request = setRequestHeaders [("user-agent", "curl/7.79.1"), ("Accept", "application/vnd.github+json")] request' diff --git a/app/Commands/Eval.hs b/app/Commands/Eval.hs index 5d2efe0c03..9b763b782e 100644 --- a/app/Commands/Eval.hs +++ b/app/Commands/Eval.hs @@ -6,7 +6,7 @@ import Evaluator qualified as Eval import Juvix.Compiler.Core qualified as Core import Juvix.Extra.Strings qualified as Str -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => EvalOptions -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => EvalOptions -> Sem r () runCommand opts@EvalOptions {..} = do gopts <- askGlobalOptions Core.CoreResult {..} <- runPipeline _evalInputFile upToCore diff --git a/app/Commands/Extra/Compile.hs b/app/Commands/Extra/Compile.hs index 755837b896..5c244eb461 100644 --- a/app/Commands/Extra/Compile.hs +++ b/app/Commands/Extra/Compile.hs @@ -8,7 +8,7 @@ import Juvix.Extra.Paths import System.Environment import System.Process qualified as P -runCommand :: forall r. (Members '[Embed IO, App] r) => CompileOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App] r) => CompileOptions -> Sem r () runCommand opts = do inputFile <- getMainFile (opts ^. compileInputFile) result <- runCompile inputFile opts @@ -17,7 +17,7 @@ runCommand opts = do _ -> return () runCompile :: - (Members '[App, Embed IO] r) => + (Members '[App, EmbedIO] r) => Path Abs File -> CompileOptions -> Sem r (Either Text ()) @@ -37,7 +37,7 @@ runCompile inputFile o = do TargetTree -> return (Right ()) TargetNockma -> return (Right ()) -prepareRuntime :: forall r. (Members '[App, Embed IO] r) => Path Abs Dir -> CompileOptions -> Sem r () +prepareRuntime :: forall r. (Members '[App, EmbedIO] r) => Path Abs Dir -> CompileOptions -> Sem r () prepareRuntime buildDir o = do mapM_ writeHeader headersDir case o ^. compileTarget of @@ -120,7 +120,7 @@ outputFile opts inputFile = clangNativeCompile :: forall r. - (Members '[App, Embed IO, Error Text] r) => + (Members '[App, EmbedIO, Error Text] r) => Path Abs File -> CompileOptions -> Sem r () @@ -135,7 +135,7 @@ clangNativeCompile inputFile o = do clangWasmWasiCompile :: forall r. - (Members '[App, Embed IO, Error Text] r) => + (Members '[App, EmbedIO, Error Text] r) => Path Abs File -> CompileOptions -> Sem r () @@ -223,16 +223,16 @@ wasiArgs buildDir o outfile inputFile sysrootPath = | otherwise -> [] ) -findClangOnPath :: (Member (Embed IO) r) => Sem r (Maybe (Path Abs File)) +findClangOnPath :: (Member EmbedIO r) => Sem r (Maybe (Path Abs File)) findClangOnPath = findExecutable $(mkRelFile "clang") -findClangUsingEnvVar :: forall r. (Member (Embed IO) r) => Sem r (Maybe (Path Abs File)) +findClangUsingEnvVar :: forall r. (Member EmbedIO r) => Sem r (Maybe (Path Abs File)) findClangUsingEnvVar = do p <- clangBinPath join <$> mapM checkExecutable p where checkExecutable :: Path Abs File -> Sem r (Maybe (Path Abs File)) - checkExecutable p = whenMaybeM (embed @IO (isExecutable p)) (return p) + checkExecutable p = whenMaybeM (embed (isExecutable p)) (return p) clangBinPath :: Sem r (Maybe (Path Abs File)) clangBinPath = fmap ( $(mkRelFile "bin/clang")) <$> llvmDistPath @@ -240,7 +240,7 @@ findClangUsingEnvVar = do llvmDistPath :: Sem r (Maybe (Path Abs Dir)) llvmDistPath = do p <- embed (lookupEnv llvmDistEnvironmentVar) - embed @IO (mapM parseAbsDir p) + embed (mapM parseAbsDir p) data ClangPath = ClangSystemPath (Path Abs File) @@ -252,7 +252,7 @@ extractClangPath = \case ClangEnvVarPath p -> p --- Try searching clang JUVIX_LLVM_DIST_PATH. Otherwise use the PATH -findClang :: (Member (Embed IO) r) => Sem r (Maybe ClangPath) +findClang :: (Member EmbedIO r) => Sem r (Maybe ClangPath) findClang = do envVarPath <- findClangUsingEnvVar case envVarPath of @@ -261,7 +261,7 @@ findClang = do runClang :: forall r. - (Members '[Embed IO, Error Text] r) => + (Members '[EmbedIO, Error Text] r) => [String] -> Sem r () runClang args = do diff --git a/app/Commands/Extra/Package.hs b/app/Commands/Extra/Package.hs index 1244e3fc1f..e7fb207e62 100644 --- a/app/Commands/Extra/Package.hs +++ b/app/Commands/Extra/Package.hs @@ -8,14 +8,14 @@ import Juvix.Prelude renderPackage :: Package -> Text renderPackage = renderPackageVersion currentPackageVersion -writePackageFile' :: (Member (Embed IO) r) => PackageVersion -> Path Abs Dir -> Package -> Sem r () +writePackageFile' :: (Member EmbedIO r) => PackageVersion -> Path Abs Dir -> Package -> Sem r () writePackageFile' v root pkg = writeFileEnsureLn (root packageFilePath) (renderPackageVersion v pkg) -writePackageFile :: (Member (Embed IO) r) => Path Abs Dir -> Package -> Sem r () +writePackageFile :: (Member EmbedIO r) => Path Abs Dir -> Package -> Sem r () writePackageFile = writePackageFile' currentPackageVersion -writeBasicPackage :: (Member (Embed IO) r) => Path Abs Dir -> Sem r () +writeBasicPackage :: (Member EmbedIO r) => Path Abs Dir -> Sem r () writeBasicPackage root = writePackageFile' PackageBasic root (emptyPackage DefaultBuildDir (root packageFilePath)) diff --git a/app/Commands/Format.hs b/app/Commands/Format.hs index 4f7be3a790..ed499b0ebd 100644 --- a/app/Commands/Format.hs +++ b/app/Commands/Format.hs @@ -24,7 +24,7 @@ isTargetProject = \case TargetProject {} -> True _ -> False -targetFromOptions :: (Members '[Embed IO, App] r) => FormatOptions -> Sem r FormatTarget +targetFromOptions :: (Members '[EmbedIO, App] r) => FormatOptions -> Sem r FormatTarget targetFromOptions opts = do globalOpts <- askGlobalOptions let isStdin = globalOpts ^. globalStdin @@ -45,7 +45,7 @@ targetFromOptions opts = do "Use the --help option to display more usage information." ] -runCommand :: forall r. (Members '[Embed IO, App, TaggedLock, Resource, Files] r) => FormatOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock, Resource, Files] r) => FormatOptions -> Sem r () runCommand opts = do target <- targetFromOptions opts runOutputSem (renderFormattedOutput target opts) $ runScopeFileApp $ do @@ -82,7 +82,7 @@ renderModeFromOptions target opts formattedInfo | formattedInfo ^. formattedFileInfoContentsModified = res | otherwise = NoEdit Silent -renderFormattedOutput :: forall r. (Members '[Embed IO, App, Resource, Files] r) => FormatTarget -> FormatOptions -> FormattedFileInfo -> Sem r () +renderFormattedOutput :: forall r. (Members '[EmbedIO, App, Resource, Files] r) => FormatTarget -> FormatOptions -> FormattedFileInfo -> Sem r () renderFormattedOutput target opts fInfo = do let renderMode = renderModeFromOptions target opts fInfo outputResult renderMode @@ -98,7 +98,7 @@ renderFormattedOutput target opts fInfo = do InputPath p -> say (pack (toFilePath p)) Silent -> return () -runScopeFileApp :: (Members '[App, Embed IO, TaggedLock] r) => Sem (ScopeEff ': r) a -> Sem r a +runScopeFileApp :: (Members '[App, EmbedIO, TaggedLock] r) => Sem (ScopeEff ': r) a -> Sem r a runScopeFileApp = interpret $ \case ScopeFile p -> do let appFile = diff --git a/app/Commands/Html.hs b/app/Commands/Html.hs index e95d861d23..36c8d21630 100644 --- a/app/Commands/Html.hs +++ b/app/Commands/Html.hs @@ -14,7 +14,7 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Da import Juvix.Extra.Process import System.Process qualified as Process -runGenOnlySourceHtml :: (Members '[Embed IO, TaggedLock, App] r) => HtmlOptions -> Sem r () +runGenOnlySourceHtml :: (Members '[EmbedIO, TaggedLock, App] r) => HtmlOptions -> Sem r () runGenOnlySourceHtml HtmlOptions {..} = do res <- runPipeline _htmlInputFile upToScoping let m = res ^. Scoper.resultModule @@ -48,7 +48,7 @@ resultToJudocCtx res = where sres = res ^. resultInternal . resultScoper -runCommand :: forall r. (Members '[Embed IO, TaggedLock, App] r) => HtmlOptions -> Sem r () +runCommand :: forall r. (Members '[EmbedIO, TaggedLock, App] r) => HtmlOptions -> Sem r () runCommand HtmlOptions {..} | _htmlOnlySource = runGenOnlySourceHtml HtmlOptions {..} | otherwise = do diff --git a/app/Commands/Init.hs b/app/Commands/Init.hs index 5fb0704232..01520d883e 100644 --- a/app/Commands/Init.hs +++ b/app/Commands/Init.hs @@ -23,7 +23,7 @@ parse p t = mapLeft ppErr (P.runParser p "" t) ppErr :: P.ParseErrorBundle Text Void -> Text ppErr = pack . errorBundlePretty -init :: forall r. (Members '[Embed IO] r) => InitOptions -> Sem r () +init :: forall r. (Members '[EmbedIO] r) => InitOptions -> Sem r () init opts = do checkNotInProject cwd <- getCurrentDir @@ -50,7 +50,7 @@ init opts = do isInteractive :: Bool isInteractive = not (opts ^. initOptionsNonInteractive) && not (opts ^. initOptionsBasic) -checkNotInProject :: forall r. (Members '[Embed IO] r) => Sem r () +checkNotInProject :: forall r. (Members '[EmbedIO] r) => Sem r () checkNotInProject = whenM (orM [doesFileExist juvixYamlFile, doesFileExist packageFilePath]) err where @@ -59,7 +59,7 @@ checkNotInProject = say "You are already in a Juvix project" embed exitFailure -checkPackage :: forall r. (Members '[Embed IO] r) => Sem r () +checkPackage :: forall r. (Members '[EmbedIO] r) => Sem r () checkPackage = do cwd <- getCurrentDir ep <- runError @JuvixError (runTaggedLockPermissive (loadPackageFileIO cwd DefaultBuildDir)) @@ -69,7 +69,7 @@ checkPackage = do embed exitFailure Right {} -> return () -getPackage :: forall r. (Members '[Embed IO] r) => Sem r Package +getPackage :: forall r. (Members '[EmbedIO] r) => Sem r Package getPackage = do tproj <- getProjName say "Write the version of your project [leave empty for 0.0.0]" @@ -86,12 +86,12 @@ getPackage = do _packageLockfile = Nothing } -getDefaultProjectName :: (Member (Embed IO) r) => Sem r (Maybe Text) +getDefaultProjectName :: (Member EmbedIO r) => Sem r (Maybe Text) getDefaultProjectName = runFail $ do dir <- map toLower . dropTrailingPathSeparator . toFilePath . dirname <$> getCurrentDir Fail.fromRight (parse projectNameParser (pack dir)) -getProjName :: forall r. (Members '[Embed IO] r) => Sem r Text +getProjName :: forall r. (Members '[EmbedIO] r) => Sem r Text getProjName = do d <- getDefaultProjectName let defMsg :: Text @@ -129,13 +129,13 @@ getProjName = do tryAgain go -say :: (Members '[Embed IO] r) => Text -> Sem r () +say :: (Members '[EmbedIO] r) => Text -> Sem r () say = putStrLn -tryAgain :: (Members '[Embed IO] r) => Sem r () +tryAgain :: (Members '[EmbedIO] r) => Sem r () tryAgain = say "Please, try again:" -getVersion :: forall r. (Members '[Embed IO] r) => Sem r SemVer +getVersion :: forall r. (Members '[EmbedIO] r) => Sem r SemVer getVersion = do txt <- embed getLine if diff --git a/app/Commands/Markdown.hs b/app/Commands/Markdown.hs index d77de0de7e..a90f4b8400 100644 --- a/app/Commands/Markdown.hs +++ b/app/Commands/Markdown.hs @@ -12,7 +12,7 @@ import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified import Juvix.Extra.Assets (writeAssets) runCommand :: - (Members '[Embed IO, TaggedLock, App] r) => + (Members '[EmbedIO, TaggedLock, App] r) => MarkdownOptions -> Sem r () runCommand opts = do diff --git a/app/Commands/Repl.hs b/app/Commands/Repl.hs index 942cef7022..5ac5760680 100644 --- a/app/Commands/Repl.hs +++ b/app/Commands/Repl.hs @@ -490,7 +490,7 @@ printRoot _ = do r <- State.gets (^. replStateRoot . rootRootDir) liftIO $ putStrLn (pack (toFilePath r)) -runCommand :: (Members '[Embed IO, App, TaggedLock] r) => ReplOptions -> Sem r () +runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => ReplOptions -> Sem r () runCommand opts = do root <- askRoot pkg <- askPackage diff --git a/app/Commands/Typecheck.hs b/app/Commands/Typecheck.hs index 39387b56ec..b7006342b8 100644 --- a/app/Commands/Typecheck.hs +++ b/app/Commands/Typecheck.hs @@ -3,7 +3,7 @@ module Commands.Typecheck where import Commands.Base import Commands.Typecheck.Options -runCommand :: (Members '[Embed IO, TaggedLock, App] r) => TypecheckOptions -> Sem r () +runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => TypecheckOptions -> Sem r () runCommand localOpts = do void (runPipeline (localOpts ^. typecheckInputFile) upToCoreTypecheck) say "Well done! It type checks" diff --git a/app/Evaluator.hs b/app/Evaluator.hs index d0bcb89c92..79c48ffca1 100644 --- a/app/Evaluator.hs +++ b/app/Evaluator.hs @@ -29,7 +29,7 @@ doEvalIO noIO i tab node = runM (Core.doEval noIO i tab node) evalAndPrint :: forall r a. - (Members '[Embed IO, App] r, CanonicalProjection a EvalOptions, CanonicalProjection a Core.Options) => + (Members '[EmbedIO, App] r, CanonicalProjection a EvalOptions, CanonicalProjection a Core.Options) => a -> Core.InfoTable -> Core.Node -> @@ -59,7 +59,7 @@ evalAndPrint opts tab node = do normalizeAndPrint :: forall r a. - (Members '[Embed IO, App] r, CanonicalProjection a EvalOptions, CanonicalProjection a Core.Options) => + (Members '[EmbedIO, App] r, CanonicalProjection a EvalOptions, CanonicalProjection a Core.Options) => a -> Core.InfoTable -> Core.Node -> diff --git a/app/GlobalOptions.hs b/app/GlobalOptions.hs index d0b710ef20..30771bee4b 100644 --- a/app/GlobalOptions.hs +++ b/app/GlobalOptions.hs @@ -142,12 +142,12 @@ parseBuildDir m = do ) pure AppPath {_pathIsInput = False, ..} -entryPointFromGlobalOptionsPre :: (Members '[TaggedLock, Embed IO] r) => Root -> Prepath File -> GlobalOptions -> Sem r EntryPoint +entryPointFromGlobalOptionsPre :: (Members '[TaggedLock, EmbedIO] r) => Root -> Prepath File -> GlobalOptions -> Sem r EntryPoint entryPointFromGlobalOptionsPre root premainFile opts = do mainFile <- liftIO (prepathToAbsFile (root ^. rootInvokeDir) premainFile) entryPointFromGlobalOptions root mainFile opts -entryPointFromGlobalOptions :: (Members '[TaggedLock, Embed IO] r) => Root -> Path Abs File -> GlobalOptions -> Sem r EntryPoint +entryPointFromGlobalOptions :: (Members '[TaggedLock, EmbedIO] r) => Root -> Path Abs File -> GlobalOptions -> Sem r EntryPoint entryPointFromGlobalOptions root mainFile opts = do mabsBuildDir :: Maybe (Path Abs Dir) <- liftIO (mapM (prepathToAbsDir cwd) optBuildDir) pkg <- readPackageRootIO root @@ -169,7 +169,7 @@ entryPointFromGlobalOptions root mainFile opts = do optBuildDir = fmap (^. pathPath) (opts ^. globalBuildDir) cwd = root ^. rootInvokeDir -entryPointFromGlobalOptionsNoFile :: (Members '[Embed IO, TaggedLock] r, MonadIO (Sem r)) => Root -> GlobalOptions -> Sem r EntryPoint +entryPointFromGlobalOptionsNoFile :: (Members '[EmbedIO, TaggedLock] r, MonadIO (Sem r)) => Root -> GlobalOptions -> Sem r EntryPoint entryPointFromGlobalOptionsNoFile root opts = do mabsBuildDir :: Maybe (Path Abs Dir) <- mapM (prepathToAbsDir cwd) optBuildDir pkg <- readPackageRootIO root diff --git a/app/TopCommand.hs b/app/TopCommand.hs index 4abae2ab5b..5a7f902616 100644 --- a/app/TopCommand.hs +++ b/app/TopCommand.hs @@ -25,7 +25,7 @@ showHelpText = do (msg, _) = renderFailure helpText progn putStrLn (pack msg) -runTopCommand :: forall r. (Members '[Embed IO, App, Resource, TaggedLock] r) => TopCommand -> Sem r () +runTopCommand :: forall r. (Members '[EmbedIO, App, Resource, TaggedLock] r) => TopCommand -> Sem r () runTopCommand = \case DisplayVersion -> embed runDisplayVersion DisplayNumericVersion -> embed runDisplayNumericVersion diff --git a/app/TreeEvaluator.hs b/app/TreeEvaluator.hs index eaa1a9cd6a..db64f6e944 100644 --- a/app/TreeEvaluator.hs +++ b/app/TreeEvaluator.hs @@ -15,7 +15,7 @@ import Juvix.Compiler.Tree.EvaluatorSem qualified as TreeSem import Juvix.Compiler.Tree.Language.Value qualified as Tree import Juvix.Compiler.Tree.Pretty qualified as Tree -evalTree :: forall r. (Members '[Embed IO, App] r) => Evaluator -> Tree.InfoTable -> Sem r () +evalTree :: forall r. (Members '[EmbedIO, App] r) => Evaluator -> Tree.InfoTable -> Sem r () evalTree ev tab = case tab ^. Tree.infoMainFunction of Just sym -> do diff --git a/src/Juvix/Compiler/Asm/Interpreter/Runtime.hs b/src/Juvix/Compiler/Asm/Interpreter/Runtime.hs index f183bbe8e2..008a2b1401 100644 --- a/src/Juvix/Compiler/Asm/Interpreter/Runtime.hs +++ b/src/Juvix/Compiler/Asm/Interpreter/Runtime.hs @@ -113,11 +113,11 @@ runRuntime tab = runState (RuntimeState (CallStack []) emptyFrame [] Nothing tab let logs = reverse (s ^. runtimeMessages) in map' (\x -> Debug.trace (fromText x) ()) logs `GHC.seq` () -hEvalRuntime :: forall r a. (Member (Embed IO) r) => Handle -> InfoTable -> Sem (Runtime ': r) a -> Sem r a +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)) return a -evalRuntime :: forall r a. (Member (Embed IO) r) => InfoTable -> Sem (Runtime ': r) a -> Sem r a +evalRuntime :: forall r a. (Member EmbedIO r) => InfoTable -> Sem (Runtime ': r) a -> Sem r a evalRuntime = hEvalRuntime stdout diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs index 9239b0b4ca..ff19ebfbb2 100644 --- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs +++ b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs @@ -96,7 +96,7 @@ indexFileName = $(mkRelFile "index.html") createIndexFile :: forall r. - (Members '[Embed IO, Reader HtmlOptions, Reader EntryPoint] r) => + (Members '[EmbedIO, Reader HtmlOptions, Reader EntryPoint] r) => [TopModulePath] -> Sem r () createIndexFile ps = do @@ -168,7 +168,7 @@ createIndexFile ps = do $ summary row' <> ul (mconcatMap li c') -writeHtml :: (Members '[Embed IO] r) => Path Abs File -> Html -> Sem r () +writeHtml :: (Members '[EmbedIO] r) => Path Abs File -> Html -> Sem r () writeHtml f h = Prelude.embed $ do ensureDir dir Builder.writeFile (toFilePath f) (Html.renderHtmlBuilder h) @@ -176,7 +176,7 @@ writeHtml f h = Prelude.embed $ do dir :: Path Abs Dir dir = parent f -genJudocHtml :: (Members '[Embed IO] r) => EntryPoint -> JudocArgs -> Sem r () +genJudocHtml :: (Members '[EmbedIO] r) => EntryPoint -> JudocArgs -> Sem r () genJudocHtml entry JudocArgs {..} = runReader htmlOpts . runReader normTable . runReader entry $ do Prelude.embed (writeAssets _judocArgsOutputDir) @@ -280,7 +280,7 @@ template rightMenu' content' = do -- | This function compiles a module into Html documentation. goTopModule :: forall r. - (Members '[Reader HtmlOptions, Embed IO, Reader EntryPoint, Reader NormalizedTable] r) => + (Members '[Reader HtmlOptions, EmbedIO, Reader EntryPoint, Reader NormalizedTable] r) => Comments -> Module 'Scoped 'ModuleTop -> Sem r () @@ -298,7 +298,7 @@ goTopModule cs m = do tmp :: TopModulePath tmp = m ^. modulePath . S.nameConcrete - srcHtml :: forall s. (Members '[Reader HtmlOptions, Embed IO] s) => Sem s Html + srcHtml :: forall s. (Members '[Reader HtmlOptions, EmbedIO] s) => Sem s Html srcHtml = do utc <- Prelude.embed getCurrentTime genModuleHtml diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index 1027eca4df..ef02a0bad4 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -43,7 +43,7 @@ import Juvix.Data.Effect.Process import Juvix.Data.Effect.TaggedLock import Juvix.Prelude -type PipelineAppEffects = '[TaggedLock, Embed IO, Resource, Final IO] +type PipelineAppEffects = '[TaggedLock, EmbedIO, Resource, Final IO] type PipelineLocalEff = '[PathResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, Reader EntryPoint, Files, Error JuvixError, HighlightBuilder, Internet] diff --git a/src/Juvix/Compiler/Pipeline/EntryPoint/IO.hs b/src/Juvix/Compiler/Pipeline/EntryPoint/IO.hs index f793b05c01..f08dd93765 100644 --- a/src/Juvix/Compiler/Pipeline/EntryPoint/IO.hs +++ b/src/Juvix/Compiler/Pipeline/EntryPoint/IO.hs @@ -5,13 +5,13 @@ import Juvix.Compiler.Pipeline.Root import Juvix.Data.Effect.TaggedLock import Juvix.Prelude -defaultEntryPointIO :: (Members '[Embed IO, TaggedLock, Final IO] r) => Path Abs Dir -> Path Abs File -> Sem r EntryPoint +defaultEntryPointIO :: (Members '[EmbedIO, TaggedLock, Final IO] r) => Path Abs Dir -> Path Abs File -> Sem r EntryPoint defaultEntryPointIO cwd mainFile = do root <- findRootAndChangeDir (Just (parent mainFile)) Nothing cwd pkg <- readPackageRootIO root return (defaultEntryPoint pkg root mainFile) -defaultEntryPointNoFileIO :: (Members '[Embed IO, TaggedLock, Final IO] r) => Path Abs Dir -> Sem r EntryPoint +defaultEntryPointNoFileIO :: (Members '[EmbedIO, TaggedLock, Final IO] r) => Path Abs Dir -> Sem r EntryPoint defaultEntryPointNoFileIO cwd = do root <- findRootAndChangeDir Nothing Nothing cwd pkg <- readPackageRootIO root diff --git a/src/Juvix/Compiler/Pipeline/Package/IO.hs b/src/Juvix/Compiler/Pipeline/Package/IO.hs index 0601e680cc..6a60f7a7f6 100644 --- a/src/Juvix/Compiler/Pipeline/Package/IO.hs +++ b/src/Juvix/Compiler/Pipeline/Package/IO.hs @@ -11,14 +11,14 @@ import Juvix.Compiler.Pipeline.Package.Loader.EvalEff.IO import Juvix.Data.Effect.TaggedLock import Juvix.Prelude -loadPackageFileIO :: (Members '[TaggedLock, Error JuvixError, Embed IO] r) => Path Abs Dir -> BuildDir -> Sem r Package +loadPackageFileIO :: (Members '[TaggedLock, Error JuvixError, EmbedIO] r) => Path Abs Dir -> BuildDir -> Sem r Package loadPackageFileIO root buildDir = runFilesIO . mapError (JuvixError @PackageLoaderError) . runEvalFileEffIO $ loadPackage buildDir (mkPackagePath root) -readPackageIO :: (Members '[TaggedLock, Embed IO] r) => Path Abs Dir -> BuildDir -> Sem r Package +readPackageIO :: (Members '[TaggedLock, EmbedIO] r) => Path Abs Dir -> BuildDir -> Sem r Package readPackageIO root buildDir = runFilesIO . runErrorIO' @JuvixError @@ -26,7 +26,7 @@ readPackageIO root buildDir = . runEvalFileEffIO $ readPackage root buildDir -readGlobalPackageIO :: (Members '[Embed IO, TaggedLock] r) => Sem r Package +readGlobalPackageIO :: (Members '[EmbedIO, TaggedLock] r) => Sem r Package readGlobalPackageIO = runFilesIO . runErrorIO' @JuvixError diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs index 3ec8bd40c2..5c4aa27f57 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs @@ -27,7 +27,7 @@ data LoaderResource = LoaderResource makeLenses ''LoaderResource -runEvalFileEffIO :: forall r a. (Members '[TaggedLock, Files, Embed IO, Error PackageLoaderError] r) => Sem (EvalFileEff ': r) a -> Sem r a +runEvalFileEffIO :: forall r a. (Members '[TaggedLock, Files, EmbedIO, Error PackageLoaderError] r) => Sem (EvalFileEff ': r) a -> Sem r a runEvalFileEffIO = interpretScopedAs allocator handler where allocator :: Path Abs File -> Sem r LoaderResource @@ -115,7 +115,7 @@ runEvalFileEffIO = interpretScopedAs allocator handler Just l -> l ^. intervalFile == f Nothing -> False -loadPackage' :: (Members '[TaggedLock, Files, Embed IO, Error PackageLoaderError] r) => Path Abs File -> Sem r CoreResult +loadPackage' :: (Members '[TaggedLock, Files, EmbedIO, Error PackageLoaderError] r) => Path Abs File -> Sem r CoreResult loadPackage' packagePath = do ( mapError ( \e -> diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs index 8bf7efc333..cfadf2e84e 100644 --- a/src/Juvix/Compiler/Pipeline/Repl.hs +++ b/src/Juvix/Compiler/Pipeline/Repl.hs @@ -143,7 +143,7 @@ data ReplPipelineResult | ReplPipelineResultOpen Name compileReplInputIO :: - (Members '[Reader EntryPoint, State Artifacts, Embed IO] r) => + (Members '[Reader EntryPoint, State Artifacts, EmbedIO] r) => Path Abs File -> Text -> Sem r (Either JuvixError ReplPipelineResult) diff --git a/src/Juvix/Compiler/Pipeline/Root.hs b/src/Juvix/Compiler/Pipeline/Root.hs index 9efdf5c786..2a3f289a25 100644 --- a/src/Juvix/Compiler/Pipeline/Root.hs +++ b/src/Juvix/Compiler/Pipeline/Root.hs @@ -12,12 +12,12 @@ import Juvix.Data.Effect.TaggedLock import Juvix.Extra.Paths qualified as Paths import Juvix.Prelude -readPackageRootIO :: (Members '[TaggedLock, Embed IO] r) => Root -> Sem r Package +readPackageRootIO :: (Members '[TaggedLock, EmbedIO] r) => Root -> Sem r Package readPackageRootIO root = readPackageIO (root ^. rootRootDir) (root ^. rootBuildDir) findRootAndChangeDir :: forall r. - (Members '[TaggedLock, Embed IO, Final IO] r) => + (Members '[TaggedLock, EmbedIO, Final IO] r) => Maybe (Path Abs Dir) -> Maybe (Path Abs Dir) -> Path Abs Dir -> @@ -35,7 +35,7 @@ findRootAndChangeDir minputFileDir mbuildDir _rootInvokeDir = do possiblePaths :: Path Abs Dir -> [Path Abs Dir] possiblePaths p = p : toList (parents p) - findPackageFile :: (Members '[Embed IO] r') => Sem r' (Maybe (Path Abs File)) + findPackageFile :: (Members '[EmbedIO] r') => Sem r' (Maybe (Path Abs File)) findPackageFile = do let cwd = fromMaybe _rootInvokeDir minputFileDir findPackageFile' = findFile (possiblePaths cwd) diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index 729b1177ce..02bd8205fd 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -31,28 +31,28 @@ import Juvix.Prelude -- | It returns `ResolverState` so that we can retrieve the `juvix.yaml` files, -- which we require for `Scope` tests. -runIOEither :: forall a r. (Members '[TaggedLock, Embed IO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a)) +runIOEither :: forall a r. (Members '[TaggedLock, EmbedIO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a)) runIOEither entry = fmap snd . runIOEitherHelper entry -runIOEither' :: forall a r. (Members '[TaggedLock, Embed IO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a)) +runIOEither' :: forall a r. (Members '[TaggedLock, EmbedIO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a)) runIOEither' entry = fmap snd . runIOEitherHelper entry -runPipelineHighlight :: forall a r. (Members '[TaggedLock, Embed IO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r HighlightInput +runPipelineHighlight :: forall a r. (Members '[TaggedLock, EmbedIO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r HighlightInput runPipelineHighlight entry = fmap fst . runIOEitherHelper entry -runPipelineHtmlEither :: forall r. (Members '[TaggedLock, Embed IO] r) => EntryPoint -> Sem r (Either JuvixError (Typed.InternalTypedResult, [Typed.InternalTypedResult])) +runPipelineHtmlEither :: forall r. (Members '[TaggedLock, EmbedIO] r) => EntryPoint -> Sem r (Either JuvixError (Typed.InternalTypedResult, [Typed.InternalTypedResult])) runPipelineHtmlEither entry = do x <- runIOEitherPipeline' entry $ entrySetup defaultDependenciesConfig >> processRecursiveUpToTyped return $ mapRight snd $ snd x -runIOEitherHelper :: forall a r. (Members '[TaggedLock, Embed IO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r (HighlightInput, (Either JuvixError (ResolverState, PipelineResult a))) +runIOEitherHelper :: forall a r. (Members '[TaggedLock, EmbedIO] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r (HighlightInput, (Either JuvixError (ResolverState, PipelineResult a))) runIOEitherHelper entry a = do runIOEitherPipeline' entry $ entrySetup defaultDependenciesConfig >> processFileUpTo a runIOEitherPipeline :: forall a r. - (Members '[TaggedLock, Embed IO] r) => + (Members '[TaggedLock, EmbedIO] r) => EntryPoint -> Sem (PipelineEff' r) a -> Sem r (Either JuvixError (ResolverState, a)) @@ -60,7 +60,7 @@ runIOEitherPipeline entry = fmap snd . runIOEitherPipeline' entry runIOEitherPipeline' :: forall a r. - (Members '[TaggedLock, Embed IO] r) => + (Members '[TaggedLock, EmbedIO] r) => EntryPoint -> Sem (PipelineEff' r) a -> Sem r (HighlightInput, (Either JuvixError (ResolverState, a))) @@ -91,14 +91,14 @@ mainIsPackageFile entry = case entry ^. entryPointModulePath of runIO :: forall a r. - (Members '[TaggedLock, Embed IO] r) => + (Members '[TaggedLock, EmbedIO] r) => GenericOptions -> EntryPoint -> Sem (PipelineEff r) a -> Sem r (ResolverState, PipelineResult a) runIO opts entry = runIOEither entry >=> mayThrow where - mayThrow :: (Members '[Embed IO] r') => Either JuvixError x -> Sem r' x + mayThrow :: (Members '[EmbedIO] r') => Either JuvixError x -> Sem r' x mayThrow = \case Left err -> runReader opts $ printErrorAnsiSafe err >> embed exitFailure Right r -> return r diff --git a/src/Juvix/Compiler/Tree/EvaluatorSem.hs b/src/Juvix/Compiler/Tree/EvaluatorSem.hs index 91d28ab2fd..d62a97c911 100644 --- a/src/Juvix/Compiler/Tree/EvaluatorSem.hs +++ b/src/Juvix/Compiler/Tree/EvaluatorSem.hs @@ -320,7 +320,7 @@ hEvalIOEither hin hout infoTable funInfo = do $ x -- | Interpret IO actions. -hRunIO :: forall r. (Members '[Embed IO, Error EvalError, Output Value] r) => Handle -> Handle -> InfoTable -> Value -> Sem r Value +hRunIO :: forall r. (Members '[EmbedIO, Error EvalError, Output Value] r) => Handle -> Handle -> InfoTable -> Value -> Sem r Value hRunIO hin hout infoTable = \case ValConstr (Constr (BuiltinTag TagReturn) [x]) -> return x ValConstr (Constr (BuiltinTag TagBind) [x, f]) -> do diff --git a/src/Juvix/Data/Effect/Fail.hs b/src/Juvix/Data/Effect/Fail.hs index e4dcf62ed7..78374fb779 100644 --- a/src/Juvix/Data/Effect/Fail.hs +++ b/src/Juvix/Data/Effect/Fail.hs @@ -64,7 +64,7 @@ failMaybe = \case {-# INLINE failMaybe #-} failFromException :: - (Members '[Fail, Embed IO] r) => + (Members '[Fail, EmbedIO] r) => IO a -> Sem r a failFromException m = do diff --git a/src/Juvix/Data/Effect/FileLock/IO.hs b/src/Juvix/Data/Effect/FileLock/IO.hs index a83b617e80..4cd272b032 100644 --- a/src/Juvix/Data/Effect/FileLock/IO.hs +++ b/src/Juvix/Data/Effect/FileLock/IO.hs @@ -6,6 +6,6 @@ import Juvix.Prelude.Path import System.FileLock hiding (FileLock) -- | Interpret `FileLock` using `System.FileLock` -runFileLockIO :: (Members '[Resource, Embed IO] r) => Sem (FileLock ': r) a -> Sem r a +runFileLockIO :: (Members '[Resource, EmbedIO] r) => Sem (FileLock ': r) a -> Sem r a runFileLockIO = interpretH $ \case WithFileLock' p ma -> bracket (embed $ lockFile (toFilePath p) Exclusive) (embed . unlockFile) (const (runTSimple ma)) diff --git a/src/Juvix/Data/Effect/Files/IO.hs b/src/Juvix/Data/Effect/Files/IO.hs index 5c967dda28..a830fd6649 100644 --- a/src/Juvix/Data/Effect/Files/IO.hs +++ b/src/Juvix/Data/Effect/Files/IO.hs @@ -20,7 +20,7 @@ import System.PosixCompat.Files qualified as P runFilesIO :: forall r a. - (Members '[Embed IO] r) => + (Members '[EmbedIO] r) => Sem (Files ': r) a -> Sem r a runFilesIO = interpret helper @@ -58,7 +58,7 @@ juvixConfigDirIO = ( versionDir) . absDir <$> getUserConfigDir "juvix" runTempFileIO :: forall r a. - (Members '[Embed IO] r) => + (Members '[EmbedIO] r) => Sem (TempFile ': r) a -> Sem r a runTempFileIO = interpret $ \case diff --git a/src/Juvix/Data/Effect/Log.hs b/src/Juvix/Data/Effect/Log.hs index 35ca91c6ec..914904b354 100644 --- a/src/Juvix/Data/Effect/Log.hs +++ b/src/Juvix/Data/Effect/Log.hs @@ -9,7 +9,7 @@ data Log m a where makeSem ''Log runLogIO :: - (Member (Embed IO) r) => + (Member EmbedIO r) => InterpreterFor Log r runLogIO sem = do embed (hSetBuffering stdout LineBuffering) diff --git a/src/Juvix/Data/Effect/Process/IO.hs b/src/Juvix/Data/Effect/Process/IO.hs index 318be2289b..fe61277f34 100644 --- a/src/Juvix/Data/Effect/Process/IO.hs +++ b/src/Juvix/Data/Effect/Process/IO.hs @@ -9,7 +9,7 @@ import System.Process.Typed qualified as P runProcessIO :: forall r a. - (Members '[Embed IO] r) => + (Members '[EmbedIO] r) => Sem (Process ': r) a -> Sem r a runProcessIO = interpret $ \case diff --git a/src/Juvix/Data/Effect/TaggedLock.hs b/src/Juvix/Data/Effect/TaggedLock.hs index af55498fd0..ece6185c37 100644 --- a/src/Juvix/Data/Effect/TaggedLock.hs +++ b/src/Juvix/Data/Effect/TaggedLock.hs @@ -36,7 +36,7 @@ data LockMode = LockModePermissive | LockModeExclusive -runTaggedLock :: (Members '[Resource, Embed IO] r) => LockMode -> Sem (TaggedLock ': r) a -> Sem r a +runTaggedLock :: (Members '[Resource, EmbedIO] r) => LockMode -> Sem (TaggedLock ': r) a -> Sem r a runTaggedLock = \case LockModePermissive -> runTaggedLockPermissive LockModeExclusive -> runTaggedLockIO diff --git a/src/Juvix/Data/Effect/TaggedLock/IO.hs b/src/Juvix/Data/Effect/TaggedLock/IO.hs index b88895adf3..0a8176d32e 100644 --- a/src/Juvix/Data/Effect/TaggedLock/IO.hs +++ b/src/Juvix/Data/Effect/TaggedLock/IO.hs @@ -10,7 +10,7 @@ import Juvix.Prelude.Path -- -- When multiple processes or threads call `withTaggedLock` with the same tag, -- then only one of them can perform the action at a time. -runTaggedLockIO :: forall r a. (Members '[Resource, Embed IO] r) => Sem (TaggedLock ': r) a -> Sem r a +runTaggedLockIO :: forall r a. (Members '[Resource, EmbedIO] r) => Sem (TaggedLock ': r) a -> Sem r a runTaggedLockIO sem = do rootLockPath <- ( $(mkRelDir "juvix-file-locks")) <$> getTempDir runFileLockIO (runFilesIO (go rootLockPath sem)) diff --git a/src/Juvix/Data/Error/GenericError.hs b/src/Juvix/Data/Error/GenericError.hs index 5c722e099a..e5dc90e19b 100644 --- a/src/Juvix/Data/Error/GenericError.hs +++ b/src/Juvix/Data/Error/GenericError.hs @@ -78,14 +78,14 @@ renderText = render False False renderAnsiText :: (ToGenericError e, Member (Reader GenericOptions) r) => e -> Sem r Text renderAnsiText = render True False -printErrorAnsi :: (ToGenericError e, Members '[Embed IO, Reader GenericOptions] r) => e -> Sem r () +printErrorAnsi :: (ToGenericError e, Members '[EmbedIO, Reader GenericOptions] r) => e -> Sem r () printErrorAnsi e = renderAnsiText e >>= \txt -> embed (hPutStrLn stderr txt) -- | Print the error to stderr without formatting. -printErrorText :: (ToGenericError e, Members '[Embed IO, Reader GenericOptions] r) => e -> Sem r () +printErrorText :: (ToGenericError e, Members '[EmbedIO, Reader GenericOptions] r) => e -> Sem r () printErrorText e = renderText e >>= \txt -> embed (hPutStrLn stderr txt) -printErrorAnsiSafe :: (ToGenericError e, Members '[Embed IO, Reader GenericOptions] r) => e -> Sem r () +printErrorAnsiSafe :: (ToGenericError e, Members '[EmbedIO, Reader GenericOptions] r) => e -> Sem r () printErrorAnsiSafe e = ifM (embed (Ansi.hSupportsANSIColor stderr)) @@ -93,7 +93,7 @@ printErrorAnsiSafe e = (printErrorText e) runErrorIO :: - (ToGenericError a, Members '[Embed IO, Reader GenericOptions] r) => + (ToGenericError a, Members '[EmbedIO, Reader GenericOptions] r) => Sem (Error a ': r) b -> Sem r b runErrorIO = @@ -102,7 +102,7 @@ runErrorIO = Right a -> return a runErrorIO' :: - (ToGenericError a, Member (Embed IO) r) => + (ToGenericError a, Member EmbedIO r) => Sem (Error a ': r) b -> Sem r b runErrorIO' = runReader defaultGenericOptions . runErrorIO . raiseUnder diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs index 9da32ed13a..135e268ebf 100644 --- a/src/Juvix/Prelude/Base.hs +++ b/src/Juvix/Prelude/Base.hs @@ -48,7 +48,6 @@ module Juvix.Prelude.Base module GHC.Real, module Lens.Micro.Platform, module Polysemy, - module Polysemy.Embed, module Polysemy.Error, module Polysemy.Input, module Polysemy.Fixpoint, @@ -163,8 +162,8 @@ import Language.Haskell.TH.Syntax (Exp, Lift, Q) import Lens.Micro.Platform import Path import Path.IO qualified as Path hiding (getCurrentDir, setCurrentDir, withCurrentDir) -import Polysemy -import Polysemy.Embed +import Polysemy hiding (embed) +import Polysemy.Embed qualified as Embed import Polysemy.Error hiding (fromEither) import Polysemy.Fixpoint import Polysemy.Input @@ -203,6 +202,11 @@ import Text.Show qualified as Show import Text.Show.Unicode (urecover, ushow) import Prelude (Double) +type EmbedIO = Embed.Embed IO + +embed :: (Member EmbedIO r) => IO a -> Sem r a +embed = Embed.embed + traverseM :: (Monad m, Traversable m, Applicative f) => (a1 -> f (m a2)) -> diff --git a/test/Formatter/Positive.hs b/test/Formatter/Positive.hs index 629bedfacc..68a682afee 100644 --- a/test/Formatter/Positive.hs +++ b/test/Formatter/Positive.hs @@ -5,7 +5,7 @@ import Juvix.Formatter import Scope.Positive qualified import Scope.Positive qualified as Scope -runScopeEffIO :: (Member (Embed IO) r) => Path Abs Dir -> Sem (ScopeEff ': r) a -> Sem r a +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) diff --git a/test/Nockma/Eval/Positive.hs b/test/Nockma/Eval/Positive.hs index edadcecd13..d46ed91380 100644 --- a/test/Nockma/Eval/Positive.hs +++ b/test/Nockma/Eval/Positive.hs @@ -8,7 +8,7 @@ import Juvix.Compiler.Nockma.Pretty import Juvix.Compiler.Nockma.Translation.FromSource.QQ import Juvix.Compiler.Nockma.Translation.FromTree -type Check = Sem '[Reader [Term Natural], Reader (Term Natural), Embed IO] +type Check = Sem '[Reader [Term Natural], Reader (Term Natural), EmbedIO] data Test = Test { _testEvalOptions :: EvalOptions,