/vim/haskellmode-20090430.vba
Visual Basic | 2035 lines | 1829 code | 205 blank | 1 comment | 339 complexity | 43f70636eecf1e84667405319ffe8e58 MD5 | raw file
Large files files are truncated, but you can click here to view the full file
1" Vimball Archiver by Charles E. Campbell, Jr., Ph.D.
2UseVimball
3finish
4compiler/ghc.vim [[[1
5479
6
7" Vim Compiler File
8" Compiler: GHC
9" Maintainer: Claus Reinke <claus.reinke@talk21.com>
10" Last Change: 30/04/2009
11"
12" part of haskell plugins: http://projects.haskell.org/haskellmode-vim
13
14" ------------------------------ paths & quickfix settings first
15"
16
17if exists("current_compiler") && current_compiler == "ghc"
18 finish
19endif
20let current_compiler = "ghc"
21
22let s:scriptname = "ghc.vim"
23
24if (!exists("g:ghc") || !executable(g:ghc))
25 if !executable('ghc')
26 echoerr s:scriptname.": can't find ghc. please set g:ghc, or extend $PATH"
27 finish
28 else
29 let g:ghc = 'ghc'
30 endif
31endif
32let ghc_version = substitute(system(g:ghc . ' --numeric-version'),'\n','','')
33if (!exists("b:ghc_staticoptions"))
34 let b:ghc_staticoptions = ''
35endif
36
37" set makeprg (for quickfix mode)
38execute 'setlocal makeprg=' . g:ghc . '\ ' . escape(b:ghc_staticoptions,' ') .'\ -e\ :q\ %'
39"execute 'setlocal makeprg=' . g:ghc .'\ -e\ :q\ %'
40"execute 'setlocal makeprg=' . g:ghc .'\ --make\ %'
41
42" quickfix mode:
43" fetch file/line-info from error message
44" TODO: how to distinguish multiline errors from warnings?
45" (both have the same header, and errors have no common id-tag)
46" how to get rid of first empty message in result list?
47setlocal errorformat=
48 \%-Z\ %#,
49 \%W%f:%l:%c:\ Warning:\ %m,
50 \%E%f:%l:%c:\ %m,
51 \%E%>%f:%l:%c:,
52 \%+C\ \ %#%m,
53 \%W%>%f:%l:%c:,
54 \%+C\ \ %#%tarning:\ %m,
55
56" oh, wouldn't you guess it - ghc reports (partially) to stderr..
57setlocal shellpipe=2>
58
59" ------------------------- but ghc can do a lot more for us..
60"
61
62" allow map leader override
63if !exists("maplocalleader")
64 let maplocalleader='_'
65endif
66
67" initialize map of identifiers to their types
68" associate type map updates to changedtick
69if !exists("b:ghc_types")
70 let b:ghc_types = {}
71 let b:my_changedtick = b:changedtick
72endif
73
74if exists("g:haskell_functions")
75 finish
76endif
77let g:haskell_functions = "ghc"
78
79" avoid hit-enter prompts
80set cmdheight=3
81
82" edit static GHC options
83" TODO: add completion for options/packages?
84command! GHCStaticOptions call GHC_StaticOptions()
85function! GHC_StaticOptions()
86 let b:ghc_staticoptions = input('GHC static options: ',b:ghc_staticoptions)
87 execute 'setlocal makeprg=' . g:ghc . '\ ' . escape(b:ghc_staticoptions,' ') .'\ -e\ :q\ %'
88 let b:my_changedtick -=1
89endfunction
90
91map <LocalLeader>T :call GHC_ShowType(1)<cr>
92map <LocalLeader>t :call GHC_ShowType(0)<cr>
93function! GHC_ShowType(addTypeDecl)
94 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
95 if namsym==[]
96 redraw
97 echo 'no name/symbol under cursor!'
98 return 0
99 endif
100 let [_,symb,qual,unqual] = namsym
101 let name = qual=='' ? unqual : qual.'.'.unqual
102 let pname = ( symb ? '('.name.')' : name )
103 call GHC_HaveTypes()
104 if !has_key(b:ghc_types,name)
105 redraw
106 echo pname "type not known"
107 else
108 redraw
109 for type in split(b:ghc_types[name],' -- ')
110 echo pname "::" type
111 if a:addTypeDecl
112 call append( line(".")-1, pname . " :: " . type )
113 endif
114 endfor
115 endif
116endfunction
117
118" show type of identifier under mouse pointer in balloon
119if has("balloon_eval")
120 set ballooneval
121 set balloondelay=600
122 set balloonexpr=GHC_TypeBalloon()
123 function! GHC_TypeBalloon()
124 if exists("b:current_compiler") && b:current_compiler=="ghc"
125 let [line] = getbufline(v:beval_bufnr,v:beval_lnum)
126 let namsym = haskellmode#GetNameSymbol(line,v:beval_col,0)
127 if namsym==[]
128 return ''
129 endif
130 let [start,symb,qual,unqual] = namsym
131 let name = qual=='' ? unqual : qual.'.'.unqual
132 let pname = name " ( symb ? '('.name.')' : name )
133 silent call GHC_HaveTypes()
134 if has("balloon_multiline")
135 return (has_key(b:ghc_types,pname) ? split(b:ghc_types[pname],' -- ') : '')
136 else
137 return (has_key(b:ghc_types,pname) ? b:ghc_types[pname] : '')
138 endif
139 else
140 return ''
141 endif
142 endfunction
143endif
144
145map <LocalLeader>si :call GHC_ShowInfo()<cr>
146function! GHC_ShowInfo()
147 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
148 if namsym==[]
149 redraw
150 echo 'no name/symbol under cursor!'
151 return 0
152 endif
153 let [_,symb,qual,unqual] = namsym
154 let name = qual=='' ? unqual : (qual.'.'.unqual)
155 let output = GHC_Info(name)
156 pclose | new
157 setlocal previewwindow
158 setlocal buftype=nofile
159 setlocal noswapfile
160 put =output
161 wincmd w
162 "redraw
163 "echo output
164endfunction
165
166" fill the type map, unless nothing has changed since the last attempt
167function! GHC_HaveTypes()
168 if b:ghc_types == {} && (b:my_changedtick != b:changedtick)
169 let b:my_changedtick = b:changedtick
170 return GHC_BrowseAll()
171 endif
172endfunction
173
174" update b:ghc_types after successful make
175au QuickFixCmdPost make if GHC_CountErrors()==0 | silent call GHC_BrowseAll() | endif
176
177" count only error entries in quickfix list, ignoring warnings
178function! GHC_CountErrors()
179 let c=0
180 for e in getqflist() | if e.type=='E' && e.text !~ "^[ \n]*Warning:" | let c+=1 | endif | endfor
181 return c
182endfunction
183
184command! GHCReload call GHC_BrowseAll()
185function! GHC_BrowseAll()
186 " let imports = haskellmode#GatherImports()
187 " let modules = keys(imports[0]) + keys(imports[1])
188 let imports = {} " no need for them at the moment
189 let current = GHC_NameCurrent()
190 let module = current==[] ? 'Main' : current[0]
191 if GHC_VersionGE([6,8,1])
192 return GHC_BrowseBangStar(module)
193 else
194 return GHC_BrowseMultiple(imports,['*'.module])
195 endif
196endfunction
197
198function! GHC_VersionGE(target)
199 let current = split(g:ghc_version, '\.' )
200 let target = a:target
201 for i in current
202 if ((target==[]) || (i>target[0]))
203 return 1
204 elseif (i==target[0])
205 let target = target[1:]
206 else
207 return 0
208 endif
209 endfor
210 return 1
211endfunction
212
213function! GHC_NameCurrent()
214 let last = line("$")
215 let l = 1
216 while l<last
217 let ml = matchlist( getline(l), '^module\s*\([^ (]*\)')
218 if ml != []
219 let [_,module;x] = ml
220 return [module]
221 endif
222 let l += 1
223 endwhile
224 redraw
225 echo "cannot find module header for file " . expand("%")
226 return []
227endfunction
228
229function! GHC_BrowseBangStar(module)
230 redraw
231 echo "browsing module " a:module
232 let command = ":browse! *" . a:module
233 let orig_shellredir = &shellredir
234 let &shellredir = ">" " ignore error/warning messages, only output or lack of it
235 let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -v0 --interactive ' . expand("%") , command )
236 let &shellredir = orig_shellredir
237 return GHC_ProcessBang(a:module,output)
238endfunction
239
240function! GHC_BrowseMultiple(imports,modules)
241 redraw
242 echo "browsing modules " a:modules
243 let command = ":browse " . join( a:modules, " \n :browse ")
244 let command = substitute(command,'\(:browse \(\S*\)\)','putStrLn "-- \2" \n \1','g')
245 let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -v0 --interactive ' . expand("%") , command )
246 return GHC_Process(a:imports,output)
247endfunction
248
249function! GHC_Info(what)
250 " call GHC_HaveTypes()
251 let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -v0 --interactive ' . expand("%"), ":i ". a:what)
252 return output
253endfunction
254
255function! GHC_ProcessBang(module,output)
256 let module = a:module
257 let b = a:output
258 let linePat = '^\(.\{-}\)\n\(.*\)'
259 let contPat = '\s\+\(.\{-}\)\n\(.*\)'
260 let typePat = '^\(\)\(\S*\)\s*::\(.*\)'
261 let commentPat = '^-- \(\S*\)'
262 let definedPat = '^-- defined locally'
263 let importedPat = '^-- imported via \(.*\)'
264 if !(b=~commentPat)
265 echo s:scriptname.": GHCi reports errors (try :make?)"
266 return 0
267 endif
268 let b:ghc_types = {}
269 let ml = matchlist( b , linePat )
270 while ml != []
271 let [_,l,rest;x] = ml
272 let mlDecl = matchlist( l, typePat )
273 if mlDecl != []
274 let [_,indent,id,type;x] = mlDecl
275 let ml2 = matchlist( rest , '^'.indent.contPat )
276 while ml2 != []
277 let [_,c,rest;x] = ml2
278 let type .= c
279 let ml2 = matchlist( rest , '^'.indent.contPat )
280 endwhile
281 let id = substitute( id, '^(\(.*\))$', '\1', '')
282 let type = substitute( type, '\s\+', " ", "g" )
283 " using :browse! *<current>, we get both unqualified and qualified ids
284 let qualified = (id =~ '\.') && (id =~ '[A-Z]')
285 let b:ghc_types[id] = type
286 if !qualified
287 for qual in qualifiers
288 let b:ghc_types[qual.'.'.id] = type
289 endfor
290 endif
291 else
292 let mlImported = matchlist( l, importedPat )
293 let mlDefined = matchlist( l, definedPat )
294 if mlImported != []
295 let [_,modules;x] = mlImported
296 let qualifiers = split( modules, ', ' )
297 elseif mlDefined != []
298 let qualifiers = [module]
299 endif
300 endif
301 let ml = matchlist( rest , linePat )
302 endwhile
303 return 1
304endfunction
305
306function! GHC_Process(imports,output)
307 let b = a:output
308 let imports = a:imports
309 let linePat = '^\(.\{-}\)\n\(.*\)'
310 let contPat = '\s\+\(.\{-}\)\n\(.*\)'
311 let typePat = '^\(\s*\)\(\S*\)\s*::\(.*\)'
312 let modPat = '^-- \(\S*\)'
313 " add '-- defined locally' and '-- imported via ..'
314 if !(b=~modPat)
315 echo s:scriptname.": GHCi reports errors (try :make?)"
316 return 0
317 endif
318 let b:ghc_types = {}
319 let ml = matchlist( b , linePat )
320 while ml != []
321 let [_,l,rest;x] = ml
322 let mlDecl = matchlist( l, typePat )
323 if mlDecl != []
324 let [_,indent,id,type;x] = mlDecl
325 let ml2 = matchlist( rest , '^'.indent.contPat )
326 while ml2 != []
327 let [_,c,rest;x] = ml2
328 let type .= c
329 let ml2 = matchlist( rest , '^'.indent.contPat )
330 endwhile
331 let id = substitute(id, '^(\(.*\))$', '\1', '')
332 let type = substitute( type, '\s\+', " ", "g" )
333 " using :browse *<current>, we get both unqualified and qualified ids
334 if current_module " || has_key(imports[0],module)
335 if has_key(b:ghc_types,id) && !(matchstr(b:ghc_types[id],escape(type,'[].'))==type)
336 let b:ghc_types[id] .= ' -- '.type
337 else
338 let b:ghc_types[id] = type
339 endif
340 endif
341 if 0 " has_key(imports[1],module)
342 let qualid = module.'.'.id
343 let b:ghc_types[qualid] = type
344 endif
345 else
346 let mlMod = matchlist( l, modPat )
347 if mlMod != []
348 let [_,module;x] = mlMod
349 let current_module = module[0]=='*'
350 let module = current_module ? module[1:] : module
351 endif
352 endif
353 let ml = matchlist( rest , linePat )
354 endwhile
355 return 1
356endfunction
357
358let s:ghc_templates = ["module _ () where","class _ where","class _ => _ where","instance _ where","instance _ => _ where","type family _","type instance _ = ","data _ = ","newtype _ = ","type _ = "]
359
360" use ghci :browse index for insert mode omnicompletion (CTRL-X CTRL-O)
361function! GHC_CompleteImports(findstart, base)
362 if a:findstart
363 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),-1) " insert-mode: we're 1 beyond the text
364 if namsym==[]
365 redraw
366 echo 'no name/symbol under cursor!'
367 return -1
368 endif
369 let [start,symb,qual,unqual] = namsym
370 return (start-1)
371 else " find keys matching with "a:base"
372 let res = []
373 let l = len(a:base)-1
374 call GHC_HaveTypes()
375 for key in keys(b:ghc_types)
376 if key[0 : l]==a:base
377 let res += [{"word":key,"menu":":: ".b:ghc_types[key],"dup":1}]
378 endif
379 endfor
380 return res
381 endif
382endfunction
383set omnifunc=GHC_CompleteImports
384"
385" Vim's default completeopt is menu,preview
386" you probably want at least menu, or you won't see alternatives listed
387" setlocal completeopt+=menu
388
389" menuone is useful, but other haskellmode menus will try to follow your choice here in future
390" setlocal completeopt+=menuone
391
392" longest sounds useful, but doesn't seem to do what it says, and interferes with CTRL-E
393" setlocal completeopt-=longest
394
395map <LocalLeader>ct :call GHC_CreateTagfile()<cr>
396function! GHC_CreateTagfile()
397 redraw
398 echo "creating tags file"
399 let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -e ":ctags" ' . expand("%"))
400 " for ghcs older than 6.6, you would need to call another program
401 " here, such as hasktags
402 echo output
403endfunction
404
405command! -nargs=1 GHCi redraw | echo system(g:ghc. ' ' . b:ghc_staticoptions .' '.expand("%").' -e "'.escape(<f-args>,'"').'"')
406
407" use :make 'not in scope' errors to explicitly list imported ids
408" cursor needs to be on import line, in correctly loadable module
409map <LocalLeader>ie :call GHC_MkImportsExplicit()<cr>
410function! GHC_MkImportsExplicit()
411 let save_cursor = getpos(".")
412 let line = getline('.')
413 let lineno = line('.')
414 let ml = matchlist(line,'^import\(\s*qualified\)\?\s*\([^( ]\+\)')
415 if ml!=[]
416 let [_,q,mod;x] = ml
417 silent make
418 if getqflist()==[]
419 if line=~"import[^(]*Prelude"
420 call setline(lineno,substitute(line,"(.*","","").'()')
421 else
422 call setline(lineno,'-- '.line)
423 endif
424 silent write
425 silent make
426 let qflist = getqflist()
427 call setline(lineno,line)
428 silent write
429 let ids = {}
430 for d in qflist
431 let ml = matchlist(d.text,'Not in scope: \([^`]*\)`\([^'']*\)''')
432 if ml!=[]
433 let [_,what,qid;x] = ml
434 let id = ( qid =~ "^[A-Z]" ? substitute(qid,'.*\.\([^.]*\)$','\1','') : qid )
435 let pid = ( id =~ "[a-zA-Z0-9_']\\+" ? id : '('.id.')' )
436 if what =~ "data"
437 call GHC_HaveTypes()
438 if has_key(b:ghc_types,id)
439 let pid = substitute(b:ghc_types[id],'^.*->\s*\(\S*\).*$','\1','').'('.pid.')'
440 else
441 let pid = '???('.pid.')'
442 endif
443 endif
444 let ids[pid] = 1
445 endif
446 endfor
447 call setline(lineno,'import'.q.' '.mod.'('.join(keys(ids),',').')')
448 else
449 copen
450 endif
451 endif
452 call setpos('.', save_cursor)
453endfunction
454
455if GHC_VersionGE([6,8,2])
456 let opts = filter(split(substitute(system(g:ghc . ' -v0 --interactive', ':set'), ' ', '','g'), '\n'), 'v:val =~ "-f"')
457else
458 let opts = ["-fglasgow-exts","-fallow-undecidable-instances","-fallow-overlapping-instances","-fno-monomorphism-restriction","-fno-mono-pat-binds","-fno-cse","-fbang-patterns","-funbox-strict-fields"]
459endif
460
461amenu ]OPTIONS_GHC.- :echo '-'<cr>
462aunmenu ]OPTIONS_GHC
463for o in opts
464 exe 'amenu ]OPTIONS_GHC.'.o.' :call append(0,"{-# OPTIONS_GHC '.o.' #-}")<cr>'
465endfor
466if has("gui_running")
467 map <LocalLeader>opt :popup ]OPTIONS_GHC<cr>
468else
469 map <LocalLeader>opt :emenu ]OPTIONS_GHC.
470endif
471
472amenu ]LANGUAGES_GHC.- :echo '-'<cr>
473aunmenu ]LANGUAGES_GHC
474if GHC_VersionGE([6,8])
475 let ghc_supported_languages = split(system(g:ghc . ' --supported-languages'),'\n')
476 for l in ghc_supported_languages
477 exe 'amenu ]LANGUAGES_GHC.'.l.' :call append(0,"{-# LANGUAGE '.l.' #-}")<cr>'
478 endfor
479 if has("gui_running")
480 map <LocalLeader>lang :popup ]LANGUAGES_GHC<cr>
481 else
482 map <LocalLeader>lang :emenu ]LANGUAGES_GHC.
483 endif
484endif
485ftplugin/haskell.vim [[[1
48614
487"
488" general Haskell source settings
489" (shared functions are in autoload/haskellmode.vim)
490"
491" (Claus Reinke, last modified: 28/04/2009)
492"
493" part of haskell plugins: http://projects.haskell.org/haskellmode-vim
494" please send patches to <claus.reinke@talk21.com>
495
496" try gf on import line, or ctrl-x ctrl-i, or [I, [i, ..
497setlocal include=^import\\s*\\(qualified\\)\\?\\s*
498setlocal includeexpr=substitute(v:fname,'\\.','/','g').'.'
499setlocal suffixesadd=hs,lhs,hsc
500
501ftplugin/haskell_doc.vim [[[1
502837
503"
504" use haddock docs and index files
505" show documentation, complete & qualify identifiers
506"
507" (Claus Reinke; last modified: 30/04/2009)
508"
509" part of haskell plugins: http://projects.haskell.org/haskellmode-vim
510" please send patches to <claus.reinke@talk21.com>
511
512" :Doc <name> and :IDoc <name> open haddocks for <name> in opera
513"
514" :Doc needs qualified name (default Prelude) and package (default base)
515" :IDoc needs unqualified name, looks up possible links in g:haddock_index
516"
517" :DocIndex populates g:haddock_index from haddock's index files
518" :ExportDocIndex saves g:haddock_index to cache file
519" :ImportDocIndex reloads g:haddock_index from cache file
520"
521" all the following use the haddock index (g:haddock_index)
522"
523" _? opens haddocks for unqualified name under cursor,
524" suggesting alternative full qualifications in popup menu
525"
526" _. fully qualifies unqualified name under cursor,
527" suggesting alternative full qualifications in popup menu
528"
529" _i add import <module>(<name>) statement for unqualified <name> under cursor,
530" _im add import <module> statement for unqualified <name> under cursor,
531" suggesting alternative full qualifications in popup menu
532" (this currently adds one statement per call, instead of
533" merging into existing import statements, but it's a start;-)
534"
535" CTRL-X CTRL-U (user-defined insert mode completion)
536" suggests completions of unqualified names in popup menu
537
538let s:scriptname = "haskell_doc.vim"
539
540" script parameters
541" g:haddock_browser *mandatory* which browser to call
542" g:haddock_browser_callformat [optional] how to call browser
543" g:haddock_indexfiledir [optional] where to put 'haddock_index.vim'
544" g:haddock_docdir [optional] where to find html docs
545" g:ghc [optional] which ghc to call
546" g:ghc_pkg [optional] which ghc_pkg to call
547
548" been here before?
549if exists("g:haddock_index")
550 finish
551endif
552
553" initialise nested dictionary, to be populated
554" - from haddock index files via :DocIndex
555" - from previous cached version via :ImportDocIndex
556let g:haddock_index = {}
557
558" initialise dictionary, mapping modules with haddocks to their packages,
559" populated via MkHaddockModuleIndex() or HaveModuleIndex()
560let g:haddock_moduleindex = {}
561
562" program to open urls, please set this in your vimrc
563 "examples (for windows):
564 "let g:haddock_browser = "C:/Program Files/Opera/Opera.exe"
565 "let g:haddock_browser = "C:/Program Files/Mozilla Firefox/firefox.exe"
566 "let g:haddock_browser = "C:/Program Files/Internet Explorer/IEXPLORE.exe"
567if !exists("g:haddock_browser")
568 echoerr s:scriptname." WARNING: please set g:haddock_browser!"
569endif
570
571if (!exists("g:ghc") || !executable(g:ghc))
572 if !executable('ghc')
573 echoerr s:scriptname." can't find ghc. please set g:ghc, or extend $PATH"
574 finish
575 else
576 let g:ghc = 'ghc'
577 endif
578endif
579
580if (!exists("g:ghc_pkg") || !executable(g:ghc_pkg))
581 let g:ghc_pkg = substitute(g:ghc,'\(.*\)ghc','\1ghc-pkg','')
582endif
583
584if exists("g:haddock_docdir") && isdirectory(g:haddock_docdir)
585 let s:docdir = g:haddock_docdir
586elseif executable(g:ghc_pkg)
587" try to figure out location of html docs
588" first choice: where the base docs are (from the first base listed)
589 let [field;x] = split(system(g:ghc_pkg . ' field base haddock-html'),'\n')
590 let field = substitute(field,'haddock-html: \(.*\)libraries.base','\1','')
591 let field = substitute(field,'\\','/','g')
592 let alternate = substitute(field,'html','doc/html','')
593 if isdirectory(field)
594 let s:docdir = field
595 elseif isdirectory(alternate)
596 let s:docdir = alternate
597 endif
598else
599 echoerr s:scriptname." can't find ghc-pkg (set g:ghc_pkg ?)."
600endif
601
602" second choice: try some known suspects for windows/unix
603if !exists('s:docdir') || !isdirectory(s:docdir)
604 let s:ghc_libdir = substitute(system(g:ghc . ' --print-libdir'),'\n','','')
605 let location1a = s:ghc_libdir . '/doc/html/'
606 let location1b = s:ghc_libdir . '/doc/'
607 let s:ghc_version = substitute(system(g:ghc . ' --numeric-version'),'\n','','')
608 let location2 = '/usr/share/doc/ghc-' . s:ghc_version . '/html/'
609 if isdirectory(location1a)
610 let s:docdir = location1a
611 elseif isdirectory(location1b)
612 let s:docdir = location1b
613 elseif isdirectory(location2)
614 let s:docdir = location2
615 else " give up
616 echoerr s:scriptname." can't find locaton of html documentation (set g:haddock_docdir)."
617 finish
618 endif
619endif
620
621" todo: can we turn s:docdir into a list of paths, and
622" include docs for third-party libs as well?
623
624let s:libraries = s:docdir . 'libraries/'
625let s:guide = s:docdir . 'users_guide/'
626let s:index = 'index.html'
627if exists("g:haddock_indexfiledir") && filewritable(g:haddock_indexfiledir)
628 let s:haddock_indexfiledir = g:haddock_indexfiledir
629elseif filewritable(s:libraries)
630 let s:haddock_indexfiledir = s:libraries
631elseif filewritable($HOME)
632 let s:haddock_indexfiledir = $HOME.'/'
633else "give up
634 echoerr s:scriptname." can't locate index file. please set g:haddock_indexfiledir"
635 finish
636endif
637let s:haddock_indexfile = s:haddock_indexfiledir . 'haddock_index.vim'
638
639" different browser setups require different call formats;
640" you might want to call the browser synchronously or
641" asynchronously, and the latter is os-dependent;
642"
643" by default, the browser is started in the background when on
644" windows or if running in a gui, and in the foreground otherwise
645" (eg, console-mode for remote sessions, with text-mode browsers).
646"
647" you can override these defaults in your vimrc, via a format
648" string including 2 %s parameters (the first being the browser
649" to call, the second being the url).
650if !exists("g:haddock_browser_callformat")
651 if has("win32") || has("win64")
652 let g:haddock_browser_callformat = 'start %s "%s"'
653 else
654 if has("gui_running")
655 let g:haddock_browser_callformat = '%s %s '.printf(&shellredir,'/dev/null').' &'
656 else
657 let g:haddock_browser_callformat = '%s %s'
658 endif
659 endif
660endif
661
662" allow map leader override
663if !exists("maplocalleader")
664 let maplocalleader='_'
665endif
666
667command! DocSettings call DocSettings()
668function! DocSettings()
669 for v in ["g:haddock_browser","g:haddock_browser_callformat","g:haddock_docdir","g:haddock_indexfiledir","s:ghc_libdir","s:ghc_version","s:docdir","s:libraries","s:guide","s:haddock_indexfile"]
670 if exists(v)
671 echo v '=' eval(v)
672 else
673 echo v '='
674 endif
675 endfor
676endfunction
677
678function! DocBrowser(url)
679 "echomsg "DocBrowser(".url.")"
680 if (!exists("g:haddock_browser") || !executable(g:haddock_browser))
681 echoerr s:scriptname." can't find documentation browser. please set g:haddock_browser"
682 return
683 endif
684 " start browser to open url, according to specified format
685 let url = a:url=~'^\(file://\|http://\)' ? a:url : 'file://'.a:url
686 silent exe '!'.printf(g:haddock_browser_callformat,g:haddock_browser,escape(url,'#%'))
687endfunction
688
689"Doc/Doct are an old interface for documentation lookup
690"(that is the reason they are not documented!-)
691"
692"These uses are still fine at the moment, and are the reason
693"that this command still exists at all
694"
695" :Doc -top
696" :Doc -libs
697" :Doc -guide
698"
699"These uses may or may not work, and shouldn't be relied on anymore
700"(usually, you want _?/_?1/_?2 or :MDoc; there is also :IDoc)
701"
702" :Doc length
703" :Doc Control.Monad.when
704" :Doc Data.List.
705" :Doc Control.Monad.State.runState mtl
706command! -nargs=+ Doc call Doc('v',<f-args>)
707command! -nargs=+ Doct call Doc('t',<f-args>)
708
709function! Doc(kind,qualname,...)
710 let suffix = '.html'
711 let relative = '#'.a:kind.'%3A'
712
713 if a:qualname=="-top"
714 call DocBrowser(s:docdir . s:index)
715 return
716 elseif a:qualname=="-libs"
717 call DocBrowser(s:libraries . s:index)
718 return
719 elseif a:qualname=="-guide"
720 call DocBrowser(s:guide . s:index)
721 return
722 endif
723
724 if a:0==0 " no package specified
725 let package = 'base/'
726 else
727 let package = a:1 . '/'
728 endif
729
730 if match(a:qualname,'\.')==-1 " unqualified name
731 let [qual,name] = [['Prelude'],a:qualname]
732 let file = join(qual,'-') . suffix . relative . name
733 elseif a:qualname[-1:]=='.' " module qualifier only
734 let parts = split(a:qualname,'\.')
735 let quallen = len(parts)-1
736 let [qual,name] = [parts[0:quallen],parts[-1]]
737 let file = join(qual,'-') . suffix
738 else " qualified name
739 let parts = split(a:qualname,'\.')
740 let quallen = len(parts)-2
741 let [qual,name] = [parts[0:quallen],parts[-1]]
742 let file = join(qual,'-') . suffix . relative . name
743 endif
744
745 let path = s:libraries . package . file
746 call DocBrowser(path)
747endfunction
748
749" TODO: add commandline completion for :IDoc
750" switch to :emenu instead of inputlist?
751" indexed variant of Doc, looking up links in g:haddock_index
752" usage:
753" 1. :IDoc length
754" 2. click on one of the choices, or select by number (starting from 0)
755command! -nargs=+ IDoc call IDoc(<f-args>)
756function! IDoc(name,...)
757 let choices = HaddockIndexLookup(a:name)
758 if choices=={} | return | endif
759 if a:0==0
760 let keylist = map(deepcopy(keys(choices)),'substitute(v:val,"\\[.\\]","","")')
761 let choice = inputlist(keylist)
762 else
763 let choice = a:1
764 endif
765 let path = values(choices)[choice] " assumes same order for keys/values..
766 call DocBrowser(path)
767endfunction
768
769let s:flagref = s:guide . 'flag-reference.html'
770if filereadable(s:flagref)
771 " extract the generated fragment ids for the
772 " flag reference sections
773 let s:headerPat = '.\{-}<h3 class="title"><a name="\([^"]*\)"><\/a>\([^<]*\)<\/h3>\(.*\)'
774 let s:flagheaders = []
775 let s:flagheaderids = {}
776 let s:contents = join(readfile(s:flagref))
777 let s:ml = matchlist(s:contents,s:headerPat)
778 while s:ml!=[]
779 let [_,s:id,s:title,s:r;s:x] = s:ml
780 let s:flagheaders = add(s:flagheaders, s:title)
781 let s:flagheaderids[s:title] = s:id
782 let s:ml = matchlist(s:r,s:headerPat)
783 endwhile
784 command! -nargs=1 -complete=customlist,CompleteFlagHeaders FlagReference call FlagReference(<f-args>)
785 function! FlagReference(section)
786 let relativeUrl = a:section==""||!exists("s:flagheaderids['".a:section."']") ?
787 \ "" : "#".s:flagheaderids[a:section]
788 call DocBrowser(s:flagref.relativeUrl)
789 endfunction
790 function! CompleteFlagHeaders(al,cl,cp)
791 let s:choices = s:flagheaders
792 return CompleteAux(a:al,a:cl,a:cp)
793 endfunction
794endif
795
796command! -nargs=1 -complete=customlist,CompleteHaddockModules MDoc call MDoc(<f-args>)
797function! MDoc(module)
798 let suffix = '.html'
799 call HaveModuleIndex()
800 if !has_key(g:haddock_moduleindex,a:module)
801 echoerr a:module 'not found in haddock module index'
802 return
803 endif
804 let package = g:haddock_moduleindex[a:module]['package']
805 let file = substitute(a:module,'\.','-','g') . suffix
806" let path = s:libraries . package . '/' . file
807 let path = g:haddock_moduleindex[a:module]['html']
808 call DocBrowser(path)
809endfunction
810
811function! CompleteHaddockModules(al,cl,cp)
812 call HaveModuleIndex()
813 let s:choices = keys(g:haddock_moduleindex)
814 return CompleteAux(a:al,a:cl,a:cp)
815endfunction
816
817" create a dictionary g:haddock_index, containing the haddoc index
818command! DocIndex call DocIndex()
819function! DocIndex()
820 let files = split(globpath(s:libraries,'doc-index*.html'),'\n')
821 let g:haddock_index = {}
822 call ProcessHaddockIndexes2(s:libraries,files)
823 if GHC_VersionGE([6,8,2])
824 if &shell =~ 'sh' " unix-type shell
825 let s:addon_libraries = split(system(g:ghc_pkg . ' field \* haddock-html'),'\n')
826 else " windows cmd.exe and the like
827 let s:addon_libraries = split(system(g:ghc_pkg . ' field * haddock-html'),'\n')
828 endif
829 for addon in s:addon_libraries
830 let ml = matchlist(addon,'haddock-html: \("\)\?\(file:///\)\?\([^"]*\)\("\)\?')
831 if ml!=[]
832 let [_,quote,file,addon_path;x] = ml
833 let addon_path = substitute(addon_path,'\(\\\\\|\\\)','/','g')
834 let addon_files = split(globpath(addon_path,'doc-index*.html'),'\n')
835 call ProcessHaddockIndexes2(addon_path,addon_files)
836 endif
837 endfor
838 endif
839 return 1
840endfunction
841
842function! ProcessHaddockIndexes(location,files)
843 let entryPat= '.\{-}"indexentry"[^>]*>\([^<]*\)<\(\%([^=]\{-}TD CLASS="\%(indexentry\)\@!.\{-}</TD\)*\)[^=]\{-}\(\%(="indexentry\|TABLE\).*\)'
844 let linkPat = '.\{-}HREF="\([^"]*\)".>\([^<]*\)<\(.*\)'
845
846 redraw
847 echo 'populating g:haddock_index from haddock index files in ' a:location
848 for f in a:files
849 echo f[len(a:location):]
850 let contents = join(readfile(f))
851 let ml = matchlist(contents,entryPat)
852 while ml!=[]
853 let [_,entry,links,r;x] = ml
854 "echo entry links
855 let ml2 = matchlist(links,linkPat)
856 let link = {}
857 while ml2!=[]
858 let [_,l,m,links;x] = ml2
859 "echo l m
860 let link[m] = a:location . '/' . l
861 let ml2 = matchlist(links,linkPat)
862 endwhile
863 let g:haddock_index[DeHTML(entry)] = deepcopy(link)
864 "echo entry g:haddock_index[entry]
865 let ml = matchlist(r,entryPat)
866 endwhile
867 endfor
868endfunction
869
870" concatenating all lines is too slow for a big file, process lines directly
871function! ProcessHaddockIndexes2(location,files)
872 let entryPat= '^>\([^<]*\)</'
873 let linkPat = '.\{-}A HREF="\([^"]*\)"'
874 let kindPat = '#\(.\)'
875
876 " redraw
877 echo 'populating g:haddock_index from haddock index files in ' a:location
878 for f in a:files
879 echo f[len(a:location):]
880 let isEntry = 0
881 let isLink = ''
882 let link = {}
883 let entry = ''
884 for line in readfile(f)
885 if line=~'CLASS="indexentry'
886 if (link!={}) && (entry!='')
887 if has_key(g:haddock_index,DeHTML(entry))
888 let dict = extend(g:haddock_index[DeHTML(entry)],deepcopy(link))
889 else
890 let dict = deepcopy(link)
891 endif
892 let g:haddock_index[DeHTML(entry)] = dict
893 let link = {}
894 let entry = ''
895 endif
896 let isEntry=1
897 continue
898 endif
899 if isEntry==1
900 let ml = matchlist(line,entryPat)
901 if ml!=[] | let [_,entry;x] = ml | let isEntry=0 | continue | endif
902 endif
903 if entry!=''
904 let ml = matchlist(line,linkPat)
905 if ml!=[] | let [_,isLink;x]=ml | continue | endif
906 endif
907 if isLink!=''
908 let ml = matchlist(line,entryPat)
909 if ml!=[]
910 let [_,module;x] = ml
911 let [_,kind;x] = matchlist(isLink,kindPat)
912 let last = a:location[strlen(a:location)-1]
913 let link[module."[".kind."]"] = a:location . (last=='/'?'':'/') . isLink
914 let isLink=''
915 continue
916 endif
917 endif
918 endfor
919 if link!={}
920 if has_key(g:haddock_index,DeHTML(entry))
921 let dict = extend(g:haddock_index[DeHTML(entry)],deepcopy(link))
922 else
923 let dict = deepcopy(link)
924 endif
925 let g:haddock_index[DeHTML(entry)] = dict
926 endif
927 endfor
928endfunction
929
930command! ExportDocIndex call ExportDocIndex()
931function! ExportDocIndex()
932 call HaveIndex()
933 let entries = []
934 for key in keys(g:haddock_index)
935 let entries += [key,string(g:haddock_index[key])]
936 endfor
937 call writefile(entries,s:haddock_indexfile)
938 redir end
939endfunction
940
941command! ImportDocIndex call ImportDocIndex()
942function! ImportDocIndex()
943 if filereadable(s:haddock_indexfile)
944 let lines = readfile(s:haddock_indexfile)
945 let i=0
946 while i<len(lines)
947 let [key,dict] = [lines[i],lines[i+1]]
948 sandbox let g:haddock_index[key] = eval(dict)
949 let i+=2
950 endwhile
951 return 1
952 else
953 return 0
954 endif
955endfunction
956
957function! HaveIndex()
958 return (g:haddock_index!={} || ImportDocIndex() || DocIndex() )
959endfunction
960
961function! MkHaddockModuleIndex()
962 let g:haddock_moduleindex = {}
963 call HaveIndex()
964 for key in keys(g:haddock_index)
965 let dict = g:haddock_index[key]
966 for module in keys(dict)
967 let html = dict[module]
968 let html = substitute(html ,'#.*$','','')
969 let module = substitute(module,'\[.\]','','')
970 let ml = matchlist(html,'libraries/\([^\/]*\)\/')
971 if ml!=[]
972 let [_,package;x] = ml
973 let g:haddock_moduleindex[module] = {'package':package,'html':html}
974 endif
975 let ml = matchlist(html,'/\([^\/]*\)\/html/[A-Z]')
976 if ml!=[]
977 let [_,package;x] = ml
978 let g:haddock_moduleindex[module] = {'package':package,'html':html}
979 endif
980 endfor
981 endfor
982endfunction
983
984function! HaveModuleIndex()
985 return (g:haddock_moduleindex!={} || MkHaddockModuleIndex() )
986endfunction
987
988" decode HTML symbol encodings (are these all we need?)
989function! DeHTML(entry)
990 let res = a:entry
991 let decode = { '<': '<', '>': '>', '&': '\\&' }
992 for enc in keys(decode)
993 exe 'let res = substitute(res,"'.enc.'","'.decode[enc].'","g")'
994 endfor
995 return res
996endfunction
997
998" find haddocks for word under cursor
999" also lists possible definition sites
1000" - needs to work for both qualified and unqualified items
1001" - for 'import qualified M as A', consider M.item as source of A.item
1002" - offer sources from both type [t] and value [v] namespaces
1003" - for unqualified items, list all possible sites
1004" - for qualified items, list imported sites only
1005" keep track of keys with and without namespace tags:
1006" the former are needed for lookup, the latter for matching against source
1007map <LocalLeader>? :call Haddock()<cr>
1008function! Haddock()
1009 amenu ]Popup.- :echo '-'<cr>
1010 aunmenu ]Popup
1011 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
1012 if namsym==[]
1013 redraw
1014 echo 'no name/symbol under cursor!'
1015 return 0
1016 endif
1017 let [start,symb,qual,unqual] = namsym
1018 let imports = haskellmode#GatherImports()
1019 let asm = has_key(imports[1],qual) ? imports[1][qual]['modules'] : []
1020 let name = unqual
1021 let dict = HaddockIndexLookup(name)
1022 if dict=={} | return | endif
1023 " for qualified items, narrow results to possible imports that provide qualifier
1024 let filteredKeys = filter(copy(keys(dict))
1025 \ ,'match(asm,substitute(v:val,''\[.\]'','''',''''))!=-1')
1026 let keys = (qual!='') ? filteredKeys : keys(dict)
1027 if (keys==[]) && (qual!='')
1028 echoerr qual.'.'.unqual.' not found in imports'
1029 return 0
1030 endif
1031 " use 'setlocal completeopt+=menuone' if you always want to see menus before
1032 " anything happens (I do, but many users don't..)
1033 if len(keys)==1 && (&completeopt!~'menuone')
1034 call DocBrowser(dict[keys[0]])
1035 elseif has("gui_running")
1036 for key in keys
1037 exe 'amenu ]Popup.'.escape(key,'\.').' :call DocBrowser('''.dict[key].''')<cr>'
1038 endfor
1039 popup ]Popup
1040 else
1041 let s:choices = keys
1042 let key = input('browse docs for '.name.' in: ','','customlist,CompleteAux')
1043 if key!=''
1044 call DocBrowser(dict[key])
1045 endif
1046 endif
1047endfunction
1048
1049if !exists("g:haskell_search_engines")
1050 let g:haskell_search_engines =
1051 \ {'hoogle':'http://www.haskell.org/hoogle/?hoogle=%s'
1052 \ ,'hayoo!':'http://holumbus.fh-wedel.de/hayoo/hayoo.html?query=%s'
1053 \ }
1054endif
1055
1056map <LocalLeader>?? :let es=g:haskell_search_engines
1057 \ \|echo "g:haskell_search_engines"
1058 \ \|for e in keys(es)
1059 \ \|echo e.' : '.es[e]
1060 \ \|endfor<cr>
1061map <LocalLeader>?1 :call HaskellSearchEngine('hoogle')<cr>
1062map <LocalLeader>?2 :call HaskellSearchEngine('hayoo!')<cr>
1063
1064" query one of the Haskell search engines for the thing under cursor
1065" - unqualified symbols need to be url-escaped
1066" - qualified ids need to be fed as separate qualifier and id for
1067" both hoogle (doesn't handle qualified symbols) and hayoo! (no qualified
1068" ids at all)
1069" - qualified ids referring to import-qualified-as qualifiers need to be
1070" translated to the multi-module searches over the list of original modules
1071function! HaskellSearchEngine(engine)
1072 amenu ]Popup.- :echo '-'<cr>
1073 aunmenu ]Popup
1074 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
1075 if namsym==[]
1076 redraw
1077 echo 'no name/symbol under cursor!'
1078 return 0
1079 endif
1080 let [start,symb,qual,unqual] = namsym
1081 let imports = haskellmode#GatherImports()
1082 let asm = has_key(imports[1],qual) ? imports[1][qual]['modules'] : []
1083 let unqual = haskellmode#UrlEncode(unqual)
1084 if a:engine=='hoogle'
1085 let name = asm!=[] ? unqual.'+'.join(map(copy(asm),'"%2B".v:val'),'+')
1086 \ : qual!='' ? unqual.'+'.haskellmode#UrlEncode('+').qual
1087 \ : unqual
1088 elseif a:engine=='hayoo!'
1089 let name = asm!=[] ? unqual.'+module:('.join(copy(asm),' OR ').')'
1090 \ : qual!='' ? unqual.'+module:'.qual
1091 \ : unqual
1092 else
1093 let name = qual=="" ? unqual : qual.".".unqual
1094 endif
1095 if has_key(g:haskell_search_engines,a:engine)
1096 call DocBrowser(printf(g:haskell_search_engines[a:engine],name))
1097 else
1098 echoerr "unknown search engine: ".a:engine
1099 endif
1100endfunction
1101
1102" used to pass on choices to CompleteAux
1103let s:choices=[]
1104
1105" if there's no gui, use commandline completion instead of :popup
1106" completion function CompleteAux suggests completions for a:al, wrt to s:choices
1107function! CompleteAux(al,cl,cp)
1108 "echomsg '|'.a:al.'|'.a:cl.'|'.a:cp.'|'
1109 let res = []
1110 let l = len(a:al)-1
1111 for r in s:choices
1112 if l==-1 || r[0 : l]==a:al
1113 let res += [r]
1114 endif
1115 endfor
1116 return res
1117endfunction
1118
1119" CamelCase shorthand matching:
1120" favour upper-case letters and module qualifier separators (.) for disambiguation
1121function! CamelCase(shorthand,string)
1122 let s1 = a:shorthand
1123 let s2 = a:string
1124 let notFirst = 0 " don't elide before first pattern letter
1125 while ((s1!="")&&(s2!=""))
1126 let head1 = s1[0]
1127 let head2 = s2[0]
1128 let elide = notFirst && ( ((head1=~'[A-Z]') && (head2!~'[A-Z.]'))
1129 \ ||((head1=='.') && (head2!='.')) )
1130 if elide
1131 let s2=s2[1:]
1132 elseif (head1==head2)
1133 let s1=s1[1:]
1134 let s2=s2[1:]
1135 else
1136 return 0
1137 endif
1138 let notFirst = (head1!='.')||(head2!='.') " treat separators as new beginnings
1139 endwhile
1140 return (s1=="")
1141endfunction
1142
1143" use haddock name index for insert mode completion (CTRL-X CTRL-U)
1144function! CompleteHaddock(findstart, base)
1145 if a:findstart
1146 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),-1) " insert-mode: we're 1 beyond the text
1147 if namsym==[]
1148 redraw
1149 echo 'no name/symbol under cursor!'
1150 return -1
1151 endif
1152 let [start,symb,qual,unqual] = namsym
1153 return (start-1)
1154 else " find keys matching with "a:base"
1155 let res = []
1156 let l = len(a:base)-1
1157 let qual = a:base =~ '^[A-Z][a-zA-Z0-9_'']*\(\.[A-Z][a-zA-Z0-9_'']*\)*\(\.[a-zA-Z0-9_'']*\)\?$'
1158 call HaveIndex()
1159 for key in keys(g:haddock_index)
1160 let keylist = map(deepcopy(keys(g:haddock_index[key])),'substitute(v:val,"\\[.\\]","","")')
1161 if (key[0 : l]==a:base)
1162 for m in keylist
1163 let res += [{"word":key,"menu":m,"dup":1}]
1164 endfor
1165 elseif qual " this tends to be slower
1166 for m in keylist
1167 let word = m . '.' . key
1168 if word[0 : l]==a:base
1169 let res += [{"word":word,"menu":m,"dup":1}]
1170 endif
1171 endfor
1172 endif
1173 endfor
1174 if res==[] " no prefix matches, try CamelCase shortcuts
1175 for key in keys(g:haddock_index)
1176 let keylist = map(deepcopy(keys(g:haddock_index[key])),'substitute(v:val,"\\[.\\]","","")')
1177 if CamelCase(a:base,key)
1178 for m in keylist
1179 let res += [{"word":key,"menu":m,"dup":1}]
1180 endfor
1181 elseif qual " this tends to be slower
1182 for m in keylist
1183 let word = m . '.' . key
1184 if CamelCase(a:base,word)
1185 let res += [{"word":word,"menu":m,"dup":1}]
1186 endif
1187 endfor
1188 endif
1189 endfor
1190 endif
1191 return res
1192 endif
1193endfunction
1194setlocal completefunc=CompleteHaddock
1195"
1196" Vim's default completeopt is menu,preview
1197" you probably want at least menu, or you won't see alternatives listed
1198" setlocal completeopt+=menu
1199
1200" menuone is useful, but other haskellmode menus will try to follow your choice here in future
1201" setlocal completeopt+=menuone
1202
1203" longest sounds useful, but doesn't seem to do what it says, and interferes with CTRL-E
1204" setlocal completeopt-=longest
1205
1206" fully qualify an unqualified name
1207" TODO: - standardise commandline versions of menus
1208map <LocalLeader>. :call Qualify()<cr>
1209function! Qualify()
1210 amenu ]Popup.- :echo '-'<cr>
1211 aunmenu ]Popup
1212 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
1213 if namsym==[]
1214 redraw
1215 echo 'no name/symbol under cursor!'
1216 return 0
1217 endif
1218 let [start,symb,qual,unqual] = namsym
1219 if qual!='' " TODO: should we support re-qualification?
1220 redraw
1221 echo 'already qualified'
1222 return 0
1223 endif
1224 let name = unqual
1225 let line = line('.')
1226 let prefix = (start<=1 ? '' : getline(line)[0:start-2] )
1227 let dict = HaddockIndexLookup(name)
1228 if dict=={} | return | endif
1229 let keylist = map(deepcopy(keys(dict)),'substitute(v:val,"\\[.\\]","","")')
1230 let imports = haskellmode#GatherImports()
1231 let qualifiedImports = []
1232 for qualifiedImport in keys(imports[1])
1233 let c=0
1234 for module in imports[1][qualifiedImport]['modules']
1235 if haskellmode#ListElem(keylist,module) | let c+=1 | endif
1236 endfor
1237 if c>0 | let qualifiedImports=[qualifiedImport]+qualifiedImports | endif
1238 endfor
1239 "let asm = has_key(imports[1],qual) ? imports[1][qual]['modules'] : []
1240 let keylist = filter(copy(keylist),'index(qualifiedImports,v:val)==-1')
1241 if has("gui_running")
1242 " amenu ]Popup.-imported- :
1243 for key in qualifiedImports
1244 let lhs=escape(prefix.name,'/.|\')
1245 let rhs=escape(prefix.key.'.'.name,'/&|\')
1246 exe 'amenu ]Popup.'.escape(key,'\.').' :'.line.'s/'.lhs.'/'.rhs.'/<cr>:noh<cr>'
1247 endfor
1248 amenu ]Popup.-not\ imported- :
1249 for key in keylist
1250 let lhs=escape(prefix.name,'/.|\')
1251 let rhs=escape(prefix.key.'.'.name,'/&|\')
1252 exe 'amenu ]Popup.'.escape(key,'\.').' :'.line.'s/'.lhs.'/'.rhs.'/<cr>:noh<cr>'
1253 endfor
1254 popup ]Popup
1255 else
1256 let s:choices = qualifiedImports+keylist
1257 let key = input('qualify '.name.' with: ','','customlist,CompleteAux')
1258 if key!=''
1259 let lhs=escape(prefix.name,'/.\')
1260 let rhs=escape(prefix.key.'.'.name,'/&\')
1261 exe line.'s/'.lhs.'/'.rhs.'/'
1262 noh
1263 endif
1264 endif
1265endfunction
1266
1267" create (qualified) import for a (qualified) name
1268" TODO: refine search patterns, to avoid misinterpretation of
1269" oddities like import'Neither or not'module
1270map <LocalLeader>i :call Import(0,0)<cr>
1271map <LocalLeader>im :call Import(1,0)<cr>
1272map <LocalLeader>iq :call Import(0,1)<cr>
1273map <LocalLeader>iqm :call Import(1,1)<cr>
1274function! Import(module,qualified)
1275 amenu ]Popup.- :echo '-'<cr>
1276 aunmenu ]Popup
1277 let namsym = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
1278 if namsym==[]
1279 redraw
1280 echo 'no name/symbol under cursor!'
1281 return 0
1282 endif
1283 let [start,symb,qual,unqual] = namsym
1284 let name = unqual
1285 let pname = ( symb ? '('.name.')' : name )
1286 let importlist = a:module ? '' : '('.pname.')'
1287 let qualified = a:qualified ? 'qualified ' : ''
1288
1289 if qual!=''
1290 exe 'call append(search(''\%1c\(\<import\>\|\<module\>\|{-# OPTIONS\|{-# LANGUAGE\)'',''nb''),''import '.qualified.qual.importlist.''')'
1291 return
1292 endif
1293
1294 let line = line('.')
1295 let prefix = getline(line)[0:start-1]
1296 let dict = HaddockIndexLookup(name)
1297 if dict=={} | return | endif
1298 let keylist = map(deepcopy(keys(dict)),'substitute(v:val,"\\[.\\]","","")')
1299 if has("gui_running")
1300 for key in keylist
1301 " exe 'amenu ]Popup.'.escape(key,'\.').' :call append(search("\\%1c\\(import\\\\|module\\\\|{-# OPTIONS\\)","nb"),"import '.key.importlist.'")<cr>'
1302 exe 'amenu ]Popup.'.escape(key,'\.').' :call append(search(''\%1c\(\<import\>\\|\<module\>\\|{-# OPTIONS\\|{-# LANGUAGE\)'',''nb''),''import '.qualified.key.escape(importlist,'|').''')<cr>'
1303 endfor
1304 popup ]Popup
1305 else
1306 let s:choices = keylist
1307 let key = input('import '.name.' from: ','','customlist,CompleteAux')
1308 if key!=''
1309 exe 'call append(search(''\%1c\(\<import\>\|\<module\>\|{-# OPTIONS\|{-# LANGUAGE\)'',''nb''),''import '.qualified.key.importlist.''')'
1310 endif
1311 endif
1312endfunction
1313
1314function! HaddockIndexLookup(name)
1315 call HaveIndex()
1316 if !has_key(g:haddock_index,a:name)
1317 echoerr a:name 'not found in haddock index'
1318 return {}
1319 endif
1320 return g:haddock_index[a:name]
1321endfunction
1322
1323" copied from ghc.vim :-( should we move everything to using autoload instead?
1324" we query the ghc version here, as we don't otherwise need it..
1325function! GHC_VersionGE(target)
1326 let s:ghc_version = substitute(system(g:ghc . ' --numeric-version'),'\n','','')
1327 let current = split(g:ghc_version, '\.' )
1328 let target = a:target
1329 for i in current
1330 if ((target==[]) || (i>target[0]))
1331 return 1
1332 elseif (i==target[0])
1333 let target = target[1:]
1334 else
1335 return 0
1336 endif
1337 endfor
1338 return 1
1339endfunction
1340ftplugin/haskell_hpaste.vim [[[1
134179
1342" rudimentary hpaste support for vim
1343" (using netrw for reading, wget for posting/annotating)
1344"
1345" claus reinke, last modified: 07/04/2009
1346"
1347" part of haskell plugins: http://projects.haskell.org/haskellmode-vim
1348
1349" unless wget is in your PATH, you need to set g:wget
1350" before loading this script. windows users are out of
1351" luck, unless they have wget installed (such as the
1352" cygwin one looked for here), or adapt this script to
1353" whatever alternative they have at hand (perhaps using
1354" vim's perl/python bindings?)
1355if !exists("g:wget")
1356 if executable("wget")
1357 let g:wget = "!wget -q"
1358 else
1359 let g:wget = "!c:\\cygwin\\bin\\wget -q"
1360 endif
1361endif
1362
1363" read (recent) hpaste files
1364" show index in new buffer, where ,r will open current entry
1365" and ,p will annotate current entry with current buffer
1366command! HpasteIndex call HpasteIndex()
1367function! HpasteIndex()
1368 new
1369 read http://hpaste.org
1370 %s/\_$\_.//g
1371 %s/<tr[^>]*>//g
1372 %s/<\/tr>/
1373/g
1374 g/<\/table>/d
1375 g/DOCTYPE/d
1376 %s/<td>\([^<]*\)<\/td><td><a href="\/fastcgi\/hpaste\.fcgi\/view?id=\([0-9]*\)">\([^<]*\)<\/a><\/td><td>\([^<]*\)<\/td><td>\([^<]*\)<\/td><td>\([^<]*\)<\/td>/\2 [\1] "\3" \4 \5 \6/
1377 map <buffer> ,r 0yE:noh<cr>:call HpasteEditEntry('"')<cr>
1378endfunction
1379
1380" load an existing entry for editing
1381command! -nargs=1 HpasteEditEntry call HpasteEditEntry(<f-args>)
1382function! HpasteEditEntry(entry)
1383 new
1384 exe 'Nread http://hpaste.org/fastcgi/hpaste.fcgi/raw?id='.a:entry
1385 "exe 'map <buffer> ,p :call HpasteAnnotate('''.a:entry.''')<cr>'
1386endfunction
1387
1388" " posting temporarily disabled -- needs someone to look into new
1389" " hpaste.org structure
1390
1391" " annotate existing entry (only to be called via ,p in HpasteIndex)
1392" function! HpasteAnnotate(entry)
1393" let nick = input("nick? ")
1394" let title = input("title? ")
1395" if nick=='' || title==''
1396" echo "nick or title missing. aborting annotation"
1397" return
1398" endif
1399" call HpastePost('annotate/'.a:entry,nick,title)
1400" endfunction
1401"
1402" " post new hpaste entry
1403" " using 'wget --post-data' and url-encoded content
1404" command! HpastePostNew call HpastePost('new',<args>)
1405" function! HpastePost(mode,nick,title,...)
1406" let lines = getbufline("%",1,"$")
1407" let pat = '\([^[:alnum:]]\)'
1408" let code = '\=printf("%%%02X",char2nr(submatch(1)))'
1409" let lines = map(lines,'substitute(v:val."\r\n",'''.pat.''','''.code.''',''g'')')
1410"
1411" let url = 'http://hpaste.org/' . a:mode
1412" let nick = substitute(a:nick,pat,code,'g')
1413" let title = substitute(a:title,pat,code,'g')
1414" if a:0==0
1415" let announce = 'false'
1416" else
1417" let announce = a:1
1418" endif
1419" let cmd = g:wget.' --post-data="content='.join(lines,'').'&nick='.nick.'&title='.title.'&announce='.announce.'" '.url
1420" exe escape(cmd,'%')
1421" endfunction
1422autoload/haskellmode.vim [[[1
1423155
1424"
1425" utility functions for haskellmode plugins
1426"
1427" (Claus Reinke; last modified: 23/04/2009)
1428"
1429" part of haskell plugins: http://projects.haskell.org/haskellmode-vim
1430" please send patches to <claus.reinke@talk21.com>
1431
1432
1433
1434" find start/extent of name/symbol under cursor;
1435" return start, symbolic flag, qualifier, unqualified id
1436" (this is used in both haskell_doc.vim and in GHC.vim)
1437function! haskellmode#GetNameSymbol(line,col,off)
1438 let name = "[a-zA-Z0-9_']"
1439 let symbol = "[-!#$%&\*\+/<=>\?@\\^|~:.]"
1440 "let [line] = getbufline(a:buf,a:lnum)
1441 let line = a:line
1442
1443 " find the beginning of unqualified id or qualified id component
1444 let start = (a:col - 1) + a:off
1445 if line[start] =~ name
1446 let pattern = name
1447 elseif line[start] =~ symbol
1448 let pattern = symbol
1449 else
1450 return []
1451 endif
1452 while start > 0 && line[start - 1] =~ pattern
1453 let start -= 1
1454 endwhile
1455 let id = matchstr(line[start :],pattern.'*')
1456 " call confirm(id)
1457
1458 " expand id to left and right, to get full id
1459 let idPos = id[0] == '.' ? start+2 : start+1
1460 let posA = match(line,'\<\(\([A-Z]'.name.'*\.\)\+\)\%'.idPos.'c')
1461 let start = posA>-1 ? posA+1 : idPos
1462 let posB = matchend(line,'\%'.idPos.'c\(\([A-Z]'.name.'*\.\)*\)\('.name.'\+\|'.symbol.'\+\)')
1463 let end = posB>-1 ? posB : idPos
1464
1465 " special case: symbolic ids starting with .
1466 if id[0]=='.' && posA==-1
1467 let start = idPos-1
1468 let end = posB==-1 ? start : end
1469 endif
1470
1471 " classify full id and split into qualifier and unqualified id
1472 let fullid = line[ (start>1 ? start-1 : 0) : (end-1) ]
1473 let symbolic = fullid[-1:-1] =~ symbol " might also be incomplete qualified id ending in .
1474 let qualPos = matchend(fullid, '\([A-Z]'.name.'*\.\)\+')
1475 let qualifier = qualPos>-1 ? fullid[ 0 : (qualPos-2) ] : ''
1476 let unqualId = qualPos>-1 ? fullid[ qualPos : -1 ] : fullid
1477 " call confirm(start.'/'.end.'['.symbolic.']:'.qualifier.' '.unqualId)
1478
1479 return [start,symbolic,qualifier,unqualId]
1480endfunction
1481
1482function! haskellmode#GatherImports()
1483 let imports={0:{},1:{}}
1484 let i=1
1485 while i<=line('$')
1486 let res = haskellmode#GatherImport(i)
1487 if !empty(res)
1488 let [i,import] = res
1489 let prefixPat = '^import\s*\(qualified\)\?\s\+'
1490 let modulePat = '\([A-Z][a-zA-Z0-9_''.]*\)'
1491 let asPat = '\(\s\+as\s\+'.modulePat.'\)\?'
1492 let hidingPat = '\(\s\+hiding\s*\((.*)\)\)\?'
1493 let listPat = '\(\s*\((.*)\)\)\?'
1494 let importPat = prefixPat.modulePat.asPat.hidingPat.listPat ".'\s*$'
1495
1496 let ml = matchlist(import,importPat)
1497 if ml!=[]
1498 let [_,qualified,module,_,as,_,hiding,_,explicit;x] = ml
1499 let what …Large files files are truncated, but you can click here to view the full file