ghc-mod 0.4.1 → 0.4.2
raw patch · 11 files changed
+119/−61 lines, 11 filesdep +hlint
Dependencies added: hlint
Files
- Check.hs +2/−1
- GHCMod.hs +49/−20
- Lint.hs +5/−11
- Types.hs +2/−2
- elisp/ghc-command.el +3/−3
- elisp/ghc-comp.el +12/−5
- elisp/ghc-doc.el +2/−2
- elisp/ghc-flymake.el +34/−13
- elisp/ghc-func.el +7/−1
- elisp/ghc.el +1/−1
- ghc-mod.cabal +2/−2
Check.hs view
@@ -78,13 +78,14 @@ ---------------------------------------------------------------- showErrMsg :: ErrMsg -> String-showErrMsg err = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ msg+showErrMsg err = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ msg ++ "\0" ++ ext where spn = head (errMsgSpans err) file = unpackFS (srcSpanFile spn) line = show (srcSpanStartLine spn) col = show (srcSpanStartCol spn) msg = showSDoc (errMsgShortDoc err)+ ext = showSDoc (errMsgExtraInfo err) style :: PprStyle style = mkUserStyle neverQualify AllTheWay
GHCMod.hs view
@@ -1,28 +1,32 @@+{-# LANGUAGE DeriveDataTypeable #-}+ module Main where import Browse import Check import Control.Applicative-import Control.Exception hiding (try)+import Control.Exception+import Data.Typeable import Lang import Lint import List-import Prelude hiding (catch)+import Prelude import System.Console.GetOpt import System.Directory import System.Environment (getArgs)+import System.IO (hPutStr, hPutStrLn, stderr) import Types ---------------------------------------------------------------- usage :: String-usage = "ghc-mod version 0.4.1\n"+usage = "ghc-mod version 0.4.2\n" ++ "Usage:\n"- ++ "\t ghc-mod list\n"- ++ "\t ghc-mod lang\n"- ++ "\t ghc-mod browse <module> [<module> ...]\n"+ ++ "\t ghc-mod [-l] list\n"+ ++ "\t ghc-mod [-l] lang\n"+ ++ "\t ghc-mod [-l] browse <module> [<module> ...]\n" ++ "\t ghc-mod check <HaskellFile>\n"- ++ "\t ghc-mod lint <HaskellFile>\n"+ ++ "\t ghc-mod [-h opt] lint <HaskellFile>\n" ++ "\t ghc-mod boot\n" ++ "\t ghc-mod help\n" @@ -31,51 +35,76 @@ defaultOptions :: Options defaultOptions = Options { convert = toPlain- , hlint = "hlint"+ , hlintOpts = [] } 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"+ , Option "h" ["hlintOpt"]+ (ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")+ "hint to be ignored" ] parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String]) parseArgs spec argv = case getOpt Permute spec argv of (o,n,[] ) -> (foldl (flip id) defaultOptions o, n)- (_,_,errs) -> error $ concat errs ++ usageInfo usage argspec+ (_,_,errs) -> throw (CmdArg errs) ---------------------------------------------------------------- +data GHCModError = SafeList+ | NoSuchCommand String+ | CmdArg [String]+ | FileNotExist String deriving (Show, Typeable)++instance Exception GHCModError++----------------------------------------------------------------+ main :: IO ()-main = flip catch handler $ do+main = flip catches handlers $ do args <- getArgs let (opt,cmdArg) = parseArgs argspec args- res <- case head cmdArg of+ res <- case safelist cmdArg 0 of "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg) "list" -> listModules opt- "check" -> withFile (checkSyntax opt) (cmdArg !! 1)- "lint" -> withFile (lintSyntax opt) (cmdArg !! 1)+ "check" -> withFile (checkSyntax opt) (safelist cmdArg 1)+ "lint" -> withFile (lintSyntax opt) (safelist cmdArg 1) "lang" -> listLanguages opt "boot" -> do mods <- listModules opt langs <- listLanguages opt pre <- browseModule opt "Prelude" return $ mods ++ langs ++ pre- _ -> error usage+ cmd -> throw (NoSuchCommand cmd) putStr res where- handler :: ErrorCall -> IO ()- handler _ = putStr usage+ handlers = [Handler handler1, Handler handler2]+ handler1 :: ErrorCall -> IO ()+ handler1 e = print e -- for debug+ handler2 :: GHCModError -> IO ()+ handler2 SafeList = printUsage+ handler2 (NoSuchCommand cmd) = do+ hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported"+ printUsage+ handler2 (CmdArg errs) = do+ mapM_ (hPutStr stderr) errs+ printUsage+ handler2 (FileNotExist file) = do+ hPutStrLn stderr $ "\"" ++ file ++ "\" not found"+ printUsage+ printUsage = hPutStrLn stderr $ "\n" ++ usageInfo usage argspec withFile cmd file = do exist <- doesFileExist file if exist then cmd file- else return ""+ else throw (FileNotExist file)+ safelist xs idx+ | length xs <= idx = throw SafeList+ | otherwise = xs !! idx ---------------------------------------------------------------- toLisp :: [String] -> String
Lint.hs view
@@ -2,19 +2,13 @@ import Control.Applicative import Data.List-import System.IO-import System.Process+import Language.Haskell.HLint import Types lintSyntax :: Options -> String -> IO String-lintSyntax cmd file = pretty <$> lint cmd file+lintSyntax opt file = pretty <$> lint opt file where- pretty = unlines . map (concat . intersperse "\0")- . filter (\x -> length x > 1)- . groupBy (\a b -> a /= "" && b /= "") - . lines+ pretty = unlines . map (concat . intersperse "\0" . lines) -lint :: Options -> String -> IO String-lint cmd file = do- (_,hout,_,_) <- runInteractiveProcess (hlint cmd) ["-i","Use camelCase",file] Nothing Nothing- hGetContents hout+lint :: Options -> String -> IO [String]+lint opt file = map show <$> hlint ([file, "--quiet"] ++ hlintOpts opt)
Types.hs view
@@ -5,8 +5,8 @@ import GHC.Paths (libdir) data Options = Options {- convert :: [String] -> String- , hlint :: String+ convert :: [String] -> String+ , hlintOpts :: [String] } withGHC :: Ghc [String] -> IO [String]
elisp/ghc-command.el view
@@ -8,19 +8,19 @@ ;;; Code: -(provide 'ghc-flymake)+(require 'ghc-flymake) (defun ghc-insert-template () (interactive) (cond ((bobp) (ghc-insert-module-template))+ ((ghc-flymake-have-errs-p)+ (ghc-flymake-insert-from-warning)) ((save-excursion (beginning-of-line) (looking-at "^[^ ]+ *::")) (ghc-insert-function-template))- ((ghc-flymake-have-errs-p)- (ghc-flymake-insert-from-warning)) (t (message "Nothing to be done"))))
elisp/ghc-comp.el view
@@ -15,13 +15,20 @@ ;;; Customize Variables ;;; -(defvar ghc-idle-timer-interval 30)+(defvar ghc-idle-timer-interval 30+ "*Period of idele timer in second. When timeout, the names of+unloaded modules are loaded") +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;;;+;;; Constants+;;;+ ;; must be sorted-(defvar ghc-reserved-keyword-for-bol '("class" "data" "default" "import" "infix" "infixl" "infixr" "instance" "main" "module" "newtype" "type"))+(defconst ghc-reserved-keyword-for-bol '("class" "data" "default" "import" "infix" "infixl" "infixr" "instance" "main" "module" "newtype" "type")) ;; must be sorted-(defvar ghc-reserved-keyword '("case" "deriving" "do" "else" "if" "in" "let" "module" "of" "then" "where"))+(defconst ghc-reserved-keyword '("case" "deriving" "do" "else" "if" "in" "let" "module" "of" "then" "where")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;@@ -42,7 +49,7 @@ (defvar ghc-merged-keyword nil) ;; completion for type/func/... (defvar ghc-language-extensions nil) -(defvar ghc-keyword-prefix "ghc-keyword-")+(defconst ghc-keyword-prefix "ghc-keyword-") (defvar ghc-keyword-Prelude nil) (defvar ghc-loaded-module nil) @@ -170,7 +177,7 @@ (defun ghc-completion-start-point () (save-excursion (let ((beg (save-excursion (beginning-of-line) (point))))- (if (re-search-backward "[ (,`]" beg t)+ (if (re-search-backward "[ (,`]" beg t) ;; xxx "." (1+ (point)) beg))))
elisp/ghc-doc.el view
@@ -34,8 +34,8 @@ (when (looking-at "^haddock-html: \\([^ \n]+\\)$") (match-string-no-properties 1)))) -(defvar ghc-doc-local-format "file://%s/%s.html")-(defvar ghc-doc-hackage-format+(defconst ghc-doc-local-format "file://%s/%s.html")+(defconst ghc-doc-hackage-format "http://hackage.haskell.org/packages/archive/%s/latest/doc/html/%s.html") (defun ghc-display-document (pkg mod haskell-org)
elisp/ghc-flymake.el view
@@ -10,12 +10,18 @@ (require 'flymake) -(defvar ghc-error-buffer-name "*GHC Errors*")+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar ghc-flymake-allowed-file-name-masks+(defvar ghc-hlint-options nil "*Hlint options")++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;++(defconst ghc-error-buffer-name "*GHC Errors*")++(defconst 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+(defconst ghc-flymake-err-line-patterns '("^\\(.*\\.l?hs\\):\\([0-9]+\\):\\([0-9]+\\):[ ]*\\(.+\\)" 1 2 3 4)) (add-to-list 'flymake-allowed-file-name-masks@@ -30,15 +36,14 @@ (let ((after-save-hook nil)) (save-buffer)) (let ((file (file-name-nondirectory (buffer-file-name))))- (list ghc-module-command (ghc-flymake-command file))))--(defvar ghc-hlint (ghc-which "hlint"))+ (list ghc-module-command (ghc-flymake-command file ghc-hlint-options)))) (defvar ghc-flymake-command nil) ;; nil: check, t: lint -(defun ghc-flymake-command (file)+(defun ghc-flymake-command (file opts) (if ghc-flymake-command- (list "-f" ghc-hlint "lint" file)+ (let ((hopts (ghc-mapconcat (lambda (x) (list "-h" x)) opts)))+ `(,@hopts "lint" ,file)) (list "check" file))) (defun ghc-flymake-toggle-command ()@@ -64,8 +69,14 @@ (defun ghc-flymake-insert-errors (title errs) (save-excursion- (insert title "\n")- (mapc (lambda (x) (insert (ghc-replace-character x ghc-null ghc-newline) "\n")) errs)))+ (insert title "\n\n")+ (mapc (lambda (x) (insert (ghc-replace-character x ghc-null ghc-newline) "\n")) errs)+ (goto-char (point-min))+ (while (re-search-forward "In the [^:\n ]+: \\|Expected type: \\|Inferred type: \\|Possible fix: " nil t)+ (replace-match (concat "\n" (match-string 0) "\n ")))+ (goto-char (point-max))+ (while (re-search-backward "In the [a-z]+ argument\\|In the `" nil t)+ (insert "\n")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -76,14 +87,24 @@ (cond ((string-match "Inferred type: \\([^:]+ :: \\)\\(forall [^.]+\\. \\)?\\([^\0]*\\)" data) (beginning-of-line)- (insert (match-string 1 data) (match-string 3 data) "\n"))+ (insert (match-string 1 data)+ (replace-regexp-in-string "\\[Char\\]" "String" (match-string 3 data))+ "\n")) ((string-match "Not in scope: `\\([^']+\\)'" data) (save-match-data (unless (re-search-forward "^$" nil t) (goto-char (point-max)) (insert "\n")))- (insert "\n" (match-string 1 data) " = undefined\n"))))))- + (insert "\n" (match-string 1 data) " = undefined\n"))+ ((string-match "Found:\0[ ]*\\([^\0]+\\)\0Why not:\0[ ]*\\([^\0]+\\)" data)+ (let ((old (match-string 1 data))+ (new (match-string 2 data)))+ (beginning-of-line)+ (when (search-forward old nil t)+ (let ((end (point)))+ (search-backward old nil t)+ (delete-region (point) end))+ (insert new)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
elisp/ghc-func.el view
@@ -8,7 +8,8 @@ ;;; Code: -(defvar ghc-module-command "ghc-mod")+(defvar ghc-module-command "ghc-mod"+"*The command name of \"ghc-mod\"") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -78,6 +79,11 @@ (dotimes (i n (nreverse ret)) (ghc-add ret (read m)))) (error ()))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;++(defun ghc-mapconcat (func list)+ (apply 'append (mapcar func list))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
elisp/ghc.el view
@@ -16,7 +16,7 @@ ;;; Code: -(defvar ghc-version "0.4.0")+(defconst ghc-version "0.4.0") ;; (eval-when-compile ;; (require 'haskell-mode))
ghc-mod.cabal view
@@ -1,5 +1,5 @@ Name: ghc-mod-Version: 0.4.1+Version: 0.4.2 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -29,7 +29,7 @@ else GHC-Options: -Wall Build-Depends: base >= 4.0 && < 5, ghc, ghc-paths,- process, directory, filepath+ process, directory, filepath, hlint >= 1.7.1 Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/ghc-mod.git