<commit_before>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc-check.el
;;;

;; Author:  <NAME> <<EMAIL>>
;; Created: Mar  9, 2014

;;; Code:

(require 'ghc-func)
(require 'ghc-process)
(require 'button)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; stolen from flymake.el
(defface ghc-face-error
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "orangered"))
    (t
     :inherit error))
  "Face used for marking error lines."
  :group 'ghc)

(defface ghc-face-warn
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "gold"))
    (t
     :inherit warning))
  "Face used for marking warning lines."
  :group 'ghc)

(defface ghc-face-hole
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "purple"))
    (t
     :inherit warning))
  "Face used for marking hole lines."
  :group 'ghc)

(defvar ghc-check-error-fringe (propertize "!" 'display '(left-fringe exclamation-mark)))

(defvar ghc-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark)))

(defvar ghc-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar)))

(defvar ghc-display-error nil
  "*An action to display errors/warnings for 'M-n' and 'M-p:

nil            does not display errors/warnings.
'minibuffer    displays errors/warnings in the minibuffer.
'other-buffer  displays errors/warnings in the other buffer.
")

(defvar ghc-display-hole 'other-buffer
  "*An action to display hole information for 'C-c C-j' and 'C-c C-h'

'minibuffer    displays errors/warnings in the minibuffer.
'other-buffer  displays errors/warnings in the other buffer"
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun ghc-check-syntax ()
  (interactive)
  (ghc-with-process (ghc-check-send)
		    'ghc-check-callback
		    (lambda () (setq mode-line-process " -:-"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ghc-defstruct hilit-info file line msg err hole coln)

(defun ghc-check-send ()
  (let ((file (buffer-file-name)))
    (if ghc-check-command
	(let ((opts (ghc-haskell-list-of-string ghc-hlint-options)))
	  (if opts
	      (format "lint %s %s\n" opts file)
	    (format "lint %s\n" file)))
      (format "check %s\n" file))))

(defun ghc-haskell-list-of-string (los)
  (when los
    (concat "["
	    (mapconcat (lambda (x) (concat "\"" x "\"")) los ", ")
	    "]")))

(defun ghc-check-callback (status)
  (cond
   ((eq status 'ok)
    (let* ((errs (ghc-read-lisp-this-buffer))
	   (infos (ghc-to-info errs)))
      (cond
       (infos
	(let ((file ghc-process-original-file)
	      (buf ghc-process-original-buffer))
	  (ghc-check-highlight-original-buffer file buf infos)))
       (t
	(ghc-with-current-buffer ghc-process-original-buffer
	  (remove-overlays (point-min) (point-max) 'ghc-check t))))
      (ghc-with-current-buffer ghc-process-original-buffer
	(let ((len (length infos)))
	  (if (= len 0)
	      (setq mode-line-process "")
	    (let* ((errs (ghc-filter 'ghc-hilit-info-get-err infos))
		   (elen (length errs))
		   (wlen (- len elen)))
	      (setq mode-line-process (format " %d:%d" elen wlen))))))))
   (t
    (ghc-with-current-buffer ghc-process-original-buffer
      (setq mode-line-process " failed")))))
<commit_msg>using force-mode-line-update just in case.<commit_after>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc-check.el
;;;

;; Author:  <NAME> <<EMAIL>>
;; Created: Mar  9, 2014

;;; Code:

(require 'ghc-func)
(require 'ghc-process)
(require 'button)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; stolen from flymake.el
(defface ghc-face-error
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "orangered"))
    (t
     :inherit error))
  "Face used for marking error lines."
  :group 'ghc)

(defface ghc-face-warn
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "gold"))
    (t
     :inherit warning))
  "Face used for marking warning lines."
  :group 'ghc)

(defface ghc-face-hole
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "purple"))
    (t
     :inherit warning))
  "Face used for marking hole lines."
  :group 'ghc)

(defvar ghc-check-error-fringe (propertize "!" 'display '(left-fringe exclamation-mark)))

(defvar ghc-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark)))

(defvar ghc-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar)))

(defvar ghc-display-error nil
  "*An action to display errors/warnings for 'M-n' and 'M-p:

nil            does not display errors/warnings.
'minibuffer    displays errors/warnings in the minibuffer.
'other-buffer  displays errors/warnings in the other buffer.
")

(defvar ghc-display-hole 'other-buffer
  "*An action to display hole information for 'C-c C-j' and 'C-c C-h'

'minibuffer    displays errors/warnings in the minibuffer.
'other-buffer  displays errors/warnings in the other buffer"
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun ghc-check-syntax ()
  (interactive)
  (ghc-with-process (ghc-check-send)
		    'ghc-check-callback
		    (lambda () (setq mode-line-process " -:-"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ghc-defstruct hilit-info file line msg err hole coln)

(defun ghc-check-send ()
  (let ((file (buffer-file-name)))
    (if ghc-check-command
	(let ((opts (ghc-haskell-list-of-string ghc-hlint-options)))
	  (if opts
	      (format "lint %s %s\n" opts file)
	    (format "lint %s\n" file)))
      (format "check %s\n" file))))

(defun ghc-haskell-list-of-string (los)
  (when los
    (concat "["
	    (mapconcat (lambda (x) (concat "\"" x "\"")) los ", ")
	    "]")))

(defun ghc-check-callback (status)
  (cond
   ((eq status 'ok)
    (let* ((errs (ghc-read-lisp-this-buffer))
	   (infos (ghc-to-info errs)))
      (cond
       (infos
	(let ((file ghc-process-original-file)
	      (buf ghc-process-original-buffer))
	  (ghc-check-highlight-original-buffer file buf infos)))
       (t
	(ghc-with-current-buffer ghc-process-original-buffer
	  (remove-overlays (point-min) (point-max) 'ghc-check t))))
      (ghc-with-current-buffer ghc-process-original-buffer
	(let ((len (length infos)))
	  (if (= len 0)
	      (setq mode-line-process "")
	    (let* ((errs (ghc-filter 'ghc-hilit-info-get-err infos))
		   (elen (length errs))
		   (wlen (- len elen)))
	      (setq mode-line-process (format " %d:%d" elen wlen)))))
	(force-mode-line-update))))
   (t
    (ghc-with-current-buffer ghc-process-original-buffer
      (setq mode-line-process " failed")
      (force-mode-line-update)))))

{'fraction_non_alphanumeric': 0.23179791976225855, 'fraction_numerical': 0.0017830609212481426, 'mean_word_length': 3.603967168262654, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1955203', 'n_tokens_mistral': 2605, 'n_tokens_neox': 2392, 'n_words': 572}