From dc3ce1551243c021b3f600aa3ff5d25e9116e491 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Wed, 12 Aug 2015 15:44:16 +0900
Subject: [PATCH] caching a project root to a local variable.

---
 elisp/ghc-check.el   |  2 +-
 elisp/ghc-process.el | 47 +++++++++++++++++++++++---------------------
 2 files changed, 26 insertions(+), 23 deletions(-)

diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el
index 4e7236a..e468504 100644
--- a/elisp/ghc-check.el
+++ b/elisp/ghc-check.el
@@ -137,7 +137,7 @@ nil            does not display errors/warnings.
 	info infos)
     (dolist (err errs (nreverse infos))
       (when (string-match regex err)
-	(let* ((file (expand-file-name (match-string 1 err) (ghc-get-project-root))) ;; for Windows
+	(let* ((file (expand-file-name (match-string 1 err) ghc-process-root)) ;; for Windows
 	       (line (string-to-number (match-string 2 err)))
                (coln (string-to-number (match-string 3 err)))
 	       (msg (match-string 4 err))
diff --git a/elisp/ghc-process.el b/elisp/ghc-process.el
index b44416e..d9c0821 100644
--- a/elisp/ghc-process.el
+++ b/elisp/ghc-process.el
@@ -19,6 +19,7 @@
 (defvar-local ghc-process-original-file nil)
 (defvar-local ghc-process-callback nil)
 (defvar-local ghc-process-hook nil)
+(defvar-local ghc-process-root nil)
 
 (defvar ghc-command "ghc-mod")
 
@@ -28,28 +29,30 @@
   (ghc-run-ghc-mod '("root")))
 
 (defun ghc-with-process (cmd callback &optional hook1 hook2)
-  (unless ghc-process-process-name
-    (setq ghc-process-process-name (ghc-get-project-root)))
-  (when (and ghc-process-process-name (not ghc-process-running))
-    (setq ghc-process-running t)
-    (if hook1 (funcall hook1))
-    (let* ((cbuf (current-buffer))
-	   (name ghc-process-process-name)
-	   (buf (get-buffer-create (concat " ghc-mod:" name)))
-	   (file (buffer-file-name))
-	   (cpro (get-process name)))
-      (ghc-with-current-buffer buf
-        (setq ghc-process-original-buffer cbuf)
-	(setq ghc-process-original-file file)
-	(setq ghc-process-callback callback)
-	(setq ghc-process-hook hook2)
-	(erase-buffer)
-	(let ((pro (ghc-get-process cpro name buf)))
-	  (process-send-string pro cmd)
-	  (when ghc-debug
-	    (ghc-with-debug-buffer
-	     (insert (format "%% %s" cmd))))
-	  pro)))))
+  (let ((root (ghc-get-project-root)))
+    (unless ghc-process-process-name
+      (setq ghc-process-process-name root))
+    (when (and ghc-process-process-name (not ghc-process-running))
+      (setq ghc-process-running t)
+      (if hook1 (funcall hook1))
+      (let* ((cbuf (current-buffer))
+	     (name ghc-process-process-name)
+	     (buf (get-buffer-create (concat " ghc-mod:" name)))
+	     (file (buffer-file-name))
+	     (cpro (get-process name)))
+	(ghc-with-current-buffer buf
+	  (setq ghc-process-original-buffer cbuf)
+	  (setq ghc-process-original-file file)
+	  (setq ghc-process-callback callback)
+	  (setq ghc-process-hook hook2)
+	  (setq ghc-process-root root)
+	  (erase-buffer)
+	  (let ((pro (ghc-get-process cpro name buf)))
+	    (process-send-string pro cmd)
+	    (when ghc-debug
+	      (ghc-with-debug-buffer
+	       (insert (format "%% %s" cmd))))
+	    pro))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;