about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/lsp-haskell-20180826.1119/lsp-haskell.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/lsp-haskell-20180826.1119/lsp-haskell.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/lsp-haskell-20180826.1119/lsp-haskell.el301
1 files changed, 301 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/lsp-haskell-20180826.1119/lsp-haskell.el b/configs/shared/emacs/.emacs.d/elpa/lsp-haskell-20180826.1119/lsp-haskell.el
new file mode 100644
index 000000000000..4197334b9c5e
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/lsp-haskell-20180826.1119/lsp-haskell.el
@@ -0,0 +1,301 @@
+;;; lsp-haskell.el --- Haskell support for lsp-mode
+
+;; Version: 1.0
+;; Package-Version: 20180826.1119
+;; Package-Requires: ((lsp-mode "3.0") (haskell-mode "1.0"))
+;; Keywords: haskell
+;; URL: https://github.com/emacs-lsp/lsp-haskell
+
+;;; Code:
+
+(require 'haskell)
+(require 'lsp-mode)
+(require 'projectile nil 'noerror)
+
+;; ---------------------------------------------------------------------
+;; Configuration
+
+;;;###autoload
+(defgroup lsp-haskell nil
+  "Customization group for ‘lsp-haskell’."
+  :group 'lsp-mode)
+
+;;;###autoload
+(defcustom lsp-haskell-process-path-hie
+  ;; "hie"
+  "hie-wrapper"
+  "The path for starting the haskell-ide-engine
+server. hie-wrapper exists on HIE master from 2018-06-10"
+  :group 'lsp-haskell
+  :type '(choice string))
+
+;;;###autoload
+(defcustom lsp-haskell-process-args-hie
+  '("-d" "-l" "/tmp/hie.log")
+  "The arguments for starting the haskell-ide-engine server.
+For a debug log, use `-d -l /tmp/hie.log'."
+  :group 'lsp-haskell
+  :type '(repeat (string :tag "Argument")))
+
+;; ---------------------------------------------------------------------
+;; HaRe functions
+
+(defun lsp-demote ()
+  "Demote a function to the level it is used"
+  (interactive)
+  (lsp--cur-workspace-check)
+  (lsp--send-execute-command
+   "hare:demote"
+   (vector `(:file ,(concat "file://" buffer-file-name)
+             :pos  ,(lsp-point-to-position (point))))))
+
+(defun lsp-duplicate-definition (newname)
+  "Duplicate a definition"
+  (interactive "sNew definition name: ")
+  (lsp--cur-workspace-check)
+  (lsp--send-execute-command
+   "hare:dupdef"
+   (vector `(:file ,(concat "file://" buffer-file-name)
+             :pos  ,(lsp-point-to-position (point))
+             :text ,newname))))
+
+(defun lsp-if-to-case ()
+  "Convert an if statement to a case statement"
+  (interactive)
+  (lsp--cur-workspace-check)
+  (lsp--send-execute-command
+   "hare:iftocase"
+   (vector `(:file      ,(concat "file://" buffer-file-name)
+             :start_pos ,(lsp-get-start-position)
+             :end_pos   ,(lsp-get-end-position)))))
+
+(defun lsp-lift-level ()
+  "Lift a function to the top level"
+  (interactive)
+  (lsp--cur-workspace-check)
+  (lsp--send-execute-command
+   "hare:liftonelevel"
+   (vector `(:file ,(concat "file://" buffer-file-name)
+             :pos  ,(lsp-point-to-position (point))))))
+
+(defun lsp-lift-to-top ()
+  "Lift a function to the top level"
+  (interactive)
+  (lsp--cur-workspace-check)
+  (lsp--send-execute-command
+   "hare:lifttotoplevel"
+   (vector `(:file ,(concat "file://" buffer-file-name)
+             :pos  ,(lsp-point-to-position (point))))))
+
+(defun lsp-delete-definition ()
+  "Delete a definition"
+  (interactive)
+  (lsp--cur-workspace-check)
+  (lsp--send-execute-command
+   "hare:deletedef"
+   (vector `(:file ,(concat "file://" buffer-file-name)
+             :pos  ,(lsp-point-to-position (point))))))
+
+(defun lsp-generalise-applicative ()
+  "Generalise a monadic function to use applicative"
+  (interactive)
+  (lsp--cur-workspace-check)
+  (lsp--send-execute-command
+   "hare:genapplicative"
+   (vector `(:file ,(concat "file://" buffer-file-name)
+             :pos  ,(lsp-point-to-position (point))))))
+
+;; ---------------------------------------------------------------------
+
+(defun lsp-haskell--session-cabal-dir ()
+  "Get the session cabal-dir."
+  (let* ((cabal-file (haskell-cabal-find-file))
+         (cabal-dir (if cabal-file
+                        (file-name-directory cabal-file)
+                      "." ;; no cabal file, use directory only
+                      )))
+    (progn
+      (message "cabal-dir: %s" cabal-dir)
+      cabal-dir)))
+
+(defun lsp-haskell--get-root ()
+  "Get project root directory.
+
+First searches for root via projectile.  Tries to find cabal file
+if projectile way fails"
+  (if (fboundp 'projectile-project-root)
+      (projectile-project-root)
+    (let ((dir (lsp-haskell--session-cabal-dir)))
+      (if (string= dir "/")
+          (user-error (concat "Couldn't find cabal file, using:" dir))
+        dir))))
+
+;; ---------------------------------------------------------------------
+
+;;----------------------------------------------------------------------
+;; AZ: Not sure where this section should go, putting it here for now
+
+;; AZ: This section based on/inspired by the intero 'intero-apply-suggestions' code, at
+;; https://github.com/commercialhaskell/intero/blob/master/elisp/intero.el
+
+(defun lsp-apply-commands ()
+  "Prompt and apply any codeAction commands."
+  (interactive)
+  (if (null lsp-code-actions)
+      (message "No actions to apply")
+    (let ((to-apply
+           (lsp--intero-multiswitch
+            (format "There are %d suggestions to apply:" (length lsp-code-actions))
+            (cl-remove-if-not
+             #'identity
+             (mapcar
+              (lambda (suggestion)
+                ;; (pcase (plist-get suggestion :type)
+                ;;   (add-extension
+                ;;    (list :key suggestion
+                ;;          :title (concat "Add {-# LANGUAGE "
+                ;;                         (plist-get suggestion :extension)
+                ;;                         " #-}")
+                ;;          :default t))
+                ;;   (redundant-constraint
+                ;;    (list :key suggestion
+                ;;          :title (concat
+                ;;                  "Remove redundant constraints: "
+                ;;                  (string-join (plist-get suggestion :redundancies)
+                ;;                               ", ")
+                ;;                  "\n    from the "
+                ;;                  (plist-get suggestion :signature))
+                ;;          :default nil)))
+                ;; (message "lsp-apply-command:suggestion command=%s"    (gethash "command" suggestion))
+                ;; (message "lsp-apply-command:suggestion ommand=args%s" (gethash "arguments" suggestion))
+                (list :key   (gethash "title" suggestion)
+                      :title (gethash "title" suggestion)
+                      :type  "codeAction"
+                      :default t
+                      :command suggestion)
+                )
+              lsp-code-actions)))))
+      (if (null to-apply)
+          (message "No changes selected to apply.")
+        (let ((sorted (sort to-apply
+                            (lambda (lt gt)
+                              (let ((lt-line   (or (plist-get lt :line)   0))
+                                    (lt-column (or (plist-get lt :column) 0))
+                                    (gt-line   (or (plist-get gt :line)   0))
+                                    (gt-column (or (plist-get gt :column) 0)))
+                                (or (> lt-line gt-line)
+                                    (and (= lt-line gt-line)
+                                         (> lt-column gt-column))))))))
+          ;; # Changes unrelated to the buffer
+          (cl-loop
+           for suggestion in sorted
+           do ;; (message "lsp-apply-commands:suggestion=%s" suggestion)
+              (pcase (plist-get suggestion :type)
+                (otherwise
+                 (lsp--execute-lsp-server-command suggestion))))
+          ;; # Changes that do not increase/decrease line numbers
+          ;;
+          ;; Update in-place suggestions
+
+          ;; # Changes that do increase/decrease line numbers
+          ;;
+
+          ;; Add extensions to the top of the file
+          )))))
+
+;; The following is copied directly from intero. I suspect it would be better to
+;; have it in a dependency somewhere
+
+(defun lsp--intero-multiswitch (title options)
+  "Displaying TITLE, read multiple flags from a list of OPTIONS.
+Each option is a plist of (:key :default :title) wherein:
+
+  :key should be something comparable with EQUAL
+  :title should be a string
+  :default (boolean) specifies the default checkedness"
+  (let ((available-width (window-total-width)))
+    (save-window-excursion
+      (lsp--intero-with-temp-buffer
+        (rename-buffer (generate-new-buffer-name "multiswitch"))
+        (widget-insert (concat title "\n\n"))
+        (widget-insert (propertize "Hit " 'face 'font-lock-comment-face))
+        (widget-create 'push-button :notify
+                       (lambda (&rest ignore)
+                         (exit-recursive-edit))
+                       "C-c C-c")
+        (widget-insert (propertize " to apply these choices.\n\n" 'face 'font-lock-comment-face))
+        (let* ((me (current-buffer))
+               (choices (mapcar (lambda (option)
+                                  (append option (list :value (plist-get option :default))))
+                                options)))
+          (cl-loop for option in choices
+                   do (widget-create
+                       'toggle
+                       :notify (lambda (widget &rest ignore)
+                                 (setq choices
+                                       (mapcar (lambda (choice)
+                                                 (if (equal (plist-get choice :key)
+                                                            (plist-get (cdr widget) :key))
+                                                     (plist-put choice :value (plist-get (cdr widget) :value))
+                                                   choice))
+                                               choices)))
+                       :on (concat "[x] " (plist-get option :title))
+                       :off (concat "[ ] " (plist-get option :title))
+                       :value (plist-get option :default)
+                       :key (plist-get option :key)
+                       :command (plist-get option :command)))
+          (let ((lines (line-number-at-pos)))
+            (select-window (split-window-below))
+            (switch-to-buffer me)
+            (goto-char (point-min)))
+          (use-local-map
+           (let ((map (copy-keymap widget-keymap)))
+             (define-key map (kbd "C-c C-c") 'exit-recursive-edit)
+             (define-key map (kbd "C-g") 'abort-recursive-edit)
+             map))
+          (widget-setup)
+          (recursive-edit)
+          (kill-buffer me)
+          (mapcar (lambda (choice)
+                    (plist-get choice :command))
+                  (cl-remove-if-not (lambda (choice)
+                                      (plist-get choice :value))
+                                    choices)))))))
+
+;; The following is copied directly from intero. I suspect it would be better to
+;; have it in a dependency somewhere
+(defmacro lsp--intero-with-temp-buffer (&rest body)
+  "Run BODY in `with-temp-buffer', but inherit certain local variables from the current buffer first."
+  (declare (indent 0) (debug t))
+  `(let ((initial-buffer (current-buffer)))
+     (with-temp-buffer
+       (lsp--intero-inherit-local-variables initial-buffer)
+       ,@body)))
+
+;; The following is copied directly from intero. I suspect it would be better to
+;; have it in a dependency somewhere
+(defun lsp--intero-inherit-local-variables (buffer)
+  "Make the current buffer inherit values of certain local variables from BUFFER."
+  (let ((variables '(
+                     ;; TODO: shouldn’t more of the above be here?
+                     )))
+    (cl-loop for v in variables do
+             (set (make-local-variable v) (buffer-local-value v buffer)))))
+;; ---------------------------------------------------------------------
+
+(lsp-define-stdio-client lsp-haskell "haskell" #'lsp-haskell--get-root
+			 ;; '("hie" "--lsp" "-d" "-l" "/tmp/hie.log"))
+       ;; '("hie" "--lsp" "-d" "-l" "/tmp/hie.log" "--vomit"))
+       (lsp--haskell-hie-command))
+
+(defun lsp--haskell-hie-command ()
+  "Comamnd and arguments for launching the inferior hie process.
+These are assembled from the customizable variables
+ `lsp-haskell-process-path-hie' and
+ `lsp-haskell-process-args-hie'. If the hie executable is
+ installed via its Makefile, there will be compiler-specific
+ versions with names like 'hie-8.0.2' or 'hie-8.2.2'."
+   (append (list lsp-haskell-process-path-hie "--lsp") lsp-haskell-process-args-hie) )
+
+(provide 'lsp-haskell)
+;;; lsp-haskell.el ends here