Merge pull request #1090 from geraldus/utils-coverage

Utils coverage

Author: gracjan

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

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))) ;; "<limit count> <all count> <unused string>"

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 <[email protected]>
 
@@ -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
+* \"<interactive>: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 "^<interactive>:" first-line) 'interactive-error)
-     (t 'success))))
+     ((string-match-p "^<interactive>:" 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.

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<interactive>: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