~ubuntu-branches/ubuntu/trusty/haskell-mode/trusty-proposed

« back to all changes in this revision

Viewing changes to .pc/0001-logo-loco.patch/haskell-process.el

  • Committer: Package Import Robot
  • Author(s): Barak A. Pearlmutter
  • Date: 2013-12-27 17:38:40 UTC
  • mfrom: (1.3.5)
  • Revision ID: package-import@ubuntu.com-20131227173840-5qjuscd4uj7ag382
Tags: 13.10-2
* build dependency on texinfo for /usr/bin/makeinfo (closes: #730955)
* no haskell-ghci.el breaking agda-mode (<< 2.3.2) (closes: #731326)

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
;;; haskell-process.el -- Communicating with the inferior Haskell process.
 
1
;;; haskell-process.el --- Communicating with the inferior Haskell process
2
2
 
3
 
;; Copyright (C) 2011-2012 Chris Done
 
3
;; Copyright (C) 2011-2012  Chris Done
4
4
 
5
5
;; Author: Chris Done <chrisdone@gmail.com>
6
6
 
 
7
;; This file is not part of GNU Emacs.
 
8
 
7
9
;; This file is free software; you can redistribute it and/or modify
8
10
;; it under the terms of the GNU General Public License as published by
9
11
;; the Free Software Foundation; either version 3, or (at your option)
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))
32
37
 
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))
50
55
  :group 'haskell-interactive
51
56
  :type '(choice string (repeat string)))
52
57
 
 
58
(defcustom haskell-process-path-cabal
 
59
  "cabal"
 
60
  "Path to the `cabal' executable."
 
61
  :group 'haskell-interactive
 
62
  :type '(choice string (repeat string)))
 
63
 
53
64
(defcustom haskell-process-path-cabal-ghci
54
65
  "cabal-ghci"
55
66
  "The path for starting cabal-ghci."
66
77
  '("-ferror-spans")
67
78
  "Any arguments for starting ghci."
68
79
  :group 'haskell-interactive
69
 
  :type '(choice list))
 
80
  :type '(repeat (string :tag "Argument")))
 
81
 
 
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")))
 
93
 
 
94
(defcustom haskell-process-do-cabal-format-string
 
95
  ":!cd %s && %s"
 
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
 
99
  :type 'string)
70
100
 
71
101
(defcustom haskell-process-type
72
102
  'ghci
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)
76
106
 
77
107
(defcustom haskell-process-log
124
154
  :type 'boolean
125
155
  :group 'haskell-interactive)
126
156
 
 
157
(defcustom haskell-process-auto-import-loaded-modules
 
158
  nil
 
159
  "Auto import the modules reported by GHC to have been loaded?"
 
160
  :type 'boolean
 
161
  :group 'haskell-interactive)
 
162
 
 
163
(defcustom haskell-process-reload-with-fbytecode
 
164
  nil
 
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?"
 
168
  :type 'boolean
 
169
  :group 'haskell-interactive)
 
170
 
 
171
(defcustom haskell-process-use-presentation-mode
 
172
  nil
 
173
  "Use presentation mode to show things like type info instead of
 
174
  printing to the message area."
 
175
  :type 'boolean
 
176
  :group 'haskell-interactive)
 
177
 
127
178
(defvar haskell-process-prompt-regex "\\(^[> ]*> $\\|\n[> ]*> $\\)")
128
179
(defvar haskell-reload-p nil)
129
180
 
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
176
 
   insert-value
177
 
   (let ((ident (haskell-ident-at-point)))
178
 
     (format (if (string-match "^[_[:lower:][:upper:]]" ident)
179
 
                 ":type %s"
180
 
               ":type (%s)")
181
 
             ident))))
 
226
  (if insert-value
 
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
 
231
       ;; one function.
 
232
       (format (if (string-match "^[_[:lower:][:upper:]]" ident)
 
233
                   ":type %s"
 
234
                 ":type (%s)")
 
235
               ident))
 
236
     'haskell-mode)))
 
237
 
 
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)
 
244
                             ":type %s"
 
245
                           ":type (%s)")
 
246
                         ident))))
 
