branch: elpa/haskell-tng-mode
commit cea8b232e21807628a7349b02af16fe3564332b0
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
proof of concept getting the ghcflags from cabal
---
cabal-ghcflags.sh | 70 ++++++++++++++++++++++++++++++++++++++++++
haskell-tng-compile.el | 17 +++++-----
haskell-tng-hsinspect.el | 80 +++++++++++++++++++++++++-----------------------
3 files changed, 122 insertions(+), 45 deletions(-)
diff --git a/cabal-ghcflags.sh b/cabal-ghcflags.sh
new file mode 100755
index 0000000..ca08e25
--- /dev/null
+++ b/cabal-ghcflags.sh
@@ -0,0 +1,70 @@
+#!/bin/bash
+
+# Dump the ghc flags that cabal-install uses to launch a repl session for
+# all components into files named `.ghc.flags.component'.
+#
+# This is a partial workaround to https://github.com/haskell/cabal/issues/6203
+#
+# Note that this flushes the build plan cache and only supports the default
+# build flags. If users wish to include test phases they must add tests: True
+# to their cabal.project.local
+
+# set -e -x -o pipefail
+
+TMP="/tmp/$PWD/hack-cabal"
+mkdir -p "$TMP" 2> /dev/null
+
+# to ensure the json plan is in place
+cabal v2-build -v0 :all --only-dependencies
+
+if [ ! -d dist-newstyle ] ; then
+ echo "dist-newstyle not found"
+ exit 1
+fi
+
+GHC=$(cabal v2-exec -v2 ghc -- --numeric-version | tail -2 | head -1 | sed 's/
.*//')
+GHC_PKG=$(echo "$GHC" | rev | sed 's/chg/gkp-chg/' | rev)
+
+# ghc is called multiple times during the v2-repl startup.
+# The only call that we're interested in is this one.
+cat <<EOF > "$TMP/ghc"
+#!/bin/bash
+if [ "\$1" == "--interactive" ]; then
+ echo -n "\${@:2}" >> "$TMP/out"
+else
+ exec "$GHC" "\$@"
+fi
+EOF
+chmod 755 "$TMP/ghc"
+
+cat <<EOF > "$TMP/ghc-pkg"
+#!/bin/bash
+exec "$GHC_PKG" "\$@"
+EOF
+chmod 755 "$TMP/ghc-pkg"
+
+jq -c '(.["install-plan"][] | select(.["pkg-src"].type == "local") |
select(.["component-name"] != null) | [ .["pkg-name"], .["component-name"],
.["pkg-src"].path, .id ] )' dist-newstyle/cache/plan.json | while read LINE ; do
+ NAME=$(echo "$LINE" | jq -r '.[0]')
+ PART=$(echo "$LINE" | jq -r '.[1]')
+ ROOT=$(echo "$LINE" | jq -r '.[2]')
+ ID=$(echo "$LINE" | jq -r '.[3]')
+
+ if [ "$PART" == "lib" ] ; then
+ COMPONENT="lib:$NAME"
+ else
+ COMPONENT="$PART"
+ fi
+
+ CACHE=$(echo "$ROOT/.ghc.flags.$PART" | sed 's/:/./g')
+ echo "creating $CACHE"
+ rm "$TMP/out" 2> /dev/null
+ cabal v2-repl -v0 -w "$TMP/ghc" "$NAME:$COMPONENT"
+ cat "$TMP/out" > "$CACHE"
+done
+
+if [ -d "$TMP" ] ; then
+ rm -rf "$TMP"
+fi
+
+# try our best to reset the cache to what the user expects
+cabal v2-build -v0 :all --dry
diff --git a/haskell-tng-compile.el b/haskell-tng-compile.el
index 14e3275..062ffec 100644
--- a/haskell-tng-compile.el
+++ b/haskell-tng-compile.el
@@ -62,15 +62,16 @@
(defvar haskell-tng--compile-history
;; Prefer --enable-tests due to
;; https://github.com/haskell/cabal/issues/6114
- '("cabal v2-build -O0 --enable-tests :all"
- "cabal v2-run -O0 --enable-tests tasty -- "))
+ '("cabal v2-build :all"
+ "cabal v2-run tasty -- "))
(defvar-local haskell-tng--compile-command nil)
(defvar-local haskell-tng--compile-alt "cabal v2-clean")
-(defvar haskell-tng--compile-dominating-file
- (rx (| "cabal.project" "cabal.project.local" "cabal.project.freeze"
- (: (+ any) ".cabal")
- "package.yaml" "stack.yaml")))
+(defvar haskell-tng--compile-dominating-project
+ ;; TODO move stack.yaml to contrib-stack
+ (rx (| "cabal.project" "cabal.project.local" "cabal.project.freeze"
"stack.yaml")))
+(defvar haskell-tng--compile-dominating-package
+ (rx (| (: (+ any) ".cabal") "package.yaml")))
(defun haskell-tng-compile (&optional edit-command)
"`compile' specialised to Haskell:
@@ -106,7 +107,9 @@ will cause the subsequent call to prompt."
(let ((default-directory
(or
(haskell-tng--util-locate-dominating-file
- haskell-tng--compile-dominating-file)
+ haskell-tng--compile-dominating-package)
+ (haskell-tng--util-locate-dominating-file
+ haskell-tng--compile-dominating-project)
default-directory)))
(compilation-start
command
diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index 81a73a7..3600d6b 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -13,9 +13,6 @@
(require 'haskell-tng-compile)
-(defvar-local haskell-tng-hsinspect-langexts nil)
-;; TODO improve the validity checker
-
;;;###autoload
(defun haskell-tng-fqn-at-point ()
"Consult the imports in scope and display the fully qualified
@@ -33,13 +30,14 @@ name of the symbol at point in the minibuffer."
(message "<not imported>"))))
(defvar haskell-tng-hsinspect
- (concat
- ;; no need to compile tests, use O0 so it is faster
- "hsinspect-init () {\n"
- " cabal v2-build -O0 :all &&\n"
- " cabal v2-exec -O0 -v0 -- sh -c 'cat $GHC_ENVIRONMENT > .hsinspect.env'\n"
- "}\n"
- "hsinspect-init"))
+ ;; NOTE in order for this hack to work, the user needs to have setup a
+ ;; cabal.project.local that contains their default options (optimisations,
+ ;; enabling tests, etc) otherwise it will (at best) invalidate the cache and
+ ;; (at worst) not find local projects.
+ (expand-file-name
+ "cabal-ghcflags.sh"
+ (when load-file-name
+ (file-name-directory load-file-name))))
;;;###autoload
(defun haskell-tng-hsinspect ()
"Required (for now) to initialise a project for use with `hsinspect'.
@@ -48,12 +46,27 @@ change."
(interactive)
(when-let ((default-directory
(or
- ;; prefer the full project before packages
- (locate-dominating-file "project.cabal" "project.cabal.local")
(haskell-tng--util-locate-dominating-file
- haskell-tng--compile-dominating-file))))
+ haskell-tng--compile-dominating-project)
+ (haskell-tng--util-locate-dominating-file
+ haskell-tng--compile-dominating-package))))
(async-shell-command haskell-tng-hsinspect)))
+(defun haskell-tng--hsinspect-ghcflags ()
+ ;; https://github.com/haskell/cabal/issues/6203
+ "Obtain the ghc flags for the current buffer"
+ (if-let (cache (locate-dominating-file default-directory ".ghc.flags.lib"))
+ (seq-map
+ ;; hsinspect works best if we trick the compiler into thinking that the
+ ;; file we are inspecting is independent of the current unit.
+ (lambda (e) (if (equal e "-this-unit-id") "-package-id" e))
+ (with-temp-buffer
+ ;; FIXME support exe/test/etc components (discover the component)
+ (insert-file-contents (expand-file-name ".ghc.flags.lib" cache))
+ (split-string
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (user-error "could not find `.ghc.flags.lib'. Run `M-x
haskell-tng-hsinspect'")))
+
;; TODO invalidate cache when imports section has changed
;; TODO is there a way to tell Emacs not to render this in `C-h v'?
;; (suggestion is to advise around describe-key)
@@ -66,31 +79,22 @@ t means the process failed.")
haskell-tng--hsinspect-imports)
(setq haskell-tng--hsinspect-imports t) ;; avoid races
(ignore-errors (kill-buffer "*hsinspect*"))
- (let ((envdir (locate-dominating-file default-directory ".hsinspect.env")))
- (if (not envdir)
- (user-error "could not find `.hsinspect.env'. Run `M-x
haskell-tng-hsinspect'")
- (if (/= 0
- (let* ((ghcenv
- (concat "GHC_ENVIRONMENT="
- (expand-file-name envdir) ".hsinspect.env"))
- (process-environment
- (cons ghcenv process-environment)))
- (apply
- #'call-process
- ;; TODO launching the correct hsinspect-ghc-X version
- ;; TODO is there a way to pipe into a string not a buffer?
- ;; TODO async
- "hsinspect"
- nil "*hsinspect*" nil
- (append `("imports" ,buffer-file-name "--")
- haskell-tng-hsinspect-langexts))))
- (user-error "`hsinspect' failed. See the *hsinspect* buffer for
more information")
- (setq haskell-tng--hsinspect-imports
- (with-current-buffer "*hsinspect*"
- (goto-char (point-min))
- (re-search-forward (rx bol "(") nil t) ;; sometimes there is
junk from the launcher
- (goto-char (match-beginning 0))
- (or (ignore-errors (read (current-buffer))) t))))))))
+ (when-let (ghcflags (haskell-tng--hsinspect-ghcflags))
+ (if (/= 0
+ (let ((process-environment (cons "GHC_ENVIRONMENT=-"
process-environment)))
+ (apply
+ #'call-process
+ ;; TODO launching the correct hsinspect-ghc-X version
+ ;; TODO async
+ "hsinspect"
+ nil "*hsinspect*" nil
+ (append `("imports" ,buffer-file-name "--") ghcflags))))
+ (user-error "`hsinspect' failed. See the *hsinspect* buffer for more
information")
+ (setq haskell-tng--hsinspect-imports
+ (with-current-buffer "*hsinspect*"
+ (goto-char (point-max))
+ (backward-sexp)
+ (or (ignore-errors (read (current-buffer))) t)))))))
(provide 'haskell-tng-hsinspect)
;;; haskell-tng-hsinspect.el ends here
