Invoke hasktags more directly

haskell-cabal.el

@@ -1069,6 +1069,55 @@ source-section."
     ;; unwind
     (haskell-mode-toggle-interactive-prompt-state t)))
 
-(provide 'haskell-cabal)
 
+(defun haskell-cabal--find-tags-dir ()
+  "Return a directory where TAGS file will be generated.
+Tries to find cabal file first and if succeeds uses its location.
+If cabal file not found uses current file directory.  If current
+buffer not visiting a file returns nil."
+  (or (haskell-cabal-find-dir)
+      (when buffer-file-name
+        (file-name-directory buffer-file-name))))
+
+(defun haskell-cabal--compose-hasktags-command (dir)
+  "Prepare command to execute `hasktags` command in DIR folder.
+By default following parameters are passed to Hasktags
+executable:
+-e - generate ETAGS file
+-x - generate additional information in CTAGS file.
+
+This function takes into account user's operation system: in case
+of Windows it generates simple command, relying on Hasktags
+itself to find source files:
+
+hasktags --output=DIR\TAGS -x -e DIR
+
+In other cases it uses `find` command to find all source files
+recursively avoiding visiting unnecessary heavy directories like
+.git, .svn, _darcs and build directories created by
+cabal-install, stack, etc and passes list of found files to Hasktags."
+  (if (eq system-type 'windows-nt)
+      (format "hasktags --output=\"%s\\TAGS\" -x -e \"%s\"" dir dir)
+    (format "cd %s && %s | %s"
+            dir
+            (concat "find . "
+                    "-type d \\( "
+                    "-path ./.git "
+                    "-o -path ./.svn "
+                    "-o -path ./_darcs "
+                    "-o -path ./.stack-work "
+                    "-o -path ./dist "
+                    "-o -path ./.cabal-sandbox "
+                    "\\) -prune "
+                    "-o -type f \\( "
+                    "-name '*.hs' "
+                    "-or -name '*.lhs' "
+                    "-or -name '*.hsc' "
+                    "\\) -not \\( "
+                    "-name '#*' "
+                    "-or -name '.*' "
+                    "\\) -print0")
+            "xargs -0 hasktags -e -x")))
+
+(provide 'haskell-cabal)
 ;;; haskell-cabal.el ends here

haskell-commands.el

@@ -35,6 +35,7 @@
 (require 'haskell-presentation-mode)
 (require 'haskell-utils)
 (require 'highlight-uses-mode)
+(require 'haskell-cabal)
 
 ;;;###autoload
 (defun haskell-process-restart ()
@@ -689,7 +690,9 @@ happened since function invocation)."
 
             (haskell-utils-async-stop-watching-changes init-buffer))))))))
 
-;;;###autoload
+(make-obsolete 'haskell-process-generate-tags
+               'haskell-mode-generate-tags
+               "2016-03-14")
 (defun haskell-process-generate-tags (&optional and-then-find-this-tag)
   "Regenerate the TAGS table.
 If optional AND-THEN-FIND-THIS-TAG argument is present it is used with
@@ -700,20 +703,13 @@ function `xref-find-definitions' after new table was generated."
      process
      (make-haskell-command
       :state (cons process and-then-find-this-tag)
-      :go (lambda (state)
-            (if (eq system-type 'windows-nt)
-                (haskell-process-send-string
-                 (car state)
-                 (format ":!hasktags --output=\"%s\\TAGS\" -x -e \"%s\""
-                            (haskell-session-cabal-dir (haskell-process-session (car state)))
-                            (haskell-session-cabal-dir (haskell-process-session (car state)))))
-              (haskell-process-send-string
-               (car state)
-               (format ":!cd %s && %s | %s"
-                       (haskell-session-cabal-dir
-                        (haskell-process-session (car state)))
-                       "find . -type d \\( -path ./.stack-work -o -path ./dist -o -path ./.cabal-sandbox \\) -prune -o -type f \\( -name '*.hs' -or -name '*.lhs' -or -name '*.hsc' \\) -not \\( -name '#*' -or -name '.*' \\) -print0"
-                       "xargs -0 hasktags -e -x"))))
+      :go
+      (lambda (state)
+        (let* ((process (car state))
+               (cabal-dir (haskell-session-cabal-dir
+                           (haskell-process-session process)))
+               (command (haskell-cabal--compose-hasktags-command cabal-dir)))
+          (haskell-process-send-string process command)))
       :complete (lambda (state _response)
                   (when (cdr state)
                     (let ((tags-file-name

haskell-interactive-mode.el

@@ -425,18 +425,6 @@ SESSION, otherwise operate on the current buffer."
   (setq haskell-interactive-mode-history-index
         0))
 
-(defun haskell-mode-message-line (str)
-  "Message only one line, multiple lines just disturbs the programmer."
-  (message (haskell-mode-one-line str (frame-width))))
-
-(defun haskell-mode-one-line (str width)
-  "Try to fit as much as possible on one line."
-  (let*
-      ((long-line (replace-regexp-in-string "\n" " " str))
-       (condensed  (replace-regexp-in-string " +" " "
-                                             (haskell-string-trim long-line))))
-    (truncate-string-to-width condensed width nil nil "…")))
-
 (defun haskell-interactive-mode-tab ()
   "Do completion if at prompt or else try collapse/expand."
   (interactive)

haskell-load.el

@@ -21,6 +21,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'haskell-mode)
 (require 'haskell-process)
 (require 'haskell-interactive-mode)
 (require 'haskell-modules)

haskell-mode.el

@@ -144,6 +144,7 @@
 (require 'haskell-string)
 (require 'haskell-indentation)
 (require 'haskell-font-lock)
+(require 'haskell-cabal)
 
 ;; All functions/variables start with `(literate-)haskell-'.
 
@@ -1069,8 +1070,36 @@ successful, nil otherwise."
     (goto-char (point-min))
     (end-of-line)))
 
