[lint] Add HLint-based Haskell linter

Summary:
This adds a lint engine for `hlint`, which is the standard and most general Haskell lint tool around these days.

Signed-off-by: Austin Seipp <aseipp@pobox.com>

Test Plan: Install `hlint`, and run `arc unit`.

Reviewers: #blessed_reviewers, epriestley

Reviewed By: #blessed_reviewers, epriestley

Subscribers: epriestley, Korvin

Projects: #arcanist

Differential Revision: https://secure.phabricator.com/D10250

src/__phutil_library_map__.php

@@ -83,6 +83,8 @@ phutil_register_library_map(array(
     'ArcanistGitHookPreReceiveWorkflow' => 'workflow/ArcanistGitHookPreReceiveWorkflow.php',
     'ArcanistGoLintLinter' => 'lint/linter/ArcanistGoLintLinter.php',
     'ArcanistGoLintLinterTestCase' => 'lint/linter/__tests__/ArcanistGoLintLinterTestCase.php',
+    'ArcanistHLintLinter' => 'lint/linter/ArcanistHLintLinter.php',
+    'ArcanistHLintLinterTestCase' => 'lint/linter/__tests__/ArcanistHLintLinterTestCase.php',
     'ArcanistHelpWorkflow' => 'workflow/ArcanistHelpWorkflow.php',
     'ArcanistHgClientChannel' => 'hgdaemon/ArcanistHgClientChannel.php',
     'ArcanistHgProxyClient' => 'hgdaemon/ArcanistHgProxyClient.php',
@@ -273,6 +275,8 @@ phutil_register_library_map(array(
     'ArcanistGitHookPreReceiveWorkflow' => 'ArcanistWorkflow',
     'ArcanistGoLintLinter' => 'ArcanistExternalLinter',
     'ArcanistGoLintLinterTestCase' => 'ArcanistArcanistLinterTestCase',
+    'ArcanistHLintLinter' => 'ArcanistExternalLinter',
+    'ArcanistHLintLinterTestCase' => 'ArcanistArcanistLinterTestCase',
     'ArcanistHelpWorkflow' => 'ArcanistWorkflow',
     'ArcanistHgClientChannel' => 'PhutilProtocolChannel',
     'ArcanistHgServerChannel' => 'PhutilProtocolChannel',

src/lint/linter/ArcanistHLintLinter.php

@@ -0,0 +1,111 @@
+<?php
+
+/**
+ * Calls `hlint` and parses its results.
+ */
+final class ArcanistHLintLinter extends ArcanistExternalLinter {
+
+  public function getInfoName() {
+    return 'HLint';
+  }
+
+  public function getInfoURI() {
+    return 'https://github.com/ndmitchell/hlint';
+  }
+
+  public function getInfoDescription() {
+    return pht('HLint is a linter for Haskell code.');
+  }
+
+  public function getLinterName() {
+    return 'HLINT';
+  }
+
+  public function getLinterConfigurationName() {
+    return 'hlint';
+  }
+
+  public function getDefaultBinary() {
+    return 'hlint';
+  }
+
+  public function getInstallInstructions() {
+    return pht('Install hlint with `cabal install hlint`.');
+  }
+
+  public function supportsReadDataFromStdin() {
+    return true;
+  }
+
+  public function getReadDataFromStdinFilename() {
+    return '-';
+  }
+
+  public function shouldExpectCommandErrors() {
+    return true;
+  }
+
+  public function getMandatoryFlags() {
+    return array('--json');
+  }
+
+  public function getVersion() {
+    list($stdout, $stderr) = execx(
+      '%C --version', $this->getExecutableCommand());
+
+    $matches = null;
+    if (preg_match('@HLint v(.*),@', $stdout, $matches)) {
+      return $matches[1];
+    }
+
+    return null;
+  }
+
+  protected function parseLinterOutput($path, $err, $stdout, $stderr) {
+
+    $json = phutil_json_decode($stdout);
+    $messages = array();
+    foreach ($json as $fix) {
+      if ($fix === null) {
+        return;
+      }
+
+      $message = new ArcanistLintMessage();
+      $message->setCode($this->getLinterName());
+      $message->setPath($path);
+      $message->setLine($fix['startLine']);
+      $message->setChar($fix['startColumn']);
+      $message->setName($fix['hint']);
+      $message->setOriginalText($fix['from']);
+      $message->setReplacementText($fix['to']);
+
+      /* Some improvements may slightly change semantics, so attach
+         all necessary notes too. */
+      $notes = '';
+      foreach ($fix['note'] as $note) {
+        $notes .= ' **NOTE**: '.trim($note, '"').'.';
+      }
+
+      $message->setDescription(
+        pht(
+          'In module `%s`, declaration `%s`.%s',
+          $fix['module'], $fix['decl'], $notes));
+
+      switch ($fix['severity']) {
+        case 'Error':
+          $message->setSeverity(ArcanistLintSeverity::SEVERITY_ERROR);
+          break;
+        case 'Warning':
+          $message->setSeverity(ArcanistLintSeverity::SEVERITY_WARNING);
+          break;
+        default:
+          $message->setSeverity(ArcanistLintSeverity::SEVERITY_ADVICE);
+          break;
+      }
+
+      $messages[] = $message;
+    }
+
+    return $messages;
+  }
+}

src/lint/linter/__tests__/ArcanistHLintLinterTestCase.php

@@ -0,0 +1,9 @@
+<?php
+
+final class ArcanistHLintLinterTestCase extends ArcanistArcanistLinterTestCase {
+  public function testHlintLinter() {
+    $this->executeTestsInDirectory(
+      dirname(__FILE__).'/hlint/',
+      new ArcanistHLintLinter());
+  }
+}

src/lint/linter/__tests__/hlint/01_warn_null.lint-test

@@ -0,0 +1,3 @@
+f xs = length xs == 0
+~~~~~~~~~~
+warning:1:8

src/lint/linter/__tests__/hlint/02_err_eta.lint-test

@@ -0,0 +1,5 @@
+f x = x
+
+test x = f x
+~~~~~~~~~~
+error:3:1

src/lint/linter/__tests__/hlint/03_no_err.lint-test

@@ -0,0 +1,2 @@
+main = map (f . g) xs
+~~~~~~~~~~