28
30
(require 'haskell-mode)
29
31
(require 'haskell-session)
30
32
(require 'haskell-compat)
33
(require 'haskell-str)
34
(require 'haskell-utils)
35
(require 'haskell-presentation-mode)
31
36
(with-no-warnings (require 'cl))
33
38
;; FIXME: haskell-process shouldn't depend on haskell-interactive-mode to avoid module-dep cycles
34
(declare-function haskell-interactive-mode-echo "haskell-interactive-mode" (session message))
39
(declare-function haskell-interactive-mode-echo "haskell-interactive-mode" (session message &optional mode))
35
40
(declare-function haskell-interactive-mode-compile-error "haskell-interactive-mode" (session message))
36
41
(declare-function haskell-interactive-mode-insert "haskell-interactive-mode" (session message))
37
42
(declare-function haskell-interactive-mode-reset-error "haskell-interactive-mode" (session))
67
78
"Any arguments for starting ghci."
68
79
:group 'haskell-interactive
80
:type '(repeat (string :tag "Argument")))
82
(defcustom haskell-process-args-cabal-repl
83
'("--ghc-option=-ferror-spans")
84
"Additional arguments to for `cabal repl' invocation.
85
Note: The settings in `haskell-process-path-ghci' and
86
`haskell-process-args-ghci' are not automatically reused as `cabal repl'
87
currently invokes `ghc --interactive'. Use
88
`--with-ghc=<path-to-executable>' if you want to use a different
89
interactive GHC frontend; use `--ghc-option=<ghc-argument>' to
90
pass additional flags to `ghc'."
91
:group 'haskell-interactive
92
:type '(repeat (string :tag "Argument")))
94
(defcustom haskell-process-do-cabal-format-string
96
"The way to run cabal comands. It takes two arguments -- the directory and the command.
97
See `haskell-process-do-cabal' for more details."
98
:group 'haskell-interactive
71
101
(defcustom haskell-process-type
73
103
"The inferior Haskell process type to use."
74
:type '(choice (const ghci) (const cabal-dev) (const cabal-ghci))
104
:type '(choice (const ghci) (const cabal-repl) (const cabal-dev) (const cabal-ghci))
75
105
:group 'haskell-interactive)
77
107
(defcustom haskell-process-log
125
155
:group 'haskell-interactive)
157
(defcustom haskell-process-auto-import-loaded-modules
159
"Auto import the modules reported by GHC to have been loaded?"
161
:group 'haskell-interactive)
163
(defcustom haskell-process-reload-with-fbytecode
165
"When using -fobject-code, auto reload with -fbyte-code (and
166
then restore the -fobject-code) so that all module info and
167
imports become available?"
169
:group 'haskell-interactive)
171
(defcustom haskell-process-use-presentation-mode
173
"Use presentation mode to show things like type info instead of
174
printing to the message area."
176
:group 'haskell-interactive)
127
178
(defvar haskell-process-prompt-regex "\\(^[> ]*> $\\|\n[> ]*> $\\)")
128
179
(defvar haskell-reload-p nil)
172
223
(defun haskell-process-do-type (&optional insert-value)
173
224
"Print the type of the given expression."
174
225
(interactive "P")
175
(haskell-process-do-simple-echo
177
(let ((ident (haskell-ident-at-point)))
178
(format (if (string-match "^[_[:lower:][:upper:]]" ident)
227
(haskell-process-insert-type)
228
(haskell-process-do-simple-echo
229
(let ((ident (haskell-ident-at-point)))
230
;; TODO: Generalize all these `string-match' of ident calls into
232
(format (if (string-match "^[_[:lower:][:upper:]]" ident)
238
(defun haskell-process-insert-type ()
239
"Get the identifer at the point and insert its type, if
240
possible, using GHCi's :type."
241
(let ((process (haskell-process))
242
(query (let ((ident (haskell-ident-at-point)))
243
(format (if (string-match "^[_[:lower:][:upper:]]" ident)
247
(haskell-process-queue-command
249
(make-haskell-command
250
:state (list process query (current-buffer))
252
(haskell-process-send-string (nth 0 state)
254
:complete (lambda (state response)
256
;; TODO: Generalize this into a function.
257
((or (string-match "^Top level" response)
258
(string-match "^<interactive>" response))
261
(with-current-buffer (nth 2 state)
262
(goto-char (line-beginning-position))
263
(insert (format "%s\n" response))))))))))
184
(defun haskell-process-do-info (&optional ident)
185
"Print the info of the given expression."
266
(defun haskell-process-do-info (&optional prompt-value)
267
"Print info on the identifier at point.
268
If PROMPT-VALUE is non-nil, request identifier via mini-buffer."
187
270
(haskell-process-do-simple-echo
189
(let ((ident (haskell-ident-at-point)))
190
(format (if (string-match "^[a-z][A-Z]" ident)
194
(haskell-ident-at-point))))))
271
(let ((ident (if prompt-value
272
(read-from-minibuffer "Info: " (haskell-ident-at-point))
273
(haskell-ident-at-point)))
274
(modname (unless prompt-value
275
(haskell-utils-parse-import-statement-at-point))))
277
(format ":browse! %s" modname)
278
(format (if (string-match "^[a-zA-Z_]" ident)
282
(haskell-ident-at-point)))))
196
285
(defun haskell-process-do-try-info (sym)
197
286
"Get info of `sym' and echo in the minibuffer."
206
295
(if (string-match "^[A-Za-z_]" (cdr state))
207
296
(format ":info %s" (cdr state))
208
297
(format ":info (%s)" (cdr state)))))
209
:complete (lambda (process response)
298
:complete (lambda (state response)
210
299
(unless (or (string-match "^Top level" response)
211
300
(string-match "^<interactive>" response))
212
301
(haskell-mode-message-line response)))))))
214
(defun haskell-process-do-simple-echo (insert-value line)
215
"Send some line to GHCi and echo the result in the REPL and minibuffer."
303
(defun haskell-process-do-simple-echo (line &optional mode)
304
"Send LINE to the GHCi process and echo the result in some
305
fashion, such as printing in the minibuffer, or using
306
haskell-present, depending on configuration."
216
307
(let ((process (haskell-process)))
217
308
(haskell-process-queue-command
219
310
(make-haskell-command
220
:state (list process line insert-value)
311
:state (list process line mode)
221
312
:go (lambda (state)
222
313
(haskell-process-send-string (car state) (cadr state)))
223
314
:complete (lambda (state response)
315
;; TODO: TBD: don't do this if
316
;; `haskell-process-use-presentation-mode' is t.
224
317
(haskell-interactive-mode-echo
225
(haskell-process-session (car state)) response)
226
(haskell-mode-message-line response)
228
(goto-char (line-beginning-position))
229
(insert (format "%s\n" response))))))))
318
(haskell-process-session (car state))
321
(if haskell-process-use-presentation-mode
322
(progn (haskell-present (cadr state)
323
(haskell-process-session (car state))
325
(haskell-session-assign
326
(haskell-process-session (car state))))
327
(haskell-mode-message-line response)))))))
231
329
(defun haskell-process-look-config-changes (session)
232
330
"Checks whether a cabal configuration file has
270
370
"Now running :load <buffer-filename>.")))
271
371
(if haskell-reload-p (haskell-process-reload-file) (haskell-process-load-file))))
273
(defun haskell-process-file-loadish (command reload-p)
373
(defun haskell-process-file-loadish (command reload-p module-buffer)
374
"Run a loading-ish COMMAND that wants to pick up type errors
375
and things like that. RELOAD-P indicates whether the notification
376
should say 'reloaded' or 'loaded'. MODULE-BUFFER may be used
377
for various things, but is optional."
274
378
(let ((session (haskell-session)))
275
379
(haskell-session-current-dir session)
276
380
(when haskell-process-check-cabal-config-on-load
306
413
(ido-completing-read "Cabal command: "
307
414
haskell-cabal-commands)))
309
(defun haskell-process-add-cabal-autogen()
416
(defun haskell-process-add-cabal-autogen ()
310
417
"Add <cabal-project-dir>/dist/build/autogen/ to the ghci search
311
418
path. This allows modules such as 'Path_...', generated by cabal,
312
419
to be loaded by ghci."
314
((session (haskell-session))
315
(cabal-dir (haskell-session-cabal-dir session))
316
(ghci-gen-dir (format "%sdist/build/autogen/" cabal-dir)))
317
(haskell-process-do-simple-echo
318
'nil (format ":set -i%s" ghci-gen-dir))))
420
(unless (eq 'cabal-repl haskell-process-type) ;; redundant with "cabal repl"
422
((session (haskell-session))
423
(cabal-dir (haskell-session-cabal-dir session))
424
(ghci-gen-dir (format "%sdist/build/autogen/" cabal-dir)))
425
(haskell-process-queue-without-filters
427
(format ":set -i%s" ghci-gen-dir)))))
320
429
(defun haskell-process-do-cabal (command)
321
430
"Run a Cabal command."
384
495
(setf (cdddr state) (list (length buffer)))
387
(defun haskell-process-load-complete (session process buffer reload)
388
"Handle the complete loading response."
389
(cond ((haskell-process-consume process "Ok, modules loaded: \\(.+\\)$")
390
(let ((cursor (haskell-process-response-cursor process)))
498
(defun haskell-process-load-complete (session process buffer reload module-buffer)
499
"Handle the complete loading response. BUFFER is the string of
500
text being sent over the process pipe. MODULE-BUFFER is the
501
actual Emacs buffer of the module being loaded."
502
(cond ((haskell-process-consume process "Ok, modules loaded: \\(.+\\)\\.$")
503
(let* ((modules (haskell-process-extract-modules buffer))
504
(cursor (haskell-process-response-cursor process)))
391
505
(haskell-process-set-response-cursor process 0)
392
506
(let ((warning-count 0))
393
507
(while (haskell-process-errors-warnings session process buffer)
394
508
(setq warning-count (1+ warning-count)))
395
509
(haskell-process-set-response-cursor process cursor)
396
(haskell-mode-message-line (if reload "Reloaded OK." "OK.")))))
397
((haskell-process-consume process "Failed, modules loaded: \\(.+\\)$")
398
(let ((cursor (haskell-process-response-cursor process)))
510
(if (and (not reload)
511
haskell-process-reload-with-fbytecode)
512
(haskell-process-reload-with-fbytecode process module-buffer)
513
(haskell-process-import-modules process (car modules)))
514
(haskell-mode-message-line
515
(if reload "Reloaded OK." "OK.")))))
516
((haskell-process-consume process "Failed, modules loaded: \\(.+\\)\\.$")
517
(let* ((modules (haskell-process-extract-modules buffer))
518
(cursor (haskell-process-response-cursor process)))
399
519
(haskell-process-set-response-cursor process 0)
400
520
(while (haskell-process-errors-warnings session process buffer))
401
521
(haskell-process-set-response-cursor process cursor)
522
(if (and (not reload) haskell-process-reload-with-fbytecode)
523
(haskell-process-reload-with-fbytecode process module-buffer)
524
(haskell-process-import-modules process (car modules)))
402
525
(haskell-interactive-mode-compile-error session "Compilation failed.")))))
527
(defun haskell-process-reload-with-fbytecode (process module-buffer)
528
"Reload FILE-NAME with -fbyte-code set, and then restore -fobject-code."
529
(haskell-process-queue-without-filters process ":set -fbyte-code")
530
(haskell-process-touch-buffer process module-buffer)
531
(haskell-process-queue-without-filters process ":reload")
532
(haskell-process-queue-without-filters process ":set -fobject-code"))
534
(defun haskell-process-touch-buffer (process buffer)
535
"Updates mtime on the file for BUFFER by queing a touch on
538
(haskell-process-queue-command
540
(make-haskell-command
541
:state (cons process buffer)
543
(haskell-process-send-string
547
(shell-quote-argument (buffer-file-name
549
:complete (lambda (state _)
550
(with-current-buffer (cdr state)
551
(clear-visited-file-modtime))))))
553
(defun haskell-process-extract-modules (buffer)
554
"Extract the modules from the process buffer."
555
(let* ((modules-string (match-string 1 buffer))
556
(modules (split-string modules-string ", ")))
557
(cons modules modules-string)))
559
(defun haskell-process-import-modules (process modules)
560
"Import `modules' with :m +, and send any import statements
561
from `module-buffer'."
562
(when haskell-process-auto-import-loaded-modules
563
(haskell-process-queue-command
565
(make-haskell-command
566
:state (cons process modules)
568
(haskell-process-send-string
570
(format ":m + %s" (mapconcat 'identity (cdr state) " "))))))))
404
572
(defun haskell-process-live-build (process buffer echo-in-repl)
405
573
"Show live updates for loading files."
406
574
(cond ((haskell-process-consume
783
948
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
784
949
;; Making commands
951
(defun haskell-process-queue-without-filters (process line)
952
"Queue LINE to be sent to PROCESS without bothering to look at
954
(haskell-process-queue-command
956
(make-haskell-command
957
:state (cons process line)
959
(haskell-process-send-string (car state)
786
962
(defun haskell-process-queue-command (process command)
787
963
"Add a command to the process command queue."
788
(haskell-process-add-to-cmd-queue process command)
964
(haskell-process-cmd-queue-add process command)
789
965
(haskell-process-trigger-queue process))
791
967
(defun haskell-process-trigger-queue (process)
792
968
"Trigger the next command in the queue to be ran if there is no current command."
793
969
(if (and (haskell-process-process process)
794
970
(process-live-p (haskell-process-process process)))
795
(when (equal (haskell-process-cmd process) 'none)
971
(unless (haskell-process-cmd process)
796
972
(let ((cmd (haskell-process-cmd-queue-pop process)))
798
974
(haskell-process-set-cmd process cmd)
801
977
(haskell-process-set (haskell-process) 'command-queue nil)
802
978
(haskell-process-prompt-restart process))))
980
(defun haskell-process-queue-flushed-p (process)
981
"Return t if command queue has been completely processed."
982
(not (or (haskell-process-cmd-queue process)
983
(haskell-process-cmd process))))
985
(defun haskell-process-queue-flush (process)
986
"Block till PROCESS' command queue has been completely processed.
987
This uses `accept-process-output' internally."
988
(while (not (haskell-process-queue-flushed-p process))
989
(haskell-process-trigger-queue process)
990
(accept-process-output (haskell-process-process process) 1)))
992
(defun haskell-process-queue-sync-request (process reqstr)
993
"Queue submitting REQSTR to PROCESS and return response blockingly."
994
(let ((cmd (make-haskell-command
995
:state (cons nil process)
996
:go `(lambda (s) (haskell-process-send-string (cdr s) ,reqstr))
998
(haskell-process-queue-command process cmd)
999
(haskell-process-queue-flush process)
1000
(car-safe (haskell-command-state cmd))))
1002
(defun haskell-process-get-repl-completions (process inputstr)
1003
"Perform `:complete repl ...' query for INPUTSTR using PROCESS."
1004
(let* ((reqstr (concat ":complete repl "
1005
(haskell-str-literal-encode inputstr)))
1006
(rawstr (haskell-process-queue-sync-request process reqstr)))
1007
(if (string-prefix-p "unknown command " rawstr)
1008
(error "GHCi lacks `:complete' support")
1009
(let* ((s1 (split-string rawstr "\r?\n"))
1010
(cs (mapcar #'haskell-str-literal-decode (cdr s1)))
1011
(h0 (car s1))) ;; "<cnt1> <cnt2> <quoted-str>"
1012
(unless (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\(\".*\"\\)\\'" h0)
1013
(error "Invalid `:complete' response"))
1014
(let ((cnt1 (match-string 1 h0))
1015
(h1 (haskell-str-literal-decode (match-string 3 h0))))
1016
(unless (= (string-to-number cnt1) (length cs))
1017
(error "Lengths inconsistent in `:complete' reponse"))
804
1020
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
805
1021
;; Accessing the process
1023
(defun haskell-process-get (process key)
1024
"Get the PROCESS's KEY value.
1025
Returns nil if KEY not set."
1026
(cdr (assq key process)))
1028
(defun haskell-process-set (process key value)
1029
"Set the PROCESS's KEY to VALUE.
1030
Returns newly set VALUE."
1032
(let ((cell (assq key process)))
1034
(setcdr cell value) ; modify cell in-place
1035
(setcdr process (cons (cons key value) (cdr process))) ; new cell
1037
(display-warning 'haskell-interactive
1038
"`haskell-process-set' called with nil process")))
1040
;; Wrappers using haskell-process-{get,set}
807
1042
(defun haskell-process-set-process (p v)
808
1043
"Set the process's inferior process."
809
1044
(haskell-process-set p 'inferior-process v))
848
1084
"Set the process's response cursor."
849
1085
(haskell-process-set p 'current-response-cursor v))
851
(defun haskell-process-add-to-cmd-queue (process cmd)
852
"Set the process's response cursor."
1087
;; low-level command queue operations
1089
(defun haskell-process-restarting (process)
1090
"Is the PROCESS restarting?"
1091
(haskell-process-get process 'is-restarting))
1093
(defun haskell-process-cmd-queue (process)
1094
"Get the PROCESS' command queue.
1095
New entries get added to the end of the list. Use
1096
`haskell-process-cmd-queue-add' and
1097
`haskell-process-cmd-queue-pop' to modify the command queue."
1098
(haskell-process-get process 'command-queue))
1100
(defun haskell-process-cmd-queue-add (process cmd)
1101
"Add CMD to end of PROCESS's command queue."
1102
(check-type cmd haskell-command)
853
1103
(haskell-process-set process
855
1105
(append (haskell-process-cmd-queue process)
858
(defun haskell-process-cmd-queue (process)
859
"Get the process's command queue."
860
(haskell-process-get process 'command-queue))
862
(defun haskell-process-restarting (process)
863
"Is the process restarting?"
864
(haskell-process-get process 'is-restarting))
866
1108
(defun haskell-process-cmd-queue-pop (process)
867
"Get the process's command queue."
868
(let ((queue (haskell-process-get process 'command-queue)))
870
(let ((next (car queue)))
871
(haskell-process-set process 'command-queue (cdr queue))
874
(defun haskell-process-get (process key)
875
"Get the PROCESS's KEY value.
876
Returns nil if KEY not set."
877
(cdr (assq key process)))
879
(defun haskell-process-set (process key value)
880
"Set the PROCESS's KEY to VALUE.
881
Returns newly set VALUE."
882
(let ((cell (assq key process)))
884
(setcdr cell value) ; modify cell in-place
885
(setcdr process (cons (cons key value) (cdr process))) ; new cell
1109
"Pop the PROCESS' next entry from command queue.
1110
Returns nil if queue is empty."
1111
(let ((queue (haskell-process-cmd-queue process)))
1113
(haskell-process-set process 'command-queue (cdr queue))
888
1116
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
889
1117
;; Accessing commands -- using cl 'defstruct'