diff --git a/Check.hs b/Check.hs --- a/Check.hs +++ b/Check.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Check (checkSyntax) where import Control.Applicative @@ -15,20 +17,27 @@ checkSyntax :: Options -> String -> IO String checkSyntax opt file = do makeDirectory (outDir opt) - (_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall",file,"-outputdir","dist/flymake","-o","dist/flymake/a.out"] Nothing Nothing +#if __GLASGOW_HASKELL__ >= 611 + (_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall","-fno-warn-unused-do-bind",file,"-outputdir","dist/flymake","-o","dist/flymake/a.out","-i..","-i../..","-i../../..","-i../../../..","-i../../../../.."] Nothing Nothing +#else + (_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall",file,"-outputdir","dist/flymake","-o","dist/flymake/a.out","-i..","-i../..","-i../../..","-i../../../..","-i../../../../.."] Nothing Nothing +#endif + hSetBinaryMode herr False refine <$> hGetContents herr where - refine = unfoldLines start . map (dropWhile isSpace) . filter (/="") . lines - start = (file `isPrefixOf`) + refine = unfoldLines . remove . lines + remove = filter (\x -> not ("Linking" `isPrefixOf` x)) + . filter (\x -> not ("[" `isPrefixOf` x)) + . filter (/="") -unfoldLines :: (String -> Bool) -> [String] -> String -unfoldLines _ [] = "" -unfoldLines p (x:xs) = x ++ unfold xs +unfoldLines :: [String] -> String +unfoldLines [] = "" +unfoldLines (x:xs) = x ++ unfold xs where unfold [] = "\n" unfold (l:ls) - | p l = ('\n':l) ++ unfold ls - | otherwise = (' ' :l) ++ unfold ls + | isAlpha (head l) = ('\n':l) ++ unfold ls + | otherwise = (drop 4 l) ++ "\0" ++ unfold ls ---------------------------------------------------------------- diff --git a/GHCMod.hs b/GHCMod.hs --- a/GHCMod.hs +++ b/GHCMod.hs @@ -5,10 +5,10 @@ import Control.Exception hiding (try) import List import Param +import Lang import Prelude hiding (catch) import System.Console.GetOpt import System.Environment (getArgs) -import System.IO ---------------------------------------------------------------- @@ -64,6 +64,7 @@ "browse" -> browseModule opt (cmdArg !! 1) "list" -> listModules opt "check" -> checkSyntax opt (cmdArg !! 1) + "lang" -> listLanguages opt _ -> error usage putStr res where diff --git a/Lang.hs b/Lang.hs new file mode 100644 --- /dev/null +++ b/Lang.hs @@ -0,0 +1,14 @@ +module Lang where + +import Control.Applicative +import Param +import System.IO +import System.Process + +listLanguages :: Options -> IO String +listLanguages opt = convert opt . lines <$> getLangs opt + +getLangs :: Options -> IO String +getLangs opt = do + (_,hout,_,_) <- runInteractiveProcess (ghc opt) ["--supported-languages"] Nothing Nothing + hGetContents hout diff --git a/List.hs b/List.hs --- a/List.hs +++ b/List.hs @@ -1,7 +1,6 @@ module List (listModules) where import Control.Applicative -import Data.Char import Data.List import Param import System.IO diff --git a/elisp/ghc-comp.el b/elisp/ghc-comp.el --- a/elisp/ghc-comp.el +++ b/elisp/ghc-comp.el @@ -40,13 +40,15 @@ (defvar ghc-module-names nil) ;; completion for "import" (defvar ghc-merged-keyword nil) ;; completion for type/func/... +(defvar ghc-language-extensions nil) (defvar ghc-keyword-prefix "ghc-keyword-") (defvar ghc-keyword-Prelude nil) (defvar ghc-loaded-module nil) (defun ghc-comp-init () - (setq ghc-module-names (ghc-load-keyword "list")) + (setq ghc-module-names (cons "hiding" (cons "qualified" (ghc-load-keyword "list")))) + (setq ghc-language-extensions (cons "LANGUAGE" (ghc-load-keyword "lang"))) (setq ghc-keyword-Prelude (ghc-load-keyword "browse" "Prelude")) (setq ghc-loaded-module '("Prelude")) (ghc-merge-keywords) @@ -139,6 +141,10 @@ (beginning-of-line) (looking-at "import "))) ghc-module-names) + ((save-excursion + (beginning-of-line) + (looking-at "{-#")) + ghc-language-extensions) ((or (bolp) (let ((end (point))) (save-excursion diff --git a/elisp/ghc-flymake.el b/elisp/ghc-flymake.el --- a/elisp/ghc-flymake.el +++ b/elisp/ghc-flymake.el @@ -10,11 +10,13 @@ (require 'flymake) +(defvar ghc-error-buffer-name "*GHC Errors*") + (defvar ghc-flymake-allowed-file-name-masks '("\\.l?hs$" ghc-flymake-init flymake-simple-cleanup flymake-get-real-file-name)) (defvar ghc-flymake-err-line-patterns - '("^\\(.*\\.l?hs\\):\\([0-9]+\\):\\([0-9]+\\):\\(.+\\)" 1 2 3 4)) + '("^\\(.*\\.l?hs\\):\\([0-9]+\\):\\([0-9]+\\):[ ]*\\(.+\\)" 1 2 3 4)) (add-to-list 'flymake-allowed-file-name-masks ghc-flymake-allowed-file-name-masks) @@ -22,11 +24,54 @@ (add-to-list 'flymake-err-line-patterns ghc-flymake-err-line-patterns) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun ghc-flymake-init () (let ((after-save-hook nil)) (save-buffer)) (let ((file (file-name-nondirectory (buffer-file-name)))) (list ghc-module-command (append (ghc-module-command-args) (list "check" file))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ghc-display-errors () + (interactive) + (let* ((data (ghc-flymake-data)) + (buf (get-buffer-create ghc-error-buffer-name))) + (with-current-buffer buf + (erase-buffer) + (ghc-insert-errors data)) + (display-buffer buf))) + +(defun ghc-insert-errors (data) + (let ((title (nth 0 data)) + (errs (nth 1 data))) + (insert title "\n") + (dolist (err errs) + (insert (ghc-replace-character (car err) 0 10) "\n")) + (goto-char (point-min)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ghc-flymake-insert-type () + (interactive) + (let ((data (ghc-flymake-first-data))) + (if (and data + (string-match "Inferred type: \\([^:]+ :: \\)\\(forall [^.]+\\. \\)?\\([^\0]*\\)" data)) + (progn + (beginning-of-line) + (insert (match-string 1 data) (match-string 3 data) "\n")) + (message "No inferred type")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ghc-flymake-data () + (let* ((line-no (flymake-current-line-no)) + (info (nth 0 (flymake-find-err-info flymake-err-info line-no)))) + (flymake-make-err-menu-data line-no info))) + +(defun ghc-flymake-first-data () + (nth 0 (nth 0 (nth 1 (ghc-flymake-data))))) (provide 'ghc-flymake) diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el --- a/elisp/ghc-func.el +++ b/elisp/ghc-func.el @@ -17,10 +17,12 @@ (defun ghc-which (cmd) (catch 'loop - (dolist (dir exec-path) - (let ((path (expand-file-name cmd dir))) - (if (file-exists-p path) - (throw 'loop path)))))) + (dolist (suffix '("" ".exe")) + (let ((cmds (concat cmd suffix))) + (dolist (dir exec-path) + (let ((path (expand-file-name cmds dir))) + (if (file-exists-p path) + (throw 'loop path)))))))) (defun ghc-uniq-lol (lol) (let ((hash (make-hash-table :test 'equal)) diff --git a/elisp/ghc.el b/elisp/ghc.el --- a/elisp/ghc.el +++ b/elisp/ghc.el @@ -30,12 +30,13 @@ ;;; Customize Variables ;;; -(defvar ghc-completion-key "\e\t") -(defvar ghc-document-key "\e\C-d") -(defvar ghc-import-key "\e\C-m") -(defvar ghc-previous-key "\ep") -(defvar ghc-next-key "\en") -(defvar ghc-help-key "\e?") +(defvar ghc-completion-key "\e\t") +(defvar ghc-document-key "\e\C-d") +(defvar ghc-import-key "\e\C-m") +(defvar ghc-previous-key "\ep") +(defvar ghc-next-key "\en") +(defvar ghc-help-key "\e?") +(defvar ghc-insert-type-key "\et") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -46,12 +47,13 @@ (defun ghc-init () (unless ghc-initialized - (define-key haskell-mode-map ghc-completion-key 'ghc-complete) - (define-key haskell-mode-map ghc-document-key 'ghc-browse-document) - (define-key haskell-mode-map ghc-import-key 'ghc-load-module-buffer) - (define-key haskell-mode-map ghc-previous-key 'flymake-goto-prev-error) - (define-key haskell-mode-map ghc-next-key 'flymake-goto-next-error) - (define-key haskell-mode-map ghc-help-key 'flymake-display-err-menu-for-current-line) + (define-key haskell-mode-map ghc-completion-key 'ghc-complete) + (define-key haskell-mode-map ghc-document-key 'ghc-browse-document) + (define-key haskell-mode-map ghc-import-key 'ghc-load-module-buffer) + (define-key haskell-mode-map ghc-previous-key 'flymake-goto-prev-error) + (define-key haskell-mode-map ghc-next-key 'flymake-goto-next-error) + (define-key haskell-mode-map ghc-help-key 'ghc-display-errors) + (define-key haskell-mode-map ghc-insert-type-key 'ghc-flymake-insert-type) (ghc-comp-init) (setq ghc-initialized t))) diff --git a/ghc-mod.cabal b/ghc-mod.cabal --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -1,5 +1,5 @@ Name: ghc-mod -Version: 0.2.0 +Version: 0.3.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -23,9 +23,12 @@ ghc-flymake.el Executable ghc-mod Main-Is: GHCMod.hs - Other-Modules: List Browse Check Param - GHC-Options: -Wall - Build-Depends: base >= 4.0 && < 10, + Other-Modules: List Browse Check Param Lang + if impl(ghc >= 6.12) + GHC-Options: -Wall -fno-warn-unused-do-bind + else + GHC-Options: -Wall + Build-Depends: base >= 4.0 && < 5, parsec >= 3, process, haskell-src-exts, directory, filepath Source-Repository head