;;; haskell-flycheck.el --- Flychecker using the GHCi process

;; Copyright (c) 2014 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:

(require 'haskell-process)
(require 'flycheck)

(defun flycheck-haskell-process-start (checker callback)
  "Start a GHCi load with CHECKER.

CALLBACK is the status callback passed by Flycheck."
  (let ((session (haskell-session)))
    (haskell-session-current-dir session)
    (let ((process (haskell-process)))
      (haskell-process-queue-command
       process
       (make-haskell-command
        :state
        (list :process process
              :session session
              :filename (buffer-file-name)
              :callback callback
              :buffer (current-buffer)
              :original (buffer-string))
        :go
        (lambda (state)
          (with-current-buffer (plist-get state :buffer)
            (let* ((filename (plist-get state :filename)))
              (write-region (point-min) (point-max) filename)
              (clear-visited-file-modtime)
              (haskell-process-send-string
               (plist-get state :process)
               (format ":load \"%s\""
                       (replace-regexp-in-string
                        "\""
                        "\\\\\""
                        filename))))))
        :live (lambda (state _)
                (when (plist-get state :original)
                  (with-temp-buffer
                    (insert (plist-get state :original))
                    (write-region (point-min) (point-max) (plist-get state :filename))
                    (plist-put state :original nil))))
        :complete
        (lambda (state response)
          (let ((session (plist-get state :session))
                (process (plist-get state :process)))
            (haskell-process-set-response-cursor process 0)
            (let ((errors (list))
                  (next-error t))
              (while next-error
                (setq next-error
                      (haskell-process-errors-warnings
                       session
                       process
                       response
                       t))
                (when (consp next-error)
                  (add-to-list 'errors
                               (flycheck-error-new-at
                                (plist-get next-error :line)
                                (plist-get next-error :col)
                                (plist-get next-error :type)
                                (plist-get next-error :msg)
                                :checker 'haskell-process
                                :buffer (plist-get state :buffer)))))
              (funcall (plist-get state :callback)
                       'finished
                       errors)))))))))


(flycheck-define-generic-checker 'haskell-process
  "A syntax and type checker for Haskell using GHCi (via the
haskell-process Emacs module)."
  :start 'flycheck-haskell-process-start
  :modes '(haskell-mode)
  :next-checkers '((warning . haskell-hlint)))

;; Register as an auto-selectable checker
(setq flycheck-checkers (cons `haskell-process flycheck-checkers))

(provide 'haskell-flycheck)