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

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

;;; Code:

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

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

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

(defface ghc-face-warn
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "DarkOrange"))
    (t
     :inherit warning))
  "Face used for marking warning 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)))

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

(defun ghc-check-syntax ()
  (interactive)
  (ghc-with-process 'ghc-check-send 'ghc-check-callback))

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

(ghc-defstruct hilit-info file line col msg err)

(defun ghc-check-send ()
  (if ghc-check-command
      (concat "lint " ghc-process-original-file "\n")
    (concat "check " ghc-process-original-file "\n")))

(defun ghc-check-callback ()
  (let ((regex "^\\([^\n\0]*\\):\\([0-9]+\\):\\([0-9]+\\): *\\(.+\\)")
	info infos)
    (while (re-search-forward regex nil t)
      (let* ((file (match-string 1))
	     (line (string-to-number (match-string 2)))
	     (col  (string-to-number (match-string 3)))
	     (msg  (match-string 4))
	     (err  (not (string-match "^Warning" msg)))
	     (info (ghc-make-hilit-info
		    :file file
		    :line line
		    :col  col
		    :msg  msg
		    :err  err)))
	(setq infos (cons info infos))))
    (setq infos (nreverse infos))
    (cond
     (infos
      (let ((file ghc-process-original-file)<commit_msg>hlint options.<commit_after>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc-check.el
;;;

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

;;; Code:

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

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

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

(defface ghc-face-warn
  '((((supports :underline (:style wave)))
     :underline (:style wave :color "DarkOrange"))
    (t
     :inherit warning))
  "Face used for marking warning 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)))

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

(defun ghc-check-syntax ()
  (interactive)
  (ghc-with-process 'ghc-check-send 'ghc-check-callback))

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

(ghc-defstruct hilit-info file line col msg err)

(defun ghc-check-send ()
  (if ghc-check-command
      (let ((opts (ghc-haskell-list-of-string ghc-hlint-options)))
	(if opts
	    (concat "lint " opts " " ghc-process-original-file "\n")
	  (concat "lint " ghc-process-original-file "\n")))
    (concat "check " ghc-process-original-file "\n")))

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

(defun ghc-check-callback ()
  (let ((regex "^\\([^\n\0]*\\):\\([0-9]+\\):\\([0-9]+\\): *\\(.+\\)")
	info infos)
    (while (re-search-forward regex nil t)
      (let* ((file (match-string 1))
	     (line (string-to-number (match-string 2)))
	     (col  (string-to-number (match-string 3)))
	     (msg  (match-string 4))
	     (err  (not (string-match "^Warning" msg)))
	     (info (ghc-make-hilit-info
		    :file file
		    :line line
		    :col  col
		    :msg  msg
		    :err  err)))
	(setq infos (cons info infos))))
    (setq infos (nreverse infos))
    (cond
     (infos
      (let ((file ghc-process-original-file)
{'fraction_non_alphanumeric': 0.29140958709065024, 'fraction_numerical': 0.007119126720455624, 'mean_word_length': 3.527389903329753, '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': '1310525', 'n_tokens_mistral': 1723, 'n_tokens_neox': 1516, 'n_words': 335}