From e27e01dccdc232b8d9897284122525ed3cf375a1 Mon Sep 17 00:00:00 2001
From: Daniil Iaitskov <dyaitskov@gmail.com>
Date: Tue, 21 Jan 2025 19:10:36 -0900
Subject: [PATCH] nix-shell-haddock pick haddock root from .haddock-ref file

---
 Makefile                   |  2 +-
 haskell-mode.el            |  2 +-
 tests/w3m-haddock-tests.el | 37 +++++++++++++++++++++++++++++++++++++
 w3m-haddock.el             | 31 +++++++++++++++++++++++++++----
 4 files changed, 66 insertions(+), 6 deletions(-)
 create mode 100644 tests/w3m-haddock-tests.el

diff --git a/Makefile b/Makefile
index af684535..9ddb81be 100644
--- a/Makefile
+++ b/Makefile
@@ -88,7 +88,7 @@ build-$(EMACS_VERSION)/build-flag : build-$(EMACS_VERSION) $(patsubst %.el,build
 	touch $@
 
 check-%: tests/%-tests.el
-	$(BATCH) -l "$<" -f ert-run-tests-batch-and-exit;
+	$(BATCH) --eval $(INIT_PACKAGES) -l "$<" -f ert-run-tests-batch-and-exit;
 
 check: compile $(AUTOLOADS) check-package-lint check-relint check-ert
 
diff --git a/haskell-mode.el b/haskell-mode.el
index f8e7c3fb..e4e18a3e 100644
--- a/haskell-mode.el
+++ b/haskell-mode.el
@@ -6,7 +6,7 @@
 ;; Copyright © 1992, 1997-1998  Simon Marlow, Graeme E Moss, and Tommy Thorn
 
 ;; Version: 17.5
-;; Package-Requires: ((emacs "25.1"))
+;; Package-Requires: ((emacs "25.1") (f "0.20.0"))
 ;; Keywords: haskell cabal ghc repl languages
 ;; URL: https://github.com/haskell/haskell-mode
 
diff --git a/tests/w3m-haddock-tests.el b/tests/w3m-haddock-tests.el
new file mode 100644
index 00000000..7b975786
--- /dev/null
+++ b/tests/w3m-haddock-tests.el
@@ -0,0 +1,37 @@
+;;; w3m-haddock-tests.el --- Tests for w3m-haddocks    -*- lexical-binding: t -*-
+;;; Summary:
+;;; Code:
+
+(require 'ert)
+(require 'f)
+(require 'haskell)
+(require 'w3m-haddock) ;; implementation under test
+
+(defmacro with-temp-directory (tdir &rest body)
+  "Cleate TDIR temp directory and execute BODY."
+  `(let ((,tdir (make-temp-file "tmpdir" t)))
+    (unwind-protect
+        (progn ,@body))
+    (delete-directory ,tdir t)))
+
+(ert-deftest w3m-haddock-discover-ref-test ()
+    (with-temp-directory
+     d
+     (let ((haddock-root (concat d "/nix/store/53195319531953-ghc-with-packages/share/doc")))
+       (make-directory haddock-root t)
+       (f-write-text haddock-root nil (concat d "/.haddock-ref"))
+       (make-directory (concat d "/src/a/b/c") t)
+       (f-write-text "module Main where" nil (concat d "/src/a/b/c/Main.hs"))
+       (find-file (concat d "/src/a/b/c/Main.hs"))
+       (should (equal haddock-root (w3m-haddock-discover-ref))))))
+
+(ert-deftest w3m-haddock-discover-ref-nil-test ()
+  (with-temp-directory
+   d
+   (make-directory (concat d "/src/a/b/c") t)
+   (f-write-text "module Main where" nil (concat d "/src/a/b/c/Main.hs"))
+   (find-file (concat d "/src/a/b/c/Main.hs"))
+   (should (null (w3m-haddock-discover-ref)))))
+
+(provide 'w3m-haddock-tests)
+;;; w3m-haddock-tests.el ends here
diff --git a/w3m-haddock.el b/w3m-haddock.el
index 0f6a9e11..44255226 100644
--- a/w3m-haddock.el
+++ b/w3m-haddock.el
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+;; (require 'f)
 (require 'haskell-mode)
 (require 'haskell-font-lock)
 
@@ -40,6 +41,23 @@
   "Face for quarantines."
   :group 'haskell)
 
+(defun w3m-haddock-discover-ref ()
+  "Return path form \".haddock-ref\" file or nil.
+
+The file is picked up from the closest parent directory
+relative to current file.  If GHC is provided via nix-shell then path
+to haddocks can be discovered in a shell hook and persisted in the project root:
+\"echo $(dirname $(dirname $(which ghc)))/share/doc > .haddock-ref\"."
+  (let ((ap (buffer-file-name))
+        (r nil))
+    (while (and (null r) (setq ap (and ap (f-dirname ap))))
+      (let ((href (concat ap "/.haddock-ref")))
+        (when (file-exists-p href)
+          (setq href (string-trim (f-read-text href)))
+          (when (f-directory-p href)
+            (setq r href)))))
+    r))
+
 (defcustom haskell-w3m-haddock-dirs
   '("~/.cabal/share/doc/")
   "The path to your cabal documentation dir.
@@ -54,7 +72,7 @@ You can rebind this if you're using hsenv by adding it to your
 
 "
   :group 'haskell
-  :type 'list)
+  :type '(list string))
 
 (defvar w3m-haddock-entry-regex "^\\(\\(data\\|type\\) \\|[a-z].* :: \\)"
   "Regex to match entry headings.")
@@ -62,18 +80,23 @@ You can rebind this if you're using hsenv by adding it to your
 (defun haskell-w3m-open-haddock ()
   "Open a haddock page in w3m."
   (interactive)
-  (let* ((entries (cl-remove-if (lambda (s) (string= s ""))
+  (let* (
+         (haddock-ref (w3m-haddock-discover-ref))
+         (haddock-dirs (if (null haddock-ref)
+                           haskell-w3m-haddock-dirs
+                         (cons haddock-ref haskell-w3m-haddock-dirs)))
+         (entries (cl-remove-if (lambda (s) (string= s ""))
                                 (apply 'append (mapcar (lambda (dir)
                                                          (split-string (shell-command-to-string (concat "ls -1 " dir))
 
                                                                        "\n"))
-                                                       haskell-w3m-haddock-dirs))))
+                                                       haddock-dirs))))
          (package-dir (ido-completing-read
                        "Package: "
                        entries)))
     (cond
      ((member package-dir entries)
-      (unless (cl-loop for dir in haskell-w3m-haddock-dirs
+      (unless (cl-loop for dir in haddock-dirs
                        when (w3m-haddock-find-index dir package-dir)
                        do (progn (w3m-browse-url (w3m-haddock-find-index dir package-dir)
                                                  t)