247
    (haskell-process-queue-command
 
248
     process
 
249
     (make-haskell-command
 
250
      :state (list process query (current-buffer))
 
251
      :go (lambda (state)
 
252
            (haskell-process-send-string (nth 0 state)
 
253
                                         (nth 1 state)))
 
254
      :complete (lambda (state response)
 
255
                  (cond
 
256
                   ;; TODO: Generalize this into a function.
 
257
                   ((or (string-match "^Top level" response)
 
258
                        (string-match "^<interactive>" response))
 
259
                    (message response))
 
260
                   (t
 
261
                    (with-current-buffer (nth 2 state)
 
262
                      (goto-char (line-beginning-position))
 
263
                      (insert (format "%s\n" response))))))))))
182
264
 
183
265
;;;###autoload
184
 
(defun haskell-process-do-info (&optional ident)
185
 
  "Print the info of the given expression."
186
 
  (interactive)
 
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."
 
269
  (interactive "P")
187
270
  (haskell-process-do-simple-echo
188
 
   nil
189
 
   (let ((ident (haskell-ident-at-point)))
190
 
     (format (if (string-match "^[a-z][A-Z]" ident)
191
 
                 ":info %s"
192
 
               ":info (%s)")
193
 
             (or 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))))
 
276
     (if modname
 
277
         (format ":browse! %s" modname)
 
278
       (format (if (string-match "^[a-zA-Z_]" ident)
 
279
                   ":info %s"
 
280
                 ":info (%s)")
 
281
               (or ident
 
282
                   (haskell-ident-at-point)))))
 
283
   'haskell-mode))
195
284
 
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)))))))
213
302
 
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
218
309
     process
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)
227
 
                  (when (caddr state)
228
 
                    (goto-char (line-beginning-position))
229
 
                    (insert (format "%s\n" response))))))))
 
318
                   (haskell-process-session (car state))
 
319
                   response
 
320
                   (caddr state))
 
321
                  (if haskell-process-use-presentation-mode
 
322
                      (progn (haskell-present (cadr state)
 
323
                                              (haskell-process-session (car state))
 
324
                                              response)
 
325
                             (haskell-session-assign
 
326
                              (haskell-process-session (car state))))
 
327
                    (haskell-mode-message-line response)))))))
230
328
 
231
329
(defun haskell-process-look-config-changes (session)
232
330
  "Checks whether a cabal configuration file has
248
346
  (interactive)
249
347
  (save-buffer)
250
348
  (haskell-interactive-mode-reset-error (haskell-session))
251
 
  (haskell-process-file-loadish (concat "load " (buffer-file-name)) nil))
 
349
  (haskell-process-file-loadish (concat "load " (buffer-file-name))
 
350
                                nil
 
351
                                (current-buffer)))
252
352
 
253
353
;;;###autoload
254
354
(defun haskell-process-reload-file ()
256
356
  (interactive)
257
357
  (save-buffer)
258
358
  (haskell-interactive-mode-reset-error (haskell-session))
259
 
  (haskell-process-file-loadish "reload" t))
 
359
  (haskell-process-file-loadish "reload" t nil))
260
360
 
261
361
;;;###autoload
262
362
(defun haskell-process-load-or-reload (&optional toggle)
270
370
                        "Now running :load <buffer-filename>.")))
271
371
    (if haskell-reload-p (haskell-process-reload-file) (haskell-process-load-file))))
272
372
 
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
279
383
      (haskell-process-queue-command
280
384
       process
281
385
       (make-haskell-command
282
 
        :state (list session process command reload-p)
 
386
        :state (list session process command reload-p module-buffer)
283
387
        :go (lambda (state)
284
388
              (haskell-process-send-string
285
389
               (cadr state) (format ":%s" (caddr state))))
288
392
                 (cadr state) buffer nil))
