diff --git a/after/ftplugin/haskell/ghcmod.vim b/after/ftplugin/haskell/ghcmod.vim index 5492baa..f453713 100644 --- a/after/ftplugin/haskell/ghcmod.vim +++ b/after/ftplugin/haskell/ghcmod.vim @@ -59,6 +59,7 @@ command! -buffer -nargs=0 -bang GhcModCheckAsync call ghcmod#command#async_make( command! -buffer -nargs=0 -bang GhcModLintAsync call ghcmod#command#async_make('lint', 0) command! -buffer -nargs=0 -bang GhcModCheckAndLintAsync call ghcmod#command#check_and_lint_async(0) command! -buffer -nargs=0 -bang GhcModExpand call ghcmod#command#expand(0) +command! -buffer -nargs=0 -bang GhcModKillModi call ghcmod#command#kill_modi(0) let b:undo_ftplugin .= join(map([ \ 'GhcModType', \ 'GhcModTypeInsert', @@ -72,7 +73,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' diff --git a/autoload/ghcmod.vim b/autoload/ghcmod.vim index 145c614..7df3396 100644 --- a/autoload/ghcmod.vim +++ b/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 + function! ghcmod#highlight_group() "{{{ return get(g:, 'ghcmod_type_highlight', 'Search') endfunction "}}} @@ -15,8 +21,8 @@ function! ghcmod#getHaskellIdentifier() "{{{ endfunction "}}} function! ghcmod#info(fexp, path, ...) "{{{ - let l:cmd = ghcmod#build_command(["-b \n", 'info', a:path, a:fexp]) - let l:output = ghcmod#system(l:cmd) + let l:lines = s:command(['info', a:path, a:fexp]) + let l:output = join(split(l:lines[0], '\\n'), "\n") " Remove trailing newlines to prevent empty lines let l:output = substitute(l:output, '\n*$', '', '') return s:remove_dummy_prefix(l:output) @@ -24,22 +30,20 @@ endfunction "}}} function! ghcmod#split(line, col, path, ...) "{{{ " `ghc-mod split` is available since v5.0.0. - let l:cmd = ghcmod#build_command(['split', a:path, a:line, a:col]) - let l:lines = s:system('split', l:cmd) + let l:lines = s:command(['split', a:path, a:line, a:col]) if empty(l:lines) return [] endif - let l:parsed = matchlist(l:lines[0], '\(\d\+\) \(\d\+\) \(\d\+\) \(\d\+\) "\(.*\)"') + let l:parsed = matchlist(l:lines[0], '^\(\d\+\) \(\d\+\) \(\d\+\) \(\d\+\) "\([^"]\+\)"$') if len(l:parsed) < 5 return [] endif - return split(l:parsed[5], '\n') + return split(l:parsed[5], '\\n') endfunction "}}} function! ghcmod#sig(line, col, path, ...) "{{{ " `ghc-mod sig` is available since v5.0.0. - let l:cmd = ghcmod#build_command(['sig', a:path, a:line, a:col]) - let l:lines = s:system('sig', l:cmd) + let l:lines = s:command(['sig', a:path, a:line, a:col]) if len(l:lines) < 3 return [] endif @@ -47,11 +51,10 @@ function! ghcmod#sig(line, col, path, ...) "{{{ endfunction "}}} function! ghcmod#type(line, col, path, ...) "{{{ - let l:cmd = ghcmod#build_command(['type', a:path, a:line, a:col]) - let l:output = ghcmod#system(l:cmd) + let l:lines = s:command(['type', a:path, a:line, a:col]) let l:types = [] - for l:line in split(l:output, '\n') - let l:m = matchlist(l:line, '\(\d\+\) \(\d\+\) \(\d\+\) \(\d\+\) "\([^"]\+\)"') + for l:line in l:lines + let l:m = matchlist(l:line, '^\(\d\+\) \(\d\+\) \(\d\+\) \(\d\+\) "\([^"]\+\)"$') if !empty(l:m) call add(l:types, [map(l:m[1 : 4], 'str2nr(v:val, 10)'), l:m[5]]) endif @@ -114,7 +117,7 @@ function! ghcmod#parse_make(lines, basedir) "{{{ else let l:qf.type = 'E' endif - let l:texts = split(l:rest, '\n') + let l:texts = split(l:rest, '\\n') if len(l:texts) > 0 let l:qf.text = l:texts[0] call add(l:qflist, l:qf) @@ -135,21 +138,21 @@ function! ghcmod#parse_make(lines, basedir) "{{{ return l:qflist endfunction "}}} -function! s:build_make_command(type, path) "{{{ - let l:cmd = ghcmod#build_command([a:type]) +function! s:build_make_args(type, path) "{{{ + let l:args = [a:type] if a:type ==# 'lint' for l:hopt in get(g:, 'ghcmod_hlint_options', []) - call extend(l:cmd, ['-h', l:hopt]) + call extend(l:args, ['-h', l:hopt]) endfor endif - call add(l:cmd, a:path) - return l:cmd + call add(l:args, a:path) + return l:args endfunction "}}} function! ghcmod#make(type, path) "{{{ try - let l:args = s:build_make_command(a:type, a:path) - return ghcmod#parse_make(s:system(a:type, l:args), b:ghcmod_basedir) + let l:lines = s:command(s:build_make_args(a:type, a:path)) + return ghcmod#parse_make(l:lines, b:ghcmod_basedir) catch call ghcmod#util#print_error(printf('%s %s', v:throwpoint, v:exception)) endtry @@ -157,7 +160,7 @@ endfunction "}}} function! ghcmod#async_make(type, path, callback) "{{{ let l:tmpfile = tempname() - let l:args = s:build_make_command(a:type, a:path) + let l:args = ghcmod#build_command(s:build_make_args(a:type, a:path)) let l:proc = s:plineopen3([{'args': l:args, 'fd': { 'stdin': '', 'stdout': l:tmpfile, 'stderr': '' }}]) let l:obj = { \ 'proc': l:proc, @@ -183,8 +186,7 @@ function! ghcmod#expand(path) "{{{ let l:dir = fnamemodify(a:path, ':h') let l:qflist = [] - let l:cmd = ghcmod#build_command(['expand', "-b '\n'", a:path]) - for l:line in split(ghcmod#system(l:cmd), '\n') + for l:line in s:command(['expand', a:path]) let l:line = s:remove_dummy_prefix(l:line) " path:line:col1-col2: message @@ -245,7 +247,7 @@ function! ghcmod#add_autogen_dir(path, cmd) "{{{ endfunction "}}} function! ghcmod#build_command(args) "{{{ - let l:cmd = ['ghc-mod', '--silent'] + let l:cmd = ['ghc-mod', '--silent', '-b\\n'] let l:dist_top = s:find_basedir() . '/dist' let l:sandboxes = split(glob(l:dist_top . '/dist-*', 1), '\n') @@ -279,6 +281,57 @@ function! ghcmod#build_command(args) "{{{ return l:cmd endfunction "}}} +" Cache a handle to the ghc-modi process. +let s:ghc_modi_procs = {} + +function! s:modi_command(args) "{{{ + let l:basedir = ghcmod#basedir() + + if has_key(s:ghc_modi_procs, l:basedir) + let l:ghc_modi_proc = s:ghc_modi_procs[l:basedir] + else + let l:ghc_modi_prog = ghcmod#build_command(["legacy-interactive"]) + let l:ghc_modi_proc = s:plineopen3([{'args': l:ghc_modi_prog, 'fd': { 'stdin': '', 'stdout': '', 'stderr': '/dev/null' }}]) + let s:ghc_modi_procs[l:basedir] = l:ghc_modi_proc + endif + + call l:ghc_modi_proc.stdin.write("ascii-escape " . join(map(copy(a:args), '"\2" . v:val . "\3"')) . "\n") + + let l:res = [] + while 1 + for l:line in l: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! s:command(args) "{{{ + if s:use_modi + return s:modi_command(a:args) + else + return s:system(a:args[0], ghcmod#build_command(a:args)) + endif +endfunction "}}} + +function! ghcmod#kill_modi(sig) "{{{ + let l:basedir = ghcmod#basedir() + + if has_key(s:ghc_modi_procs, l:basedir) + let l:ghc_modi_proc = s:ghc_modi_procs[l:basedir] + let l:ret = l:ghc_modi_proc.kill(a:sig) + call l:ghc_modi_proc.waitpid() + unlet s:ghc_modi_procs[l:basedir] + return l:ret + endif +endfunction "}}} + function! ghcmod#system(...) "{{{ let l:dir = getcwd() try @@ -308,7 +361,7 @@ function! s:system(type, args) "{{{ let [l:cond, l:status] = ghcmod#util#wait(l:proc) let l:tries = 1 while l:cond ==# 'run' - if l:tries >= 50 + if l:tries >= 500 call l:proc.kill(15) " SIGTERM call l:proc.waitpid() throw printf('ghcmod#make: `ghc-mod %s` takes too long time!', a:type) diff --git a/autoload/ghcmod/command.vim b/autoload/ghcmod/command.vim index d8541a7..49ac0b9 100644 --- a/autoload/ghcmod/command.vim +++ b/autoload/ghcmod/command.vim @@ -257,6 +257,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#SIGINT + 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) diff --git a/test.sh b/test.sh index d409fa3..1fd7112 100755 --- a/test.sh +++ b/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_{expand,check,info,lint,split,type,command_check,command_sig_codegen,command_split,command_type}.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 diff --git a/test/test_build_command.vim b/test/test_build_command.vim index d94e416..ac464e1 100644 --- a/test/test_build_command.vim +++ b/test/test_build_command.vim @@ -10,14 +10,14 @@ endfunction function! s:unit.test_build() edit test/data/without-cabal/Foo/Bar.hs - call self.assert.equal(['ghc-mod', 'do'], s:build()) + call self.assert.equal(['ghc-mod', '--silent', '-b\\n', 'do'], s:build()) endfunction function! s:unit.test_build_with_dist_dir() try call system('cd test/data/with-cabal; cabal configure; cabal build') edit test/data/with-cabal/src/Foo/Bar.hs - call self.assert.equal(['ghc-mod', + call self.assert.equal(['ghc-mod', '--silent', '-b\\n', \ '-g', '-i' . fnamemodify('test/data/with-cabal/dist/build/autogen', ':p:h'), \ '-g', '-I' . fnamemodify('test/data/with-cabal/dist/build/autogen', ':p:h'), \ '-g', '-optP-include', @@ -34,7 +34,7 @@ function! s:unit.test_build_global_opt() let g:ghcmod_ghc_options = ['-Wall'] try edit test/data/without-cabal/Main.hs - call self.assert.equal(['ghc-mod', '-g', '-Wall', 'do'], s:build()) + call self.assert.equal(['ghc-mod', '--silent', '-b\\n', '-g', '-Wall', 'do'], s:build()) finally unlet g:ghcmod_ghc_options endtry @@ -46,7 +46,7 @@ function! s:unit.test_build_buffer_opt() let g:ghcmod_ghc_options = ['-Wall'] try let b:ghcmod_ghc_options = ['-W'] - call self.assert.equal(['ghc-mod', '-g', '-W', 'do'], s:build()) + call self.assert.equal(['ghc-mod', '--silent', '-b\\n', '-g', '-W', 'do'], s:build()) finally unlet g:ghcmod_ghc_options endtry diff --git a/test/test_lint.vim b/test/test_lint.vim index 099a4de..01aac06 100644 --- a/test/test_lint.vim +++ b/test/test_lint.vim @@ -59,7 +59,7 @@ function! s:unit.test_lint() \ 'lnum': 5, \ 'col': 9, \ 'filename': 'test/data/with-cabal/src/Foo/Bar.hs', - \ 'text': 'Redundant $', + \ 'text': 'Suggestion: Redundant $', \ }), l:qflist) endfunction @@ -76,7 +76,7 @@ function! s:unit.test_lint_whitespace() \ 'lnum': 5, \ 'col': 9, \ 'filename': 'test/data/with whitespace/src/Foo/Bar.hs', - \ 'text': 'Redundant $', + \ 'text': 'Suggestion: Redundant $', \ }), l:qflist) endfunction @@ -95,7 +95,7 @@ function! s:unit.test_lint_async() \ 'lnum': 5, \ 'col': 9, \ 'filename': 'test/data/with-cabal/src/Foo/Bar.hs', - \ 'text': 'Redundant $', + \ 'text': 'Suggestion: Redundant $', \ }), a:qflist) endfunction call s:async(l:callback) @@ -111,7 +111,7 @@ function! s:unit.test_lint_opt() \ 'lnum': 5, \ 'col': 9, \ 'filename': 'test/data/with-cabal/src/Foo/Bar.hs', - \ 'text': 'Redundant $', + \ 'text': 'Suggestion: Redundant $', \ }), l:qflist) finally unlet g:ghcmod_hlint_options @@ -130,7 +130,7 @@ function! s:unit.test_lint_async_opt() \ 'lnum': 5, \ 'col': 9, \ 'filename': 'test/data/with-cabal/src/Foo/Bar.hs', - \ 'text': 'Redundant $', + \ 'text': 'Suggestion: Redundant $', \ }), a:qflist) endfunction call s:async(l:callback) diff --git a/test/test_type.vim b/test/test_type.vim index 7e38c05..c6e8547 100644 --- a/test/test_type.vim +++ b/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()