[nongnu] elpa/haskell-tng-mode cea8b23 240/385: proof of concept getting the ghcflags from cabal

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit cea8b232e21807628a7349b02af16fe3564332b0
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@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