diff --git a/haskell-commands.el b/haskell-commands.el index 33f3c07b1..9715d988c 100644 --- a/haskell-commands.el +++ b/haskell-commands.el @@ -639,7 +639,7 @@ happened since function invocation)." (min-pos (caar pos-reg)) (max-pos (cdar pos-reg)) (sig (haskell-utils-reduce-string response)) - (res-type (haskell-utils-parse-repl-response sig))) + (res-type (haskell-utils-repl-response-error-status sig))) (cl-case res-type ;; neither popup presentation buffer diff --git a/haskell-process.el b/haskell-process.el index a68c0415b..b64aff457 100644 --- a/haskell-process.el +++ b/haskell-process.el @@ -297,10 +297,11 @@ Returns NIL when no completions found." (reqstr (concat ":complete repl" mlimit (haskell-string-literal-encode inputstr))) - (rawstr (haskell-process-queue-sync-request process reqstr))) - ;; TODO use haskell-utils-parse-repl-response - (if (string-prefix-p "unknown command " rawstr) - (error "GHCi lacks `:complete' support (try installing 7.8 or ghci-ng)") + (rawstr (haskell-process-queue-sync-request process reqstr)) + (response-status (haskell-utils-repl-response-error-status rawstr))) + (if (eq 'unknown-command response-status) + (error + "GHCi lacks `:complete' support (try installing GHC 7.8+ or ghci-ng)") (let* ((s1 (split-string rawstr "\r?\n" t)) (cs (mapcar #'haskell-string-literal-decode (cdr s1))) (h0 (car s1))) ;; " " diff --git a/haskell-utils.el b/haskell-utils.el index 5139282ce..bd919cafd 100644 --- a/haskell-utils.el +++ b/haskell-utils.el @@ -1,6 +1,7 @@ ;;; haskell-utils.el --- General utility functions used by haskell-mode modules -*- lexical-binding: t -*- -;; Copyright (C) 2013 Herbert Valerio Riedel +;; Copyright © 2013 Herbert Valerio Riedel +;; 2016 Arthur Fayzrakhmanov ;; Author: Herbert Valerio Riedel @@ -47,7 +48,8 @@ (defun haskell-utils-read-directory-name (prompt default) "Read directory name and normalize to true absolute path. Refer to `read-directory-name' for the meaning of PROMPT and -DEFAULT. If `haskell-process-load-or-reload-prompt' is nil, accept `default'." +DEFAULT. If `haskell-process-load-or-reload-prompt' is nil, +accept `default'." (let ((filename (file-truename (read-directory-name prompt default default)))) (concat (replace-regexp-in-string "/$" "" filename) "/"))) @@ -105,25 +107,37 @@ only a single space. Then removes all newlines." (let ((s_ (replace-regexp-in-string "^\s+" " " s))) (replace-regexp-in-string "\n" "" s_))) -(defun haskell-utils-parse-repl-response (r) - "Parse response R from REPL and return special kind of result. -The result is the response string itself with the special property -response-type added. - -This property could be one of the following: +(defun haskell-utils-repl-response-error-status (response) + "Parse response REPL's RESPONSE for errors. +Returns one of the following symbols: + unknown-command + option-missing + interactive-error -+ success" - (let ((first-line (car (split-string r "\n")))) ++ no-error + +*Warning*: this funciton covers only three kind of responses: + +* \"unknown command …\" + REPL missing requested command +* \":3:5: …\" + interactive REPL error +* \"Couldn't guess that module name. Does it exist?\" + (:type-at and maybe some other commands error) +* *all other reposnses* are treated as success reposneses and + 'no-error is returned." + (let ((first-line (car (split-string response "\n" t)))) (cond - ((string-match-p "^unknown command" first-line) 'unknown-command) - ((string-match-p "^Couldn't guess that module name. Does it exist?" - first-line) + ((null first-line) 'no-error) + ((string-match-p "^unknown command" first-line) + 'unknown-command) + ((string-match-p + "^Couldn't guess that module name. Does it exist?" + first-line) 'option-missing) - ((string-match-p "^:" first-line) 'interactive-error) - (t 'success)))) + ((string-match-p "^:" first-line) + 'interactive-error) + (t 'no-error)))) (defun haskell-utils-compose-type-at-command (pos) "Prepare :type-at command to be send to haskell process. diff --git a/tests/haskell-utils-tests.el b/tests/haskell-utils-tests.el index acffda417..8738d84f5 100644 --- a/tests/haskell-utils-tests.el +++ b/tests/haskell-utils-tests.el @@ -1,6 +1,6 @@ ;;; haskell-utils-tests.el --- Tests for Haskell utilities package -;; Copyright © 2016 Athur Fayzrakhmanov. All rights reserved. +;; Copyright © 2016 Arthur Fayzrakhmanov. All rights reserved. ;; This file is part of haskell-mode package. ;; You can contact with authors using GitHub issue tracker: @@ -132,7 +132,7 @@ (haskell-utils-parse-import-statement-at-point))))) (ert-deftest type-at-command-composition () - "Test haskell-utils-compose-type-at-command. + "Test `haskell-utils-compose-type-at-command'. Test only position conversion to line and column numbers, do not test last string compontent, it is used in `:type-at` command to provide user friendly output only and could be any string, even @@ -176,4 +176,29 @@ strings will change in future." (haskell-utils-compose-type-at-command test-b-points)) (should (string-prefix-p ":type-at nil 4 1 4 4" test-a-result)) (should (string-prefix-p ":type-at nil 7 3 8 16" test-b-result))))) + +(ert-deftest parse-repl-response () + "Test `haskell-utils-repl-response-error-status' function." + (let* ((t1-str "unknown command ':type-at'\nuse :? for help.") + (t2-str "\n:3:5: Not in scope: ‘x’") + (t3-str "Couldn't guess that module name. Does it exist?") + (t4-str "Hello World!") + (t5-str " ") + (t6-str "") + (t7-str "\n\n\n\n") + (r1 (haskell-utils-repl-response-error-status t1-str)) + (r2 (haskell-utils-repl-response-error-status t2-str)) + (r3 (haskell-utils-repl-response-error-status t3-str)) + (r4 (haskell-utils-repl-response-error-status t4-str)) + (r5 (haskell-utils-repl-response-error-status t5-str)) + (r6 (haskell-utils-repl-response-error-status t6-str)) + (r7 (haskell-utils-repl-response-error-status t7-str))) + (should (equal r1 'unknown-command)) + (should (equal r2 'interactive-error)) + (should (equal r3 'option-missing)) + (should (equal r4 'no-error)) + (should (equal r5 'no-error)) + (should (equal r6 'no-error)) + (should (equal r7 'no-error)))) + ;;; haskell-utils-tests.el ends here