Integration of sandboxed GHC and HLint with Emacs' Flymake.

haskell-flymake.el

;; Copyright 2013  Guilherme Azzi

;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;; THE SOFTWARE.


;;;;;;;;
;; How to use this:

;; When cabal uses a sandbox, it maintains a local package database,
;; located within the sandbox directory and named after the platform
;; currently used, e.g.:
;;  .cabal-sandbox/x86_64-linux-ghc-7.6.3-packages.conf.d
;; Cabal-dev should work in a similar way.
;;
;; When GHC is called, it must be passed this package database
;; directory on the '-package-db' option. This is what this
;; flymake configuration does.
;;
;; The user must therefore specify the package-db directory when asked

;;;;;;;;
;; Possible improvements:
;;  - Better identification of the package-db, perhaps reading configuration files



;; Please set this according to your configuration.
(defvar ghc-flymake-script (expand-file-name "~/.emacs.d/scripts/hslint.py"))


(defvar ghc-sandbox-package-db-location nil
  "Location of the current package-db that should be used by GHC when
called by flymake for syntax checking of the current buffer.")
(make-variable-buffer-local 'ghc-sandbox-package-db-location)

(defvar ghc-sandbox-package-db-location-set nil
  "Indicates if the user was already asked about the use and
location of a sandbox package-db for the current buffer.")
(make-variable-buffer-local 'ghc-sandbox-package-db-location-set)
 
(defvar ghc-sandbox-location-history nil
  "List of package-dbs previously selected by the user.")


(defun ghc-flymake-set-sandbox ()
  "Configures the use of a sandbox for syntax-checking with GHC."
  (interactive)

  (setq ghc-sandbox-package-db-location
	(if (yes-or-no-p "Use ghc sandbox? ")
	    (expand-file-name (read-file-name "Location of sandbox package database: "))
	  nil))
  
  (setq ghc-sandbox-package-db-location-set t))


(defun haskell-flymake-init ()
  "When flymake triggers, generates a tempfile containing the
contents of the current buffer, runs GHC-FLYMAKE-SCRIPT on it,
and deletes the temporary file.

Uses the configured sandbox package-db, and if the user
didn't yet configure it, asks about it."
  (when (not ghc-sandbox-package-db-location-set)
    (ghc-flymake-set-sandbox))
 
  (let* ((temp-file   (flymake-init-create-temp-buffer-copy
                       'flymake-create-temp-intemp))
         (local-file  (file-relative-name
                       temp-file
                       (file-name-directory buffer-file-name)))
         (hslint      (concat dotemacs-dir "scripts/hslint.py")))
    (list ghc-flymake-script
          (cons temp-file
                (when ghc-sandbox-package-db-location
		  (list "-package-db" ghc-sandbox-package-db-location))))))

hslint.py

#!/usr/bin/env python

# Copyright 2013  Guilherme Azzi

# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:

# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.

# This script is based on a perl script called 'hslint' which was, at the
# time of this writing, available from multiple online sources, and whose
# authorship could not be determined by the author of the present script.

"""Script used to integrate GHC and HLint with Emacs' Flymake.

Usage:  hslint.py FILE [GHC_OPTS]

Runs ghc and hlint on the given file, using the given
ghc options, and reformats their output for Flymake.
"""



##
## Configuration variables
ENCODING = 'utf-8'

GHC = "ghc"
GHC_OPTIONS = ['-Wall']  # e.g. ['-fglasgow-exts']
GHC_PACKAGES = []        # e.g. ['QuickCheck']

PROJ_TREE_DEPTH = 5 # Assume the root directory for the project
                    # is at most n steps up the filesystem tree

HLINT = "hlint"
HLINT_OPTIONS = []



##
## Actual code (modify at your own risk)
import re
import sys
from subprocess import check_output, CalledProcessError, STDOUT


# Extract the command line arguments
if len(sys.argv) < 2:
    print(__doc__)
    sys.exit(1)
hsfile    = sys.argv[1]
ghcparams = sys.argv[2:]

# Initialize the messages for error cases
ghc_message, hlint_message = b'', b''

# Assemble the compiler command
ghc_command = [GHC] + GHC_OPTIONS
for package in GHC_PACKAGES:
    ghc_command.extend(['-package', package])
for num_backtracks in range(1,NUM_BACKTRACKING_INCLUDES+1):
    include_dir = '/'.join( '..' for i in range(num_backtracks))
    ghc_command.append('-i'+include_dir)

ghc_command.extend(ghcparams)
ghc_command.extend([ '--make', '-fno-code', hsfile ])

# Run the compiler and keep its output
try:
    ghc_message = check_output(ghc_command, stderr=STDOUT)
except CalledProcessError as e:
    ghc_message = e.output

# If compiler succeeded, run hlint
else:
    try:
        hlint_message = check_output([HLINT, hsfile], stderr=STDOUT)
    except CalledProcessError as e:
        hlint_message = e.output


# Parse the ghc output, outputing errors in the correct format
for line in str(ghc_message, ENCODING).splitlines():

    match = re.match("(^\\S+\\.l?hs)(:\\d*:\\d*:)\\s?(.*)", line)
    if match:
        print('\n',
              match.group(1),
              match.group(2),
              match.group(3).strip(),
              sep='', end=' ')
    else:
       print(line.strip(), end=' ')

print()


# Parse the hlint output, outputing errors in the correct format
for line in str(hlint_message, ENCODING).splitlines():

    match = re.match("(^\\S+\\.l?hs)(:\\d*:\\d*:)\\s?(.*)", line)
    if match:
        print('\n',
              match.group(1),
              match.group(2),
              # HLint errors should be considered warnings
              match.group(3).strip().replace('Error', 'Warning', 1),
              sep='', end=' ')
    else:
        print(line.strip(), end=' ')

print()