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.
975 lines
36 KiB
975 lines
36 KiB
9 years ago
|
;;; 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
|