Skip to content

Proposal - Add haskell-process-wrapper-function #370

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.

Sign up for GitHub

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

Closed
wants to merge 3 commits into from
Closed

Proposal - Add haskell-process-wrapper-function #370

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
966dbe7
Sandboxable haskell-mode using haskell-process-wrapper
ardumont Nov 10, 2014
4185716
Refactor to use only a `haskell-process-wrapper-function`.
ardumont Nov 17, 2014
bfc10c5
Improve the docstring to show as example a function that actually works.
ardumont Nov 17, 2014
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
94 changes: 45 additions & 49 deletions haskell-process.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -111,6 +111,16 @@ See `haskell-process-do-cabal' for more details."
:type '(choice (const auto) (const ghci) (const cabal-repl) (const cabal-dev) (const cabal-ghci))
:group 'haskell-interactive)

(defcustom haskell-process-wrapper-function
#'identity
"A default wrapper function to deal with an eventual haskell-process-wrapper.

If no wrapper is needed, then using 'identify function is sufficient.
Otherwise, define a function which takes a list of arguments.
For example:
(lambda (argv) (append (list \"nix-shell\" \"default.nix\" \"--command\" )
(list (mapconcat 'identity argv \" \"))))")

(defcustom haskell-process-log
nil
"Enable debug logging to \"*haskell-process-log*\" buffer."
Expand Down Expand Up @@ -1010,6 +1020,36 @@ from `module-buffer'."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Building the process

(defun haskell-process-compute-process-log-and-command (session hptype)
"Compute the log and process to start command for the SESSION from the HPTYPE.
Do not actually start any process.
HPTYPE is the result of calling `'haskell-process-type`' function."
(let ((session-name (haskell-session-name session)))
(cl-ecase hptype
('ghci
(append (list (format "Starting inferior GHCi process %s ..." haskell-process-path-ghci)
session-name
nil)
(apply haskell-process-wrapper-function (list (cons haskell-process-path-ghci haskell-process-args-ghci)))))
('cabal-repl
(append (list (format "Starting inferior `cabal repl' process using %s ..." haskell-process-path-cabal)
session-name
nil)
(apply haskell-process-wrapper-function (list (cons haskell-process-path-cabal (cons "repl" haskell-process-args-cabal-repl))))
(let ((target (haskell-session-target session)))
(if target (list target) nil))))
('cabal-ghci
(append (list (format "Starting inferior cabal-ghci process using %s ..." haskell-process-path-cabal-ghci)
session-name
nil)
(apply haskell-process-wrapper-function (list (list haskell-process-path-cabal-ghci)))))
('cabal-dev
(let ((dir (concat (haskell-session-cabal-dir session) "/cabal-dev")))
(append (list (format "Starting inferior cabal-dev process %s -s %s ..." haskell-process-path-cabal-dev dir)
session-name
nil)
(apply haskell-process-wrapper-function (list (cons haskell-process-path-cabal-dev (list "ghci" "-s" dir))))))))))

;;;###autoload
(defun haskell-process-start (session)
"Start the inferior Haskell process."
Expand All @@ -1026,58 +1066,14 @@ from `module-buffer'."
(haskell-process-set-session process session)
(haskell-process-set-cmd process nil)
(haskell-process-set (haskell-session-process session) 'is-restarting nil)
(let ((default-directory (haskell-session-cabal-dir session)))
(let ((default-directory (haskell-session-cabal-dir session))
(log-and-process-to-start (haskell-process-compute-process-log-and-command session (haskell-process-type))))
(haskell-session-pwd session)
(haskell-process-set-process
process
(cl-ecase (haskell-process-type)
('ghci
(haskell-process-log
(propertize (format "Starting inferior GHCi process %s ..."
haskell-process-path-ghci)
'face font-lock-comment-face))
(apply #'start-process
(append (list (haskell-session-name session)
nil
haskell-process-path-ghci)
haskell-process-args-ghci)))
('cabal-repl
(haskell-process-log
(propertize
(format "Starting inferior `cabal repl' process using %s ..."
haskell-process-path-cabal)
'face font-lock-comment-face))

