[ fix ] jump-to-definition (":name-at" IDE command) (#2811)

src/Core/Context.idr

@@ -2085,11 +2085,11 @@ getDirs
 
 export
 addExtraDir : {auto c : Ref Ctxt Defs} -> String -> Core ()
-addExtraDir dir = update Ctxt { options->dirs->extra_dirs $= (++ [dir]) }
+addExtraDir dir = update Ctxt { options->dirs->extra_dirs $= ((::) dir) . filter (/= dir) }
 
 export
 addPackageDir: {auto c : Ref Ctxt Defs} -> String -> Core ()
-addPackageDir dir = update Ctxt { options->dirs->package_dirs $= (++ [dir]) }
+addPackageDir dir = update Ctxt { options->dirs->package_dirs $= ((::) dir) . filter (/= dir) }
 
 export
 addDataDir : {auto c : Ref Ctxt Defs} -> String -> Core ()
@@ -2130,6 +2130,14 @@ getWorkingDir
               | Nothing => throw (InternalError "Can't get current directory")
          pure d
 
+export
+setExtraDirs : {auto c : Ref Ctxt Defs} -> List String -> Core ()
+setExtraDirs dirs = update Ctxt { options->dirs->extra_dirs := dirs }
+
+export
+setPackageDirs : {auto c : Ref Ctxt Defs} -> List String -> Core ()
+setPackageDirs dirs = update Ctxt { options->dirs->package_dirs := dirs }
+
 export
 withCtxt : {auto c : Ref Ctxt Defs} -> Core a -> Core a
 withCtxt = wrapRef Ctxt resetCtxt

src/Core/Directory.idr

@@ -47,11 +47,21 @@ ttcBuildDirectory =
   do d <- getDirs
      pure (build_dir d </> "ttc" </> show ttcVersion)
 
+export
+libInstallDirectory : {auto c : Ref Ctxt Defs} -> String -> Core String
+libInstallDirectory lib =
+  do gbdir <- pkgGlobalDirectory
+     pure (gbdir </> lib)
+
 export
 ttcInstallDirectory : {auto c : Ref Ctxt Defs} -> String -> Core String
 ttcInstallDirectory lib =
-  do gbdir <- pkgGlobalDirectory
-     pure (gbdir </> lib </> show ttcVersion)
+  do libDir <- libInstallDirectory lib
+     pure (libDir </> show ttcVersion)
+
+export
+srcInstallDirectory : {auto c : Ref Ctxt Defs} -> String -> Core String
+srcInstallDirectory = libInstallDirectory
 
 export
 extraSearchDirectories : {auto c : Ref Ctxt Defs} -> Core (List String)

src/Idris/IDEMode/REPL.idr

@@ -148,22 +148,10 @@ process : {auto c : Ref Ctxt Defs} ->
 process (Interpret cmd)
     = replWrap $ interpret cmd
 process (LoadFile fname_in _)
-    = do
-         defs <- get Ctxt
-         --both extra dirs and packageDirs keeps getting added to by findIpkg when we load
-         --the file. If left unchecked, loading time will go slower and slower everytime
-         --LoadFile is invoked. To prevent this, the entirety of dirs is replaced after
-         --the operation is complete
-         let dirs = defs.options.dirs
-
-         let fname = case !(findIpkg (Just fname_in)) of
+    = do let fname = case !(findIpkg (Just fname_in)) of
                           Nothing => fname_in
                           Just f' => f'
-         res <- replWrap $ Idris.REPL.process (Load fname) >>= outputSyntaxHighlighting fname
-         --putting the dirs back
-         defs <- get Ctxt
-         put Ctxt ({ options->dirs := dirs } defs)
-         pure res
+         replWrap $ Idris.REPL.process (Load fname) >>= outputSyntaxHighlighting fname
 
 process (NameAt name Nothing)
     = do defs <- get Ctxt
@@ -438,7 +426,7 @@ displayIDEResult outf i (NameLocList dat)
     sexpOriginDesc (PhysicalIdrSrc modIdent) = do
       defs <- get Ctxt
       let wdir = defs.options.dirs.working_dir
-      let pkg_dirs = filter (/= ".") defs.options.dirs.extra_dirs
+      let pkg_dirs = filter (/= ".") (defs.options.dirs.extra_dirs ++ defs.options.dirs.package_dirs)
       let exts = listOfExtensionsStr
       Just fname <- catch
           (Just . (wdir </>) <$> nsToSource replFC modIdent) -- Try local source first

src/Idris/Package.idr

@@ -486,6 +486,7 @@ installBuildArtifactFrom : {auto o : Ref ROpts REPLOpts} ->
               {auto c : Ref Ctxt Defs} ->
               String ->
               String -> String -> ModuleIdent -> Core ()
+
 installBuildArtifactFrom file_extension builddir destdir ns
     = do let filename_trunk = ModuleIdent.toPath ns
          let filename = builddir </> filename_trunk <.> file_extension
@@ -495,7 +496,7 @@ installBuildArtifactFrom file_extension builddir destdir ns
          let destPath = destdir </> destNest
          let destFile = destdir </> filename_trunk <.> file_extension
 
-         Right _ <- coreLift $ mkdirAll $ destNest
+         Right _ <- coreLift $ mkdirAll $ destPath
              | Left err => throw $ InternalError $ unlines
                              [ "Can't make directories " ++ show modPath
                              , show err ]
@@ -560,7 +561,7 @@ installSrcFrom wdir destdir (ns, srcRelPath)
          let destPath = destdir </> destNest
          let destFile = destdir </> srcfile <.> ext
 
-         Right _ <- coreLift $ mkdirAll $ destNest
+         Right _ <- coreLift $ mkdirAll $ destPath
              | Left err => throw $ InternalError $ unlines
                              [ "Can't make directories " ++ show modPath
                              , show err ]
@@ -592,8 +593,11 @@ install : {auto c : Ref Ctxt Defs} ->
 install pkg opts installSrc -- not used but might be in the future
     = do defs <- get Ctxt
          build <- ttcBuildDirectory
-         libdir <- (</> installDir pkg) <$> pkgGlobalDirectory
-         targetDir <- ttcInstallDirectory (installDir pkg)
+         let lib = installDir pkg
+         libTargetDir <- libInstallDirectory lib
+         ttcTargetDir <- ttcInstallDirectory lib
+         srcTargetDir <- srcInstallDirectory lib
+
          let src = source_dir (dirs (options defs))
          runScript (preinstall pkg)
          let toInstall = maybe (modules pkg)
@@ -601,28 +605,24 @@ install pkg opts installSrc -- not used but might be in the future
                                (mainmod pkg)
          wdir <- getWorkingDir
          -- Make the package installation directory
-         Right _ <- coreLift $ mkdirAll targetDir
+         Right _ <- coreLift $ mkdirAll libTargetDir
              | Left err => throw $ InternalError $ unlines
-                             [ "Can't make directory " ++ targetDir
+                             [ "Can't make directory " ++ libTargetDir
                              , show err ]
-         True <- coreLift $ changeDir targetDir
-             | False => throw $ InternalError $ "Can't change directory to " ++ targetDir
 
-         -- We're in that directory now, so copy the files from
-         -- wdir/build into it
-         traverse_ (installFrom (wdir </> build) targetDir . fst) toInstall
+         traverse_ (installFrom (wdir </> build) ttcTargetDir . fst) toInstall
+
          when installSrc $ do
-           traverse_ (installSrcFrom wdir targetDir) toInstall
+           traverse_ (installSrcFrom wdir srcTargetDir) toInstall
 
          -- install package file
-         let pkgFile = libdir </> pkg.name <.> "ipkg"
-         coreLift $ putStrLn $ "Installing package file for \{pkg.name} to \{targetDir}"
+         let pkgFile = libTargetDir </> pkg.name <.> "ipkg"
+         coreLift $ putStrLn $ "Installing package file for \{pkg.name} to \{libTargetDir}"
+
          let pkgStr = String.renderString $ layoutUnbounded $ pretty $ savePkgMetadata pkg
          log "package.depends" 25 $ "  package file:\n\{pkgStr}"
          coreLift_ $ writeFile pkgFile pkgStr
 
-         coreLift_ $ changeDir wdir
-
          runScript (postinstall pkg)
   where
     savePkgMetadata : PkgDesc -> PkgDesc

tests/Main.idr

@@ -253,7 +253,7 @@ idrisTestsIPKG : TestPool
 idrisTestsIPKG = MkTestPool "Package and .ipkg files" [] Nothing
       ["pkg001", "pkg002", "pkg003", "pkg004", "pkg005", "pkg006", "pkg007",
        "pkg008", "pkg009", "pkg010", "pkg011", "pkg012", "pkg013", "pkg014",
-       "pkg015", "pkg016" ]
+       "pkg015", "pkg016", "pkg017" ]
 
 idrisTests : TestPool
 idrisTests = MkTestPool "Misc" [] Nothing

tests/idris2/pkg017/a1/A.idr

@@ -0,0 +1,5 @@
+module A
+
+export
+i : Int
+i = 1

tests/idris2/pkg017/a1/a1.ipkg

@@ -0,0 +1,7 @@
+package a1
+
+modules = A
+
+sourcedir = "."
+
+options = "--no-prelude"

tests/idris2/pkg017/a2/A.idr

@@ -0,0 +1,5 @@
+module A
+
+export
+i : Int
+i = 2

tests/idris2/pkg017/a2/a2.ipkg

@@ -0,0 +1,7 @@
+package a2
+
+modules = A
+
+sourcedir = "."
+
+options = "--no-prelude"

tests/idris2/pkg017/b1/b1.ipkg

@@ -0,0 +1,8 @@
+package b1
+sourcedir = "src"
+
+modules = B1
+
+options = "--no-prelude"
+
+depends = a1

tests/idris2/pkg017/b1/src/B1.idr

@@ -0,0 +1,6 @@
+module B1
+
+import A
+
+i1 : Int
+i1 = A.i

tests/idris2/pkg017/b2/b2.ipkg

@@ -0,0 +1,8 @@
+package b2
+sourcedir = "src"
+
+modules = B2
+
+options = "--no-prelude"
+
+depends = a2

tests/idris2/pkg017/b2/src/B2.idr

@@ -0,0 +1,6 @@
+module B2
+
+import A
+
+i2 : Int
+i2 = A.i

tests/idris2/pkg017/expected.in

@@ -0,0 +1,22 @@
+(:protocol-version 2 1)
+(:return (:ok "Current working directory is \"__PWD__b1\"") 1)
+(:write-string "1/1: Building B1 (src/B1.idr)" 2)
+(:return (:ok ()) 2)
+(:return (:ok "1" ((0 1 ((:decor :data))))) 4)
+(:return (:ok (("A.i" (:filename "__PWD__prefix/idris2-0.6.0/a1-0/A.idr") (:start 2 0) (:end 3 7)))) 5)
+(:return (:ok "Current working directory is \"__PWD__b2\"") 6)
+(:write-string "1/1: Building B2 (src/B2.idr)" 7)
+(:return (:ok ()) 7)
+(:return (:ok "2" ((0 1 ((:decor :data))))) 8)
+(:return (:ok (("A.i" (:filename "__PWD__prefix/idris2-0.6.0/a2-0/A.idr") (:start 2 0) (:end 3 7)))) 9)
+he file is done, aborting
+(:protocol-version 2 1)
+(:return (:ok "Current working directory is \"__PWD__b2\"") 1)
+(:return (:ok ()) 2)
+(:return (:ok "2" ((0 1 ((:decor :data))))) 4)
+(:return (:ok (("A.i" (:filename "__PWD__prefix/idris2-0.6.0/a2-0/A.idr") (:start 2 0) (:end 3 7)))) 5)
+(:return (:ok "Current working directory is \"__PWD__b1\"") 6)
+(:return (:ok ()) 7)
+(:return (:ok "1" ((0 1 ((:decor :data))))) 8)
+(:return (:ok (("A.i" (:filename "__PWD__prefix/idris2-0.6.0/a1-0/A.idr") (:start 2 0) (:end 3 7)))) 9)
+he file is done, aborting

tests/idris2/pkg017/gen_expected.sh

@@ -0,0 +1,3 @@
+#!/usr/bin/env sh
+
+sed -e "s|__PWD__|${MY_PWD}|g" expected.in >expected

tests/idris2/pkg017/input1

@@ -0,0 +1,8 @@
+((:interpret ":cd \"b1\"") 1)
+((:load-file "src/B1.idr") 2)
+((:interpret "A.i") 4)
+((:name-at "i") 5)
+((:interpret ":cd \"../b2\"") 6)
+((:load-file "src/B2.idr") 7)
+((:interpret "A.i") 8)
+((:name-at "i") 9)

tests/idris2/pkg017/input2

@@ -0,0 +1,8 @@
+((:interpret ":cd \"b2\"") 1)
+((:load-file "src/B2.idr") 2)
+((:interpret "A.i") 4)
+((:name-at "i") 5)
+((:interpret ":cd \"../b1\"") 6)
+((:load-file "src/B1.idr") 7)
+((:interpret "A.i") 8)
+((:name-at "i") 9)

tests/idris2/pkg017/run

@@ -0,0 +1,18 @@
+if [ "$OS" = "windows" ]; then
+    MY_PWD="$(cygpath -m "$(pwd)")\\\\"
+else
+    MY_PWD="$(pwd)/"
+fi
+
+MY_PWD="${MY_PWD}" ./gen_expected.sh
+
+mkdir prefix
+
+IDRIS2_PREFIX="${MY_PWD}/prefix" $1 --install-with-src a1/a1.ipkg > /dev/null
+IDRIS2_PREFIX="${MY_PWD}/prefix" $1 --install-with-src a2/a2.ipkg > /dev/null
+
+IDRIS2_PREFIX="${MY_PWD}/prefix" $1 --no-prelude --no-color --console-width 0 --ide-mode  < input1 | grep -v ":highlight-source" | cut -c 7-
+IDRIS2_PREFIX="${MY_PWD}/prefix" $1 --no-prelude --no-color --console-width 0 --ide-mode  < input2 | grep -v ":highlight-source" | cut -c 7-
+
+rm -r a1/build a2/build b1/build b2/build
+rm -rf prefix