You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
974 lines
36 KiB
974 lines
36 KiB
;;; haskell-cabal.el --- Support for Cabal packages -*- lexical-binding: t -*- |
|
|
|
;; Copyright (C) 2007, 2008 Stefan Monnier |
|
|
|
;; Author: Stefan Monnier <monnier@iro.umontreal.ca> |
|
|
|
;; This file is not part of GNU Emacs. |
|
|
|
;; 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 GNU Emacs; see the file COPYING. If not, write to |
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|
;; Boston, MA 02110-1301, USA. |
|
|
|
;;; Commentary: |
|
|
|
;; Todo: |
|
|
|
;; - distinguish continued lines from indented lines. |
|
;; - indent-line-function. |
|
;; - outline-minor-mode. |
|
|
|
;;; Code: |
|
|
|
;; (defun haskell-cabal-extract-fields-from-doc () |
|
;; (require 'xml) |
|
;; (with-no-warnings (require 'cl)) |
|
;; (let ((section (completing-read |
|
;; "Section: " |
|
;; '("general-fields" "library" "executable" "buildinfo")))) |
|
;; (goto-char (point-min)) |
|
;; (search-forward (concat "<sect3 id=\"" section "\">"))) |
|
;; (let* ((xml (xml-parse-region |
|
;; (progn (search-forward "<variablelist>") (match-beginning 0)) |
|
;; (progn (search-forward "</variablelist>") (point)))) |
|
;; (varlist (remove-if-not 'consp (cddar xml))) |
|
;; (syms (mapcar (lambda (entry) (caddr (assq 'literal (assq 'term entry)))) |
|
;; varlist)) |
|
;; (fields (mapcar (lambda (sym) (substring-no-properties sym 0 -1)) syms))) |
|
;; fields)) |
|
|
|
(require 'cl-lib) |
|
(require 'haskell-utils) |
|
|
|
(defconst haskell-cabal-general-fields |
|
;; Extracted with (haskell-cabal-extract-fields-from-doc "general-fields") |
|
'("name" "version" "cabal-version" "license" "license-file" "copyright" |
|
"author" "maintainer" "stability" "homepage" "package-url" "synopsis" |
|
"description" "category" "tested-with" "build-depends" "data-files" |
|
"extra-source-files" "extra-tmp-files")) |
|
|
|
(defconst haskell-cabal-library-fields |
|
;; Extracted with (haskell-cabal-extract-fields-from-doc "library") |
|
'("exposed-modules")) |
|
|
|
(defconst haskell-cabal-executable-fields |
|
;; Extracted with (haskell-cabal-extract-fields-from-doc "executable") |
|
'("executable" "main-is")) |
|
|
|
(defconst haskell-cabal-buildinfo-fields |
|
;; Extracted with (haskell-cabal-extract-fields-from-doc "buildinfo") |
|
'("buildable" "other-modules" "hs-source-dirs" "extensions" "ghc-options" |
|
"ghc-prof-options" "hugs-options" "nhc-options" "includes" |
|
"install-includes" "include-dirs" "c-sources" "extra-libraries" |
|
"extra-lib-dirs" "cc-options" "ld-options" "frameworks")) |
|
|
|
(defvar haskell-cabal-mode-syntax-table |
|
(let ((st (make-syntax-table))) |
|
;; The comment syntax can't be described simply in syntax-table. |
|
;; We could use font-lock-syntactic-keywords, but is it worth it? |
|
;; (modify-syntax-entry ?- ". 12" st) |
|
(modify-syntax-entry ?\n ">" st) |
|
(modify-syntax-entry ?. "w" st) |
|
(modify-syntax-entry ?- "w" st) |
|
st)) |
|
|
|
(defvar haskell-cabal-font-lock-keywords |
|
;; The comment syntax can't be described simply in syntax-table. |
|
;; We could use font-lock-syntactic-keywords, but is it worth it? |
|
'(("^[ \t]*--.*" . font-lock-comment-face) |
|
("^ *\\([^ \t:]+\\):" (1 font-lock-keyword-face)) |
|
("^\\(Library\\)[ \t]*\\({\\|$\\)" (1 font-lock-keyword-face)) |
|
("^\\(Executable\\|Test-Suite\\|Benchmark\\)[ \t]+\\([^\n \t]*\\)" |
|
(1 font-lock-keyword-face) (2 font-lock-function-name-face)) |
|
("^\\(Flag\\)[ \t]+\\([^\n \t]*\\)" |
|
(1 font-lock-keyword-face) (2 font-lock-constant-face)) |
|
("^\\(Source-Repository\\)[ \t]+\\(head\\|this\\)" |
|
(1 font-lock-keyword-face) (2 font-lock-constant-face)) |
|
("^ *\\(if\\)[ \t]+.*\\({\\|$\\)" (1 font-lock-keyword-face)) |
|
("^ *\\(}[ \t]*\\)?\\(else\\)[ \t]*\\({\\|$\\)" |
|
(2 font-lock-keyword-face)))) |
|
|
|
(defvar haskell-cabal-buffers nil |
|
"List of Cabal buffers.") |
|
|
|
(defun haskell-cabal-buffers-clean (&optional buffer) |
|
(let ((bufs ())) |
|
(dolist (buf haskell-cabal-buffers) |
|
(if (and (buffer-live-p buf) (not (eq buf buffer)) |
|
(with-current-buffer buf (derived-mode-p 'haskell-cabal-mode))) |
|
(push buf bufs))) |
|
(setq haskell-cabal-buffers bufs))) |
|
|
|
(defun haskell-cabal-unregister-buffer () |
|
(haskell-cabal-buffers-clean (current-buffer))) |
|
|
|
;;;###autoload |
|
(add-to-list 'auto-mode-alist '("\\.cabal\\'" . haskell-cabal-mode)) |
|
|
|
(defvar haskell-cabal-mode-map |
|
(let ((map (make-sparse-keymap))) |
|
(define-key map (kbd "C-c C-s") 'haskell-cabal-subsection-arrange-lines) |
|
(define-key map (kbd "C-M-n") 'haskell-cabal-next-section) |
|
(define-key map (kbd "C-M-p") 'haskell-cabal-previous-section) |
|
(define-key map (kbd "M-n") 'haskell-cabal-next-subsection) |
|
(define-key map (kbd "M-p") 'haskell-cabal-previous-subsection) |
|
(define-key map (kbd "C-<down>") 'haskell-cabal-next-subsection) |
|
(define-key map (kbd "C-<up>") 'haskell-cabal-previous-subsection) |
|
(define-key map (kbd "C-c C-f") 'haskell-cabal-find-or-create-source-file) |
|
(define-key map (kbd "M-g l") 'haskell-cabal-goto-library-section) |
|
(define-key map (kbd "M-g e") 'haskell-cabal-goto-executable-section) |
|
(define-key map (kbd "M-g b") 'haskell-cabal-goto-benchmark-section) |
|
(define-key map (kbd "M-g t") 'haskell-cabal-goto-test-suite-section) |
|
map)) |
|
|
|
;;;###autoload |
|
(define-derived-mode haskell-cabal-mode fundamental-mode "Haskell-Cabal" |
|
"Major mode for Cabal package description files." |
|
(set (make-local-variable 'font-lock-defaults) |
|
'(haskell-cabal-font-lock-keywords t t nil nil)) |
|
(add-to-list 'haskell-cabal-buffers (current-buffer)) |
|
(add-hook 'change-major-mode-hook 'haskell-cabal-unregister-buffer nil 'local) |
|
(add-hook 'kill-buffer-hook 'haskell-cabal-unregister-buffer nil 'local) |
|
(set (make-local-variable 'comment-start) "-- ") |
|
(set (make-local-variable 'comment-start-skip) "\\(^[ \t]*\\)--[ \t]*") |
|
(set (make-local-variable 'comment-end) "") |
|
(set (make-local-variable 'comment-end-skip) "[ \t]*\\(\\s>\\|\n\\)") |
|
(set (make-local-variable 'indent-line-function) 'haskell-cabal-indent-line) |
|
(setq indent-tabs-mode nil) |
|
) |
|
|
|
(defun haskell-cabal-get-setting (name) |
|
(save-excursion |
|
(let ((case-fold-search t)) |
|
(goto-char (point-min)) |
|
(when (re-search-forward |
|
(concat "^[ \t]*" (regexp-quote name) |
|
":[ \t]*\\(.*\\(\n[ \t]+[ \t\n].*\\)*\\)") |
|
nil t) |
|
(let ((val (match-string 1)) |
|
(start 1)) |
|
(when (match-end 2) ;Multiple lines. |
|
;; The documentation is not very precise about what to do about |
|
;; the \n and the indentation: are they part of the value or |
|
;; the encoding? I take the point of view that \n is part of |
|
;; the value (so that values can span multiple lines as well), |
|
;; and that only the first char in the indentation is part of |
|
;; the encoding, the rest is part of the value (otherwise, lines |
|
;; in the value cannot start with spaces or tabs). |
|
(while (string-match "^[ \t]\\(?:\\.$\\)?" val start) |
|
(setq start (1+ (match-beginning 0))) |
|
(setq val (replace-match "" t t val)))) |
|
val))))) |
|
|
|
;;;###autoload |
|
(defun haskell-cabal-guess-setting (name) |
|
"Guess the specified setting of this project. |
|
If there is no valid .cabal file to get the setting from (or |
|
there is no corresponding setting with that name in the .cabal |
|
file), then this function returns nil." |
|
(interactive) |
|
(when (and name buffer-file-name) |
|
(let ((cabal-file (haskell-cabal-find-file))) |
|
(when (and cabal-file (file-readable-p cabal-file)) |
|
(with-temp-buffer |
|
(insert-file-contents cabal-file) |
|
(haskell-cabal-get-setting name)))))) |
|
|
|
;;;###autoload |
|
(defun haskell-cabal-get-dir (&optional use-defaults) |
|
"Get the Cabal dir for a new project. Various ways of figuring this out, |
|
and indeed just prompting the user. Do them all." |
|
(let* ((file (haskell-cabal-find-file)) |
|
(dir (if file (file-name-directory file) default-directory))) |
|
(if use-defaults |
|
dir |
|
(haskell-utils-read-directory-name |
|
(format "Cabal dir%s: " (if file (format " (guessed from %s)" (file-relative-name file)) "")) |
|
dir)))) |
|
|
|
(defun haskell-cabal-compute-checksum (dir) |
|
"Compute MD5 checksum of package description file in DIR. |
|
Return nil if no Cabal description file could be located via |
|
`haskell-cabal-find-pkg-desc'." |
|
(let ((cabal-file (haskell-cabal-find-pkg-desc dir))) |
|
(when cabal-file |
|
(with-temp-buffer |
|
(insert-file-contents cabal-file) |
|
(md5 (buffer-string)))))) |
|
|
|
(defun haskell-cabal-find-file (&optional dir) |
|
"Search for package description file upwards starting from DIR. |
|
If DIR is nil, `default-directory' is used as starting point for |
|
directory traversal. Upward traversal is aborted if file owner |
|
changes. Uses`haskell-cabal-find-pkg-desc' internally." |
|
(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 ((cabal-file (haskell-cabal-find-pkg-desc root))) |
|
(when cabal-file |
|
(throw 'found cabal-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 haskell-cabal-find-pkg-desc (dir &optional allow-multiple) |
|
"Find a package description file in the directory DIR. |
|
Returns nil if none or multiple \".cabal\" files were found. If |
|
ALLOW-MULTIPLE is non nil, in case of multiple \".cabal\" files, |
|
a list is returned instead of failing with a nil result." |
|
;; This is basically a port of Cabal's |
|
;; Distribution.Simple.Utils.findPackageDesc function |
|
;; http://hackage.haskell.org/packages/archive/Cabal/1.16.0.3/doc/html/Distribution-Simple-Utils.html |
|
;; but without the exception throwing. |
|
(let* ((cabal-files |
|
(cl-remove-if 'file-directory-p |
|
(cl-remove-if-not 'file-exists-p |
|
(directory-files dir t ".\\.cabal\\'"))))) |
|
(cond |
|
((= (length cabal-files) 1) (car cabal-files)) ;; exactly one candidate found |
|
(allow-multiple cabal-files) ;; pass-thru multiple candidates |
|
(t nil)))) |
|
|
|
(defun haskell-cabal-find-dir (&optional dir) |
|
"Like `haskell-cabal-find-file' but returns directory instead. |
|
See `haskell-cabal-find-file' for meaning of DIR argument." |
|
(let ((cabal-file (haskell-cabal-find-file dir))) |
|
(when cabal-file |
|
(file-name-directory cabal-file)))) |
|
|
|
;;;###autoload |
|
(defun haskell-cabal-visit-file (other-window) |
|
"Locate and visit package description file for file visited by current buffer. |
|
This uses `haskell-cabal-find-file' to locate the closest |
|
\".cabal\" file and open it. This command assumes a common Cabal |
|
project structure where the \".cabal\" file is in the top-folder |
|
of the project, and all files related to the project are in or |
|
below the top-folder. If called with non-nil prefix argument |
|
OTHER-WINDOW use `find-file-other-window'." |
|
(interactive "P") |
|
;; Note: We aren't allowed to rely on haskell-session here (which, |
|
;; in pathological cases, can have a different .cabal file |
|
;; associated with the current buffer) |
|
(if buffer-file-name |
|
(let ((cabal-file (haskell-cabal-find-file (file-name-directory buffer-file-name)))) |
|
(if cabal-file |
|
(if other-window |
|
(find-file-other-window cabal-file) |
|
(find-file cabal-file)) |
|
(error "Could not locate \".cabal\" file for %S" buffer-file-name))) |
|
(error "Cannot locate \".cabal\" file for buffers not visiting any file"))) |
|
|
|
(defvar haskell-cabal-commands |
|
'("install" |
|
"update" |
|
"list" |
|
"info" |
|
"upgrade" |
|
"fetch" |
|
"unpack" |
|
"check" |
|
"sdist" |
|
"upload" |
|
"report" |
|
"init" |
|
"configure" |
|
"build" |
|
"copy" |
|
"haddock" |
|
"clean" |
|
"hscolour" |
|
"register" |
|
"test" |
|
"help" |
|
"run")) |
|
|
|
;;;###autoload |
|
(defgroup haskell-cabal nil |
|
"Haskell cabal files" |
|
:group 'haskell |
|
) |
|
|
|
;;;###autoload |
|
(defcustom haskell-cabal-list-comma-position |
|
'before |
|
"Where to put the comma in lists" |
|
:safe t |
|
:group 'haskell-cabal |
|
:type '(choice (const before) |
|
(const after))) |
|
|
|
(defconst haskell-cabal-section-header-regexp "^[[:alnum:]]" ) |
|
(defconst haskell-cabal-subsection-header-regexp "^[ \t]*[[:alnum:]]\\w*:") |
|
(defconst haskell-cabal-comment-regexp "^[ \t]*--") |
|
(defconst haskell-cabal-empty-regexp "^[ \t]*$") |
|
(defconst haskell-cabal-conditional-regexp "^[ \t]*\\(\\if\\|else\\|}\\)") |
|
|
|
(defun haskell-cabal-classify-line () |
|
"Classify the current line into 'section-header 'subsection-header 'section-data 'comment and 'empty '" |
|
(save-excursion |
|
(beginning-of-line) |
|
(cond |
|
((looking-at haskell-cabal-subsection-header-regexp ) 'subsection-header) |
|
((looking-at haskell-cabal-section-header-regexp) 'section-header) |
|
((looking-at haskell-cabal-comment-regexp) 'comment) |
|
((looking-at haskell-cabal-empty-regexp ) 'empty) |
|
((looking-at haskell-cabal-conditional-regexp ) 'conditional) |
|
(t 'section-data)))) |
|
|
|
(defun haskell-cabal-header-p () |
|
"Is the current line a section or subsection header?" |
|
(cl-case (haskell-cabal-classify-line) |
|
((section-header subsection-header) t))) |
|
|
|
(defun haskell-cabal-section-header-p () |
|
"Is the current line a section or subsection header?" |
|
(cl-case (haskell-cabal-classify-line) |
|
((section-header) t))) |
|
|
|
|
|
(defun haskell-cabal-section-beginning () |
|
"Find the beginning of the current section" |
|
(save-excursion |
|
(while (not (or (bobp) (haskell-cabal-section-header-p))) |
|
(forward-line -1)) |
|
(point))) |
|
|
|
(defun haskell-cabal-beginning-of-section () |
|
"go to the beginning of the section" |
|
(interactive) |
|
(goto-char (haskell-cabal-section-beginning)) |
|
) |
|
|
|
(defun haskell-cabal-section-end () |
|
"Find the end of the current section" |
|
(interactive) |
|
(save-excursion |
|
(if (re-search-forward "\n\\([ \t]*\n\\)*[[:alnum:]]" nil t) |
|
(match-beginning 0) |
|
(point-max)))) |
|
|
|
(defun haskell-cabal-end-of-section () |
|
"go to the end of the section" |
|
(interactive) |
|
(goto-char (haskell-cabal-section-end))) |
|
|
|
(defun haskell-cabal-next-section () |
|
"Go to the next extion" |
|
(interactive) |
|
(when (haskell-cabal-section-header-p) (forward-line)) |
|
(while (not (or (eobp) (haskell-cabal-section-header-p))) |
|
(forward-line))) |
|
|
|
(defun haskell-cabal-previous-section () |
|
"Go to the next extion" |
|
(interactive) |
|
(when (haskell-cabal-section-header-p) (forward-line -1)) |
|
(while (not (or (bobp) (haskell-cabal-section-header-p))) |
|
(forward-line -1))) |
|
|
|
(defun haskell-cabal-subsection-end () |
|
"find the end of the current subsection" |
|
(save-excursion |
|
(haskell-cabal-beginning-of-subsection) |
|
(forward-line) |
|
(while (and (not (eobp)) |
|
(member (haskell-cabal-classify-line) '(empty section-data))) |
|
(forward-line)) |
|
(unless (eobp) (forward-line -1)) |
|
(while (and (equal (haskell-cabal-classify-line) 'empty) |
|
(not (bobp))) |
|
(forward-line -1)) |
|
(end-of-line) |
|
(point))) |
|
|
|
(defun haskell-cabal-end-of-subsection () |
|
"go to the end of the current subsection" |
|
(interactive) |
|
(goto-char (haskell-cabal-subsection-end))) |
|
|
|
(defun haskell-cabal-section () |
|
"Get the name and data of the associated section" |
|
(save-excursion |
|
(haskell-cabal-beginning-of-section) |
|
(when (and (haskell-cabal-section-header-p) |
|
(looking-at "^\\(\\w+\\)[ \t]*\\(.*\\)$")) |
|
(list :name (match-string-no-properties 1) |
|
:value (match-string-no-properties 2) |
|
:beginning (match-beginning 0) |
|
:end (haskell-cabal-section-end))))) |
|
|
|
|
|
(defun haskell-cabal-subsection () |
|
"Get the name and bounds of of the current subsection" |
|
(save-excursion |
|
(haskell-cabal-beginning-of-subsection) |
|
(when (looking-at "\\([ \t]*\\(\\w*\\):\\)[ \t]*") |
|
(list :name (match-string-no-properties 2) |
|
:beginning (match-end 0) |
|
:end (save-match-data (haskell-cabal-subsection-end)) |
|
:data-start-column (save-excursion (goto-char (match-end 0)) |
|
(current-column) |
|
))))) |
|
|
|
|
|
(defun haskell-cabal-section-name (section) |
|
(plist-get section :name)) |
|
|
|
(defun haskell-cabal-section-value (section) |
|
(plist-get section :value)) |
|
|
|
(defun haskell-cabal-section-start (section) |
|
(plist-get section :beginning)) |
|
|
|
(defun haskell-cabal-section-data-start-column (section) |
|
(plist-get section :data-start-column)) |
|
|
|
(defun haskell-cabal-enum-targets () |
|
"Enumerate .cabal targets." |
|
(let ((cabal-file (haskell-cabal-find-file))) |
|
(when (and cabal-file (file-readable-p cabal-file)) |
|
(with-temp-buffer |
|
(insert-file-contents cabal-file) |
|
(haskell-cabal-mode) |
|
(let (matches) |
|
(goto-char (point-min)) |
|
(haskell-cabal-next-section) |
|
(while (not (eobp)) |
|
(if (haskell-cabal-source-section-p (haskell-cabal-section)) |
|
(let ((val (haskell-cabal-section-value (haskell-cabal-section)))) |
|
(if (string= val "") |
|
(push "library" matches) |
|
(push val matches)))) |
|
(haskell-cabal-next-section)) |
|
(reverse matches)))))) |
|
|
|
(defmacro haskell-cabal-with-subsection (subsection replace &rest funs) |
|
"Copy subsection data into a temporary buffer, save indentation |
|
and execute FORMS |
|
|
|
If REPLACE is non-nil the subsection data is replaced with the |
|
resultung buffer-content" |
|
(let ((section (make-symbol "section")) |
|
(beg (make-symbol "beg")) |
|
(end (make-symbol "end")) |
|
(start-col (make-symbol "start-col")) |
|
(section-data (make-symbol "section-data"))) |
|
`(let* ((,section ,subsection) |
|
(,beg (plist-get ,section :beginning)) |
|
(,end (plist-get ,section :end)) |
|
(,start-col (plist-get ,section :data-start-column)) |
|
(,section-data (buffer-substring ,beg ,end))) |
|
(save-excursion |
|
(prog1 |
|
(with-temp-buffer |
|
(setq indent-tabs-mode nil) |
|
(indent-to ,start-col) |
|
(insert ,section-data) |
|
(goto-char (point-min)) |
|
(prog1 |
|
(progn (haskell-cabal-save-indentation ,@funs)) |
|
(goto-char (point-min)) |
|
(when (looking-at (format "[ ]\\{0,%d\\}" (1+ ,start-col))) |
|
(replace-match "")) |
|
|
|
(setq ,section-data (buffer-substring (point-min) (point-max))))) |
|
,@(when replace |
|
`((delete-region ,beg ,end) |
|
(goto-char ,beg) |
|
(insert ,section-data)))))))) |
|
|
|
(defmacro haskell-cabal-each-line (&rest fun) |
|
"Execute FOMRS on each line" |
|
`(save-excursion |
|
(while (< (point) (point-max)) |
|
,@fun |
|
(forward-line)))) |
|
|
|
(defun haskell-cabal-chomp-line () |
|
"Remove leading and trailing whitespaces from current line" |
|
(beginning-of-line) |
|
(when (looking-at "^[ \t]*\\([^ \t]\\|\\(?:[^ \t].*[^ \t]\\)\\)[ \t]*$") |
|
(replace-match (match-string 1) nil t) |
|
t)) |
|
|
|
|
|
(defun haskell-cabal-min-indentation (&optional beg end) |
|
"Compute largest common whitespace prefix of each line in between BEG and END" |
|
(save-excursion |
|
(goto-char (or beg (point-min))) |
|
(let ((min-indent nil)) |
|
(while (< (point) (or end (point-max))) |
|
(let ((indent (current-indentation))) |
|
(if (and (not (haskell-cabal-ignore-line-p)) |
|
(or (not min-indent) |
|
(< indent min-indent))) |
|
(setq min-indent indent))) |
|
(forward-line)) |
|
min-indent))) |
|
|
|
(defun haskell-cabal-ignore-line-p () |
|
"Does line only contain whitespaces and comments?" |
|
(save-excursion |
|
(beginning-of-line) |
|
(looking-at "^[ \t]*\\(?:--.*\\)?$"))) |
|
|
|
(defun haskell-cabal-kill-indentation () |
|
"Remove longest common whitespace prefix from each line" |
|
(goto-char (point-min)) |
|
(let ((indent (haskell-cabal-min-indentation))) |
|
(haskell-cabal-each-line (unless (haskell-cabal-ignore-line-p) |
|
(delete-char indent)) ) |
|
indent)) |
|
|
|
(defun haskell-cabal-add-indentation (indent) |
|
(goto-char (point-min)) |
|
(haskell-cabal-each-line |
|
(unless (haskell-cabal-ignore-line-p) |
|
(indent-to indent)))) |
|
|
|
|
|
(defmacro haskell-cabal-save-indentation (&rest funs) |
|
"Strip indentation from each line, execute FORMS and reinstate indentation |
|
so that the indentation of the FIRST LINE matches" |
|
(let ((old-l1-indent (make-symbol "new-l1-indent")) |
|
(new-l1-indent (make-symbol "old-l1-indent"))) |
|
`(let ( (,old-l1-indent (save-excursion |
|
(goto-char (point-min)) |
|
(current-indentation)))) |
|
(unwind-protect |
|
(progn |
|
(haskell-cabal-kill-indentation) |
|
,@funs) |
|
(progn |
|
(goto-char (point-min)) |
|
(let ((,new-l1-indent (current-indentation))) |
|
(haskell-cabal-add-indentation (- ,old-l1-indent |
|
,new-l1-indent)))))))) |
|
|
|
(defun haskell-cabal-strip-list () |
|
"strip commas from comma-seperated list" |
|
(goto-char (point-min)) |
|
;; split list items on single line |
|
(while (re-search-forward |
|
"\\([^ \t,\n]\\)[ \t]*,[ \t]*\\([^ \t,\n]\\)" nil t) |
|
(replace-match "\\1\n\\2" nil nil)) |
|
(goto-char (point-min)) |
|
(while (re-search-forward "^\\([ \t]*\\),\\([ \t]*\\)" nil t) |
|
(replace-match "" nil nil)) |
|
(goto-char (point-min)) |
|
(while (re-search-forward ",[ \t]*$" nil t) |
|
(replace-match "" nil nil)) |
|
(goto-char (point-min)) |
|
(haskell-cabal-each-line (haskell-cabal-chomp-line))) |
|
|
|
(defun haskell-cabal-listify () |
|
"Add commas so that buffer contains a comma-seperated list" |
|
(cl-case haskell-cabal-list-comma-position |
|
('before |
|
(goto-char (point-min)) |
|
(while (haskell-cabal-ignore-line-p) (forward-line)) |
|
(indent-to 2) |
|
(forward-line) |
|
(haskell-cabal-each-line |
|
(unless (haskell-cabal-ignore-line-p) |
|
(insert ", ")))) |
|
('after |
|
(goto-char (point-max)) |
|
(while (not (bobp)) |
|
(unless (haskell-cabal-ignore-line-p) |
|
(forward-line -1) |
|
(end-of-line) |
|
(insert ",") |
|
(beginning-of-line)))))) |
|
|
|
|
|
|
|
(defmacro haskell-cabal-with-cs-list (&rest funs) |
|
"format buffer so that each line contains a list element " |
|
`(progn |
|
(save-excursion (haskell-cabal-strip-list)) |
|
(unwind-protect (progn ,@funs) |
|
(haskell-cabal-listify)))) |
|
|
|
|
|
(defun haskell-cabal-sort-lines-key-fun () |
|
(when (looking-at "[ \t]*--[ \t,]*") |
|
(goto-char (match-end 0))) |
|
nil) |
|
|
|
(defmacro haskell-cabal-save-position (&rest forms) |
|
"Save position as mark, execute FORMs and go back to mark" |
|
`(prog2 |
|
(haskell-cabal-mark) |
|
(progn ,@forms) |
|
(haskell-cabal-goto-mark) |
|
(haskell-cabal-remove-mark))) |
|
|
|
(defun haskell-cabal-subsection-arrange-lines () |
|
"Sort lines of current subsection" |
|
(interactive) |
|
(haskell-cabal-save-position |
|
(haskell-cabal-with-subsection |
|
(haskell-cabal-subsection) t |
|
(haskell-cabal-with-cs-list |
|
(sort-subr nil 'forward-line 'end-of-line |
|
'haskell-cabal-sort-lines-key-fun) |
|
)))) |
|
|
|
(defun haskell-cabal-subsection-beginning () |
|
"find the beginning of the current subsection" |
|
(save-excursion |
|
(while (and (not (bobp)) |
|
(not (haskell-cabal-header-p))) |
|
(forward-line -1)) |
|
(back-to-indentation) |
|
(point))) |
|
|
|
(defun haskell-cabal-beginning-of-subsection () |
|
"go to the beginniing of the current subsection" |
|
(interactive) |
|
(goto-char (haskell-cabal-subsection-beginning))) |
|
|
|
(defun haskell-cabal-next-subsection () |
|
"go to the next subsection" |
|
(interactive) |
|
(if (haskell-cabal-header-p) (forward-line)) |
|
(while (and (not (eobp)) |
|
(not (haskell-cabal-header-p))) |
|
(forward-line)) |
|
(haskell-cabal-forward-to-line-entry)) |
|
|
|
(defun haskell-cabal-previous-subsection () |
|
"go to the next subsection" |
|
(interactive) |
|
(if (haskell-cabal-header-p) (forward-line -1)) |
|
(while (and (not (bobp)) |
|
(not (haskell-cabal-header-p))) |
|
(forward-line -1)) |
|
(haskell-cabal-forward-to-line-entry) |
|
) |
|
|
|
|
|
(defun haskell-cabal-find-subsection-by (section pred) |
|
"Find sunsection with name NAME" |
|
(save-excursion |
|
(when section (goto-char (haskell-cabal-section-start section))) |
|
(let* ((end (if section (haskell-cabal-section-end) (point-max))) |
|
(found nil)) |
|
(while (and (< (point) end) |
|
(not found)) |
|
(let ((subsection (haskell-cabal-subsection))) |
|
(when (and subsection (funcall pred subsection)) |
|
(setq found subsection))) |
|
(haskell-cabal-next-subsection)) |
|
found))) |
|
|
|
(defun haskell-cabal-find-subsection (section name) |
|
"Find sunsection with name NAME" |
|
(let ((downcase-name (downcase name))) |
|
(haskell-cabal-find-subsection-by |
|
section |
|
`(lambda (subsection) |
|
(string= (downcase (haskell-cabal-section-name subsection)) |
|
,downcase-name))))) |
|
|
|
(defun haskell-cabal-goto-subsection (name) |
|
(let ((subsection (haskell-cabal-find-subsection (haskell-cabal-section) name))) |
|
(when subsection |
|
(goto-char (haskell-cabal-section-start subsection))))) |
|
|
|
(defun haskell-cabal-goto-exposed-modules () |
|
(interactive) |
|
(haskell-cabal-goto-subsection "exposed-modules")) |
|
|
|
(defun haskell-cabal-subsection-entry-list (section name) |
|
"Get the data of a subsection as a list" |
|
(let ((subsection (haskell-cabal-find-subsection section name))) |
|
(when subsection |
|
(haskell-cabal-with-subsection |
|
subsection nil |
|
(haskell-cabal-with-cs-list |
|
(delete-matching-lines |
|
(format "\\(?:%s\\)\\|\\(?:%s\\)" |
|
haskell-cabal-comment-regexp |
|
haskell-cabal-empty-regexp) |
|
(point-min) (point-max)) |
|
(split-string (buffer-substring-no-properties (point-min) (point-max)) |
|
"\n" t)))))) |
|
|
|
(defun haskell-cabal-remove-mark () |
|
(remove-list-of-text-properties (point-min) (point-max) |
|
'(haskell-cabal-marker))) |
|
|
|
|
|
(defun haskell-cabal-mark () |
|
"Mark the current position with the text property haskell-cabal-marker" |
|
(haskell-cabal-remove-mark) |
|
(put-text-property (line-beginning-position) (line-end-position) |
|
'haskell-cabal-marker 'marked-line) |
|
(put-text-property (point) (1+ (point)) |
|
'haskell-cabal-marker 'marked)) |
|
|
|
|
|
(defun haskell-cabal-goto-mark () |
|
"Go to marked line" |
|
(let ((marked-pos (text-property-any (point-min) (point-max) |
|
'haskell-cabal-marker |
|
'marked)) |
|
(marked-line (text-property-any (point-min) (point-max) |
|
'haskell-cabal-marker |
|
'marked-line) ) |
|
) |
|
(cond (marked-pos (goto-char marked-pos)) |
|
(marked-line (goto-char marked-line))))) |
|
|
|
(defmacro haskell-cabal-with-subsection-line (replace &rest forms) |
|
"Mark line and " |
|
`(progn |
|
(haskell-cabal-mark) |
|
(unwind-protect |
|
(haskell-cabal-with-subsection (haskell-cabal-subsection) ,replace |
|
(haskell-cabal-goto-mark) |
|
,@forms) |
|
(haskell-cabal-remove-mark)))) |
|
|
|
|
|
(defun haskell-cabal-get-line-content () |
|
(haskell-cabal-with-subsection-line |
|
nil |
|
(haskell-cabal-with-cs-list |
|
(haskell-cabal-goto-mark) |
|
(buffer-substring-no-properties (line-beginning-position) |
|
(line-end-position))))) |
|
|
|
(defun haskell-cabal-module-to-filename (module) |
|
(concat (replace-regexp-in-string "[.]" "/" module ) ".hs")) |
|
|
|
(defconst haskell-cabal-module-sections '("exposed-modules" "other-modules") |
|
"List of sections that contain module names" |
|
) |
|
|
|
(defconst haskell-cabal-file-sections |
|
'("main-is" "c-sources" "data-files" "extra-source-files" |
|
"extra-doc-files" "extra-tmp-files" ) |
|
"List of subsections that contain filenames" |
|
) |
|
|
|
(defconst haskell-cabal-source-bearing-sections |
|
'("library" "executable" "test-suite" "benchmark")) |
|
|
|
(defun haskell-cabal-source-section-p (section) |
|
(not (not (member (downcase (haskell-cabal-section-name section)) |
|
haskell-cabal-source-bearing-sections)))) |
|
|
|
(defun haskell-cabal-line-filename () |
|
"Expand filename in current line according to the subsection type |
|
|
|
Module names in exposed-modules and other-modules are expanded by replacing each dot (.) in the module name with a foward slash (/) and appending \".hs\" |
|
|
|
Example: Foo.Bar.Quux ==> Foo/Bar/Quux.hs |
|
|
|
Source names from main-is and c-sources sections are left untouched |
|
|
|
" |
|
(let ((entry (haskell-cabal-get-line-content)) |
|
(subsection (downcase (haskell-cabal-section-name |
|
(haskell-cabal-subsection))))) |
|
(cond ((member subsection haskell-cabal-module-sections) |
|
(haskell-cabal-module-to-filename entry)) |
|
((member subsection haskell-cabal-file-sections) entry)))) |
|
|
|
(defun haskell-cabal-join-paths (&rest args) |
|
"Crude hack to replace f-join" |
|
(mapconcat 'identity args "/") |
|
) |
|
|
|
(defun haskell-cabal-find-or-create-source-file () |
|
"Open the source file this line refers to" |
|
(interactive) |
|
(let* ((src-dirs (append (haskell-cabal-subsection-entry-list |
|
(haskell-cabal-section) "hs-source-dirs") |
|
'(""))) |
|
(base-dir (file-name-directory (buffer-file-name))) |
|
(filename (haskell-cabal-line-filename))) |
|
(when filename |
|
(let ((candidates |
|
(delq nil (mapcar |
|
(lambda (dir) |
|
(let ((file (haskell-cabal-join-paths base-dir dir filename))) |
|
(when (and (file-readable-p file) |
|
(not (file-directory-p file))) |
|
file))) |
|
src-dirs)))) |
|
(if (null candidates) |
|
(let* ((src-dir (haskell-cabal-join-paths base-dir (or (car src-dirs) ""))) |
|
(newfile (haskell-cabal-join-paths src-dir filename)) |
|
(do-create-p (y-or-n-p (format "Create file %s ?" newfile)))) |
|
(when do-create-p |
|
(find-file-other-window newfile ))) |
|
(find-file-other-window (car candidates))))))) |
|
|
|
|
|
(defun haskell-cabal-find-section-type (type &optional wrap) |
|
(save-excursion |
|
(haskell-cabal-next-section) |
|
(while |
|
(not |
|
(or |
|
(eobp) |
|
(string= |
|
(downcase type) |
|
(downcase (haskell-cabal-section-name (haskell-cabal-section)))))) |
|
(haskell-cabal-next-section)) |
|
(if (eobp) |
|
(if wrap (progn |
|
(goto-char (point-min)) |
|
(haskell-cabal-find-section-type type nil) ) |
|
nil) |
|
(point)))) |
|
|
|
(defun haskell-cabal-goto-section-type (type) |
|
(let ((section (haskell-cabal-find-section-type type t))) |
|
(if section (goto-char section) |
|
(message "No %s section found" type)))) |
|
|
|
(defun haskell-cabal-goto-library-section () |
|
(interactive) |
|
(haskell-cabal-goto-section-type "library")) |
|
|
|
(defun haskell-cabal-goto-test-suite-section () |
|
(interactive) |
|
(haskell-cabal-goto-section-type "test-suite")) |
|
|
|
(defun haskell-cabal-goto-executable-section () |
|
(interactive) |
|
(haskell-cabal-goto-section-type "executable")) |
|
|
|
(defun haskell-cabal-goto-benchmark-section () |
|
(interactive) |
|
(haskell-cabal-goto-section-type "benchmark")) |
|
|
|
|
|
|
|
(defun haskell-cabal-line-entry-column () |
|
"Column at which the line entry starts" |
|
(save-excursion |
|
(cl-case (haskell-cabal-classify-line) |
|
(section-data (beginning-of-line) |
|
(when (looking-at "[ ]*\\(?:,[ ]*\\)?") |
|
(goto-char (match-end 0)) |
|
(current-column))) |
|
(subsection-header |
|
(haskell-cabal-section-data-start-column (haskell-cabal-subsection)))))) |
|
|
|
(defun haskell-cabal-forward-to-line-entry () |
|
"go forward to the beginning of the line entry (but never move backwards)" |
|
(let ((col (haskell-cabal-line-entry-column))) |
|
(when (and col (< (current-column) col)) |
|
(beginning-of-line) |
|
(forward-char col)))) |
|
|
|
(defun haskell-cabal-indent-line () |
|
"Indent current line according to subsection" |
|
(interactive) |
|
(cl-case (haskell-cabal-classify-line) |
|
(section-data |
|
(save-excursion |
|
(let ((indent (haskell-cabal-section-data-start-column |
|
(haskell-cabal-subsection)))) |
|
(indent-line-to indent) |
|
(beginning-of-line) |
|
(when (looking-at "[ ]*\\([ ]\\{2\\},[ ]*\\)") |
|
(replace-match ", " t t nil 1))))) |
|
(empty |
|
(indent-relative))) |
|
(haskell-cabal-forward-to-line-entry)) |
|
|
|
(defun haskell-cabal-map-sections (fun) |
|
"Execute fun over each section, collecting the result" |
|
(save-excursion |
|
(goto-char (point-min)) |
|
(let ((results nil)) |
|
(while (not (eobp)) |
|
(let* ((section (haskell-cabal-section)) |
|
(result (and section (funcall fun (haskell-cabal-section))))) |
|
(when section (setq results (cons result results)))) |
|
(haskell-cabal-next-section)) |
|
(nreverse results)))) |
|
|
|
(defun haskell-cabal-section-add-build-dependency (dependency &optional sort sec) |
|
"Add a build dependency to the build-depends section" |
|
(let* ((section (or sec (haskell-cabal-section))) |
|
(subsection (and section |
|
(haskell-cabal-find-subsection section "build-depends")))) |
|
(when subsection |
|
(haskell-cabal-with-subsection |
|
subsection t |
|
(haskell-cabal-with-cs-list |
|
(insert dependency) |
|
(insert "\n") |
|
(when sort |
|
(goto-char (point-min)) |
|
(sort-subr nil 'forward-line 'end-of-line |
|
'haskell-cabal-sort-lines-key-fun))))))) |
|
|
|
(defun haskell-cabal-add-build-dependency (dependency &optional sort silent) |
|
"Add a build dependencies to sections" |
|
(haskell-cabal-map-sections |
|
(lambda (section) |
|
(when (haskell-cabal-source-section-p section) |
|
(when (or silent |
|
(y-or-n-p (format "Add dependency %s to %s section %s?" |
|
dependency |
|
(haskell-cabal-section-name section) |
|
(haskell-cabal-section-value section)))) |
|
(haskell-cabal-section-add-build-dependency dependency sort section) |
|
nil))))) |
|
|
|
(defun haskell-cabal-add-dependency (package &optional version no-prompt |
|
sort silent) |
|
"Add PACKAGE (and optionally suffix -VERSION) to the cabal |
|
file. Prompts the user before doing so. |
|
|
|
If VERSION is non-nil it will be appended as a minimum version. |
|
If NO-PROMPT is nil the minimum-version is read from the minibuffer |
|
When SORT is non-nil the package entries are sorted afterwards |
|
If SILENT ist nil the user is prompted for each source-section |
|
" |
|
(interactive |
|
(list (read-from-minibuffer "Package entry: ") |
|
nil t t nil)) |
|
(save-window-excursion |
|
(find-file-other-window (haskell-cabal-find-file)) |
|
(let ((entry (if no-prompt package |
|
(read-from-minibuffer |
|
"Package entry: " |
|
(concat package (if version (concat " >= " version) "")))))) |
|
(haskell-cabal-add-build-dependency entry sort silent) |
|
(when (or silent (y-or-n-p "Save cabal file?")) |
|
(save-buffer))))) |
|
|
|
(provide 'haskell-cabal) |
|
|
|
;;; haskell-cabal.el ends here
|
|
|