diff --git a/src/Core/Context.idr b/src/Core/Context.idr index 277bb6db7..76c999c7f 100644 --- a/src/Core/Context.idr +++ b/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 diff --git a/src/Core/Directory.idr b/src/Core/Directory.idr index 5d95ed6f1..8037e3275 100644 --- a/src/Core/Directory.idr +++ b/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) diff --git a/src/Idris/IDEMode/REPL.idr b/src/Idris/IDEMode/REPL.idr index dc528baae..a96c4ce79 100644 --- a/src/Idris/IDEMode/REPL.idr +++ b/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 diff --git a/src/Idris/Package.idr b/src/Idris/Package.idr index 2c75981b5..fbdf29405 100644 --- a/src/Idris/Package.idr +++ b/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 diff --git a/tests/Main.idr b/tests/Main.idr index 17bf3dbd5..1fa52ca95 100644 --- a/tests/Main.idr +++ b/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 diff --git a/tests/idris2/pkg017/a1/A.idr b/tests/idris2/pkg017/a1/A.idr new file mode 100644 index 000000000..0efc5f6a1 --- /dev/null +++ b/tests/idris2/pkg017/a1/A.idr @@ -0,0 +1,5 @@ +module A + +export +i : Int +i = 1 diff --git a/tests/idris2/pkg017/a1/a1.ipkg b/tests/idris2/pkg017/a1/a1.ipkg new file mode 100644 index 000000000..a9bfeae0a --- /dev/null +++ b/tests/idris2/pkg017/a1/a1.ipkg @@ -0,0 +1,7 @@ +package a1 + +modules = A + +sourcedir = "." + +options = "--no-prelude" diff --git a/tests/idris2/pkg017/a2/A.idr b/tests/idris2/pkg017/a2/A.idr new file mode 100644 index 000000000..c8d1b9de8 --- /dev/null +++ b/tests/idris2/pkg017/a2/A.idr @@ -0,0 +1,5 @@ +module A + +export +i : Int +i = 2 diff --git a/tests/idris2/pkg017/a2/a2.ipkg b/tests/idris2/pkg017/a2/a2.ipkg new file mode 100644 index 000000000..f138bcfb7 --- /dev/null +++ b/tests/idris2/pkg017/a2/a2.ipkg @@ -0,0 +1,7 @@ +package a2 + +modules = A + +sourcedir = "." + +options = "--no-prelude" diff --git a/tests/idris2/pkg017/b1/b1.ipkg b/tests/idris2/pkg017/b1/b1.ipkg new file mode 100644 index 000000000..50c510457 --- /dev/null +++ b/tests/idris2/pkg017/b1/b1.ipkg @@ -0,0 +1,8 @@ +package b1 +sourcedir = "src" + +modules = B1 + +options = "--no-prelude" + +depends = a1 diff --git a/tests/idris2/pkg017/b1/src/B1.idr b/tests/idris2/pkg017/b1/src/B1.idr new file mode 100644 index 000000000..09cf3f78b --- /dev/null +++ b/tests/idris2/pkg017/b1/src/B1.idr @@ -0,0 +1,6 @@ +module B1 + +import A + +i1 : Int +i1 = A.i diff --git a/tests/idris2/pkg017/b2/b2.ipkg b/tests/idris2/pkg017/b2/b2.ipkg new file mode 100644 index 000000000..efa6e4b40 --- /dev/null +++ b/tests/idris2/pkg017/b2/b2.ipkg @@ -0,0 +1,8 @@ +package b2 +sourcedir = "src" + +modules = B2 + +options = "--no-prelude" + +depends = a2 diff --git a/tests/idris2/pkg017/b2/src/B2.idr b/tests/idris2/pkg017/b2/src/B2.idr new file mode 100644 index 000000000..0840143cc --- /dev/null +++ b/tests/idris2/pkg017/b2/src/B2.idr @@ -0,0 +1,6 @@ +module B2 + +import A + +i2 : Int +i2 = A.i diff --git a/tests/idris2/pkg017/expected.in b/tests/idris2/pkg017/expected.in new file mode 100644 index 000000000..9c5483764 --- /dev/null +++ b/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 diff --git a/tests/idris2/pkg017/gen_expected.sh b/tests/idris2/pkg017/gen_expected.sh new file mode 100755 index 000000000..193a8ad31 --- /dev/null +++ b/tests/idris2/pkg017/gen_expected.sh @@ -0,0 +1,3 @@ +#!/usr/bin/env sh + +sed -e "s|__PWD__|${MY_PWD}|g" expected.in >expected diff --git a/tests/idris2/pkg017/input1 b/tests/idris2/pkg017/input1 new file mode 100644 index 000000000..42fa12c74 --- /dev/null +++ b/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) diff --git a/tests/idris2/pkg017/input2 b/tests/idris2/pkg017/input2 new file mode 100644 index 000000000..179bd1ddf --- /dev/null +++ b/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) diff --git a/tests/idris2/pkg017/run b/tests/idris2/pkg017/run new file mode 100644 index 000000000..b5fbf48c0 --- /dev/null +++ b/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