path resolver et al

src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs

@@ -21,7 +21,6 @@ import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Extra.Assets
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
-import Juvix.Prelude qualified as Prelude
 import Juvix.Prelude.Pretty
 import Text.Blaze.Html.Renderer.Utf8 qualified as Html
 import Text.Blaze.Html5 as Html hiding (map)
@@ -169,7 +168,7 @@ createIndexFile ps = do
                       <> ul (mconcatMap li c')
 
 writeHtml :: (Members '[EmbedIO] r) => Path Abs File -> Html -> Sem r ()
-writeHtml f h = Prelude.embed $ do
+writeHtml f h = liftIO $ do
   ensureDir dir
   Builder.writeFile (toFilePath f) (Html.renderHtmlBuilder h)
   where
@@ -179,7 +178,7 @@ writeHtml f h = Prelude.embed $ do
 genJudocHtml :: (Members '[EmbedIO] r) => EntryPoint -> JudocArgs -> Sem r ()
 genJudocHtml entry JudocArgs {..} =
   runReader htmlOpts . runReader normTable . runReader entry $ do
-    Prelude.embed (writeAssets _judocArgsOutputDir)
+    liftIO (writeAssets _judocArgsOutputDir)
     mapM_ (goTopModule cs) allModules
     createIndexFile (map topModulePath (toList allModules))
   where
@@ -300,7 +299,7 @@ goTopModule cs m = do
 
     srcHtml :: forall s. (Members '[Reader HtmlOptions, EmbedIO] s) => Sem s Html
     srcHtml = do
-      utc <- Prelude.embed getCurrentTime
+      utc <- liftIO getCurrentTime
       genModuleHtml
         GenModuleHtmlArgs
           { _genModuleHtmlArgsConcreteOpts = defaultOptions,

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/Pipeline.hs

@@ -43,7 +43,7 @@ import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.Process
 import Juvix.Data.Effect.TaggedLock
 
-type PipelineAppEffects = '[TaggedLock, EmbedIO, Resource, Final IO]
+type PipelineAppEffects = '[TaggedLock, EmbedIO, Resource, EmbedIO]
 
 type PipelineLocalEff = '[PathResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, Reader EntryPoint, Files, Error JuvixError, HighlightBuilder, Internet]
 

src/Juvix/Compiler/Pipeline/Driver.hs

@@ -287,8 +287,7 @@ withPath' ::
   TopModulePath ->
   (Path Abs File -> Sem r a) ->
   Sem r a
-withPath' path a = withPathFile path (either throwError a)
+withPath' path a = withPathFile path (either throwErr a)
   where
-    throwError :: PathResolverError -> Sem r a
-    throwError e =
-      mapError (JuvixError @PathResolverError) $ throw e
+    throwErr :: PathResolverError -> Sem r a
+    throwErr = mapError (JuvixError @PathResolverError) . throw

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 '[EmbedIO, TaggedLock, Final IO] r) => Path Abs Dir -> Path Abs File -> Sem r EntryPoint
+defaultEntryPointIO :: (Members '[EmbedIO, TaggedLock, EmbedIO] 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 '[EmbedIO, TaggedLock, Final IO] r) => Path Abs Dir -> Sem r EntryPoint
+defaultEntryPointNoFileIO :: (Members '[EmbedIO, TaggedLock, EmbedIO] r) => Path Abs Dir -> Sem r EntryPoint
 defaultEntryPointNoFileIO cwd = do
   root <- findRootAndChangeDir Nothing Nothing cwd
   pkg <- readPackageRootIO root

src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs

@@ -142,7 +142,7 @@ resolveDependency i = case i ^. packageDepdendencyInfoDependency of
             { _cloneArgsCloneDir = cloneDir,
               _cloneArgsRepoUrl = g ^. gitDependencyUrl
             }
-    scoped cloneArgs $ do
+    provideWith_ cloneArgs $ do
       fetchOnNoSuchRefAndRetry (errorHandler cloneDir) (`checkout` (g ^. gitDependencyRef))
       resolvedRef <- headRef (errorHandler cloneDir)
       return
@@ -406,25 +406,26 @@ re ::
   (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
   Sem (PathResolver ': r) a ->
   Sem (Reader ResolverEnv ': State ResolverState ': r) a
-re = reinterpret2H helper
+re = interpretTop2H helper
   where
     helper ::
-      forall rInitial x.
-      PathResolver (Sem rInitial) x ->
-      Tactical PathResolver (Sem rInitial) (Reader ResolverEnv ': (State ResolverState ': r)) x
-    helper = \case
-      RegisterDependencies forceUpdateLockfile -> registerDependencies' forceUpdateLockfile >>= pureT
-      ExpectedPathInfoTopModule m -> expectedPath' m >>= pureT
+      forall x localEs.
+      LocalEnv localEs (Reader ResolverEnv ': State ResolverState ': r) ->
+      PathResolver (Sem localEs) x ->
+      Sem (Reader ResolverEnv ': State ResolverState ': r) x
+    helper localEnv = \case
+      RegisterDependencies forceUpdateLockfile -> registerDependencies' forceUpdateLockfile
+      ExpectedPathInfoTopModule m -> expectedPath' m
       WithPath m a -> do
         x :: Either PathResolverError (Path Abs Dir, Path Rel File) <- resolvePath' m
         oldroot <- asks (^. envRoot)
-        x' <- pureT x
-        a' <- bindT a
+        -- a' <- bindT a
         st' <- get
         let root' = case x of
               Left {} -> oldroot
               Right (r, _) -> r
-        raise (evalPathResolver' st' root' (a' x'))
+            localEff :: Sem (PathResolver ': State ResolverState ': r) x = runTSimpleEff localEnv (a x)
+        raise (evalPathResolver' st' root' localEff)
 
 evalPathResolver' :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
 evalPathResolver' st root = fmap snd . runPathResolver' st root

src/Juvix/Compiler/Pipeline/Loader/PathResolver/Base.hs

@@ -26,7 +26,7 @@ data PathInfoTopModule = PathInfoTopModule
   }
   deriving stock (Show)
 
-data PathResolver m a where
+data PathResolver :: Effect where
   RegisterDependencies :: DependenciesConfig -> PathResolver m ()
   ExpectedPathInfoTopModule :: TopModulePath -> PathResolver m PathInfoTopModule
   WithPath ::

src/Juvix/Compiler/Pipeline/Package/Loader.hs

@@ -40,7 +40,7 @@ renderPackageVersion v pkg = toPlainText (ppOutDefaultNoComments (toConcrete (ge
 -- | Load a package file in the context of the PackageDescription module and the global package stdlib.
 loadPackage :: (Members '[Files, EvalFileEff, Error PackageLoaderError] r) => BuildDir -> Path Abs File -> Sem r Package
 loadPackage buildDir packagePath = do
-  scoped @(Path Abs File) @EvalEff packagePath $ do
+  provideWith_ @EvalEff packagePath $ do
     (v, t) <- getPackageNode
     ((getPackageType (t ^. typeSpecVersion)) ^. packageDescriptionTypeToPackage) buildDir packagePath =<< eval' v
   where

src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff.hs

@@ -20,4 +20,4 @@ data EvalEff :: Effect where
 
 makeSem ''EvalEff
 
-type EvalFileEff = Provider EvalEff (Path Abs File)
+type EvalFileEff = Provider_ EvalEff (Path Abs File)

src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs

@@ -34,24 +34,22 @@ runPackagePathResolver rootPath sem = do
   initFiles ds
   fs <- rootInfoFiles ds
   let mkRootInfo' = mkRootInfo ds fs
-  ( interpretH $ \case
-      RegisterDependencies {} -> pureT ()
-      ExpectedPathInfoTopModule m -> do
-        let _pathInfoTopModule = m
-            _pathInfoRootInfo =
-              --  A Package file is a member of a package by definition.
-              fromMaybe (error "runPackagePathResolver: expected root info") $
-                mkRootInfo' (topModulePathToRelativePath' m)
-        pureT PathInfoTopModule {..}
-      WithPath m a -> do
-        let relPath = topModulePathToRelativePath' m
-            x :: Either PathResolverError (Path Abs Dir, Path Rel File)
-            x = case mkRootInfo' relPath of
-              Just p -> Right (p ^. rootInfoPath, relPath)
-              Nothing -> Left (ErrPackageInvalidImport PackageInvalidImport {_packageInvalidImport = m})
-        runTSimple (return x) >>= bindTSimple a
-    )
-    sem
+  (`interpretH` sem) $ \localEnv -> \case
+    RegisterDependencies {} -> return ()
+    ExpectedPathInfoTopModule m -> do
+      let _pathInfoTopModule = m
+          _pathInfoRootInfo =
+            --  A Package file is a member of a package by definition.
+            fromMaybe (error "runPackagePathResolver: expected root info") $
+              mkRootInfo' (topModulePathToRelativePath' m)
+      return PathInfoTopModule {..}
+    WithPath m a -> do
+      let relPath = topModulePathToRelativePath' m
+          x :: Either PathResolverError (Path Abs Dir, Path Rel File)
+          x = case mkRootInfo' relPath of
+            Just p -> Right (p ^. rootInfoPath, relPath)
+            Nothing -> Left (ErrPackageInvalidImport PackageInvalidImport {_packageInvalidImport = m})
+      runTSimpleEff localEnv (a x)
   where
     rootInfoDirs :: Sem r RootInfoDirs
     rootInfoDirs = do

src/Juvix/Compiler/Pipeline/Root.hs

@@ -17,7 +17,7 @@ readPackageRootIO root = readPackageIO (root ^. rootRootDir) (root ^. rootBuildD
 
 findRootAndChangeDir ::
   forall r.
-  (Members '[TaggedLock, EmbedIO, Final IO] r) =>
+  (Members '[TaggedLock, EmbedIO, EmbedIO] r) =>
   Maybe (Path Abs Dir) ->
   Maybe (Path Abs Dir) ->
   Path Abs Dir ->

src/Juvix/Prelude/Effects/Base.hs

@@ -22,8 +22,8 @@ import Effectful.Error.Static hiding (runError)
 import Effectful.Internal.Env (getEnv, putEnv)
 import Effectful.Provider
 import Effectful.Reader.Static
-import Effectful.Resource
-import Effectful.State.Static.Local hiding (runState)
+import Effectful.Resource hiding (register)
+import Effectful.State.Static.Local hiding (runState, state)
 import Effectful.State.Static.Local qualified as State
 import Effectful.TH
 import Juvix.Prelude.Base.Foundation
@@ -205,8 +205,9 @@ reinterpret re i = reinterpretH re (const i)
 
 -- TODO maybe think of a better name
 runTSimpleEff ::
-  forall (localEs :: [Effect]) (r :: [Effect]) x.
-  LocalEnv localEs r ->
+  forall (handlerEs :: [Effect]) (localEs :: [Effect]) (r :: [Effect]) x.
+  (SharedSuffix r handlerEs) =>
+  LocalEnv localEs handlerEs ->
   Sem localEs x ->
   Sem r x
 runTSimpleEff locEnv ma =