Merge remote-tracking branch 'origin/main' into module-dependencies

src/Juvix/Compiler/Pipeline.hs

@@ -35,6 +35,7 @@ import Juvix.Compiler.Pipeline.Artifacts
 import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Compiler.Pipeline.ImportParents
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Base
+import Juvix.Compiler.Pipeline.Loader.PathResolver.DependencyResolver
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Error
 import Juvix.Compiler.Pipeline.ModuleInfoCache
 import Juvix.Compiler.Pipeline.Package.Loader.Error
@@ -52,7 +53,7 @@ import Juvix.Data.Field
 
 type PipelineAppEffects = '[TaggedLock, EmbedIO]
 
-type PipelineLocalEff = '[ModuleInfoCache, Reader ImportParents, TopModuleNameChecker, PathResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, Reader EntryPoint, Files, Error JuvixError, HighlightBuilder, Internet]
+type PipelineLocalEff = '[ModuleInfoCache, Reader ImportParents, TopModuleNameChecker, PathResolver, DependencyResolver, EvalFileEff, Error PackageLoaderError, Error DependencyError, GitClone, Error GitProcessError, Process, Log, Reader EntryPoint, Files, Error JuvixError, HighlightBuilder, Internet]
 
 type PipelineEff' r = PipelineLocalEff ++ r
 

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

@@ -5,12 +5,11 @@ import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Compiler.Pipeline.Loader.PathResolver
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff
 import Juvix.Compiler.Pipeline.Package.Loader.PathResolver
-import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.TaggedLock
 import Juvix.Prelude
 
