integrating hlint.

GHCMod.hs

@@ -5,6 +5,7 @@ import Check
 import Control.Applicative
 import Control.Exception hiding (try)
 import Lang
+import Lint
 import List
 import Prelude hiding (catch)
 import System.Console.GetOpt
@@ -21,18 +22,25 @@ usage =    "ghc-mod version 0.4.0\n"
         ++ "\t ghc-mod lang\n"
         ++ "\t ghc-mod browse <module> [<module> ...]\n"
         ++ "\t ghc-mod check <HaskellFile>\n"
+        ++ "\t ghc-mod lint <HaskellFile>\n"
         ++ "\t ghc-mod boot\n"
         ++ "\t ghc-mod help\n"
 
 ----------------------------------------------------------------
 
 defaultOptions :: Options
-defaultOptions = Options { convert = toPlain }
+defaultOptions = Options {
+    convert = toPlain
+  , hlint = "hlint"
+  }
 
 argspec :: [OptDescr (Options -> Options)]
 argspec = [ Option "l" ["tolisp"]
             (NoArg (\opts -> opts { convert = toLisp }))
             "print as a list of Lisp"
+          , Option "f" ["hlint"]
+            (ReqArg (\str opts -> opts { hlint = str }) "hlint")
+            "path to hlint"
           ]
 
 parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
@@ -50,12 +58,8 @@ main = flip catch handler $ do
     res <- case head cmdArg of
       "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
       "list"   -> listModules opt
-      "check"  -> do
+      "check"  -> withFile (checkSyntax opt) (cmdArg !! 1)
-          let file = cmdArg !! 1
+      "lint"   -> withFile (lintSyntax opt) (cmdArg !! 1)
-          exist <- doesFileExist file
-          if exist
-             then checkSyntax opt file
-             else return ""
       "lang"   -> listLanguages opt
       "boot"   -> do
          mods  <- listModules opt
@@ -67,6 +71,11 @@ main = flip catch handler $ do
   where
     handler :: ErrorCall -> IO ()
     handler _ = putStr usage
+    withFile cmd file = do
+        exist <- doesFileExist file
+        if exist
+            then cmd file
+            else return ""
 
 ----------------------------------------------------------------
 toLisp :: [String] -> String

Lint.hs

@@ -0,0 +1,20 @@
+module Lint where
+
+import Control.Applicative
+import Data.List
+import System.IO
+import System.Process
+import Types
+
+lintSyntax :: Options -> String -> IO String
+lintSyntax cmd file = pretty <$> lint cmd file
+  where
+    pretty = unlines . map (concat . intersperse "\0")
+           . filter (\x -> length x > 1)
+           . groupBy (\a b -> a /= "" && b /= "") 
+           . lines
+
+lint :: Options -> String -> IO String
+lint cmd file = do
+  (_,hout,_,_) <- runInteractiveProcess (hlint cmd) [file] Nothing Nothing
+  hGetContents hout

Types.hs

@@ -6,6 +6,7 @@ import GHC.Paths (libdir)
 
 data Options = Options {
     convert :: [String] -> String
+  , hlint   :: String
   }
 
 withGHC :: Ghc [String] -> IO [String]

elisp/ghc-flymake.el

@@ -30,7 +30,23 @@
   (let ((after-save-hook nil))
     (save-buffer))
   (let ((file (file-name-nondirectory (buffer-file-name))))
-    (list ghc-module-command (list "check" file))))
+    (list ghc-module-command (ghc-flymake-command file))))
+
+(defvar ghc-hlint (ghc-which "hlint"))
+
+(defvar ghc-flymake-command nil) ;; nil: check, t: lint
+
+(defun ghc-flymake-command (file)
+   (if ghc-flymake-command
+       (list "-f" ghc-hlint "lint" file)
+     (list "check" file)))
+
+(defun ghc-flymake-toggle-command ()
+  (interactive)
+  (setq ghc-flymake-command (not ghc-flymake-command))
+  (if ghc-flymake-command
+      (message "Syntax check with hlint")
+    (message "Syntax check with GHC")))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -49,7 +65,7 @@
 (defun ghc-flymake-insert-errors (title errs)
   (save-excursion
     (insert title "\n")
-    (mapc (lambda (x) (insert x "\n")) errs)))
+    (mapc (lambda (x) (insert (ghc-replace-character x ghc-null ghc-newline) "\n")) errs)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

elisp/ghc-func.el

@@ -79,4 +79,9 @@
 	    (ghc-add ret (read m))))
       (error ()))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst ghc-null 0)
+(defconst ghc-newline 10)
+
 (provide 'ghc-func)

elisp/ghc.el

@@ -41,6 +41,7 @@
 (defvar ghc-insert-key      "\et")
 (defvar ghc-sort-key        "\es")
 (defvar ghc-check-key       "\C-x\C-s")
+(defvar ghc-toggle-key      "\C-c\C-c")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -61,6 +62,7 @@
     (define-key haskell-mode-map ghc-insert-key      'ghc-insert-template)
     (define-key haskell-mode-map ghc-sort-key        'ghc-sort-lines)
     (define-key haskell-mode-map ghc-check-key       'ghc-save-buffer)
+    (define-key haskell-mode-map ghc-toggle-key      'ghc-flymake-toggle-command)
     (ghc-comp-init)
     (setq ghc-initialized t)))