Skip to content

Commit

Permalink
Improve idris-filename-to-load to return a pair of
Browse files Browse the repository at this point in the history
"source dir" and "relative file path" or
"work dir" and "relative file path" when idris protocol version
is greater than 1.

Why:
In Idris2 the files are loaded relative to work directory
which is a directory containing an ".ipkg" file.

Relates to:
idris-lang/Idris2#3310
#627
  • Loading branch information
keram committed Jul 8, 2024
1 parent 09de86a commit 2694443
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 8 deletions.
16 changes: 8 additions & 8 deletions idris-commands.el
Original file line number Diff line number Diff line change
Expand Up @@ -168,14 +168,14 @@
(defun idris-filename-to-load ()
"Compute the working directory and filename to load in Idris.
Returning these as a cons."
(let* ((fn (buffer-file-name))
(ipkg-srcdir (idris-ipkg-find-src-dir))
(srcdir (or ipkg-srcdir (file-name-directory fn))))
(when (and ;; check that srcdir is prefix of filename - then load relative
(> (length fn) (length srcdir))
(string= (substring fn 0 (length srcdir)) srcdir))
(setq fn (file-relative-name fn srcdir)))
(cons srcdir fn)))
(let* ((ipkg-file (car-safe (idris-find-file-upwards "ipkg")))
(file-name (buffer-file-name))
(work-dir (directory-file-name (file-name-parent-directory (or ipkg-file file-name))))
(source-dir (or (idris-ipkg-find-src-dir) work-dir)))
;; TODO: Update once https://github.com/idris-lang/Idris2/issues/3310 is resolved
(if (> idris-protocol-version 1)
(cons work-dir (file-relative-name file-name work-dir))
(cons source-dir (file-relative-name file-name source-dir)))))

(defun idris-load-file (&optional set-line)
"Pass the current buffer's file to the inferior Idris process.
Expand Down
40 changes: 40 additions & 0 deletions test/idris-commands-test.el
Original file line number Diff line number Diff line change
Expand Up @@ -313,6 +313,46 @@ myReverse xs = revAcc [] xs where
(delete-directory mock-directory-name t)
(idris-quit))))

(ert-deftest idris-test-idris-filename-to-load ()
"Test that `idris-filename-to-load' returns expected data structure."
(cl-flet ((idris-ipkg-find-src-dir-stub () src-dir)
(idris-find-file-upwards-stub (_ex) ipkg-files)
(buffer-file-name-stub () "/some/path/to/idris-project/src/Component/Foo.idr"))
(advice-add 'idris-ipkg-find-src-dir :override #'idris-ipkg-find-src-dir-stub)
(advice-add 'idris-find-file-upwards :override #'idris-find-file-upwards-stub)
(advice-add 'buffer-file-name :override #'buffer-file-name-stub)
(let* ((default-directory "/some/path/to/idris-project/src/Component")
ipkg-files
src-dir)
(unwind-protect
(progn
(let ((result (idris-filename-to-load)))
(should (equal default-directory (car result)))
(should (equal "Foo.idr" (cdr result))))

;; When ipkg sourcedir value is set
;; Then return combination of source directory
;; and relative path of the file to the source directory
(let* ((src-dir "/some/path/to/idris-project/src")
(result (idris-filename-to-load)))
(should (equal src-dir (car result)))
(should (equal "Component/Foo.idr" (cdr result))))

;; When ipkg sourcedir value is set
;; and idris-protocol-version is greater than 1
;; Then return combination of work directory
;; (Directory containing the first found ipkg file)
;; and relative path of the file to the work directory
(let* ((ipkg-files '("/some/path/to/idris-project/baz.ipkg"))
(idris-protocol-version 2)
(result (idris-filename-to-load)))
(should (equal "/some/path/to/idris-project" (car result)))
(should (equal "src/Component/Foo.idr" (cdr result)))))

(advice-remove 'idris-ipkg-find-src-dir #'idris-ipkg-find-src-dir-stub)
(advice-remove 'idris-find-file-upwards #'idris-find-file-upwards-stub)
(advice-remove 'buffer-file-name #'buffer-file-name-stub)))))

;; Tests by Yasuhiko Watanabe
;; https://github.com/idris-hackers/idris-mode/pull/537/files
(idris-ert-command-action "test-data/CaseSplit.idr" idris-case-split idris-test-eq-buffer)
Expand Down

0 comments on commit 2694443

Please sign in to comment.