Normalise paths on ResolverCache set and lookup (#2498)

Paths are used as keys in the PathResolver ResolverCache. These paths
must be normalised because a path may have a different representation
when it is used to set an entry in the cache and when it is used to
lookup from the cache.

Path normalisation is also used in the REPL before a directory is
compared with the standard library path.

* Closes https://github.com/anoma/juvix/issues/2497

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/PathResolver.hs

@@ -245,17 +245,12 @@ addDependency' pkg me resolvedDependency = do
             { _lockfileDependencyDependency = resolvedDependency ^. resolvedDependencyDependency,
               _lockfileDependencyDependencies = subDeps
             }
-    modify'
-      ( set
-          (resolverCache . at (resolvedDependency ^. resolvedDependencyPath))
-          ( Just
-              ( ResolverCacheItem
-                  { _resolverCacheItemPackage = pkgInfo,
-                    _resolverCacheItemDependency = dep
-                  }
-              )
-          )
-      )
+        cacheItem =
+          ResolverCacheItem
+            { _resolverCacheItemPackage = pkgInfo,
+              _resolverCacheItemDependency = dep
+            }
+    setResolverCacheItem (resolvedDependency ^. resolvedDependencyPath) (Just cacheItem)
     return dep
   where
     selectPackageLockfile :: Package -> Sem r a -> Sem r a
@@ -276,14 +271,14 @@ addDependency' pkg me resolvedDependency = do
           Just dlf -> withLockfile dlf action
           Nothing -> action
 
-currentPackage :: (Members '[State ResolverState, Reader ResolverEnv] r) => Sem r PackageInfo
+currentPackage :: (Members '[Files, State ResolverState, Reader ResolverEnv] r) => Sem r PackageInfo
 currentPackage = do
   curRoot <- asks (^. envRoot)
-  (^. resolverCacheItemPackage) <$> gets (^?! resolverCache . at curRoot . _Just)
+  (^. resolverCacheItemPackage) . fromJust <$> getResolverCacheItem curRoot
 
 -- | Returns the root of the package where the module belongs and the path to
 -- the module relative to the root.
-resolvePath' :: (Members '[State ResolverState, Reader ResolverEnv] r) => TopModulePath -> Sem r (Either PathResolverError (Path Abs Dir, Path Rel File))
+resolvePath' :: (Members '[Files, State ResolverState, Reader ResolverEnv] r) => TopModulePath -> Sem r (Either PathResolverError (Path Abs Dir, Path Rel File))
 resolvePath' mp = do
   z <- gets (^. resolverFiles)
   curPkg <- currentPackage

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/PathResolver/Data.hs

@@ -55,3 +55,13 @@ withEnvRoot root' = local (set envRoot root')
 
 withLockfile :: (Members '[Reader ResolverEnv] r) => LockfileInfo -> Sem r a -> Sem r a
 withLockfile f = local (set envLockfileInfo (Just f))
+
+setResolverCacheItem :: (Members '[Files, State ResolverState] r) => Path Abs Dir -> Maybe (ResolverCacheItem) -> Sem r ()
+setResolverCacheItem p mi = do
+  np <- normalizeDir p
+  modify' (set (resolverCache . at np) mi)
+
+getResolverCacheItem :: (Members '[Files, State ResolverState] r) => Path Abs Dir -> Sem r (Maybe (ResolverCacheItem))
+getResolverCacheItem p = do
+  np <- normalizeDir p
+  gets (^. resolverCache . at np)

src/Juvix/Data/Effect/Files/Base.hs

@@ -31,7 +31,6 @@ data Files m a where
   EnsureDir' :: Path Abs Dir -> Files m ()
   DirectoryExists' :: Path Abs Dir -> Files m Bool
   FileExists' :: Path Abs File -> Files m Bool
-  GetDirAbsPath :: Path Rel Dir -> Files m (Path Abs Dir)
   ListDirRel :: Path Abs Dir -> Files m ([Path Rel Dir], [Path Rel File])
   PathUid :: Path Abs b -> Files m Uid
   ReadFile' :: Path Abs File -> Files m Text
@@ -44,5 +43,6 @@ data Files m a where
   CopyFile' :: Path Abs File -> Path Abs File -> Files m ()
   JuvixConfigDir :: Files m (Path Abs Dir)
   CanonicalDir :: Path Abs Dir -> Prepath Dir -> Files m (Path Abs Dir)
+  NormalizeDir :: Path b Dir -> Files m (Path Abs Dir)
 
 makeSem ''Files

src/Juvix/Data/Effect/Files/IO.hs

@@ -44,12 +44,12 @@ runFilesIO = interpret helper
         let P.CDev dev = P.deviceID status
             P.CIno fid = P.fileID status
         return (Uid (dev, fid))
-      GetDirAbsPath f -> canonicalizePath f
       RemoveFile' f -> Path.removeFile f
       RenameFile' p1 p2 -> Path.renameFile p1 p2
       CopyFile' p1 p2 -> Path.copyFile p1 p2
       JuvixConfigDir -> juvixConfigDirIO
       CanonicalDir root d -> prepathToAbsDir root d
+      NormalizeDir p -> canonicalizePath p
 
 juvixConfigDirIO :: IO (Path Abs Dir)
 juvixConfigDirIO = (<//> versionDir) . absDir <$> getUserConfigDir "juvix"

src/Juvix/Data/Effect/Files/Pure.hs

@@ -72,7 +72,6 @@ re cwd = reinterpret $ \case
   FileExists' f -> isJust <$> lookupFile f
   PathUid p -> return (Uid (toFilePath p))
   ReadFileBS' f -> encodeUtf8 <$> lookupFile' f
-  GetDirAbsPath p -> return (absDir (cwd' </> toFilePath p))
   EnsureDir' p -> ensureDirHelper p
   DirectoryExists' p -> isJust <$> lookupDir p
   WriteFile' p t -> writeFileHelper p t
@@ -86,6 +85,7 @@ re cwd = reinterpret $ \case
   CopyFile' p1 p2 -> copyFileHelper p1 p2
   JuvixConfigDir -> return juvixConfigDirPure
   CanonicalDir root d -> return (canonicalDirPure root d)
+  NormalizeDir p -> return (absDir (cwd' </> toFilePath p))
   where
     cwd' :: FilePath
     cwd' = toFilePath cwd

src/Juvix/Extra/Stdlib.hs

@@ -21,7 +21,8 @@ packageStdlib rootDir buildDir = firstJustM isStdLib
     isStdLib = \case
       DependencyPath dep -> do
         adir <- canonicalDir rootDir (dep ^. pathDependencyPath)
-        let mstdlib :: Maybe (Path Rel Dir) = stripProperPrefix buildDir adir
+        normBuildDir <- normalizeDir buildDir
+        let mstdlib :: Maybe (Path Rel Dir) = stripProperPrefix normBuildDir adir
         return $
           if
               | mstdlib == Just relStdlibDir -> Just stdLibBuildDir

tests/smoke/Commands/compile.smoke.yaml

@@ -193,3 +193,24 @@ tests:
       contains: |
         positive/NonExistingCompileFile.juvix" does not exist
     exit-status: 1
+
+  - name: hello-world-symlink-XDG_CONFIG_DIR
+    command:
+      shell:
+        - bash
+      script: |
+        base=$PWD
+        config=$(mktemp -d)
+        temp=$(mktemp -d)
+        trap 'rm -rf -- "$temp"' EXIT
+        trap 'rm -rf -- "$config"' EXIT
+        mkdir "$config/root"
+        ln -s "$config/root" "$config/symlink"
+        cd $temp
+        cp "$base"/examples/milestone/HelloWorld/HelloWorld.juvix .
+        export XDG_CONFIG_HOME="$config/symlink"
+        juvix compile HelloWorld.juvix
+        ./HelloWorld
+    exit-status: 0
+    stdout: |
+      hello world!

tests/smoke/Commands/repl.smoke.yaml

@@ -496,3 +496,21 @@ tests:
     stdout:
       contains: "100"
     exit-status: 0
+
+  - name: repl-symlink-XDG_CONFIG_HOME
+    command:
+      shell:
+        - bash
+      script: |
+        config=$(mktemp -d)
+        temp=$(mktemp -d)
+        trap 'rm -rf -- "$temp"' EXIT
+        trap 'rm -rf -- "$config"' EXIT
+        mkdir "$config/root"
+        ln -s "$config/root" "$config/symlink"
+        cd $temp
+        export XDG_CONFIG_HOME="$config/symlink"
+        juvix repl
+    stdout:
+      contains: "Stdlib.Prelude>"
+    exit-status: 0