289
393
        :complete (lambda (state response)
290
394
                    (haskell-process-load-complete
291
 
                     (car state) (cadr state) response
292
 
                     (cadddr state))))))))
 
395
                     (car state)
 
396
                     (cadr state)
 
397
                     response
 
398
                     (cadddr state)
 
399
                     (cadddr (cdr state)))))))))
293
400
 
294
401
;;;###autoload
295
402
(defun haskell-process-cabal-build ()
306
413
   (ido-completing-read "Cabal command: "
307
414
                        haskell-cabal-commands)))
308
415
 
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."
313
 
  (let*
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"
 
421
    (let*
 
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
 
426
       (haskell-process)
 
427
       (format ":set -i%s" ghci-gen-dir)))))
319
428
 
320
429
(defun haskell-process-do-cabal (command)
321
430
  "Run a Cabal command."
329
438
      (lambda (state)
330
439
        (haskell-process-send-string
331
440
         (cadr state)
332
 
         (format ":!%s && %s"
333
 
                 (format "cd %s" (haskell-session-cabal-dir (car state)))
 
441
         (format haskell-process-do-cabal-format-string
 
442
                 (haskell-session-cabal-dir (car state))
334
443
                 (format "%s %s"
335
444
                         (ecase haskell-process-type
336
445
                           ('ghci "cabal")
 
446
                           ('cabal-repl "cabal")
337
447
                           ('cabal-ghci "cabal")
338
448
                           ('cabal-dev "cabal-dev"))
339
449
                         (caddr state)))))
368
478
               :body msg
369
479
               :app-name (ecase haskell-process-type
370
480
                           ('ghci "cabal")
 
481
                           ('cabal-repl "cabal")
371
482
                           ('cabal-ghci "cabal")
372
483
                           ('cabal-dev "cabal-dev"))
373
484
               :app-icon haskell-process-logo
384
495
  (setf (cdddr state) (list (length buffer)))
385
496
  nil)
386
497
 
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.")))))
403
526
 
 
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"))
 
533
 
 
534
(defun haskell-process-touch-buffer (process buffer)
 
535
  "Updates mtime on the file for BUFFER by queing a touch on
 
536
PROCESS."
 
537
  (interactive)
 
538
  (haskell-process-queue-command
 
539
   process
 
540
   (make-haskell-command
 
541
    :state (cons process buffer)
 
542
    :go (lambda (state)
 
543
          (haskell-process-send-string
 
544
           (car state)
 
545
           (format ":!%s %s"
 
546
                   "touch"
 
547
                   (shell-quote-argument (buffer-file-name
 
548
                                          (cdr state))))))
 
549
    :complete (lambda (state _)
 
550
                (with-current-buffer (cdr state)
 
551
                  (clear-visited-file-modtime))))))
 
552
 
 
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)))
 
558
 
 
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
 
564
     process
 
565
     (make-haskell-command
 
566
      :state (cons process modules)
 
567
      :go (lambda (state)
 
568
            (haskell-process-send-string
 
569
             (car state)
 
570
             (format ":m + %s" (mapconcat 'identity (cdr state) " "))))))))
 
571
 
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
534
702
                                        'command-queue)))
535
703
    (haskell-session-set-process session process)
536
704
    (haskell-process-set-session process session)
537
 
    (haskell-process-set-cmd process 'none)
 
705
    (haskell-process-set-cmd process nil)
538
706
    (haskell-process-set (haskell-session-process session) 'is-restarting nil)
539
707
    (let ((default-directory (haskell-session-cabal-dir session)))
540
708
      (haskell-session-pwd session)
549
717
                               nil
550
718
                               haskell-process-path-ghci)
551
719
                         haskell-process-args-ghci)))
 
720
         ('cabal-repl
 
721
          (haskell-process-log (format "Starting inferior `cabal repl' process using %s ..."
 
722
                                       haskell-process-path-cabal))
 
723
 
 
724
          (apply #'start-process
 
725
                 (append (list (haskell-session-name session)
 
726
                               nil
 
727
                               haskell-process-path-cabal)
 
728
                         '("repl") haskell-process-args-cabal-repl)))
552
729
         ('cabal-ghci
553
730
          (haskell-process-log (format "Starting inferior cabal-ghci process using %s ..."
554
731
                                       haskell-process-path-cabal-ghci))
570
747
    (progn (set-process-sentinel (haskell-process-process process) 'haskell-process-sentinel)
571
748
           (set-process-filter (haskell-process-process process) 'haskell-process-filter))
572
749
    (haskell-process-send-startup process)
573
 
    (haskell-process-change-dir session
574
 
                                process
575
 
                                (haskell-session-current-dir session))
 
750
    (unless (eq 'cabal-repl haskell-process-type) ;; "cabal repl" sets the proper CWD
 
751
      (haskell-process-change-dir session
 
752
                                  process
 
753
                                  (haskell-session-current-dir session)))
576
754
    (haskell-process-set process 'command-queue
577
755
                         (append (haskell-process-get (haskell-session-process session)
578
756
                                                      'command-queue)
604
782
 
605
783
(defun haskell-process-make (name)
606
784
  "Make an inferior Haskell process."
607
 
  (list (cons 'name name)
608
 
        (cons 'current-command 'none)))
 
785
  (list (cons 'name name)))
609
786
 
610
787
;;;###autoload
611
788
(defun haskell-process ()
633
810
        (haskell-session-get session 'current-dir))
634
811
      (progn (haskell-session-set-current-dir
635
812
              session
636
 
              (haskell-read-directory-name
 
813
              (haskell-utils-read-directory-name
637
814
               (if change "Change directory: " "Set current directory: ")
638
815
               (or (haskell-session-get session 'current-dir)
639
816
                   (haskell-session-get session 'cabal-dir)
642
819
                     "~/"))))
643
820
             (haskell-session-get session 'current-dir))))
644
821
 
645
 
(defun haskell-read-directory-name (prompt default)
646
 
  "Read in a directory name, properly normalized."
647
 
  (let ((filename (file-truename
648
 
                   (read-directory-name
649
 
                    prompt
650
 
                    default
651
 
                    default))))
652
 
    (concat (replace-regexp-in-string "/$" "" filename)
653
 
            "/")))
654
 
 
655
822
(defun haskell-process-change-dir (session process dir)
656
823
  "Change the directory of the current process."
657
824
  (haskell-process-queue-command
708
875
  (haskell-process-log (format "<- %S\n" response))
709
876
  (let ((session (haskell-process-project-by-proc proc)))
710
877
    (when session
711
 
      (when (not (eq (haskell-process-cmd (haskell-session-process session))
712
 
                     'none))
 
878
      (when (haskell-process-cmd (haskell-session-process session))
713
879
        (haskell-process-collect session
714
880
                                 response
715
 
                                 (haskell-session-process session)
716
 
                                 'main)))))
 
881
                                 (haskell-session-process session))))))
717
882
 
718
883
(defun haskell-process-log (msg)
719
884
  "Write MSG to the process log (if enabled)."
729
894
                      (process-name proc)))
730
895
           haskell-sessions))
731
896
 
732
 
(defun haskell-process-collect (session response process type)
 
897
(defun haskell-process-collect (session response process)
733
898
  "Collect input for the response until receives a prompt."
734
899
  (haskell-process-set-response process
735
900
                                (concat (haskell-process-response process) response))
749
914
  "Reset the process's state, ready for the next send/reply."
750
915
  (progn (haskell-process-set-response-cursor process 0)
751
916
         (haskell-process-set-response process "")
752
 
         (haskell-process-set-cmd process 'none)))
 
917
         (haskell-process-set-cmd process nil)))
753
918
 
754
919
(defun haskell-process-consume (process regex)
755
920
  "Consume a regex from the response and move the cursor along if succeed."
783
948
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
784
949
;; Making commands
785
950
 
 
951
(defun haskell-process-queue-without-filters (process line)
 
952
  "Queue LINE to be sent to PROCESS without bothering to look at
 
953
the response."
 
954
  (haskell-process-queue-command
 
955
   process
 
956
   (make-haskell-command
 
957
    :state (cons process line)
 
958
    :go (lambda (state)
 
959
          (haskell-process-send-string (car state)
 
960
                                       (cdr state))))))
 
961
 
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))
790
966
 
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)))
797
973
          (when cmd
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))))
803
979
 
 
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))))
 
984
 
 
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)))
 
991
 
 
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))
 
997
              :complete 'setcar)))
 
998
    (haskell-process-queue-command process cmd)
 
999
    (haskell-process-queue-flush process)
 
1000
    (car-safe (haskell-command-state cmd))))
 
1001
 
 
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"))
 
1018
          (cons h1 cs))))))
 
1019
 
804
1020
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
805
1021
;; Accessing the process
806
1022
 
 
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)))
 
1027
 
 
1028
(defun haskell-process-set (process key value)
 
1029
  "Set the PROCESS's KEY to VALUE.
 
1030
Returns newly set VALUE."
 
1031
  (if process
 
1032
      (let ((cell (assq key process)))
 
1033
        (if cell
 
1034
            (setcdr cell value)         ; modify cell in-place
 
1035
          (setcdr process (cons (cons key value) (cdr process))) ; new cell
 
1036
          value))
 
1037
    (display-warning 'haskell-interactive
 
1038
                     "`haskell-process-set' called with nil process")))
 
1039
 
 
1040
;; Wrappers using haskell-process-{get,set}
 
1041
 
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))
817
1052
  (haskell-process-get p 'name))
818
1053
 
819
1054
(defun haskell-process-cmd (p)
820
 
  "Get the process's current command."
 
1055
  "Get the process's current command.
 
1056
Return nil if no current command."
821
1057
  (haskell-process-get p 'current-command))
822
1058
 
823
1059
(defun haskell-process-set-cmd (p v)
848
1084
  "Set the process's response cursor."
849
1085
  (haskell-process-set p 'current-response-cursor v))
850
1086
 
851
 
(defun haskell-process-add-to-cmd-queue (process cmd)
852
 
  "Set the process's response cursor."
 
1087
;; low-level command queue operations
 
1088
 
 
1089
(defun haskell-process-restarting (process)
 
1090
  "Is the PROCESS restarting?"
 
1091
  (haskell-process-get process 'is-restarting))
 
1092
 
 
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))
 
1099
 
 
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
854
1104
                       'command-queue
855
1105
                       (append (haskell-process-cmd-queue process)
856
1106
                               (list cmd))))
857
1107
 
858
 
(defun haskell-process-cmd-queue (process)
859
 
  "Get the process's command queue."
860
 
  (haskell-process-get process 'command-queue))
861
 
 
862
 
(defun haskell-process-restarting (process)
863
 
  "Is the process restarting?"
864
 
  (haskell-process-get process 'is-restarting))
865
 
 
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)))
869
 
    (unless (null queue)
870
 
      (let ((next (car queue)))
871
 
        (haskell-process-set process 'command-queue (cdr queue))
872
 
        next))))
873
 
 
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)))
878
 
 
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)))
883
 
    (if cell
884
 
        (setcdr cell value) ; modify cell in-place
885
 
      (setcdr process (cons (cons key value) (cdr process))) ; new cell
886
 
      value)))
 
1109
  "Pop the PROCESS' next entry from command queue.
 
1110
Returns nil if queue is empty."
 
1111
  (let ((queue (haskell-process-cmd-queue process)))
 
1112
    (when queue
 
1113
      (haskell-process-set process 'command-queue (cdr queue))
 
1114
      (car queue))))
887
1115
 
888
1116
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
889
1117
;; Accessing commands -- using cl 'defstruct'