diff options
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.el | 301 |
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 0000000000..4197334b9c --- /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 |