(apply #'start-process
(append (list (haskell-session-name session)
nil
haskell-process-path-cabal)
'("repl") haskell-process-args-cabal-repl
(let ((target (haskell-session-target session)))
(if target (list target) nil)))))
('cabal-ghci
(haskell-process-log
(propertize
(format "Starting inferior cabal-ghci process using %s ..."
haskell-process-path-cabal-ghci)
'face font-lock-comment-face))
(start-process (haskell-session-name session)
nil
haskell-process-path-cabal-ghci))
('cabal-dev
(let ((dir (concat (haskell-session-cabal-dir session)
"/cabal-dev")))
(haskell-process-log
(propertize (format "Starting inferior cabal-dev process %s -s %s ..."
haskell-process-path-cabal-dev
dir)
'face font-lock-comment-face))
(start-process (haskell-session-name session)
nil
haskell-process-path-cabal-dev
"ghci"
"-s"
dir))))))
(progn
(haskell-process-log (propertize (car log-and-process-to-start) 'face font-lock-comment-face))
(apply #'start-process (cdr log-and-process-to-start)))))
(progn (set-process-sentinel (haskell-process-process process) 'haskell-process-sentinel)
(set-process-filter (haskell-process-process process) 'haskell-process-filter))
(haskell-process-send-startup process)
Expand Down
105 changes: 105 additions & 0 deletions tests/haskell-process-tests.el
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,105 @@
;;; haskell-process-tests.el

;;; Code:

(require 'ert)
(require 'haskell-process)

;; HACK how to install deps in haskell-mode
(progn (require 'package)
(package-initialize)
(add-to-list 'package-archives '("melpa" . "http://melpa.milkbox.net/packages/"))
(package-refresh-contents)
(package-install 'el-mock))

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Beware this HACK here to install the el-mock dependencies...
How can we do better?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Probably Cask would be the way to handle this robustly across the entire repo, because it has the concept of development dependencies.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, indeed.
I did not want to take it upon me to propose it (I already use it for org-trello).

So, shall I try and propose using Cask in this PR?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here we go #372 (in another PR to avoid cluttering this functionality).

(require 'el-mock)

(ert-deftest haskell-process-wrapper-command-function-identity ()
"No wrapper, return directly the command."
(should (equal '("ghci")
(progn
(custom-set-variables '(haskell-process-wrapper-function #'identity))
(apply haskell-process-wrapper-function (list '("ghci")))))))

(ert-deftest haskell-process-wrapper-function-non-identity ()
"Wrapper as a string, return the wrapping command as a string."
(should (equal '("nix-shell" "default.nix" "--command" "cabal\\ run")
(progn
(custom-set-variables '(haskell-process-wrapper-function (lambda (argv)
(append '("nix-shell" "default.nix" "--command")
(list (shell-quote-argument argv))))))
(apply haskell-process-wrapper-function (list "cabal run"))))))

(ert-deftest test-haskell-process--compute-process-log-and-command-ghci ()
(should (equal '("Starting inferior GHCi process ghci ..." "dumses1" nil "ghci" "-ferror-spans")
(let ((haskell-process-path-ghci "ghci")
(haskell-process-args-ghci '("-ferror-spans")))
(custom-set-variables '(haskell-process-wrapper-function #'identity))
(mocklet (((haskell-session-name "dummy-session") => "dumses1"))
(haskell-process-compute-process-log-and-command "dummy-session" 'ghci))))))

(ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-ghci ()
(should (equal '("Starting inferior GHCi process ghci ..." "dumses1" nil "nix-shell" "default.nix" "--command" "ghci\\ -ferror-spans")
(let ((haskell-process-path-ghci "ghci")
(haskell-process-args-ghci '("-ferror-spans")))
(custom-set-variables '(haskell-process-wrapper-function
(lambda (argv) (append (list "nix-shell" "default.nix" "--command" )
(list (shell-quote-argument (mapconcat 'identity argv " ")))))))
(mocklet (((haskell-session-name "dummy-session") => "dumses1"))
(haskell-process-compute-process-log-and-command "dummy-session" 'ghci))))))

(ert-deftest test-haskell-process--compute-process-log-and-command-cabal-repl ()
(should (equal '("Starting inferior `cabal repl' process using cabal ..." "dumses2" nil "cabal" "repl" "--ghc-option=-ferror-spans" "dumdum-session")
(let ((haskell-process-path-cabal "cabal")
(haskell-process-args-cabal-repl '("--ghc-option=-ferror-spans")))
(custom-set-variables '(haskell-process-wrapper-function #'identity))
(mocklet (((haskell-session-name "dummy-session2") => "dumses2")
((haskell-session-target "dummy-session2") => "dumdum-session"))
(haskell-process-compute-process-log-and-command "dummy-session2" 'cabal-repl))))))

(ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-cabal-repl ()
(should (equal '("Starting inferior `cabal repl' process using cabal ..." "dumses2" nil "nix-shell" "default.nix" "--command" "cabal\\ repl\\ --ghc-option\\=-ferror-spans" "dumdum-session")
(let ((haskell-process-path-cabal "cabal")
(haskell-process-args-cabal-repl '("--ghc-option=-ferror-spans")))
(custom-set-variables '(haskell-process-wrapper-function
(lambda (argv) (append (list "nix-shell" "default.nix" "--command" )
(list (shell-quote-argument (mapconcat 'identity argv " ")))))))
(mocklet (((haskell-session-name "dummy-session2") => "dumses2")
((haskell-session-target "dummy-session2") => "dumdum-session"))
(haskell-process-compute-process-log-and-command "dummy-session2" 'cabal-repl))))))

(ert-deftest test-haskell-process--compute-process-log-and-command-cabal-ghci ()
(should (equal '("Starting inferior cabal-ghci process using cabal-ghci ..." "dumses3" nil "cabal-ghci")
(let ((haskell-process-path-ghci "ghci"))
(custom-set-variables '(haskell-process-wrapper-function #'identity))
(mocklet (((haskell-session-name "dummy-session3") => "dumses3"))
(haskell-process-compute-process-log-and-command "dummy-session3" 'cabal-ghci))))))

(ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-cabal-ghci ()
(should (equal '("Starting inferior cabal-ghci process using cabal-ghci ..." "dumses3" nil "nix-shell" "default.nix" "--command" "cabal-ghci")
(let ((haskell-process-path-ghci "ghci"))
(custom-set-variables '(haskell-process-wrapper-function
(lambda (argv) (append (list "nix-shell" "default.nix" "--command" )
(list (shell-quote-argument (mapconcat 'identity argv " ")))))))
(mocklet (((haskell-session-name "dummy-session3") => "dumses3"))
(haskell-process-compute-process-log-and-command "dummy-session3" 'cabal-ghci))))))

(ert-deftest test-haskell-process--compute-process-log-and-command-cabal-dev ()
(should (equal '("Starting inferior cabal-dev process cabal-dev -s directory/cabal-dev ..." "dumses4" nil "cabal-dev" "ghci" "-s" "directory/cabal-dev")
(let ((haskell-process-path-cabal-dev "cabal-dev"))
(custom-set-variables '(haskell-process-wrapper-function #'identity))
(mocklet (((haskell-session-name "dummy-session4") => "dumses4")
((haskell-session-cabal-dir "dummy-session4") => "directory"))
(haskell-process-compute-process-log-and-command "dummy-session4" 'cabal-dev))))))

(ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-cabal-dev ()
(should (equal '("Starting inferior cabal-dev process cabal-dev -s directory/cabal-dev ..." "dumses4" nil "run-with-docker" "cabal-dev\\ ghci\\ -s\\ directory/cabal-dev")
(let ((haskell-process-path-cabal-dev "cabal-dev"))
(custom-set-variables '(haskell-process-wrapper-function
(lambda (argv) (append (list "run-with-docker")
(list (shell-quote-argument (mapconcat 'identity argv " ")))))))
(mocklet (((haskell-session-name "dummy-session4") => "dumses4")
((haskell-session-cabal-dir "dummy-session4") => "directory"))
(haskell-process-compute-process-log-and-command "dummy-session4" 'cabal-dev))))))

;;; haskell-process-tests.el ends here