;;; shm-stack.el --- Stack integration

;; Copyright (c) 2015 Chris Done. All rights reserved.

;; 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(defvar shm-stack-project-p nil)
(make-variable-buffer-local 'shm-stack-project-p)

(defun shm-stack-project-p ()
  "Is this buffer in a stack project?"
  (or (bound-and-true-p shm-stack-project-p)
      (setq shm-stack-project-p
            (not (not (shm-stack-find-file))))))

(defun shm-stack-find-file (&optional dir)
  "Copied from `haskell-yaml-find-file'."
  (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 ((yaml-file (shm-stack-find-yaml root)))
              (when yaml-file
                (throw 'found yaml-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 shm-stack-find-yaml (dir &optional allow-multiple)
  "Copied from `haskell-yaml-find-pkg-desc'."
  (let* ((yaml-files
          (cl-remove-if 'file-directory-p
                        (cl-remove-if-not 'file-exists-p
                                          (directory-files dir t ".\\.yaml\\'")))))
    (cond
     ((= (length yaml-files) 1) (car yaml-files)) ;; exactly one candidate found
     (allow-multiple yaml-files) ;; pass-thru multiple candidates
     (t nil))))

(provide 'shm-stack)