-;; Provide ourselves:
+;;;###autoload
+(defun haskell-mode-generate-tags (&optional and-then-find-this-tag)
+  "Generate tags using Hasktags.  This is synchronous function.
+
+If optional AND-THEN-FIND-THIS-TAG argument is present it is used
+with function `xref-find-definitions' after new table was
+generated."
+  (let* ((dir (haskell-cabal--find-tags-dir))
+         (command (haskell-cabal--compose-hasktags-command dir)))
+    (if (not command)
+        (error "Unable to compose hasktags command")
+      (shell-command command)
+      (haskell-mode-message-line "Tags generated.")
+      (when and-then-find-this-tag
+        (let ((tags-file-name dir))
+          (xref-find-definitions and-then-find-this-tag))))))
+
+(defun haskell-mode-message-line (str)
+  "Echo STR in mini-buffer.
+Given string is shrinken to single line, multiple lines just
+disturbs the programmer."
+  (message (haskell-mode-one-line str (frame-width))))
+
+(defun haskell-mode-one-line (str width)
+  "Try to fit STR as much as possible on one line according to given WIDTH."
+  (let* ((long-line (replace-regexp-in-string "\n" " " str))
+         (condensed  (replace-regexp-in-string
+                      " +" " " (haskell-string-trim long-line))))
+    (truncate-string-to-width condensed width nil nil "…")))
 
+;; Provide ourselves:
 (provide 'haskell-mode)
-
 ;;; haskell-mode.el ends here

haskell.el

@@ -339,23 +339,27 @@ If `haskell-process-load-or-reload-prompt' is nil, accept `default'."
 
 ;;;###autoload
 (defun haskell-mode-jump-to-tag (&optional next-p)
-  "Jump to the tag of the given identifier."
+  "Jump to the tag of the given identifier.
+
+Give optional NEXT-P parameter to override value of
+`xref-prompt-for-identifier' during definition search."
   (interactive "P")
   (let ((ident (haskell-ident-at-point))
-        (tags-file-name (haskell-session-tags-filename (haskell-session)))
+        (tags-file-dir (haskell-cabal--find-tags-dir))
         (tags-revert-without-query t))
-    (when (and ident (not (string= "" (haskell-string-trim ident))))
-      (cond ((file-exists-p tags-file-name)
-             (let ((xref-prompt-for-identifier next-p))
-               (xref-find-definitions ident)))
-            (t (haskell-process-generate-tags ident))))))
+    (when (and ident
+               (not (string= "" (haskell-string-trim ident)))
+               tags-file-dir)
+      (let ((tags-file-name (concat tags-file-dir "TAGS")))
+        (cond ((file-exists-p tags-file-name)
+               (let ((xref-prompt-for-identifier next-p))
+                 (xref-find-definitions ident)))
+              (t (haskell-mode-generate-tags ident)))))))
 
 ;;;###autoload
 (defun haskell-mode-after-save-handler ()
   "Function that will be called after buffer's saving."
-  (when haskell-tags-on-save
-    (ignore-errors (when (and (boundp 'haskell-session) haskell-session)
-                     (haskell-process-generate-tags))))
+  (when haskell-tags-on-save (ignore-errors (haskell-mode-generate-tags)))
   (when haskell-stylish-on-save
     (ignore-errors (haskell-mode-stylish-buffer))
     (let ((before-save-hook '())