├── .circleci
└── config.yml
├── .gitignore
├── CHANGELOG.md
├── README.md
├── default.nix
└── hasky-stack.el
/.circleci/config.yml:
--------------------------------------------------------------------------------
1 | version: 2
2 | jobs:
3 | build:
4 | docker:
5 | - image: nixos/nix:2.3
6 | steps:
7 | - checkout
8 | - run: source /etc/profile && nix-build
9 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | *-autoloads.el
2 | *.elc
3 | *~
4 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | ## Hasky Stack 0.9.0
2 |
3 | * Added support for the `stack run` command.
4 |
5 | * Improved automatic opening of generated Haddocks.
6 |
7 | * Stack stopped supporting listing of known template names from CLI. Use
8 | fixed list configurable as `hasky-stack-templates` instead.
9 |
10 | ## Hasky Stack 0.8.0
11 |
12 | * Make commands like “build → bench” and “build → test” only propose targets
13 | that make sense. For example, targets for “build → bench” won't include
14 | test suite components.
15 |
16 | * Added `--copy-compiler-tool` to build popup.
17 |
18 | ## Hasky Stack 0.7.0
19 |
20 | * Fix automatic opening of Haddocks with Stack 1.6.1.
21 |
22 | * Fix propagation of arguments in the package action popup.
23 |
24 | ## Hasky Stack 0.6.0
25 |
26 | * Renamed `hasky-stack-project-action-popup` to
27 | `hasky-stack-package-action-popup`.
28 |
29 | * Updated `README.md` to reflect current state of the package.
30 |
31 | ## Hasky Stack 0.5.0
32 |
33 | * Added a variable that allows to make Hasky Stack open generated Haddocks
34 | automatically.
35 |
36 | * Enhanced detection of home page by grabbing git location and
37 | reconstructing URL from that. Given that 99% of projects are on GitHub it
38 | works fine.
39 |
40 | ## Hasky Stack 0.4.0
41 |
42 | * Added commands to edit Cabal and `stack.yaml` files from the root popup
43 | (invoked by `hasky-stack-execute`).
44 |
45 | ## Hasky Stack 0.3.0
46 |
47 | * Added the `hasky-stack-package-action` command allowing to install and
48 | lookup information about packages.
49 |
50 | * Renamed the face `hasky-project-version` to `hasky-stack-project-version`.
51 |
52 | ## Hasky Stack 0.2.0
53 |
54 | * Fixed the `stack upload` command.
55 |
56 | * Fixed the `stack clean` command.
57 |
58 | * Added support for `--file-watch` to the `stack build` popup.
59 |
60 | * Made `hasky-stack-auto-target` switchable from the `stack build` popup.
61 |
62 | * Added `hasky-stack-auto-open-coverage-reports` customization setting and
63 | the functionality for opening coverage reports automatically.
64 |
65 | ## Hasky Stack 0.1.0
66 |
67 | * Initial release.
68 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Hasky Stack
2 |
3 | *This project is in “limited-maintenance” mode. I will not spend any of my
4 | time supporting it. You can still open PRs if you must, or you can take over
5 | if you wish. I'll mark the project as deprecated and stop supporting it
6 | altogether in some months.*
7 |
8 | [](http://www.gnu.org/licenses/gpl-3.0.txt)
9 | [](https://melpa.org/#/hasky-stack)
10 | [](https://circleci.com/gh/hasky-mode/hasky-stack/tree/master)
11 |
12 | This is an Emacs interface to the [Stack](https://haskellstack.org) Haskell
13 | development tool.
14 |
15 | 
16 |
17 | 
18 |
19 | 
20 |
21 | ## Installation
22 |
23 | Download this package and place it somewhere, so Emacs can see it. Then put
24 | `(require 'hasky-stack)` into your configuration file. Done!
25 |
26 | It's available via MELPA, so you can just M-x package-install RET
27 | hasky-stack.
28 |
29 | ## Usage
30 |
31 | Bind the following useful commands:
32 |
33 | ```emacs-lisp
34 | (global-set-key (kbd " h e") #'hasky-stack-execute)
35 | (global-set-key (kbd " h h") #'hasky-stack-package-action)
36 | (global-set-key (kbd " h i") #'hasky-stack-new)
37 | ```
38 |
39 | * `hasky-stack-execute` opens a popup with a collection of stack commands
40 | you can run. Many commands have their own sub-popups like in Magit.
41 |
42 | * `hasky-stack-package-action` allows to perform actions on package that the
43 | user selects from the list of all available packages.
44 |
45 | * `hasky-stack-new` allows to create a new project in current directory
46 | using a Stack template.
47 |
48 | ## Switchable variables
49 |
50 | There is a number of variables that control various aspects of the package.
51 | They can be set with `setq` or via the customization mechanisms. This way
52 | one can change their default values. However, sometimes it's desirable to
53 | quickly toggle the variables and it's possible to do directly from the popup
54 | menus: just hit the key displayed under the “variables” section.
55 |
56 | Switchable variables include:
57 |
58 | * `hasky-stack-auto-target`—whether to automatically select the default
59 | build target (build sub-popup).
60 | * `hasky-stack-auto-open-coverage-reports`—whether to attempt to
61 | automatically open coverage report in browser (build sub-popup).
62 | * `hasky-stack-auto-open-haddocks`—whether to attempt to automatically open
63 | Haddocks in browser (build sub-popup).
64 | * `hasky-stack-auto-newest-version`—whether to install newest version of
65 | package without asking (package action popup).
66 |
67 | ## Customization
68 |
69 | There is a number of customization options that are available via M-x
70 | customize-group hasky-stack.
71 |
72 | ## License
73 |
74 | Copyright © 2017–2019 Mark Karpov
75 |
76 | Distributed under GNU GPL, version 3.
77 |
--------------------------------------------------------------------------------
/default.nix:
--------------------------------------------------------------------------------
1 | let
2 | pkgs = import {};
3 | source = pkgs.lib.sourceByRegex ./. [
4 | "^hasky-stack\.el$"
5 | ];
6 | in
7 | pkgs.stdenv.mkDerivation {
8 | name = "hasky-stack";
9 | src = source;
10 | buildInputs = [
11 | (pkgs.emacs26WithPackages (epkgs: [epkgs.f epkgs.magit-popup]))
12 | ];
13 | buildPhase = ''
14 | emacs -L . --batch -f batch-byte-compile *.el
15 | '';
16 | installPhase = ''
17 | LISPDIR=$out/share/emacs/site-lisp
18 | install -d $LISPDIR
19 | install *.el *.elc $LISPDIR
20 | '';
21 | # checkPhase = ''
22 | # emacs -L . --batch --eval "(progn (require 'ert-runner) (ert-run-tests t (lambda (x) nil)))"
23 | # '';
24 | # doCheck = true;
25 | }
26 |
--------------------------------------------------------------------------------
/hasky-stack.el:
--------------------------------------------------------------------------------
1 | ;;; hasky-stack.el --- Interface to the Stack Haskell development tool -*- lexical-binding: t; -*-
2 | ;;
3 | ;; Copyright © 2017–2019 Mark Karpov
4 | ;;
5 | ;; Author: Mark Karpov
6 | ;; URL: https://github.com/hasky-mode/hasky-stack
7 | ;; Version: 0.9.0
8 | ;; Package-Requires: ((emacs "24.4") (f "0.18.0") (magit-popup "2.10"))
9 | ;; Keywords: tools, haskell
10 | ;;
11 | ;; This file is not part of GNU Emacs.
12 | ;;
13 | ;; This program is free software: you can redistribute it and/or modify it
14 | ;; under the terms of the GNU General Public License as published by the
15 | ;; Free Software Foundation, either version 3 of the License, or (at your
16 | ;; option) any later version.
17 | ;;
18 | ;; This program is distributed in the hope that it will be useful, but
19 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
21 | ;; Public License for more details.
22 | ;;
23 | ;; You should have received a copy of the GNU General Public License along
24 | ;; with this program. If not, see .
25 |
26 | ;;; Commentary:
27 |
28 | ;; This is an Emacs interface to the Stack Haskell development tool. Bind
29 | ;; the following useful commands:
30 | ;;
31 | ;; (global-set-key (kbd " h e") #'hasky-stack-execute)
32 | ;; (global-set-key (kbd " h h") #'hasky-stack-package-action)
33 | ;; (global-set-key (kbd " h i") #'hasky-stack-new)
34 | ;;
35 | ;; * `hasky-stack-execute' opens a popup with a collection of stack commands
36 | ;; you can run. Many commands have their own sub-popups like in Magit.
37 | ;;
38 | ;; * `hasky-stack-package-action' allows to perform actions on package that
39 | ;; the user selects from the list of all available packages.
40 | ;;
41 | ;; * `hasky-stack-new' allows to create a new project in current directory
42 | ;; using a Stack template.
43 |
44 | ;;; Code:
45 |
46 | (require 'cl-lib)
47 | (require 'f)
48 | (require 'magit-popup)
49 |
50 |
51 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
52 | ;; Settings & Variables
53 |
54 | (defgroup hasky-stack nil
55 | "Interface to the Stack Haskell development tool."
56 | :group 'programming
57 | :tag "Hasky Stack"
58 | :prefix "hasky-stack-"
59 | :link '(url-link :tag "GitHub"
60 | "https://github.com/hasky-mode/hasky-stack"))
61 |
62 | (defface hasky-stack-project-name
63 | '((t (:inherit font-lock-function-name-face)))
64 | "Face used to display name of current project.")
65 |
66 | (defface hasky-stack-project-version
67 | '((t (:inherit font-lock-doc-face)))
68 | "Face used to display version of current project.")
69 |
70 | (defvar hasky-stack--last-directory nil
71 | "Path to project's directory last time `hasky-stack--prepare' was called.
72 |
73 | This is mainly used to check when we need to reload/re-parse
74 | project-local settings that user might have.")
75 |
76 | (defvar hasky-stack--cabal-mod-time nil
77 | "Time of last modification of \"*.cabal\" file.
78 |
79 | This is usually set by `hasky-stack--prepare'.")
80 |
81 | (defvar hasky-stack--project-name nil
82 | "Name of current project extracted from \"*.cabal\" file.
83 |
84 | This is usually set by `hasky-stack--prepare'.")
85 |
86 | (defvar hasky-stack--project-version nil
87 | "Version of current project extracted from \"*.cabal\" file.
88 |
89 | This is usually set by `hasky-stack--prepare'.")
90 |
91 | (defvar hasky-stack--project-targets nil
92 | "List of build targets (strings) extracted from \"*.cabal\" file.
93 |
94 | This is usually set by `hasky-stack--prepare'.")
95 |
96 | (defvar hasky-stack--package-action-package nil
97 | "This variable is temporarily bound to name of package.")
98 |
99 | (defcustom hasky-stack-executable nil
100 | "Path to Stack executable.
101 |
102 | If it's not NIL, this value is used in invocation of Stack
103 | commands instead of the standard \"stack\" string. Set this
104 | variable if your Stack is not on PATH.
105 |
106 | Note that the path is quoted with `shell-quote-argument' before
107 | being used to compose command line."
108 | :tag "Path to Stack Executable"
109 | :type '(choice (file :must-match t)
110 | (const :tag "Use Default" nil)))
111 |
112 | (defcustom hasky-stack-config-dir "~/.stack"
113 | "Path to Stack configuration directory."
114 | :tag "Path to Stack configuration directory"
115 | :type 'directory)
116 |
117 | (defcustom hasky-stack-read-function #'completing-read
118 | "Function to be called when user has to choose from list of alternatives."
119 | :tag "Completing Function"
120 | :type '(radio (function-item completing-read)))
121 |
122 | (defcustom hasky-stack-ghc-versions '("8.6.3" "8.4.4" "8.2.2" "8.0.2" "7.10.3" "7.8.4")
123 | "GHC versions to pick from (for commands like \"stack setup\")."
124 | :tag "GHC versions"
125 | :type '(repeat (string :tag "Extension name")))
126 |
127 | (defcustom hasky-stack-auto-target nil
128 | "Whether to automatically select the default build target."
129 | :tag "Build auto-target"
130 | :type 'boolean)
131 |
132 | (defcustom hasky-stack-auto-open-coverage-reports nil
133 | "Whether to attempt to automatically open coverage report in browser."
134 | :tag "Automatically open coverage reports"
135 | :type 'boolean)
136 |
137 | (defcustom hasky-stack-auto-open-haddocks nil
138 | "Whether to attempt to automatically open Haddocks in browser."
139 | :tag "Automatically open Haddocks"
140 | :type 'boolean)
141 |
142 | (defcustom hasky-stack-auto-newest-version nil
143 | "Whether to install newest version of package without asking.
144 |
145 | This is used in `hasky-stack-package-action'."
146 | :tag "Automatically install newest version"
147 | :type 'boolean)
148 |
149 | (defcustom hasky-stack-templates
150 | '("chrisdone"
151 | "foundation"
152 | "franklinchen"
153 | "ghcjs"
154 | "ghcjs-old-base"
155 | "hakyll-template"
156 | "haskeleton"
157 | "hspec"
158 | "new-template"
159 | "protolude"
160 | "quickcheck-test-framework"
161 | "readme-lhs"
162 | "rio"
163 | "rubik"
164 | "scotty-hello-world"
165 | "scotty-hspec-wai"
166 | "servant"
167 | "servant-docker"
168 | "simple"
169 | "simple-hpack"
170 | "simple-library"
171 | "spock"
172 | "tasty-discover"
173 | "tasty-travis"
174 | "unicode-syntax-exe"
175 | "unicode-syntax-lib"
176 | "yesod-minimal"
177 | "yesod-mongo"
178 | "yesod-mysql"
179 | "yesod-postgres"
180 | "yesod-simple"
181 | "yesod-sqlite")
182 | "List of known templates to choose from when creating new project."
183 | :tag "List of known stack templates"
184 | :type '(repeat (string :tag "Template name")))
185 |
186 |
187 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
188 | ;; Various utilities
189 |
190 | (defun hasky-stack--all-matches (regexp)
191 | "Return list of all stings matching REGEXP in current buffer."
192 | (let (matches
193 | (case-fold-search t))
194 | (goto-char (point-min))
195 | (while (re-search-forward regexp nil t)
196 | (push (match-string-no-properties 1) matches))
197 | (reverse matches)))
198 |
199 | (defun hasky-stack--parse-cabal-file (filename)
200 | "Parse \"*.cabal\" file with name FILENAME and set some variables.
201 |
202 | The following variables are set:
203 |
204 | `hasky-stack--project-name'
205 | `hasky-stack--project-version'
206 | `hasky-stack--project-targets'
207 |
208 | This is used by `hasky-stack--prepare'."
209 | (with-temp-buffer
210 | (insert-file-contents filename)
211 | ;; project name
212 | (setq hasky-stack--project-name
213 | (car (hasky-stack--all-matches
214 | "^[[:blank:]]*name:[[:blank:]]+\\([[:word:]-]+\\)")))
215 | ;; project version
216 | (setq hasky-stack--project-version
217 | (car (hasky-stack--all-matches
218 | "^[[:blank:]]*version:[[:blank:]]+\\([[:digit:]\\.]+\\)")))
219 | ;; project targets
220 | (setq
221 | hasky-stack--project-targets
222 | (append
223 | ;; library
224 | (mapcar (lambda (_) (format "%s:lib" hasky-stack--project-name))
225 | (hasky-stack--all-matches
226 | "^[[:blank:]]*library[[:blank:]]*"))
227 | ;; executables
228 | (mapcar (lambda (x) (format "%s:exe:%s" hasky-stack--project-name x))
229 | (hasky-stack--all-matches
230 | "^[[:blank:]]*executable[[:blank:]]+\\([[:word:]-]+\\)"))
231 | ;; test suites
232 | (mapcar (lambda (x) (format "%s:test:%s" hasky-stack--project-name x))
233 | (hasky-stack--all-matches
234 | "^[[:blank:]]*test-suite[[:blank:]]+\\([[:word:]-]+\\)"))
235 | ;; benchmarks
236 | (mapcar (lambda (x) (format "%s:bench:%s" hasky-stack--project-name x))
237 | (hasky-stack--all-matches
238 | "^[[:blank:]]*benchmark[[:blank:]]+\\([[:word:]-]+\\)"))))))
239 |
240 | (defun hasky-stack--home-page-from-cabal-file (filename)
241 | "Parse package home page from \"*.cabal\" file with FILENAME."
242 | (with-temp-buffer
243 | (insert-file-contents filename)
244 | (or
245 | (car (hasky-stack--all-matches
246 | "^[[:blank:]]*homepage:[[:blank:]]+\\(.+\\)"))
247 | (let ((without-scheme
248 | (car
249 | (hasky-stack--all-matches
250 | "^[[:blank:]]*location:[[:blank:]]+.*:\\(.+\\)\\(\\.git\\)?"))))
251 | (when without-scheme
252 | (concat "https:" without-scheme))))))
253 |
254 | (defun hasky-stack--find-dir-of-file (regexp)
255 | "Find file whose name satisfies REGEXP traversing upwards.
256 |
257 | Return absolute path to directory containing that file or NIL on
258 | failure. Returned path is guaranteed to have trailing slash."
259 | (let ((dir (f-traverse-upwards
260 | (lambda (path)
261 | (directory-files path t regexp t))
262 | (f-full default-directory))))
263 | (when dir
264 | (f-slash dir))))
265 |
266 | (defun hasky-stack--mod-time (filename)
267 | "Return time of last modification of file FILENAME."
268 | (nth 5 (file-attributes filename 'integer)))
269 |
270 | (defun hasky-stack--executable ()
271 | "Return path to stack executable if it's available and NIL otherwise."
272 | (let ((default "stack")
273 | (custom hasky-stack-executable))
274 | (cond ((executable-find default) default)
275 | ((and custom (f-file? custom)) custom))))
276 |
277 | (defun hasky-stack--index-file ()
278 | "Get path to Hackage index file."
279 | (f-expand "indices/Hackage/00-index.tar" hasky-stack-config-dir))
280 |
281 | (defun hasky-stack--index-dir ()
282 | "Get path to directory that is to contain unpackaed Hackage index."
283 | (file-name-as-directory
284 | (f-expand "indices/Hackage/00-index" hasky-stack-config-dir)))
285 |
286 | (defun hasky-stack--index-stamp-file ()
287 | "Get path to Hackage index time stamp file."
288 | (f-expand "ts" (hasky-stack--index-dir)))
289 |
290 | (defun hasky-stack--ensure-indices ()
291 | "Make sure that we have downloaded and untar-ed Hackage package indices.
292 |
293 | This uses external ‘tar’ command, so it probably won't work on
294 | Windows."
295 | (let ((index-file (hasky-stack--index-file))
296 | (index-dir (hasky-stack--index-dir))
297 | (index-stamp (hasky-stack--index-stamp-file)))
298 | (unless (f-file? index-file)
299 | ;; No indices in place, need to run stack update to get them.
300 | (message "Cannot find Hackage indices, trying to download them")
301 | (shell-command (concat (hasky-stack--executable) " update")))
302 | (if (f-file? index-file)
303 | (when (or (not (f-file? index-stamp))
304 | (time-less-p (hasky-stack--mod-time index-stamp)
305 | (hasky-stack--mod-time index-file)))
306 | (f-mkdir index-dir)
307 | (let ((default-directory index-dir))
308 | (message "Extracting Hackage indices, please be patient")
309 | (shell-command
310 | (concat "tar -xf " (shell-quote-argument index-file))))
311 | (f-touch index-stamp)
312 | (message "Finished preparing Hackage indices"))
313 | (error "%s" "Failed to fetch indices, something is wrong!"))))
314 |
315 | (defun hasky-stack--packages ()
316 | "Return list of all packages in Hackage indices."
317 | (hasky-stack--ensure-indices)
318 | (mapcar
319 | #'f-filename
320 | (f-entries (hasky-stack--index-dir) #'f-directory?)))
321 |
322 | (defun hasky-stack--package-versions (package)
323 | "Return list of all available versions of PACKAGE."
324 | (mapcar
325 | #'f-filename
326 | (f-entries (f-expand package (hasky-stack--index-dir))
327 | #'f-directory?)))
328 |
329 | (defun hasky-stack--latest-version (versions)
330 | "Return latest version from VERSIONS."
331 | (cl-reduce (lambda (x y) (if (version< y x) x y))
332 | versions))
333 |
334 | (defun hasky-stack--package-with-version (package version)
335 | "Render identifier of PACKAGE with VERSION."
336 | (concat package "-" version))
337 |
338 | (defun hasky-stack--completing-read (prompt &optional collection require-match)
339 | "Read user's input using `hasky-stack-read-function'.
340 |
341 | PROMPT is the prompt to show and COLLECTION represents valid
342 | choices. If REQUIRE-MATCH is not NIL, don't let user input
343 | something different from items in COLLECTION.
344 |
345 | COLLECTION is allowed to be a string, in this case it's
346 | automatically wrapped to make it one-element list.
347 |
348 | If COLLECTION contains \"none\", and user selects it, interpret
349 | it as NIL. If user aborts entering of the input, return NIL.
350 |
351 | Finally, if COLLECTION is nil, plain `read-string' is used."
352 | (let* ((collection
353 | (if (listp collection)
354 | collection
355 | (list collection)))
356 | (result
357 | (if collection
358 | (funcall hasky-stack-read-function
359 | prompt
360 | collection
361 | nil
362 | require-match
363 | nil
364 | nil
365 | (car collection))
366 | (read-string prompt))))
367 | (unless (and (string= result "none")
368 | (member result collection))
369 | result)))
370 |
371 | (defun hasky-stack--select-target (prompt &optional fragment)
372 | "Present the user with a choice of build target using PROMPT.
373 |
374 | If given, FRAGMENT will be as a filter so only targets that
375 | contain this string will be returned."
376 | (if hasky-stack-auto-target
377 | hasky-stack--project-name
378 | (hasky-stack--completing-read
379 | prompt
380 | (cons hasky-stack--project-name
381 | (if fragment
382 | (cl-remove-if
383 | (lambda (x)
384 | (not (string-match-p (regexp-quote fragment) x)))
385 | hasky-stack--project-targets)
386 | hasky-stack--project-targets)
387 | )
388 | t)))
389 |
390 | (defun hasky-stack--select-package-version (package)
391 | "Present the user with a choice of PACKAGE version."
392 | (let ((versions (hasky-stack--package-versions package)))
393 | (if hasky-stack-auto-newest-version
394 | (hasky-stack--latest-version versions)
395 | (hasky-stack--completing-read
396 | (format "Version of %s: " package)
397 | (cl-sort versions (lambda (x y) (version< y x)))
398 | t))))
399 |
400 |
401 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
402 | ;; Preparation
403 |
404 | (defun hasky-stack--prepare ()
405 | "Locate, read, and parse configuration files and set various variables.
406 |
407 | This commands searches for first \"*.cabal\" files traversing
408 | directories upwards beginning with `default-directory'. When
409 | Cabal file is found, the following variables are set:
410 |
411 | `hasky-stack--project-name'
412 | `hasky-stack--project-version'
413 | `hasky-stack--project-targets'
414 |
415 | At the end, `hasky-stack--last-directory' and
416 | `hasky-stack--cabal-mod-time' are set. Note that this function
417 | is smart enough to avoid re-parsing all the stuff every time. It
418 | can detect when we are in different project or when some files
419 | have been changed since its last invocation.
420 |
421 | Returned value is T on success and NIL on failure (when no
422 | \"*.cabal\" files is found)."
423 | (let* ((project-directory
424 | (hasky-stack--find-dir-of-file "^.+\.cabal$"))
425 | (cabal-file
426 | (car (and project-directory
427 | (f-glob "*.cabal" project-directory)))))
428 | (when cabal-file
429 | (if (or (not hasky-stack--last-directory)
430 | (not (f-same? hasky-stack--last-directory
431 | project-directory)))
432 | (progn
433 | ;; We are in different directory (or it's the first
434 | ;; invocation). This means we should unconditionally parse
435 | ;; everything without checking of date of last modification.
436 | (hasky-stack--parse-cabal-file cabal-file)
437 | (setq hasky-stack--cabal-mod-time (hasky-stack--mod-time cabal-file))
438 | ;; Set last directory for future checks.
439 | (setq hasky-stack--last-directory project-directory)
440 | t) ;; Return T on success.
441 | ;; We are in an already visited directory, so we don't need to reset
442 | ;; `hasky-stack--last-directory' this time. We need to
443 | ;; reread/re-parse *.cabal file if it has been modified though.
444 | (when (time-less-p hasky-stack--cabal-mod-time
445 | (hasky-stack--mod-time cabal-file))
446 | (hasky-stack--parse-cabal-file cabal-file)
447 | (setq hasky-stack--cabal-mod-time (hasky-stack--mod-time cabal-file)))
448 | t))))
449 |
450 |
451 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
452 | ;; Low-level construction of individual commands
453 |
454 | (defun hasky-stack--format-command (command &rest args)
455 | "Generate textual representation of a command.
456 |
457 | COMMAND is the name of command and ARGS are arguments (strings).
458 | Result is expected to be used as argument of `compile'."
459 | (mapconcat
460 | #'identity
461 | (append
462 | (list (shell-quote-argument (hasky-stack--executable))
463 | command)
464 | (mapcar #'shell-quote-argument
465 | (remove nil args)))
466 | " "))
467 |
468 | (defun hasky-stack--exec-command (package dir command &rest args)
469 | "Call stack for PACKAGE as if from DIR performing COMMAND with arguments ARGS.
470 |
471 | Arguments are quoted if necessary and NIL arguments are ignored.
472 | This uses `compile' internally."
473 | (let ((default-directory dir)
474 | (compilation-buffer-name-function
475 | (lambda (_major-mode)
476 | (format "*%s-%s*"
477 | (downcase
478 | (replace-regexp-in-string
479 | "[[:space:]]"
480 | "-"
481 | (or package "hasky")))
482 | "stack"))))
483 | (compile (apply #'hasky-stack--format-command command args))
484 | nil))
485 |
486 |
487 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
488 | ;; Variables
489 |
490 | (defun hasky-stack--cycle-bool-variable (symbol)
491 | "Cycle value of variable named SYMBOL."
492 | (custom-set-variables
493 | (list symbol (not (symbol-value symbol)))))
494 |
495 | (defun hasky-stack--format-bool-variable (symbol label)
496 | "Format a Boolean variable named SYMBOL, label it as LABEL."
497 | (let ((val (symbol-value symbol)))
498 | (concat
499 | (format "%s " label)
500 | (propertize
501 | (if val "enabled" "disabled")
502 | 'face
503 | (if val
504 | 'magit-popup-option-value
505 | 'magit-popup-disabled-argument)))))
506 |
507 | (defun hasky-stack--acp (fun &rest args)
508 | "Apply FUN to ARGS partially and return a command."
509 | (lambda (&rest args2)
510 | (interactive)
511 | (apply fun (append args args2))))
512 |
513 |
514 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
515 | ;; Popups
516 |
517 | (magit-define-popup hasky-stack-build-popup
518 | "Show popup for the \"stack build\" command."
519 | 'hasky-stack
520 | :variables `((?a "auto-target"
521 | ,(hasky-stack--acp
522 | #'hasky-stack--cycle-bool-variable
523 | 'hasky-stack-auto-target)
524 | ,(hasky-stack--acp
525 | #'hasky-stack--format-bool-variable
526 | 'hasky-stack-auto-target
527 | "Auto target"))
528 | (?c "auto-open-coverage-reports"
529 | ,(hasky-stack--acp
530 | #'hasky-stack--cycle-bool-variable
531 | 'hasky-stack-auto-open-coverage-reports)
532 | ,(hasky-stack--acp
533 | #'hasky-stack--format-bool-variable
534 | 'hasky-stack-auto-open-coverage-reports
535 | "Auto open coverage reports"))
536 | (?d "auto-open-haddocks"
537 | ,(hasky-stack--acp
538 | #'hasky-stack--cycle-bool-variable
539 | 'hasky-stack-auto-open-haddocks)
540 | ,(hasky-stack--acp
541 | #'hasky-stack--format-bool-variable
542 | 'hasky-stack-auto-open-haddocks
543 | "Auto open Haddocks")))
544 | :switches '((?r "Dry run" "--dry-run")
545 | (?t "Pedantic" "--pedantic")
546 | (?f "Fast" "--fast")
547 | (?F "File watch" "--file-watch")
548 | (?s "Only snapshot" "--only-snapshot")
549 | (?d "Only dependencies" "--only-dependencies")
550 | (?p "Profile" "--profile")
551 | (?c "Coverage" "--coverage")
552 | (?b "Copy bins" "--copy-bins")
553 | (?g "Copy compiler tool" "--copy-compiler-tool")
554 | (?l "Library profiling" "--library-profiling")
555 | (?e "Executable profiling" "--executable-profiling"))
556 | :options '((?o "GHC options" "--ghc-options=")
557 | (?b "Benchmark arguments" "--benchmark-arguments=")
558 | (?t "Test arguments" "--test-arguments=")
559 | (?h "Haddock arguments" "--haddock-arguments="))
560 | :actions '((?b "Build" hasky-stack-build)
561 | (?e "Bench" hasky-stack-bench)
562 | (?t "Test" hasky-stack-test)
563 | (?h "Haddock" hasky-stack-haddock))
564 | :default-action 'hasky-stack-build)
565 |
566 | (defun hasky-stack-build (target &optional args)
567 | "Execute \"stack build\" command for TARGET with ARGS."
568 | (interactive
569 | (list (hasky-stack--select-target "Build target: ")
570 | (hasky-stack-build-arguments)))
571 | (apply
572 | #'hasky-stack--exec-command
573 | hasky-stack--project-name
574 | hasky-stack--last-directory
575 | "build"
576 | target
577 | args))
578 |
579 | (defun hasky-stack-bench (target &optional args)
580 | "Execute \"stack bench\" command for TARGET with ARGS."
581 | (interactive
582 | (list (hasky-stack--select-target "Bench target: " ":bench:")
583 | (hasky-stack-build-arguments)))
584 | (apply
585 | #'hasky-stack--exec-command
586 | hasky-stack--project-name
587 | hasky-stack--last-directory
588 | "bench"
589 | target
590 | args))
591 |
592 | (defun hasky-stack-test (target &optional args)
593 | "Execute \"stack test\" command for TARGET with ARGS."
594 | (interactive
595 | (list (hasky-stack--select-target "Test target: " ":test:")
596 | (hasky-stack-build-arguments)))
597 | (apply
598 | #'hasky-stack--exec-command
599 | hasky-stack--project-name
600 | hasky-stack--last-directory
601 | "test"
602 | target
603 | args))
604 |
605 | (defun hasky-stack-haddock (&optional args)
606 | "Execute \"stack haddock\" command for TARGET with ARGS."
607 | (interactive
608 | (list (hasky-stack-build-arguments)))
609 | (apply
610 | #'hasky-stack--exec-command
611 | hasky-stack--project-name
612 | hasky-stack--last-directory
613 | "haddock"
614 | args))
615 |
616 | (magit-define-popup hasky-stack-init-popup
617 | "Show popup for the \"stack init\" command."
618 | 'hasky-stack
619 | :switches '((?s "Solver" "--solver")
620 | (?o "Omit packages" "--omit-packages")
621 | (?f "Force" "--force")
622 | (?i "Ignore subdirs" "--ignore-subdirs"))
623 | :actions '((?i "Init" hasky-stack-init))
624 | :default-action 'hasky-stack-init)
625 |
626 | (defun hasky-stack-init (&optional args)
627 | "Execute \"stack init\" with ARGS."
628 | (interactive
629 | (list (hasky-stack-init-arguments)))
630 | (apply
631 | #'hasky-stack--exec-command
632 | hasky-stack--project-name
633 | hasky-stack--last-directory
634 | "init"
635 | args))
636 |
637 | (magit-define-popup hasky-stack-setup-popup
638 | "Show popup for the \"stack setup\" command."
639 | 'hasky-stack
640 | :switches '((?r "Reinstall" "--reinstall")
641 | (?c "Upgrade Cabal" "--upgrade-cabal"))
642 | :actions '((?s "Setup" hasky-stack-setup))
643 | :default-action 'hasky-stack-setup)
644 |
645 | (defun hasky-stack-setup (ghc-version &optional args)
646 | "Execute \"stack setup\" command to install GHC-VERSION with ARGS."
647 | (interactive
648 | (list (hasky-stack--completing-read
649 | "GHC version: "
650 | (cons "implied-by-resolver"
651 | hasky-stack-ghc-versions)
652 | t)
653 | (hasky-stack-setup-arguments)))
654 | (apply
655 | #'hasky-stack--exec-command
656 | hasky-stack--project-name
657 | hasky-stack--last-directory
658 | "setup"
659 | (unless (string= ghc-version "implied-by-resolver")
660 | ghc-version)
661 | args))
662 |
663 | (magit-define-popup hasky-stack-upgrade-popup
664 | "Show popup for the \"stack upgrade\" command."
665 | 'hasky-stack
666 | :switches '((?s "Source only" "--source-only")
667 | (?b "Binary only" "--binary-only")
668 | (?f "Force download" "--force-download")
669 | (?g "Git" "--git"))
670 | :options '((?p "Binary platform" "--binary-platform=")
671 | (?v "Binary version" "--binary-version=")
672 | (?r "Git repo" "--git-repo="))
673 | :actions '((?g "Upgrade" hasky-stack-upgrade))
674 | :default-arguments '("--git-repo=https://github.com/commercialhaskell/stack")
675 | :default-action 'hasky-stack-upgrade)
676 |
677 | (defun hasky-stack-upgrade (&optional args)
678 | "Execute \"stack upgrade\" command with ARGS."
679 | (interactive
680 | (list (hasky-stack-upgrade-arguments)))
681 | (apply
682 | #'hasky-stack--exec-command
683 | hasky-stack--project-name
684 | hasky-stack--last-directory
685 | "upgrade"
686 | args))
687 |
688 | (magit-define-popup hasky-stack-upload-popup
689 | "Show popup for the \"stack upload\" command."
690 | 'hasky-stack
691 | :switches '((?i "Ignore check" "--ignore-check")
692 | (?n "No signature" "--no-signature")
693 | (?t "Test tarball" "--test-tarball"))
694 | :options '((?s "Sig server" "--sig-server="))
695 | :actions '((?p "Upload" hasky-stack-upload))
696 | :default-arguments '("--no-signature")
697 | :default-action 'hasky-stack-upload)
698 |
699 | (defun hasky-stack-upload (&optional args)
700 | "Execute \"stack upload\" command with ARGS."
701 | (interactive
702 | (list (hasky-stack-upload-arguments)))
703 | (apply
704 | #'hasky-stack--exec-command
705 | hasky-stack--project-name
706 | hasky-stack--last-directory
707 | "upload"
708 | "."
709 | args))
710 |
711 | (magit-define-popup hasky-stack-sdist-popup
712 | "Show popup for the \"stack sdist\" command."
713 | 'hasky-stack
714 | :switches '((?i "Ignore check" "--ignore-check")
715 | (?s "Sign" "--sign")
716 | (?t "Test tarball" "--test-tarball"))
717 | :options '((?s "Sig server" "--sig-server="))
718 | :actions '((?d "SDist" hasky-stack-sdist))
719 | :default-action 'hasky-stack-sdist)
720 |
721 | (defun hasky-stack-sdist (&optional args)
722 | "Execute \"stack sdist\" command with ARGS."
723 | (interactive
724 | (list (hasky-stack-sdist-arguments)))
725 | (apply
726 | #'hasky-stack--exec-command
727 | hasky-stack--project-name
728 | hasky-stack--last-directory
729 | "sdist"
730 | args))
731 |
732 | (defun hasky-stack-exec (cmd)
733 | "Execute \"stack exec\" command running CMD."
734 | (interactive
735 | (list (read-string "Command to run: ")))
736 | (cl-destructuring-bind (app . args)
737 | (progn
738 | (string-match
739 | "^[[:blank:]]*\\(?1:[^[:blank:]]+\\)[[:blank:]]*\\(?2:.*\\)$"
740 | cmd)
741 | (cons (match-string 1 cmd)
742 | (match-string 2 cmd)))
743 | (hasky-stack--exec-command
744 | hasky-stack--project-name
745 | hasky-stack--last-directory
746 | (if (string= args "")
747 | (concat "exec " app)
748 | (concat "exec " app " -- " args)))))
749 |
750 | (defun hasky-stack-run (cmd)
751 | "Execute \"stack run\" command running CMD."
752 | (interactive
753 | (list (read-string "Command to run: ")))
754 | (cl-destructuring-bind (app . args)
755 | (progn
756 | (string-match
757 | "^[[:blank:]]*\\(?1:[^[:blank:]]+\\)[[:blank:]]*\\(?2:.*\\)$"
758 | cmd)
759 | (cons (match-string 1 cmd)
760 | (match-string 2 cmd)))
761 | (hasky-stack--exec-command
762 | hasky-stack--project-name
763 | hasky-stack--last-directory
764 | (if (string= args "")
765 | (concat "run " app)
766 | (concat "run " app " -- " args)))))
767 |
768 | (magit-define-popup hasky-stack-clean-popup
769 | "Show popup for the \"stack clean\" command."
770 | 'hasky-stack
771 | :switches '((?f "Full" "--full"))
772 | :actions '((?c "Clean" hasky-stack-clean))
773 | :default-action 'hasky-stack-clean)
774 |
775 | (defun hasky-stack-clean (&optional args)
776 | "Execute \"stack clean\" command with ARGS."
777 | (interactive
778 | (list (hasky-stack-clean-arguments)))
779 | (apply
780 | #'hasky-stack--exec-command
781 | hasky-stack--project-name
782 | hasky-stack--last-directory
783 | "clean"
784 | (if (member "--full" args)
785 | args
786 | (list hasky-stack--project-name))))
787 |
788 | (magit-define-popup hasky-stack-root-popup
789 | "Show root popup with all supported commands."
790 | 'hasky-stack
791 | :actions '((lambda ()
792 | (concat
793 | (propertize hasky-stack--project-name
794 | 'face 'hasky-stack-project-name)
795 | " "
796 | (propertize hasky-stack--project-version
797 | 'face 'hasky-stack-project-version)
798 | "\n\n"
799 | (propertize "Commands"
800 | 'face 'magit-popup-heading)))
801 | (?b "Build" hasky-stack-build-popup)
802 | (?i "Init" hasky-stack-init-popup)
803 | (?s "Setup" hasky-stack-setup-popup)
804 | (?u "Update" hasky-stack-update)
805 | (?g "Upgrade" hasky-stack-upgrade-popup)
806 | (?p "Upload" hasky-stack-upload-popup)
807 | (?d "SDist" hasky-stack-sdist-popup)
808 | (?x "Exec" hasky-stack-exec)
809 | (?r "Run" hasky-stack-run)
810 | (?c "Clean" hasky-stack-clean-popup)
811 | (?l "Edit Cabal file" hasky-stack-edit-cabal)
812 | (?y "Edit stack.yaml" hasky-stack-edit-stack-yaml))
813 | :default-action 'hasky-stack-build-popup
814 | :max-action-columns 3)
815 |
816 | (defun hasky-stack-update ()
817 | "Execute \"stack update\"."
818 | (interactive)
819 | (hasky-stack--exec-command
820 | hasky-stack--project-name
821 | hasky-stack--last-directory
822 | "update"))
823 |
824 | (defun hasky-stack-edit-cabal ()
825 | "Open Cabal file of current project for editing."
826 | (interactive)
827 | (let ((cabal-file
828 | (car (and hasky-stack--last-directory
829 | (f-glob "*.cabal" hasky-stack--last-directory)))))
830 | (when cabal-file
831 | (find-file cabal-file))))
832 |
833 | (defun hasky-stack-edit-stack-yaml ()
834 | "Open \"stack.yaml\" of current project for editing."
835 | (interactive)
836 | (let ((stack-yaml-file
837 | (car (and hasky-stack--last-directory
838 | (f-glob "stack.yaml" hasky-stack--last-directory)))))
839 | (when stack-yaml-file
840 | (find-file stack-yaml-file))))
841 |
842 | (magit-define-popup hasky-stack-package-action-popup
843 | "Show package action popup."
844 | 'hasky-stack
845 | :variables `((?a "auto-newest-version"
846 | ,(hasky-stack--acp
847 | #'hasky-stack--cycle-bool-variable
848 | 'hasky-stack-auto-newest-version)
849 | ,(hasky-stack--acp
850 | #'hasky-stack--format-bool-variable
851 | 'hasky-stack-auto-newest-version
852 | "Auto newest version")))
853 | :options '((?r "Resolver to use" "--resolver="))
854 | :actions '((?i "Install" hasky-stack-package-install)
855 | (?h "Hackage" hasky-stack-package-open-hackage)
856 | (?s "Stackage" hasky-stack-package-open-stackage)
857 | (?m "Build matrix" hasky-stack-package-open-build-matrix)
858 | (?g "Home page" hasky-stack-package-open-home-page)
859 | (?c "Changelog" hasky-stack-package-open-changelog))
860 | :default-action 'hasky-stack-package-install
861 | :max-action-columns 3)
862 |
863 | (defun hasky-stack-package-install (package version &optional args)
864 | "Install PACKAGE of VERSION globally using ARGS."
865 | (interactive
866 | (list hasky-stack--package-action-package
867 | (hasky-stack--select-package-version
868 | hasky-stack--package-action-package)
869 | (hasky-stack-package-action-arguments)))
870 | (apply
871 | #'hasky-stack--exec-command
872 | hasky-stack--package-action-package
873 | hasky-stack-config-dir
874 | "install"
875 | (hasky-stack--package-with-version package version)
876 | args))
877 |
878 | (defun hasky-stack-package-open-hackage (package)
879 | "Open Hackage page for PACKAGE."
880 | (interactive (list hasky-stack--package-action-package))
881 | (browse-url
882 | (concat "https://hackage.haskell.org/package/"
883 | (url-hexify-string package))))
884 |
885 | (defun hasky-stack-package-open-stackage (package)
886 | "Open Stackage page for PACKAGE."
887 | (interactive (list hasky-stack--package-action-package))
888 | (browse-url
889 | (concat "https://www.stackage.org/package/"
890 | (url-hexify-string package))))
891 |
892 | (defun hasky-stack-package-open-build-matrix (package)
893 | "Open Hackage build matrix for PACKAGE."
894 | (interactive (list hasky-stack--package-action-package))
895 | (browse-url
896 | (concat "https://matrix.hackage.haskell.org/package/"
897 | (url-hexify-string package))))
898 |
899 | (defun hasky-stack-package-open-home-page (package)
900 | "Open home page of PACKAGE."
901 | (interactive (list hasky-stack--package-action-package))
902 | (let* ((versions (hasky-stack--package-versions package))
903 | (latest-version (hasky-stack--latest-version versions))
904 | (cabal-file (f-join (hasky-stack--index-dir)
905 | package
906 | latest-version
907 | (concat package ".cabal")))
908 | (homepage (hasky-stack--home-page-from-cabal-file cabal-file)))
909 | (browse-url homepage)))
910 |
911 | (defun hasky-stack-package-open-changelog (package)
912 | "Open Hackage build matrix for PACKAGE."
913 | (interactive (list hasky-stack--package-action-package))
914 | (browse-url
915 | (concat "https://hackage.haskell.org/package/"
916 | (url-hexify-string
917 | (hasky-stack--package-with-version
918 | package
919 | (hasky-stack--latest-version
920 | (hasky-stack--package-versions package))))
921 | "/changelog")))
922 |
923 |
924 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
925 | ;; High-level interface
926 |
927 | ;;;###autoload
928 | (defun hasky-stack-execute ()
929 | "Show the root-level popup allowing to choose and run a Stack command."
930 | (interactive)
931 | (if (hasky-stack--executable)
932 | (if (hasky-stack--prepare)
933 | (hasky-stack-root-popup)
934 | (message "Cannot locate ‘.cabal’ file"))
935 | (error "%s" "Cannot locate Stack executable on this system")))
936 |
937 | ;;;###autoload
938 | (defun hasky-stack-new (project-name template)
939 | "Initialize the current directory by using a Stack template.
940 |
941 | PROJECT-NAME is the name of project and TEMPLATE is quite
942 | obviously template name."
943 | (interactive
944 | (list (hasky-stack--completing-read
945 | "Project name: "
946 | (file-name-nondirectory
947 | (directory-file-name
948 | default-directory)))
949 | (hasky-stack--completing-read
950 | "Use template: "
951 | (cons "none" hasky-stack-templates)
952 | t)))
953 | (if (hasky-stack--prepare)
954 | (message "The directory is already initialized, it seems")
955 | (hasky-stack--exec-command
956 | project-name
957 | default-directory
958 | "new"
959 | "--bare"
960 | project-name
961 | template)))
962 |
963 | ;;;###autoload
964 | (defun hasky-stack-package-action (package)
965 | "Open a popup allowing to install or request information about PACKAGE.
966 |
967 | This functionality currently relies on existence of ‘tar’
968 | command. This means that it works on Posix systems, but may have
969 | trouble working on Windows. Please let me know if you run into
970 | any issues on Windows and we'll try to work around (I don't have
971 | a Windows machine)."
972 | (interactive
973 | (list (hasky-stack--completing-read
974 | "Package: "
975 | (hasky-stack--packages)
976 | t)))
977 | (setq hasky-stack--package-action-package package)
978 | (hasky-stack-package-action-popup))
979 |
980 |
981 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
982 | ;; Setting up post-compilation magic
983 |
984 | (defun hasky-stack--compilation-finish-function (buffer str)
985 | "Function that is called when a compilation process in BUFFER finishes.
986 |
987 | STR describes how the process finished."
988 | (when (and (string-match "^\\*.*-stack\\*$" (buffer-name buffer))
989 | (string= str "finished\n"))
990 | (with-current-buffer buffer
991 | ;; Coverage report
992 | (goto-char (point-min))
993 | (when (and hasky-stack-auto-open-coverage-reports
994 | (re-search-forward
995 | "^The coverage report for .+'s test-suite \".+\" is available at \\(.*\\)$" nil t))
996 | (browse-url (match-string-no-properties 1)))
997 | (cl-flet ((open-haddock
998 | (regexp)
999 | (goto-char (point-min))
1000 | (when (and hasky-stack-auto-open-haddocks
1001 | (re-search-forward regexp nil t))
1002 | (browse-url (f-expand (match-string-no-properties 1)
1003 | hasky-stack--last-directory))
1004 | t)))
1005 | (or (open-haddock "^Documentation created:\n\\(.*\\),$")
1006 | (open-haddock "^Haddock index for local packages already up to date at:\n\\(.*\\)$")
1007 | (open-haddock "^Updating Haddock index for local packages in\n\\(.*\\)$"))))))
1008 |
1009 | (add-to-list 'compilation-finish-functions
1010 | #'hasky-stack--compilation-finish-function)
1011 |
1012 | (provide 'hasky-stack)
1013 |
1014 | ;;; hasky-stack.el ends here
1015 |
--------------------------------------------------------------------------------