-runPathResolverArtifacts :: (Members '[TaggedLock, Files, Reader EntryPoint, State Artifacts, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
+runPathResolverArtifacts :: (Members '[TaggedLock, Files, Reader EntryPoint, State Artifacts, Error DependencyError, DependencyResolver, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
 runPathResolverArtifacts = runStateLikeArtifacts runPathResolverPipe' artifactResolver
 
-runPackagePathResolverArtifacts :: (Members '[TaggedLock, Files, Reader EntryPoint, State Artifacts, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
+runPackagePathResolverArtifacts :: (Members '[TaggedLock, Files, Reader EntryPoint, State Artifacts, Error DependencyError, DependencyResolver, Error JuvixError, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a
 runPackagePathResolverArtifacts root = runStateLikeArtifacts (runPackagePathResolver'' root) artifactResolver

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

@@ -4,6 +4,7 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver
     module Juvix.Compiler.Pipeline.Loader.PathResolver.Error,
     module Juvix.Compiler.Pipeline.Loader.PathResolver.Data,
     module Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo,
+    module Juvix.Compiler.Pipeline.Loader.PathResolver.DependencyResolver,
     runPathResolver,
     runPathResolverPipe,
     runPathResolverPipe',
@@ -15,20 +16,20 @@ where
 
 import Data.HashMap.Strict qualified as HashMap
 import Data.HashSet qualified as HashSet
-import Data.Text qualified as T
+import Juvix.Compiler.Concrete.Data.Name
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error
 import Juvix.Compiler.Concrete.Translation.ImportScanner
 import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Base
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Data
+import Juvix.Compiler.Pipeline.Loader.PathResolver.DependencyResolver
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Error
 import Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Paths
 import Juvix.Compiler.Pipeline.Lockfile
 import Juvix.Compiler.Pipeline.Package
 import Juvix.Compiler.Pipeline.Package.Loader.EvalEff
 import Juvix.Compiler.Pipeline.Root.Base (PackageType (..))
-import Juvix.Data.Effect.Git
 import Juvix.Data.Effect.TaggedLock
 import Juvix.Data.SHA256 qualified as SHA256
 import Juvix.Extra.Files
@@ -39,7 +40,7 @@ import Juvix.Prelude
 
 mkPackage ::
   forall r.
-  (Members '[Files, Error JuvixError, Reader ResolverEnv, GitClone, EvalFileEff] r) =>
+  (Members '[Files, Error JuvixError, Reader ResolverEnv, DependencyResolver, EvalFileEff] r) =>
   Maybe EntryPoint ->
   Path Abs Dir ->
   Sem r Package
@@ -60,7 +61,7 @@ findPackageJuvixFiles pkgRoot = map (fromJust . stripProperPrefix pkgRoot) <$> w
 
 mkPackageInfo ::
   forall r.
-  (Members '[TaggedLock, Files, Error JuvixError, Reader ResolverEnv, Error DependencyError, GitClone] r) =>
+  (Members '[TaggedLock, Files, Error JuvixError, Error DependencyError, Reader ResolverEnv, DependencyResolver] r) =>
   Maybe EntryPoint ->
   Path Abs Dir ->
   Package ->
@@ -132,50 +133,9 @@ mkPackageInfo mpackageEntry _packageRoot pkg = do
                       }
                 )
 
-lookupCachedDependency :: (Members '[State ResolverState, Reader ResolverEnv, Files, GitClone] r) => Path Abs Dir -> Sem r (Maybe LockfileDependency)
+lookupCachedDependency :: (Members '[State ResolverState, Reader ResolverEnv, Files, DependencyResolver] r) => Path Abs Dir -> Sem r (Maybe LockfileDependency)
 lookupCachedDependency p = fmap (^. resolverCacheItemDependency) . HashMap.lookup p <$> gets (^. resolverCache)
 
-resolveDependency :: forall r. (Members '[Reader ResolverEnv, Files, Error DependencyError, GitClone] r) => PackageDependencyInfo -> Sem r ResolvedDependency
-resolveDependency i = case i ^. packageDepdendencyInfoDependency of
-  DependencyPath p -> do
-    r <- asks (^. envRoot)
-    p' <- canonicalDir r (p ^. pathDependencyPath)
-    return
-      ResolvedDependency
-        { _resolvedDependencyPath = p',
-          _resolvedDependencyDependency = i ^. packageDepdendencyInfoDependency
-        }
-  DependencyGit g -> do
-    r <- rootBuildDir <$> asks (^. envRoot)
-    let cloneDir = r <//> relDependenciesDir <//> relDir (T.unpack (g ^. gitDependencyName))
-        cloneArgs =
-          CloneArgs
-            { _cloneArgsCloneDir = cloneDir,
-              _cloneArgsRepoUrl = g ^. gitDependencyUrl
-            }
-    provideWith_ cloneArgs $ do
-      fetchOnNoSuchRefAndRetry (errorHandler cloneDir) (`checkout` (g ^. gitDependencyRef))
-      resolvedRef <- headRef (errorHandler cloneDir)
-      return
-        ResolvedDependency
-          { _resolvedDependencyPath = cloneDir,
-            _resolvedDependencyDependency =
-              DependencyGit (set gitDependencyRef resolvedRef g)
-          }
-    where
-      errorHandler :: Path Abs Dir -> GitError -> Sem (Git ': r) a
-      errorHandler p c =
-        throw
-          DependencyError
-            { _dependencyErrorCause =
-                GitDependencyError
-                  DependencyErrorGit
-                    { _dependencyErrorGitCloneDir = p,
-                      _dependencyErrorGitError = c
-                    },
-              _dependencyErrorPackageFile = i ^. packageDependencyInfoPackageFile
-            }
-
 registerPackageBase ::
   forall r.
   (Members '[Error ParserError, TaggedLock, State ResolverState, Files] r) =>
@@ -206,7 +166,7 @@ registerPackageBase = do
 
 registerDependencies' ::
   forall r.
-  (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, DependencyResolver, EvalFileEff] r) =>
   DependenciesConfig ->
   Sem (Reader ResolverEnv ': State ResolverState ': r) ()
 registerDependencies' conf = do
@@ -243,7 +203,7 @@ registerDependencies' conf = do
 
 addRootDependency ::
   forall r.
-  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, DependencyResolver, EvalFileEff] r) =>
   DependenciesConfig ->
   EntryPoint ->
   Path Abs Dir ->
@@ -254,7 +214,7 @@ addRootDependency conf e root = do
   resolvedDependency <- resolveDependency d
   checkRemoteDependency resolvedDependency
   let p = resolvedDependency ^. resolvedDependencyPath
-  withEnvRoot p $ do
+  withEnvInitialRoot p $ do
     pkg <- mkPackage (Just e) p
     shouldUpdateLockfile' <- shouldUpdateLockfile pkg
     when shouldUpdateLockfile' setShouldUpdateLockfile
@@ -272,7 +232,7 @@ addRootDependency conf e root = do
 
 addDependency ::
   forall r.
-  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, DependencyResolver, EvalFileEff] r) =>
   Maybe EntryPoint ->
   PackageDependencyInfo ->
   Sem r LockfileDependency
@@ -294,7 +254,7 @@ addPackageRelativeFiles pkgInfo =
 
 addDependency' ::
   forall r.
-  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) =>
+  (Members '[TaggedLock, State ResolverState, Reader ResolverEnv, Files, Error JuvixError, Error DependencyError, DependencyResolver, EvalFileEff] r) =>
   Package ->
   Maybe EntryPoint ->
   ResolvedDependency ->
@@ -529,7 +489,7 @@ expectedPath' m = do
 
 runPathResolver2 ::
   forall r a v.
-  (v ~ '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff], Members v r) =>
+  (v ~ '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, DependencyResolver, EvalFileEff], Members v r) =>
   ResolverState ->
   ResolverEnv ->
   Sem (PathResolver ': r) a ->
@@ -561,19 +521,20 @@ runPathResolver2 st topEnv arg = do
             _envSingleFile
               | e ^. entryPointPackageType == GlobalStdlib = e ^. entryPointModulePath
               | otherwise = Nothing
-            env' :: ResolverEnv
-            env' =
+            env' :: ResolverEnv -> ResolverEnv
+            env' ResolverEnv {..} =
               ResolverEnv
                 { _envRoot = root',
                   _envLockfileInfo = Nothing,
+                  _envInitialRoot,
                   _envSingleFile
                 }
-        localSeqUnlift localEnv $ \unlift -> local (const env') (unlift m)
+        localSeqUnlift localEnv $ \unlift -> local env' (unlift m)
 
-runPathResolver :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolver :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, DependencyResolver, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolver = runPathResolver' iniResolverState
 
-runPathResolver' :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, GitClone, EvalFileEff] r) => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolver' :: (Members '[TaggedLock, Reader EntryPoint, Files, Error JuvixError, Error DependencyError, DependencyResolver, EvalFileEff] r) => ResolverState -> Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolver' st root x = do
   e <- ask
   let _envSingleFile :: Maybe (Path Abs File)
@@ -584,20 +545,21 @@ runPathResolver' st root x = do
       env =
         ResolverEnv
           { _envRoot = root,
+            _envInitialRoot = root,
             _envLockfileInfo = Nothing,
             _envSingleFile
           }
   runPathResolver2 st env x
 
-runPathResolverPipe' :: (Members '[TaggedLock, Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => ResolverState -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolverPipe' :: (Members '[TaggedLock, Files, Reader EntryPoint, DependencyResolver, Error JuvixError, Error DependencyError, EvalFileEff] r) => ResolverState -> Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolverPipe' iniState a = do
   r <- asks (^. entryPointResolverRoot)
   runPathResolver' iniState r a
 
-runPathResolverPipe :: (Members '[TaggedLock, Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
+runPathResolverPipe :: (Members '[TaggedLock, Files, Reader EntryPoint, DependencyResolver, Error JuvixError, Error DependencyError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r (ResolverState, a)
 runPathResolverPipe a = do
   r <- asks (^. entryPointResolverRoot)
   runPathResolver r a
 
-evalPathResolverPipe :: (Members '[TaggedLock, Files, Reader EntryPoint, Error DependencyError, GitClone, Error JuvixError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
+evalPathResolverPipe :: (Members '[TaggedLock, Files, Reader EntryPoint, DependencyResolver, Error JuvixError, Error DependencyError, EvalFileEff] r) => Sem (PathResolver ': r) a -> Sem r a
 evalPathResolverPipe = fmap snd . runPathResolverPipe

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

@@ -8,7 +8,10 @@ import Juvix.Prelude
 import Juvix.Prelude.Pretty
 
 data ResolverEnv = ResolverEnv
-  { _envRoot :: Path Abs Dir,
+  { -- | The root path of the current project being resolved
+    _envRoot :: Path Abs Dir,
+    -- | The root path of the initial project (i.e the first project considered in the resolution)
+    _envInitialRoot :: Path Abs Dir,
     -- | The path of the input file *if* we are using the global project
     _envSingleFile :: Maybe (Path Abs File),
     _envLockfileInfo :: Maybe LockfileInfo
@@ -108,6 +111,9 @@ checkRemoteDependency d = case d ^. resolvedDependencyDependency of
 withEnvRoot :: (Members '[Reader ResolverEnv] r) => Path Abs Dir -> Sem r a -> Sem r a
 withEnvRoot root' = local (set envRoot root')
 
+withEnvInitialRoot :: (Members '[Reader ResolverEnv] r) => Path Abs Dir -> Sem r a -> Sem r a
+withEnvInitialRoot projectRoot = local (set envInitialRoot projectRoot) . local (set envRoot projectRoot)
+
 withLockfile :: (Members '[Reader ResolverEnv] r) => LockfileInfo -> Sem r a -> Sem r a
 withLockfile f = local (set envLockfileInfo (Just f))
 

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

@@ -0,0 +1,86 @@
+module Juvix.Compiler.Pipeline.Loader.PathResolver.DependencyResolver where
+
+import Data.Text qualified as T
+import Juvix.Compiler.Pipeline.Loader.PathResolver.Data
+import Juvix.Compiler.Pipeline.Loader.PathResolver.Error
+import Juvix.Compiler.Pipeline.Package.Dependency
+import Juvix.Data.Effect.Git
+import Juvix.Data.SHA256 qualified as SHA256
+import Juvix.Extra.Paths.Base
+import Juvix.Prelude
+
+data DependencyResolver' :: Effect where
+  ResolveDependency' :: PackageDependencyInfo -> DependencyResolver' m ResolvedDependency
+
+makeSem ''DependencyResolver'
+
+type DependencyResolver = Provider_ DependencyResolver' ResolverEnv
+
+runDependencyResolver ::
+  forall r a.
+  (Members '[Files, Error DependencyError, GitClone] r) =>
+  Sem (DependencyResolver ': r) a ->
+  Sem r a
+runDependencyResolver = runProvider_ helper
+  where
+    helper :: forall x. ResolverEnv -> Sem (DependencyResolver' ': r) x -> Sem r x
+    helper env m = do
+      (`interpret` m) $ \case
+        ResolveDependency' i -> case i ^. packageDepdendencyInfoDependency of
+          DependencyPath p -> do
+            let r = env ^. envRoot
+            p' <- canonicalDir r (p ^. pathDependencyPath)
+            return
+              ResolvedDependency
+                { _resolvedDependencyPath = p',
+                  _resolvedDependencyDependency = i ^. packageDepdendencyInfoDependency
+                }
+          DependencyGit g -> do
+            let r = rootBuildDir (env ^. envInitialRoot)
+            gitCacheDir <- globalGitCache
+            let cloneRelDir :: Path Rel Dir
+                cloneRelDir = mkSafeDir (g ^. gitDependencyUrl)
+                cloneDir = gitCacheDir <//> cloneRelDir
+                cloneArgs =
+                  CloneArgs
+                    { _cloneArgsCloneDir = cloneDir,
+                      _cloneArgsRepoUrl = g ^. gitDependencyUrl
+                    }
+            provideWith_ cloneArgs $ do
+              fetchOnNoSuchRefAndRetry (errorHandler cloneDir) (`checkout` (g ^. gitDependencyRef))
+              resolvedRef <- headRef (errorHandler cloneDir)
+              let destDir =
+                    r
+                      <//> relDependenciesDir
+                      <//> mkSafeDir (g ^. gitDependencyUrl <> resolvedRef)
+              unlessM (directoryExists' destDir) (replaceDirectory cloneDir destDir)
+              return
+                ResolvedDependency
+                  { _resolvedDependencyPath = destDir,
+                    _resolvedDependencyDependency =
+                      DependencyGit (set gitDependencyRef resolvedRef g)
+                  }
+            where
+              errorHandler :: forall b. Path Abs Dir -> GitError -> Sem (Git ': r) b
+              errorHandler p c =
+                throw
+                  DependencyError
+                    { _dependencyErrorCause =
+                        GitDependencyError
+                          DependencyErrorGit
+                            { _dependencyErrorGitCloneDir = p,
+                              _dependencyErrorGitError = c
+                            },
+                      _dependencyErrorPackageFile = i ^. packageDependencyInfoPackageFile
+                    }
+
+              mkSafeDir :: Text -> Path Rel Dir
+              mkSafeDir = relDir . T.unpack . SHA256.digestText
+
+resolveDependency ::
+  (Members '[Reader ResolverEnv, DependencyResolver] r) =>
+  PackageDependencyInfo ->
+  Sem r ResolvedDependency
+resolveDependency i = do
+  env <- ask @ResolverEnv
+  provideWith_ @DependencyResolver' env (resolveDependency' i)

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

@@ -60,7 +60,7 @@ instance PrettyCodeAnn DependencyErrorGit where
         <+> "is not a valid git clone."
           <> line
           <> "Try running"
-        <+> code "juvix clean"
+        <+> code "juvix clean --global"
     NoSuchRef ref ->
       prefix
         <> "The git ref:"

src/Juvix/Compiler/Pipeline/Repl.hs

@@ -16,6 +16,7 @@ import Juvix.Compiler.Pipeline.Artifacts.PathResolver
 import Juvix.Compiler.Pipeline.Driver (evalModuleInfoCache)
 import Juvix.Compiler.Pipeline.Driver qualified as Driver
 import Juvix.Compiler.Pipeline.EntryPoint
+import Juvix.Compiler.Pipeline.Loader.PathResolver (runDependencyResolver)
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Base
 import Juvix.Compiler.Pipeline.Loader.PathResolver.Error
 import Juvix.Compiler.Pipeline.ModuleInfoCache
@@ -165,6 +166,7 @@ compileReplInputIO fp txt = do
     . mapError (JuvixError @DependencyError)
     . mapError (JuvixError @PackageLoaderError)
     . runEvalFileEffIO
+    . runDependencyResolver
     . runPathResolverArtifacts
     . runTopModuleNameChecker
     . evalModuleInfoCache

src/Juvix/Compiler/Pipeline/Run.hs

@@ -67,6 +67,7 @@ runPathResolverInput ::
       '[ TaggedLock,
          Files,
          Reader EntryPoint,
+         DependencyResolver,
          Error DependencyError,
          GitClone,
          Error JuvixError,
@@ -102,6 +103,7 @@ runIOEitherPipeline' entry a = do
     . mapError (JuvixError @DependencyError)
     . mapError (JuvixError @PackageLoaderError)
     . runEvalFileEffIO
+    . runDependencyResolver
     . runPathResolverInput
     . runTopModuleNameChecker
     . evalModuleInfoCache
@@ -172,6 +174,7 @@ runReplPipelineIOEither' lockMode entry = do
       . mapError (JuvixError @DependencyError)
       . mapError (JuvixError @PackageLoaderError)
       . runEvalFileEffIO
+      . runDependencyResolver
       . runPathResolver'
       . runTopModuleNameChecker
       . evalModuleInfoCache