structured-haskell-mode 1.0.20 → 1.1.0
raw patch · 12 files changed
+525/−88 lines, 12 filesdep −applicative-quotersdep ~haskell-src-exts
Dependencies removed: applicative-quoters
Dependency ranges changed: haskell-src-exts
Files
- elisp/shm-ast.el +50/−37
- elisp/shm-case-split.el +7/−4
- elisp/shm-customizations.el +1/−1
- elisp/shm-insert-del.el +13/−27
- elisp/shm-languages.el +36/−0
- elisp/shm-manipulation.el +329/−0
- elisp/shm-stack.el +62/−0
- elisp/shm-test.el +4/−0
- elisp/shm-yank-kill.el +2/−1
- elisp/shm.el +8/−3
- src/Main.hs +9/−12
- structured-haskell-mode.cabal +4/−3
elisp/shm-ast.el view
@@ -169,6 +169,16 @@ (font-lock-fontify-buffer) (buffer-substring (+ (point-min) (length "x=")) (point-max)))) +(defun shm/call-process-region-ignoring-comments (start end prog-name delete out-buffer display &rest args)+ (save-match-data+ (let ((source-code (buffer-substring-no-properties start end)))+ (with-temp-buffer+ (insert source-code)+ (goto-char (point-min))+ (while (search-forward-regexp "^#.*$" nil t)+ (replace-match ""))+ (apply #'call-process-region (point-min) (point-max) prog-name delete out-buffer display args)))))+ (defun shm-get-ast (type start end) "Get the AST for the given region at START and END. Parses with TYPE. @@ -185,7 +195,7 @@ (let ((temp-buffer (current-buffer))) (with-current-buffer buffer (condition-case e- (apply #'call-process-region+ (apply #'shm/call-process-region-ignoring-comments (append (list start end shm-program-name@@ -197,7 +207,8 @@ (shm-extra-arguments))) ((file-error) (error "Unable to find structured-haskell-mode executable! See README for help.")))))- (read (buffer-string))))))+ (goto-char (point-min))+ (read (current-buffer)))))) (defun shm-check-ast (type start end) "Check whether the region of TYPE from START to END parses.@@ -209,7 +220,7 @@ (with-temp-buffer (let ((temp-buffer (current-buffer))) (with-current-buffer buffer- (apply #'call-process-region+ (apply #'shm/call-process-region-ignoring-comments (append (list start end shm-program-name@@ -305,13 +316,13 @@ ;; proper declaration. ((and (not use-line-comments) (shm-in-comment)- (save-excursion (goto-char (line-beginning-position))+ (save-excursion (beginning-of-line) (shm-in-comment))) nil) ((save-excursion- (goto-char (line-beginning-position))- (or (looking-at "^-}$")- (looking-at "^{-$")))+ (beginning-of-line)+ (or (looking-at-p "^-}$")+ (looking-at-p "^{-$"))) nil) ((bound-and-true-p structured-haskell-repl-mode) (case major-mode@@ -330,44 +341,46 @@ haskell-interactive-mode-prompt-start (line-end-position)))) ;; Don't activate if we're doing a GHCi command.- (unless (and (string-match "^:" whole-line)- (not (string-match "^:[tk] " whole-line)))+ (unless (and (string-match-p "^:" whole-line)+ (not (string-match-p "^:[tk] " whole-line))) (cons (save-excursion (goto-char haskell-interactive-mode-prompt-start)- (when (looking-at ":[kt] ")+ (when (looking-at-p ":[kt] ") (search-forward " " (point-max) t 1)) (point)) (line-end-position)))))))))) ;; Otherwise we just do our line-based hack. (t (save-excursion- (let ((start (or (flet- ((jump ()- (search-backward-regexp "^[^ \n]" nil t 1)- (cond- ((save-excursion (goto-char (line-beginning-position))- (looking-at "|]"))- (jump))- (t (unless (or (looking-at "^-}$")- (looking-at "^{-$"))- (point))))))- (goto-char (line-end-position))- (jump))- 0))- (end (progn (goto-char (1+ (point)))- (or (flet- ((jump ()- (when (search-forward-regexp "[\n]+[^ \n]" nil t 1)- (cond- ((save-excursion (goto-char (line-beginning-position))- (looking-at "|]"))- (jump))- (t (forward-char -1)- (search-backward-regexp "[^\n ]" nil t)- (forward-char)- (point))))))- (jump))- (point-max)))))+ (let* ((skip-at-start-re (rx (or "#" "--" "|]")))+ (start (or (flet+ ((jump ()+ (search-backward-regexp "^[^ \n]" nil t 1)+ (cond+ ((save-excursion (beginning-of-line)+ (and (not (bobp))+ (looking-at-p skip-at-start-re)))+ (jump))+ (t (unless (or (looking-at-p "^-}$")+ (looking-at-p "^{-$"))+ (point))))))+ (goto-char (line-end-position))+ (jump))+ 0))+ (end (progn (goto-char (1+ (point)))+ (or (flet+ ((jump ()+ (when (search-forward-regexp "[\n]+[^ \n]" nil t 1)+ (cond+ ((save-excursion (beginning-of-line)+ (looking-at-p skip-at-start-re))+ (jump))+ (t (forward-char -1)+ (search-backward-regexp "[^\n ]" nil t)+ (forward-char)+ (point))))))+ (jump))+ (point-max))))) (cons start end)))))) (defun shm-delete-markers (decl)
elisp/shm-case-split.el view
@@ -71,9 +71,12 @@ "Given a data declaration STRING, generate a list of alternatives." (with-temp-buffer (insert (replace-regexp-in-string- "[a-zA-Z0-9]+-[0-9.]+:"+ "[A-Z][a-zA-Z0-9_'.]+?\\." ""- string))+ (replace-regexp-in-string+ "[a-zA-Z0-9]+-[0-9.]+:"+ ""+ string))) (text-mode) (structured-haskell-mode) (setq shm-last-parse-start (point-max))@@ -162,8 +165,8 @@ () to allow shm/case-split to work in more cases." (let* ((clean-s (car (last- (mapcar 'shm-trim-string- (split-string s "=>"))))))+ (mapcar 'shm-trim-string+ (split-string s "=>")))))) (if s (let ((case-fold-search nil)) (replace-regexp-in-string "\\b[a-z_][A-Za-z_]*\\b" "()" clean-s))
elisp/shm-customizations.el view
@@ -166,7 +166,7 @@ (defcustom shm-pragmas '("LANGUAGE" "OPTIONS_GHC" "INCLUDE" "DEPRECATED" "WARNING" "INLINE" "NOINLINE" "INLINABLE" "CONLIKE" "LINE" "RULES"- "SPECIALIZE" "UNPACK" "SOURCE" "SCC")+ "SPECIALIZE" "UNPACK" "SOURCE" "SCC" "MINIMAL") "Pragmas supported." :group 'shm :type 'list)
elisp/shm-insert-del.el view
@@ -21,6 +21,7 @@ (require 'shm-slot) (require 'shm-layout) (require 'shm-indent)+(require 'shm-languages) (defun shm-post-self-insert () "Self-insertion handler."@@ -102,14 +103,6 @@ ) (t (shm-insert-string " ")))))) -(defun shm-auto-insert-lambda ()- "Lambda insertion."- (save-excursion- (shm/insert-underscore)- (forward-char)- (insert " -> ")- (shm/insert-undefined)))- (defun shm-nothing-following-p () "Is there nothing following me (other than closing delimiters)?" (or (eolp)@@ -239,18 +232,18 @@ (interactive "p") (if (and (looking-back "{-") (looking-at "-}"))- (progn (insert "# #")- (forward-char -2)- (let ((pragma (ido-completing-read "Pragma: "- shm-pragmas)))- (insert pragma- " ")- (when (string= pragma "LANGUAGE")- (insert (ido-completing-read- "Language: "- (remove-if (lambda (s) (string= s ""))- (split-string (shell-command-to-string "ghc --supported-languages")- "\n")))))))+ (progn+ (insert "# #")+ (forward-char -2)+ (let ((pragma (ido-completing-read "Pragma: "+ shm-pragmas)))+ (insert pragma+ " ")+ (when (string= pragma "LANGUAGE")+ (insert+ (ido-completing-read+ "Language: "+ (shm-supported-languages)))))) (self-insert-command n))) (defun shm/open-paren ()@@ -270,13 +263,6 @@ "Delimit brackets." (interactive) (shm-delimit "[" "]"))--(defun shm/open-bars ()- "Delimit bars."- (interactive)- (if (region-active-p)- (shm-delimit "[|" "|]")- (call-interactively 'self-insert-command))) (defun shm/open-brace () "Delimit braces."
+ elisp/shm-languages.el view
@@ -0,0 +1,36 @@+;;; shm-languages.el --- Supported languages++;; Copyright (c) 2014 Chris Done. All rights reserved.++;; This file is free software; you can redistribute it and/or modify+;; it under the terms of the GNU General Public License as published by+;; the Free Software Foundation; either version 3, or (at your option)+;; any later version.++;; This file is distributed in the hope that it will be useful,+;; but WITHOUT ANY WARRANTY; without even the implied warranty of+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+;; GNU General Public License for more details.++;; You should have received a copy of the GNU General Public License+;; along with this program. If not, see <http://www.gnu.org/licenses/>.++;;; Code:++(require 'shm-stack)++(defvar shm-supported-languages nil)+(make-variable-buffer-local 'shm-supported-languages)++(defun shm-supported-languages ()+ (or shm-supported-languages+ (setq shm-supported-languages+ (remove-if+ (lambda (s) (string= s ""))+ (split-string+ (if (shm-stack-project-p)+ (shell-command-to-string "stack ghc -- --supported-languages")+ (shell-command-to-string "ghc --supported-languages"))+ "\n")))))++(provide 'shm-languages)
elisp/shm-manipulation.el view
@@ -19,6 +19,17 @@ (require 'shm-layout) +(defun shm/split ()+ "Split the current thing into two parts.++Strings: \"x|y\" -> \"x\" \"y\"+"+ (interactive)+ (cond+ ((shm-in-string)+ (insert "\" \"")+ (forward-char -2))))+ (defun shm/$ () "Swap parens with a dollar." (interactive)@@ -233,5 +244,323 @@ (if parent-pair (shm-get-binding-parent parent-pair) (error "Couldn't find a let/generator statement in the node's parents.")))))++(defun shm-push-current-data-constructor-down (&optional arg)+ "Transpose the current data constructor with the data+constructor ARG \"constructors\" below (wrap around if+necessary). Here's an example:++data Test = A | (point)B | C++=>++data Test = A | C | (point)B"+ (interactive)+ (setq arg (or arg 1))+ (let* ((regions (cond ((shm-find-current-field-member-index-at-point) (shm-get-field-constructor-members-points))+ ((shm-find-current-data-member-index-at-point) (shm-get-data-constructor-members-points))+ (t (error "Not a valid point for transposition."))))+ (end (length regions))+ (ind (or (shm-find-current-field-member-index-at-point)+ (shm-find-current-data-member-index-at-point))))+ (if ind+ (let ((next (mod (+ ind arg) end)))+ (shm-transpose-data-constructors ind next))+ (message "Point is not a data constructor."))))++(defun shm-push-current-data-constructor-up (&optional arg)+ "Transpose the current data constructor with the data+constructor ARG \"constructors\" above (wrap around if+necessary). Here's an example:++data Test = A | (point)B | C++=>++data Test = (point)B | A | C"+ (interactive)+ (setq arg (or arg 1))+ (let* ((regions (cond ((shm-find-current-field-member-index-at-point) (shm-get-field-constructor-members-points))+ ((shm-find-current-data-member-index-at-point) (shm-get-data-constructor-members-points))+ (t (error "Not a valid point for transposition."))))+ (end (length regions))+ (ind (or (shm-find-current-field-member-index-at-point)+ (shm-find-current-data-member-index-at-point))))+ (if ind+ (let ((prev (mod (- ind arg) end)))+ (shm-transpose-data-constructors ind prev))+ (message "Point is not a data constructor."))))++(defun shm-in-data-constructor ()+ "Check if the current node is a Data Declaration (DataDecl) or+the child of one."+ (eq 'DataDecl (elt (elt (shm-decl-ast) 0) 1)))++(defun shm-get-data-constructor-members-points ()+ "Find the region bounds of all the data constructors within the+current data declaration."+ (when (shm-in-data-constructor)+ (mapcar (lambda (ps) (cons (elt ps 2) (elt ps 3)))+ (remove-if (lambda (n) (eq n 'nil))+ (mapcar (lambda (c) (let ((decl (elt c 1)))+ (cond+ ((eq decl 'QualConDecl) c)+ (t nil))))+ (shm-decl-ast))))))++(defun shm-get-field-constructor-members-points ()+ "Find the region bounds of all the field constructors within+ the current data declaration."+ (let ((field-list (when (shm-in-data-constructor)+ (mapcar (lambda (ps) (cons (elt ps 2) (elt ps 3)))+ (remove-if (lambda (n) (eq n 'nil))+ (mapcar (lambda (c) (if (eq 'FieldDecl (elt c 1)) c nil))+ (shm-decl-ast)))))))+ (if-let ((data-index (shm-find-current-data-member-index-at-point)))+ (let ((bounds-data-index (elt (shm-get-data-constructor-members-points) data-index)))+ (delq nil+ (mapcar (lambda (b) (if (within-interval bounds-data-index b) b nil))+ field-list)))+ field-list)))++(defun within-interval (data field)+ "Check if field constructor is within a data constructor and+give the appropriate index."+ (let ((data-start1 (marker-position (car data)))+ (data-end1 (marker-position (cdr data)))+ (field-start1 (marker-position (car field)))+ (field-end1 (marker-position (cdr field))))+ (and (< data-start1 field-start1) (> data-end1 field-start1)+ (< data-start1 field-end1) (> data-end1 field-end1))))++(defun shm-find-current-data-member-index-at-point ()+ "Find the index of the current data constructor with the+current data declaration."+ (let ((location (point)))+ (-find-index (lambda (bounds) (and+ (>= (marker-position (cdr bounds)) location)+ (<= (marker-position (car bounds)) location)))+ (shm-get-data-constructor-members-points))))++(defun shm-find-current-field-member-index-at-point ()+ "Find the index of the current data field constructor with the+current data declaration."+ (let ((location (point)))+ (if-let ((data-index (shm-find-current-data-member-index-at-point)))+ (let ((bounds-data-index (elt (shm-get-data-constructor-members-points) data-index)))+ (-find-index (lambda (bounds) (and+ (>= (marker-position (cdr bounds)) location)+ (<= (marker-position (car bounds)) location)))+ (delq nil+ (mapcar (lambda (b) (if (within-interval bounds-data-index b) b nil))+ (shm-get-field-constructor-members-points)))))+ (-find-index (lambda (bounds) (and+ (>= (marker-position (cdr bounds)) location)+ (<= (marker-position (car bounds)) location)))+ (shm-get-field-constructor-members-points)))))++(defun shm-find-current-data-member-index-at-point ()+ "Find the index of the current data constructor with the+current data declaration."+ (let ((location (point)))+ (-find-index (lambda (bounds) (and+ (>= (marker-position (cdr bounds)) location)+ (<= (marker-position (car bounds)) location)))+ (shm-get-data-constructor-members-points))))++(defun shm-transpose-data-constructors (m n)+ "Transpose the mth and nth data constructors. This function+will silently fail if the m or n are not valid indices (the first+index is 0). Here's an example of the function working as+intended. In this example, the 1st and 9th data constructors will+be swapped.++data JSValue+ = JSLetIn String+ JSValue+ JSValue+ | JSLambda [String]+ JSValue (**)+ | JSNull+ | JSIdentifier String+ | JSString String+ | JSArray [JSValue]+ | JSIndexInfo JSValue+ JSValue+ | JSApplication JSValue+ [JSValue]+ | JSNumber Double+ | JSObject [(String, JSValue)] (**)++data JSValue+ = JSLetIn String+ JSValue+ JSValue+ | JSObject [(String, JSValue)] (**)+ | JSNull+ | JSIdentifier String+ | JSString String+ | JSArray [JSValue]+ | JSIndexInfo JSValue+ JSValue+ | JSApplication JSValue+ [JSValue]+ | JSNumber Double+ | JSLambda [String]+ JSValue (**)"+ (let* ((bounds (bounds-of-thing-at-point 'defun))+ (regions (cond ((shm-find-current-field-member-index-at-point) (shm-get-field-constructor-members-points))+ ((shm-find-current-data-member-index-at-point) (shm-get-data-constructor-members-points))+ (t (error "Not a valid point for transposition."))))+ (m1 (car (elt regions m)))+ (m2 (cdr (elt regions m)))+ (m3 (car (elt regions n)))+ (m4 (cdr (elt regions n))))+ (when (and (shm-in-data-constructor)+ n+ m+ (>= m 0)+ (>= n 0)+ (< n (length regions))+ (< m (length regions))+ (not (= m n)))+ ;; We need to move the point to the Ident node for the transposition to work correctly.+ (let ((x (elt (cdr (shm-current-node-pair)) 1)))+ (cond ((eq x 'DataDecl)+ (progn+ (forward-word 1)+ (shm-transpose-data-constructors-helper bounds m1 m2 m3 m4)))+ ((eq x 'Ident) (progn (message "%s " m4) (shm-transpose-data-constructors-helper bounds m1 m2 m3 m4)))+ ((eq x 'FieldDecl)+ (progn+ (if (= (point (shm-node-start (cdr (shm-current-node-pair)))))+ (shm-set-node-overlay)+ (progn (shm/backward-node) (shm-set-node-overlay)))+ (shm-transpose-data-constructors-helper bounds m1 m2 m3 m4)))+ ((member x '(QualConDecl ConDecl))+ (progn+ (if (= (point) (shm-node-start (cdr (shm-current-node-pair))))+ (shm-set-node-overlay)+ (progn (shm/backward-node) (shm-set-node-overlay)))+ (shm-transpose-data-constructors-helper bounds m1 m2 m3 m4)))+ (t (progn+ (while (not (eq 'ConDecl (elt (cdr (shm-current-node-pair)) 1)))+ (shm/goto-parent))+ (shm-set-node-overlay)+ (shm-transpose-data-constructors-helper bounds m1 m2 m3 m4))))))))++(defun shm-transpose-data-constructors-helper (bounds m1 m2 m3 m4)+ (let ((commentEndA+ (save-excursion+ (goto-char (marker-position m2))+ (if (comment-forward 1)+ (progn+ (while (comment-forward))+ (skip-chars-backward " " nil)+ (backward-char)+ (point))+ (if (looking-at "\}")+ (if (= (+ (save-excursion (skip-chars-backward " ")) (point)) (point-at-bol))+ (marker-position m2)+ (progn+ (delete-horizontal-space)+ (let* ((start (point))+ (commentbounds+ (save-excursion+ (progn+ (if (search-forward "--" (cdr bounds) t)+ (let ((startcommentblock (- (point) 2)))+ (backward-char 2)+ (while (comment-forward))+ (cons startcommentblock (point)))+ nil))))+ (text (if commentbounds+ (delete-and-extract-region+ (car commentbounds)+ (cdr commentbounds))+ "")))+ (goto-char start)+ (save-excursion+ (shm/newline-indent-proxy))+ (insert " ")+ (insert text)+ (point)))) ;The text will be unnormalized for now. May fix this later.+ (progn+ (skip-chars-backward " " nil)+ (backward-char)+ (point))))))+ (commentEndB+ (save-excursion+ (goto-char (marker-position m4))+ (if (comment-forward 1)+ (progn+ (while (comment-forward))+ (skip-chars-backward " " nil)+ (backward-char)+ (point))+ (if (looking-at "\}")+ (if (= (+ (save-excursion (skip-chars-backward " ")) (point)) (point-at-bol)) ; The \} might be on a newline.+ (marker-position m4)+ (progn+ (delete-horizontal-space)+ (let* ((start (point))+ (commentbounds+ (save-excursion+ (progn+ (if (search-forward "--" (cdr bounds) t)+ (let ((startcommentblock (- (point) 2)))+ (backward-char 2)+ (while (comment-forward))+ (cons startcommentblock (point)))+ nil))))+ (text (if commentbounds+ (delete-and-extract-region+ (car commentbounds)+ (cdr commentbounds))+ "")))+ (goto-char start)+ (save-excursion+ (shm/newline-indent-proxy))+ (insert " ")+ (insert text)+ (point)))) ;The text will be unnormalized for now. May fix this later.+ (progn+ (skip-chars-backward " " nil)+ (backward-char)+ (point)))))))+ (transpose-regions+ (marker-position m1)+ commentEndA+ (marker-position m3)+ commentEndB)+ (let ((parsed-ast (shm-get-ast (if (bound-and-true-p structured-haskell-repl-mode)+ "stmt"+ "decl")+ (car bounds) (cdr bounds))))+ (let ((bail (lambda ()+ (when shm-display-quarantine+ (shm-quarantine-overlay (car bounds) (cdr bounds)))+ (setq shm-lighter " SHM!")+ nil)))+ (if parsed-ast+ (progn+ (when (bound-and-true-p structured-haskell-repl-mode)+ (shm-font-lock-region (car bounds) (cdr bounds)))+ (let ((ast (shm-get-nodes parsed-ast (car bounds) (cdr bounds))))+ (if ast+ (progn (setq shm-lighter " SHM")+ (set-marker m1 nil)+ (set-marker m2 nil)+ (set-marker m3 nil)+ (set-marker m4 nil)+ (shm-set-decl-ast (car bounds) ast)+ (shm-delete-overlays (point-min) (point-max) 'shm-quarantine)+ ;This was my initial guess for+ ;silencing the message at the end. It+ ;doesn't work.+ (let ((inhibit-message t))+ (shm/init)))+ (funcall bail))))+ (funcall bail)))))) (provide 'shm-manipulation)
+ elisp/shm-stack.el view
@@ -0,0 +1,62 @@+;;; shm-stack.el --- Stack integration++;; Copyright (c) 2015 Chris Done. All rights reserved.++;; This file is free software; you can redistribute it and/or modify+;; it under the terms of the GNU General Public License as published by+;; the Free Software Foundation; either version 3, or (at your option)+;; any later version.++;; This file is distributed in the hope that it will be useful,+;; but WITHOUT ANY WARRANTY; without even the implied warranty of+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+;; GNU General Public License for more details.++;; You should have received a copy of the GNU General Public License+;; along with this program. If not, see <http://www.gnu.org/licenses/>.++;;; Code:++(defvar shm-stack-project-p nil)+(make-variable-buffer-local 'shm-stack-project-p)++(defun shm-stack-project-p ()+ "Is this buffer in a stack project?"+ (or (bound-and-true-p shm-stack-project-p)+ (setq shm-stack-project-p+ (not (not (shm-stack-find-file))))))++(defun shm-stack-find-file (&optional dir)+ "Copied from `haskell-yaml-find-file'."+ (let ((use-dir (or dir default-directory)))+ (while (and use-dir (not (file-directory-p use-dir)))+ (setq use-dir (file-name-directory (directory-file-name use-dir))))+ (when use-dir+ (catch 'found+ (let ((user (nth 2 (file-attributes use-dir)))+ ;; Abbreviate, so as to stop when we cross ~/.+ (root (abbreviate-file-name use-dir)))+ ;; traverse current dir up to root as long as file owner doesn't change+ (while (and root (equal user (nth 2 (file-attributes root))))+ (let ((yaml-file (shm-stack-find-yaml root)))+ (when yaml-file+ (throw 'found yaml-file)))++ (let ((proot (file-name-directory (directory-file-name root))))+ (if (equal proot root) ;; fix-point reached?+ (throw 'found nil)+ (setq root proot))))+ nil)))))++(defun shm-stack-find-yaml (dir &optional allow-multiple)+ "Copied from `haskell-yaml-find-pkg-desc'."+ (let* ((yaml-files+ (cl-remove-if 'file-directory-p+ (cl-remove-if-not 'file-exists-p+ (directory-files dir t ".\\.yaml\\'")))))+ (cond+ ((= (length yaml-files) 1) (car yaml-files)) ;; exactly one candidate found+ (allow-multiple yaml-files) ;; pass-thru multiple candidates+ (t nil))))++(provide 'shm-stack)
elisp/shm-test.el view
@@ -44,6 +44,8 @@ (structured-haskell-mode t) (when (fboundp 'god-local-mode) (god-local-mode -1))+ (when (fboundp 'electric-indent-mode)+ (electric-indent-mode -1)) (erase-buffer) (insert "\n") (setq shm-test-eob (set-marker (make-marker) (point)))@@ -123,6 +125,8 @@ (kill-all-local-variables) (when (fboundp 'god-local-mode) (god-local-mode -1))+ (when (fboundp 'electric-indent-mode)+ (electric-indent-mode -1)) (let ((customizations (plist-get test :customizations))) (when customizations (dolist (entry customizations)
elisp/shm-yank-kill.el view
@@ -36,7 +36,8 @@ "Copy the region, and save it in the clipboard." (interactive "r") (save-excursion- (shm-kill-region 'clipboard-kill-ring-save beg end t)))+ (shm-kill-region 'clipboard-kill-ring-save beg end t))+ (setq deactivate-mark t)) (defun shm/kill-line () "Kill everything possible to kill after point before the end of
elisp/shm.el view
@@ -47,7 +47,6 @@ (define-key map (kbd "(") 'shm/open-paren) (define-key map (kbd "M-(") 'shm/wrap-parens) (define-key map (kbd "[") 'shm/open-bracket)- (define-key map (kbd "|") 'shm/open-bars) (define-key map (kbd "{") 'shm/open-brace) (define-key map (kbd "-") 'shm/hyphen) (define-key map (kbd "#") 'shm/hash)@@ -94,6 +93,7 @@ (define-key map (kbd "C-M-SPC") 'shm/mark-node) (define-key map (kbd "C-c C-w") 'shm/goto-where) ;; Splitting, slurping, barfing, etc.+ (define-key map (kbd "M-S") 'shm/split) (define-key map (kbd "C-+") 'shm/add-operand) (define-key map (kbd "C-$") 'shm/$) (define-key map (kbd "M-r") 'shm/raise)@@ -110,7 +110,9 @@ ;;;###autoload (define-minor-mode structured-haskell-mode- "Structured editing for Haskell."+ "Structured editing for Haskell.++\\{shm-map}" :lighter shm-lighter :keymap shm-map (if structured-haskell-mode@@ -160,6 +162,7 @@ (define-key map (kbd "M-DEL") 'shm/backward-kill-word) (define-key map (kbd "C-<backspace>") 'shm/backward-kill-word) ;; Splitting, slurping, barfing, etc.+ (define-key map (kbd "M-S") 'shm/split) (define-key map (kbd "C-$") 'shm/$) (define-key map (kbd "C-+") 'shm/add-operand) (define-key map (kbd "M-r") 'shm/raise)@@ -171,7 +174,9 @@ a REPL, with inappropriate ones removed.") (define-minor-mode structured-haskell-repl-mode- "Structured editing for Haskell inside a REPL."+ "Structured editing for Haskell inside a REPL.++\\{shm-repl-map}" :lighter shm-lighter :keymap shm-repl-map (cond
src/Main.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-}@@ -14,7 +13,6 @@ module Main (main) where import Control.Applicative-import Control.Applicative.QQ.Idiom import Data.Data import Data.List import Data.Maybe@@ -22,8 +20,7 @@ import qualified Data.Text as T import Descriptive import Descriptive.Options-import GHC.Tuple-import Language.Haskell.Exts.Annotated+import Language.Haskell.Exts import System.Environment -- | A generic Dynamic-like constructor -- but more convenient to@@ -63,7 +60,7 @@ -- | Command line options. options :: Monad m => Consumer [Text] (Option ()) m (Action,ParseType,[Extension])-options = [i|(,,) action typ exts|]+options = (,,) <$> action <*> typ <*> exts where action = constant "parse" "Parse and spit out spans" Parse <|> constant "check" "Just check the syntax" Check@@ -110,17 +107,17 @@ -- parseTopLevel :: ParseMode -> String -> ParseResult D parseTopLevel mode code =- [i|(D . fix) (parseDeclWithMode mode code)|] <|>- [i|D (parseImport mode code)|] <|>- [i|(D . fix) (parseModuleWithMode mode code)|] <|>- [i|D (parseModulePragma mode code)|]+ ((D . fix) <$> parseDeclWithMode mode code) <|>+ (D <$> parseImport mode code) <|>+ ((D . fix) <$> parseModuleWithMode mode code) <|>+ (D <$> parseModulePragma mode code) -- | Parse a do-notation statement. parseSomeStmt :: ParseMode -> String -> ParseResult D parseSomeStmt mode code =- [i|(D . fix) (parseStmtWithMode mode code)|] <|>- [i|(D . fix) (parseExpWithMode mode code)|] <|>- [i|D (parseImport mode code)|]+ ((D . fix) <$> parseStmtWithMode mode code) <|>+ ((D . fix) <$> parseExpWithMode mode code) <|>+ (D <$> parseImport mode code) -- | Apply fixities after parsing. fix ast = fromMaybe ast (applyFixities baseFixities ast)
structured-haskell-mode.cabal view
@@ -1,5 +1,5 @@ name: structured-haskell-mode-version: 1.0.20+version: 1.1.0 synopsis: Structured editing Emacs mode for Haskell description: Structured editing Emacs mode for Haskell. homepage: https://github.com/chrisdone/structured-haskell-mode@@ -24,6 +24,7 @@ elisp/shm-indent.el elisp/shm-in.el elisp/shm-insert-del.el+ elisp/shm-languages.el elisp/shm-layout.el elisp/shm-macros.el elisp/shm-manipulation.el@@ -32,6 +33,7 @@ elisp/shm-overlays.el elisp/shm-simple-indent.el elisp/shm-slot.el+ elisp/shm-stack.el elisp/shm-test.el elisp/shm-tests.el elisp/shm-type.el@@ -42,8 +44,7 @@ ghc-options: -O2 -Wall hs-source-dirs: src build-depends: base >= 4 && < 5- , haskell-src-exts == 1.16.*+ , haskell-src-exts >= 1.18 , text , descriptive >= 0.7 && < 0.10- , applicative-quoters , ghc-prim