1010
1111(require 'json )
1212(require 'dash )
13+ (require 'haskell )
1314
1415;;;### autoload
1516(defcustom hie-command " hie"
2324 :group 'haskell
2425 :type '(repeat string))
2526
26- (defvar hie-process nil
27- " Variable holding current Haskell IDE Engine process"
28-
2927(defvar hie-log-buffer nil
3028 " Variable holding current Haskell IDE Engine log buffer"
3129
4644(defvar hie-plugins nil
4745 " Plugin information gained by calling the base:plugins plugin"
4846
47+ (defvar hie-sessions (list )
48+ " All hie sessions in the Emacs session."
49+
50+ (defun hie-session-from-buffer ()
51+ " Get the session based on the buffer."
52+ (when (buffer-file-name )
53+ (cl-reduce (lambda (acc a )
54+ (let ((dir (hie-session-get a 'cabal-dir )))
55+ (if dir
56+ (if (string-prefix-p dir
57+ (file-name-directory (buffer-file-name )))
58+ (if acc
59+ (if (and
60+ (> (length (hie-session-get a 'cabal-dir ))
61+ (length (hie-session-get acc 'cabal-dir ))))
62+ a
63+ acc)
64+ a)
65+ acc)
66+ acc)))
67+ hie-sessions
68+ :initial-value nil )))
69+
70+ (defun hie-session-get (session key )
71+ " Get the SESSION's KEY value.
72+ Returns nil if KEY not set."
73+ (cdr (assq key session)))
74+
75+ (defun hie-session-set (session key value )
76+ " Set the SESSION's KEY to VALUE.
77+ Returns newly set VALUE."
78+ (let ((cell (assq key session)))
79+ (if cell
80+ (setcdr cell value) ; modify cell in-place
81+ (setcdr session (cons (cons key value) (cdr session))) ; new cell
82+ value)))
83+
84+ (defun hie-session-lookup (name )
85+ " Get the session by name."
86+ (cl-find-if (lambda (s )
87+ (string= name (hie-session-name s)))
88+ hie-sessions))
89+
90+ (defun hie-session-name (s )
91+ " Get the session name."
92+ (hie-session-get s 'name ))
93+
94+ (defun hie-session-new-assume-from-cabal ()
95+ " Prompt to create a new project based on a guess from the nearest Cabal file.
96+ If `haskell-process-load-or-reload-prompt' is nil, accept `default' ."
97+ (let ((name (haskell-session-default-name)))
98+ (hie-session-make name)))
99+
100+ (defun hie-session-make (name )
101+ " Make a Haskell session."
102+ (when (hie-session-lookup name)
103+ (error " Session of name %s already exists! " name))
104+ (let ((session (list (cons 'name name))))
105+ (add-to-list 'hie-sessions session)
106+ (hie-session-cabal-dir session)
107+ session))
108+
109+ (defun hie-session-cabal-dir (s )
110+ " Get the session cabal-dir."
111+ (or (hie-session-get s 'cabal-dir )
112+ (let* ((cabal-file (haskell-cabal-find-file))
113+ (cabal-dir (when cabal-file (file-name-directory cabal-file))))
114+ (progn (hie-session-set-cabal-dir s cabal-dir)
115+ cabal-dir))))
116+
117+ (defun hie-session-set-cabal-dir (s v )
118+ " Set the session cabal-dir."
119+ (let ((true-path (file-truename v)))
120+ (hie-session-set s 'cabal-dir true-path)))
121+
122+ (defun hie-session ()
123+ " Get the Haskell session, prompt if there isn't one or fail."
124+ (or (hie-session-from-buffer)
125+ (hie-session-new-assume-from-cabal)))
126+
49127(defun hie-process-filter (process input )
50128 (let ((prev-buffer (current-buffer )))
51129 (hie-with-process-buffer hie-process-buffer
@@ -87,30 +165,40 @@ running this function does nothing."
87165 (get-buffer-create " *hie-log*"
88166 (setq hie-process-buffer
89167 (get-buffer-create " *hie-process*"
90- (setq hie-process
91- (apply #'start-process
92- " Haskell IDE Engine"
93- hie-process-buffer
94- hie-command
95- (append additional-args
96- hie-command-args)))
97- (set-process-query-on-exit-flag hie-process nil )
98- (set-process-filter hie-process #'hie-process-filter ))
99- hie-process)
168+ (let ((process
169+ (apply #'start-process
170+ " Haskell IDE Engine"
171+ hie-process-buffer
172+ hie-command
173+ (append additional-args
174+ hie-command-args))))
175+ (set-process-query-on-exit-flag process nil )
176+ (set-process-filter process #'hie-process-filter )
177+ (hie-set-process process)))
178+ (hie-process))
179+
180+ (defun hie-set-process (p )
181+ (hie-session-set (hie-session) 'hie-process p))
182+
183+ (defun hie-process ()
184+ " Get the session process."
185+ (hie-session-get (hie-session) 'hie-process ))
100186
101187(defun hie-process-live-p ()
102188 " Whether the Haskell IDE Engine process is live."
103- (and hie-process
104- (process-live-p hie-process)))
189+ (let ((process (hie-process)))
190+ (and process
191+ (process-live-p process))))
105192
106193(defun hie-kill-process ()
107194 " Kill the Haskell IDE Engine process if it is live."
108195 (interactive )
109196 (when (hie-process-live-p)
110- (kill-process hie-process)
111- (setq hie-process nil )
112- (kill-buffer hie-process-buffer)
113- (setq hie-process-buffer nil )))
197+ (let ((process (hie-process)))
198+ (kill-process process)
199+ (hie-set-process nil )
200+ (kill-buffer hie-process-buffer)
201+ (setq hie-process-buffer nil ))))
114202
115203(defun hie-log (&rest args )
116204 (hie-with-log-buffer hie-log-buffer
@@ -127,12 +215,12 @@ by `hie-handle-message'."
127215 ; ; We remove values that are empty lists from assoc lists at the top
128216 ; ; level because json serialization would use "null" for those. HIE
129217 ; ; accepts missing fields and default to empty when possible.
130- (let ((prepared-json (hie-prepare-json json)))
218+ (let* ((prepared-json (hie-prepare-json json)))
131219 (run-hook-with-args 'hie-post-message-hook prepared-json)
132220 (hie-log " -> %s"
133- (process-send-string hie-process prepared-json)
221+ (process-send-string ( hie-process) prepared-json)
134222 ; ; send \STX marker and flush buffers
135- (process-send-string hie-process " \^ b\n "
223+ (process-send-string ( hie-process) " \^ b\n "
136224
137225(defun hie-remove-alist-null-values (json )
138226 " Remove null values from assoc lists.
@@ -194,7 +282,11 @@ association lists and count on HIE to use default values there."
194282 (save-excursion
195283 ,@body )
196284 (move-to-column old-col)
197- (goto-line old-row)))
285+ (move-to-line old-row)))
286+
287+ (defun move-to-line (N )
288+ (goto-char (point-min ))
289+ (forward-line (1- N)))
198290
199291(defun hie-handle-refactor (refactor )
200292 (-if-let (((&alist 'first first 'second second 'diff diff)) refactor)
0 commit comments