Skip to content

Utils coverage #1090

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Jan 17, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion haskell-commands.el
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
9 changes: 5 additions & 4 deletions haskell-process.el
Original file line number Diff line number Diff line change
Expand Up @@ -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>"
Expand Down
44 changes: 29 additions & 15 deletions haskell-utils.el
Original file line number Diff line number Diff line change
@@ -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 <hvr@gnu.org>

Expand Down Expand Up @@ -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) "/")))

Expand Down Expand Up @@ -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.
Expand Down
29 changes: 27 additions & 2 deletions tests/haskell-utils-tests.el
Original file line number Diff line number Diff line change
@@ -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:
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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