Skip to content
Browse files

(inferior-haskell-find-project-root): New var, to

Ignore-this: de0431c92ca12c59574a780d4c131c01
(inferior-haskell-find-project-root): New var, to
replace inferior-haskell-use-cabal.
(inferior-haskell-find-project-root): New function.
(inferior-haskell-load-file): Use them.
(inferior-haskell-module-alist): Use a temp buffer so as not to write
out random junk before/after the actual module alist.

darcs-hash:20070907041931-c2f2e-bed816e32515d7e8f092e3e2b24371e2121b0d1a.gz
  • Loading branch information...
1 parent a476f80 commit 6e300b7c66ebb42dd5debf359377c01b094e5af6 monnier committed Sep 6, 2007
Showing with 80 additions and 21 deletions.
  1. +9 −0 ChangeLog
  2. +71 −21 inf-haskell.el
View
9 ChangeLog
@@ -1,3 +1,12 @@
+2007-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * inf-haskell.el (inferior-haskell-find-project-root): New var, to
+ replace inferior-haskell-use-cabal.
+ (inferior-haskell-find-project-root): New function.
+ (inferior-haskell-load-file): Use them.
+ (inferior-haskell-module-alist): Use a temp buffer so as not to write
+ out random junk before/after the actual module alist.
+
2007-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
* inf-haskell.el (inferior-haskell-load-file): Re-add the `reload' arg.
View
92 inf-haskell.el
@@ -27,11 +27,8 @@
;; Todo:
+;; - Check out Shim for ideas.
;; - i-h-load-buffer and i-h-send-region.
-;; - Obey the Hs-Source-Dirs setting in the Cabal file.
-;; - If there's no Cabal file, look for a "module" line at the beginning of
-;; the file to determine how many times to "cd .." in order to get to the
-;; root of the project (count the number of "." in the module name).
;;; Code:
@@ -98,8 +95,9 @@ The command can include arguments."
"Regexps for error messages generated by inferior Haskell processes.
The format should be the same as for `compilation-error-regexp-alist'.")
-(defcustom inferior-haskell-use-cabal t
- "If non-nil, try and find a Cabal file to get the project root directory."
+(defcustom inferior-haskell-find-project-root t
+ "If non-nil, try and find the project root directory of this file.
+This will either look for a Cabal file or a \"module\" statement in the file."
:type 'boolean)
(define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell"
@@ -217,6 +215,59 @@ The process PROC should be associated to a comint buffer."
(set (make-local-variable 'inferior-haskell-cabal-buffer)
(haskell-cabal-find-file))))))
+(defun inferior-haskell-find-project-root (buf)
+ (with-current-buffer buf
+ (let ((cabal (inferior-haskell-cabal-of-buf buf)))
+ (or (when cabal
+ (with-current-buffer cabal
+ (save-excursion
+ (goto-char (point-min))
+ (if (let ((case-fold-search t))
+ (not (re-search-forward "^hs-source-dirs:[ \t]*\\(.*\\)"
+ nil t)))
+ ;; If there's a Cabal file with no Hs-Source-Dirs, then
+ ;; just use the Cabal file's directory.
+ default-directory
+ ;; If there is an HSD, then check that it's an existing
+ ;; dir (otherwise, it may be a list of dirs and we don't
+ ;; know what to do with those). If it doesn't exist, then
+ ;; give up.
+ (let ((hsd (expand-file-name (match-string 1))))
+ (if (file-directory-p hsd) hsd))))))
+ ;; If there's no Cabal file or it's not helpful, try to look for
+ ;; a "module" statement and count the number of "." in the
+ ;; module name.
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (when (re-search-forward
+ "^module[ \t]+\\([^- \t\n]+\\.[^- \t\n]+\\)[ \t]+where\\>" nil t)
+ (let* ((dir default-directory)
+ (module (match-string 1))
+ (pos 0))
+ (while (string-match "\\." module pos)
+ (setq pos (match-end 0))
+ (setq dir (expand-file-name ".." dir)))
+ ;; Let's check that the module name matches the file name,
+ ;; otherwise the project root is probably not what we think.
+ (if (eq t (compare-strings
+ (file-name-sans-extension buffer-file-name)
+ nil nil
+ (expand-file-name
+ (replace-regexp-in-string "\\." "/" module)
+ dir)
+ nil nil t))
+ dir
+ ;; If they're not equal, it means the local directory
+ ;; hierarchy doesn't match the module name. This seems
+ ;; odd, so let's warn the user about it. May help us
+ ;; debug this code as well.
+ (message "Ignoring inconsistent `module' info: %s in %s"
+ module buffer-file-name)
+ nil)))))))))
+
+
+
;;;###autoload
(defun inferior-haskell-load-file (&optional reload)
"Pass the current buffer's file to the inferior haskell process."
@@ -229,15 +280,13 @@ The process PROC should be associated to a comint buffer."
(with-current-buffer (process-buffer proc)
(compilation-forget-errors)
(let ((parsing-end (marker-position (process-mark proc)))
- cabal)
+ root)
;; Go to the root of the Cabal project, if applicable.
- (when (and inferior-haskell-use-cabal
- (setq cabal (inferior-haskell-cabal-of-buf buf)))
+ (when (and inferior-haskell-find-project-root
+ (setq root (inferior-haskell-find-project-root buf)))
;; Not sure if it's useful/needed and if it actually works.
- (unless (equal default-directory
- (with-current-buffer cabal default-directory))
- (setq default-directory
- (with-current-buffer cabal default-directory))
+ (unless (equal default-directory root)
+ (setq default-directory root)
(inferior-haskell-send-command
proc (concat ":cd " default-directory)))
(setq file (file-relative-name file)))
@@ -537,14 +586,15 @@ so that it can be obtained more quickly next time.")
;; ...or generate it again and save it in a file for later.
(let ((alist (inferior-haskell-compute-module-alist)))
(when inferior-haskell-module-alist-file
- (print alist (current-buffer))
- ;; Do the write to a temp file first, then rename it.
- ;; This makes it more atomic, and suffers from fewer security
- ;; holes related to race conditions if the file is in /tmp.
- (let ((tmp (make-temp-file inferior-haskell-module-alist-file)))
- (write-region (point-min) (point-max) tmp)
- (rename-file tmp inferior-haskell-module-alist-file
- 'ok-if-already-exists)))
+ (with-temp-buffer
+ (print alist (current-buffer))
+ ;; Do the write to a temp file first, then rename it.
+ ;; This makes it more atomic, and suffers from fewer security
+ ;; holes related to race conditions if the file is in /tmp.
+ (let ((tmp (make-temp-file inferior-haskell-module-alist-file)))
+ (write-region (point-min) (point-max) tmp)
+ (rename-file tmp inferior-haskell-module-alist-file
+ 'ok-if-already-exists))))
alist)))))
(defvar inferior-haskell-ghc-internal-ident-alist

0 comments on commit 6e300b7

Please sign in to comment.
Something went wrong with that request. Please try again.