PageRenderTime 247ms CodeModel.GetById 24ms app.highlight 196ms RepoModel.GetById 1ms app.codeStats 1ms

/vim/haskellmode-20090430.vba

https://bitbucket.org/vertespain/config
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 = { '&lt;': '<', '&gt;': '>', '&amp;': '\\&' }
 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