Add preliminary support for ghc-modi

after/ftplugin/haskell/ghcmod.vim

@@ -57,6 +57,7 @@ command! -buffer -nargs=0 -bang GhcModCheckAsync call ghcmod#command#async_make(
 command! -buffer -nargs=0 -bang GhcModLintAsync call ghcmod#command#async_make('lint', <bang>0)
 command! -buffer -nargs=0 -bang GhcModCheckAndLintAsync call ghcmod#command#check_and_lint_async(<bang>0)
 command! -buffer -nargs=0 -bang GhcModExpand call ghcmod#command#expand(<bang>0)
+command! -buffer -nargs=0 -bang GhcModKillModi call ghcmod#command#kill_modi(<bang>0)
 let b:undo_ftplugin .= join(map([
       \ 'GhcModType',
       \ 'GhcModTypeInsert',
@@ -68,7 +69,8 @@ let b:undo_ftplugin .= join(map([
       \ 'GhcModCheckAsync',
       \ 'GhcModLintAsync',
       \ 'GhcModCheckAndLintAsync',
-      \ 'GhcModExpand'
+      \ 'GhcModExpand',
+      \ 'GhcModKillModi'
       \ ], '"delcommand " . v:val'), ' | ')
 let b:undo_ftplugin .= ' | unlet b:did_ftplugin_ghcmod'
 

autoload/ghcmod.vim

@@ -1,3 +1,9 @@
+if !exists("g:ghcmod_should_use_ghc_modi")
+  let g:ghcmod_should_use_ghc_modi = 1
+endif
+
+let s:use_modi = g:ghcmod_should_use_ghc_modi && executable('ghc-modi') == 1
+
 function! ghcmod#highlight_group() "{{{
   return get(g:, 'ghcmod_type_highlight', 'Search')
 endfunction "}}}
@@ -15,17 +21,25 @@ function! ghcmod#getHaskellIdentifier() "{{{
 endfunction "}}}
 
 function! ghcmod#info(fexp, path, module) "{{{
-  let l:cmd = ghcmod#build_command(['info', "-b \n", a:path, a:module, a:fexp])
-  let l:output = ghcmod#system(l:cmd)
+  if s:use_modi
+    let l:output = join(s:modi_command(['info', a:path, a:fexp]), "\n")
+  else
+    let l:cmd = ghcmod#build_command(['info', "-b \n", a:path, a:module, a:fexp])
+    let l:output = ghcmod#system(l:cmd)
+  endif
   " Remove trailing newlines to prevent empty lines
   let l:output = substitute(l:output, '\n*$', '', '')
   " Remove 'Dummy:0:0:Error:' prefix.
   return substitute(l:output, '^Dummy:0:0:Error:', '', '')
 endfunction "}}}
 
 function! ghcmod#type(line, col, path, module) "{{{
-  let l:cmd = ghcmod#build_command(['type', a:path, a:module, a:line, a:col])
-  let l:output = ghcmod#system(l:cmd)
+  if s:use_modi
+    let l:output = join(s:modi_command(['type', a:path, a:line, a:col]), "\n")
+  else
+    let l:cmd = ghcmod#build_command(['type', a:path, a:module, a:line, a:col])
+    let l:output = ghcmod#system(l:cmd)
+  endif
   let l:types = []
   for l:line in split(l:output, '\n')
     let l:m = matchlist(l:line, '\(\d\+\) \(\d\+\) \(\d\+\) \(\d\+\) "\([^"]\+\)"')
@@ -232,7 +246,11 @@ function! ghcmod#add_autogen_dir(path, cmd) "{{{
 endfunction "}}}
 
 function! ghcmod#build_command(args) "{{{
-  let l:cmd = ['ghc-mod']
+  return s:build_command('ghc-mod', a:args)
+endfunction "}}}
+
+function! s:build_command(cmd, args) "{{{
+  let l:cmd = [a:cmd]
 
   let l:dist_top  = s:find_basedir() . '/dist'
   let l:sandboxes = split(glob(l:dist_top . '/dist-*', 1), '\n')
@@ -266,6 +284,44 @@ function! ghcmod#build_command(args) "{{{
   return l:cmd
 endfunction "}}}
 
+" Cache a handle to the ghc-modi process.
+let s:ghc_modi_proc = {}
+
+function! s:modi_command(args) "{{{
+  if s:ghc_modi_proc == {}
+    let l:ghcmodi_prog = s:build_command('ghc-modi', ["-b \n"])
+    lcd `=ghcmod#basedir()`
+    let s:ghc_modi_proc = vimproc#popen2(ghcmodi_prog)
+    lcd -
+  endif
+
+  call s:ghc_modi_proc.stdin.write(join(a:args) . "\n")
+
+  let l:res = []
+  while 1
+    for l:line in s:ghc_modi_proc.stdout.read_lines()
+      if l:line == "OK"
+        return l:res
+      elseif line =~ "^NG "
+        echoerr "ghc-modi terminated with message: " . join(l:res, "\n")
+        return ''
+      elseif len(line) > 0
+        let l:res += [l:line]
+      endif
+    endfor
+  endwhile
+endfunction "}}}
+
+function! ghcmod#kill_modi(sig) "{{{
+  if s:ghc_modi_proc == {}
+    return
+  endif
+  let l:ret = s:ghc_modi_proc.kill(a:sig)
+  call s:ghc_modi_proc.waitpid()
+  let s:ghc_modi_proc = {}
+  return l:ret
+endfunction "}}}
+
 function! ghcmod#system(...) "{{{
   lcd `=ghcmod#basedir()`
   let l:ret = call('vimproc#system', a:000)

autoload/ghcmod/command.vim

@@ -221,6 +221,18 @@ function! ghcmod#command#expand(force) "{{{
   call s:open_quickfix()
 endfunction "}}}
 
+function! ghcmod#command#kill_modi(force) "{{{
+  if a:force
+    let l:sig = g:vimproc#SIGKILL
+  else
+    let l:sig = g:vimproc#SIGTERM
+  endif
+  let l:ret = ghcmod#kill_modi(l:sig)
+  if l:ret
+    echoerr vimproc#get_last_errmsg()
+  endif
+endfunction "}}}
+
 function! s:open_quickfix() "{{{
   let l:func = get(g:, 'ghcmod_open_quickfix_function', '')
   if empty(l:func)

test.sh

@@ -2,21 +2,39 @@
 
 shopt -s nullglob
 
+run_tests() {
+    for f in $1
+    do
+      testname=${f#test/test_}
+      testname=${testname%.vim}
+      echo "Running $testname"
+      rm -f verbose.log
+      if vim -e -N -u NONE $2 -S test/before.vim -S "$f" < /dev/null; then
+        cat stdout.log
+      else
+        retval=$[retval + 1]
+        cat stdout.log
+        cat verbose.log
+        echo
+      fi
+    done
+}
+
 retval=0
-for f in test/test_*.vim
-do
-  testname=${f#test/test_}
-  testname=${testname%.vim}
-  echo "Running $testname"
-  rm -f verbose.log
-  if vim -e -N -u NONE -S test/before.vim -S "$f" < /dev/null; then
-    cat stdout.log
-  else
-    retval=$[retval + 1]
-    cat stdout.log
-    cat verbose.log
-    echo
-  fi
-done
+
+modonly_tests=(test/test_type.vim test/test_info.vim)
+
+run_tests "test/test_*.vim"
+
+# we cannot programmatically set this in our test case vimscripts as the
+# variable is fixed once the script is loaded
+echo "Setting ghcmod_should_use_ghc_modi=0"
+
+TMPFILE=`mktemp /tmp/test.XXXXXX` || exit 1
+echo "let g:ghcmod_should_use_ghc_modi=0" >> $TMPFILE
+
+run_tests "${modonly_tests[*]}" "-S $TMPFILE"
+
+rm -f $TMPFILE
 
 exit $retval

test/test_type.vim

@@ -20,4 +20,10 @@ function! s:unit.test_type_compilation_failure()
   call self.assert.empty(l:types)
 endfunction
 
+function! s:unit.test_kill_recovery()
+  call s:unit.test_type()
+  call ghcmod#kill_modi(9)
+  call s:unit.test_type()
+endfunction
+
 call s:unit.run()