compiler/ghc.vim

   1
   2 " Vim Compiler File
   3 " Compiler:     GHC
   4 " Maintainer:   Claus Reinke <claus.reinke@talk21.com>
   5 " Last Change:  22/06/2010
   6 "
   7 " part of haskell plugins: http://projects.haskell.org/haskellmode-vim
   8
   9 " ------------------------------ paths & quickfix settings first
  10 "
  11
  12 if exists("current_compiler") && current_compiler == "ghc"
  13   finish
  14 endif
  15 let current_compiler = "ghc"
  16
  17 let s:scriptname = "ghc.vim"
  18
  19 if !haskellmode#GHC() | finish | endif
  20 if (!exists("b:ghc_staticoptions"))
  21   let b:ghc_staticoptions = ''
  22 endif
  23
  24 " set makeprg (for quickfix mode)
  25 execute 'setlocal makeprg=' . g:ghc . '\ ' . escape(b:ghc_staticoptions,' ') .'\ -e\ :q\ %'
  26 "execute 'setlocal makeprg=' . g:ghc .'\ -e\ :q\ %'
  27 "execute 'setlocal makeprg=' . g:ghc .'\ --make\ %'
  28
  29 " quickfix mode:
  30 " fetch file/line-info from error message
  31 " TODO: how to distinguish multiline errors from warnings?
  32 "       (both have the same header, and errors have no common id-tag)
  33 "       how to get rid of first empty message in result list?
  34 setlocal errorformat=
  35                     \%-Z\ %#,
  36                     \%W%f:%l:%c:\ Warning:\ %m,
  37                     \%E%f:%l:%c:\ %m,
  38                     \%E%>%f:%l:%c:,
  39                     \%+C\ \ %#%m,
  40                     \%W%>%f:%l:%c:,
  41                     \%+C\ \ %#%tarning:\ %m,
  42
  43 " oh, wouldn't you guess it - ghc reports (partially) to stderr..
  44 setlocal shellpipe=2>
  45
  46 " ------------------------- but ghc can do a lot more for us..
  47 "
  48
  49 " allow map leader override
  50 if !exists("maplocalleader")
  51   let maplocalleader='_'
  52 endif
  53
  54 " initialize map of identifiers to their types
  55 " associate type map updates to changedtick
  56 if !exists("b:ghc_types")
  57   let b:ghc_types = {}
  58   let b:my_changedtick = b:changedtick
  59 endif
  60
  61 if exists("g:haskell_functions")
  62   finish
  63 endif
  64 let g:haskell_functions = "ghc"
  65
  66 " avoid hit-enter prompts
  67 "set cmdheight=3
  68
  69 " edit static GHC options
  70 " TODO: add completion for options/packages?
  71 command! GHCStaticOptions call GHC_StaticOptions()
  72 function! GHC_StaticOptions()
  73   let b:ghc_staticoptions = input('GHC static options: ',b:ghc_staticoptions)
  74   execute 'setlocal makeprg=' . g:ghc . '\ ' . escape(b:ghc_staticoptions,' ') .'\ -e\ :q\ %'
  75   let b:my_changedtick -=1
  76 endfunction
  77
  78 map <LocalLeader>T :call GHC_ShowType(1)<cr>
  79 map <LocalLeader>t :call GHC_ShowType(0)<cr>
  80 function! GHC_ShowType(addTypeDecl)
  81   let namsym   = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
  82   if namsym==[]
  83     redraw
  84     echo 'no name/symbol under cursor!'
  85     return 0
  86   endif
  87   let [_,symb,qual,unqual] = namsym
  88   let name  = qual=='' ? unqual : qual.'.'.unqual
  89   let pname = ( symb ? '('.name.')' : name )
  90   call GHC_HaveTypes()
  91   if !has_key(b:ghc_types,name)
  92     redraw
  93     echo pname "type not known"
  94   else
  95     redraw
  96     for type in split(b:ghc_types[name],' -- ')
  97       echo pname "::" type
  98       if a:addTypeDecl
  99         call append( line(".")-1, pname . " :: " . type )
 100       endif
 101     endfor
 102   endif
 103 endfunction
 104
 105 " show type of identifier under mouse pointer in balloon
 106 " TODO: it isn't a good idea to tie potentially time-consuming tasks
 107 "       (querying GHCi for the types) to cursor movements (#14). Currently,
 108 "       we ask the user to call :GHCReload explicitly. Should there be an
 109 "       option to reenable the old implicit querying?
 110 if has("balloon_eval")
 111   set ballooneval
 112   set balloonexpr=GHC_TypeBalloon()
 113   function! GHC_TypeBalloon()
 114     if exists("b:current_compiler") && b:current_compiler=="ghc"
 115       let [line] = getbufline(v:beval_bufnr,v:beval_lnum)
 116       let namsym = haskellmode#GetNameSymbol(line,v:beval_col,0)
 117       if namsym==[]
 118         return ''
 119       endif
 120       let [start,symb,qual,unqual] = namsym
 121       let name  = qual=='' ? unqual : qual.'.'.unqual
 122       let pname = name " ( symb ? '('.name.')' : name )
 123       if b:ghc_types == {}
 124         redraw
 125         echo "no type information (try :GHGReload)"
 126       elseif (b:my_changedtick != b:changedtick)
 127         redraw
 128         echo "type information may be out of date (try :GHGReload)"
 129       endif
 130       " silent call GHC_HaveTypes()
 131       if b:ghc_types!={}
 132         if has("balloon_multiline")
 133           return (has_key(b:ghc_types,pname) ? split(b:ghc_types[pname],' -- ') : '')
 134         else
 135           return (has_key(b:ghc_types,pname) ? b:ghc_types[pname] : '')
 136         endif
 137       else
 138         return ''
 139       endif
 140     else
 141       return ''
 142     endif
 143   endfunction
 144 endif
 145
 146 map <LocalLeader>si :call GHC_ShowInfo()<cr>
 147 function! GHC_ShowInfo()
 148   let namsym   = haskellmode#GetNameSymbol(getline('.'),col('.'),0)
 149   if namsym==[]
 150     redraw
 151     echo 'no name/symbol under cursor!'
 152     return 0
 153   endif
 154   let [_,symb,qual,unqual] = namsym
 155   let name = qual=='' ? unqual : (qual.'.'.unqual)
 156   let output = GHC_Info(name)
 157   pclose | new
 158   setlocal previewwindow
 159   setlocal buftype=nofile
 160   setlocal noswapfile
 161   put =output
 162   wincmd w
 163   "redraw
 164   "echo output
 165 endfunction
 166
 167 " fill the type map, unless nothing has changed since the last attempt
 168 function! GHC_HaveTypes()
 169   if b:ghc_types == {} && (b:my_changedtick != b:changedtick)
 170     let b:my_changedtick = b:changedtick
 171     return GHC_BrowseAll()
 172   endif
 173 endfunction
 174
 175 " update b:ghc_types after successful make
 176 au QuickFixCmdPost make if GHC_CountErrors()==0 | silent call GHC_BrowseAll() | endif
 177
 178 " count only error entries in quickfix list, ignoring warnings
 179 function! GHC_CountErrors()
 180   let c=0
 181   for e in getqflist() | if e.type=='E' && e.text !~ "^[ \n]*Warning:" | let c+=1 | endif | endfor
 182   return c
 183 endfunction
 184
 185 command! GHCReload call GHC_BrowseAll()
 186 function! GHC_BrowseAll()
 187   " let imports = haskellmode#GatherImports()
 188   " let modules = keys(imports[0]) + keys(imports[1])
 189   let b:my_changedtick = b:changedtick
 190   let imports = {} " no need for them at the moment
 191   let current = GHC_NameCurrent()
 192   let module = current==[] ? 'Main' : current[0]
 193   if haskellmode#GHC_VersionGE([6,8,1])
 194     return GHC_BrowseBangStar(module)
 195   else
 196     return GHC_BrowseMultiple(imports,['*'.module])
 197   endif
 198 endfunction
 199
 200 function! GHC_NameCurrent()
 201   let last = line("$")
 202   let l = 1
 203   while l<last
 204     let ml = matchlist( getline(l), '^module\s*\([^ (]*\)')
 205     if ml != []
 206       let [_,module;x] = ml
 207       return [module]
 208     endif
 209     let l += 1
 210   endwhile
 211   redraw
 212   echo "cannot find module header for file " . expand("%")
 213   return []
 214 endfunction
 215
 216 function! GHC_BrowseBangStar(module)
 217   redraw
 218   echo "browsing module " a:module
 219   let command = ":browse! *" . a:module
 220   let orig_shellredir = &shellredir
 221   let &shellredir = ">" " ignore error/warning messages, only output or lack of it
 222   let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -v0 --interactive ' . expand("%") , command )
 223   let &shellredir = orig_shellredir
 224   return GHC_ProcessBang(a:module,output)
 225 endfunction
 226
 227 function! GHC_BrowseMultiple(imports,modules)
 228   redraw
 229   echo "browsing modules " a:modules
 230   let command = ":browse " . join( a:modules, " \n :browse ")
 231   let command = substitute(command,'\(:browse \(\S*\)\)','putStrLn "-- \2" \n \1','g')
 232   let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -v0 --interactive ' . expand("%") , command )
 233   return GHC_Process(a:imports,output)
 234 endfunction
 235
 236 function! GHC_Info(what)
 237   " call GHC_HaveTypes()
 238   let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -v0 --interactive ' . expand("%"), ":info ". a:what)
 239   return output
 240 endfunction
 241
 242 function! GHC_ProcessBang(module,output)
 243   let module      = a:module
 244   let b           = a:output
 245   let linePat     = '^\(.\{-}\)\n\(.*\)'
 246   let contPat     = '\s\+\(.\{-}\)\n\(.*\)'
 247   let typePat     = '^\(\)\(\S*\)\s*::\(.*\)'
 248   let commentPat  = '^-- \(\S*\)'
 249   let definedPat  = '^-- defined locally'
 250   let importedPat = '^-- imported via \(.*\)'
 251   if !(b=~commentPat)
 252     echo s:scriptname.": GHCi reports errors (try :make?)"
 253     return 0
 254   endif
 255   let b:ghc_types = {}
 256   let ml = matchlist( b , linePat )
 257   while ml != []
 258     let [_,l,rest;x] = ml
 259     let mlDecl = matchlist( l, typePat )
 260     if mlDecl != []
 261       let [_,indent,id,type;x] = mlDecl
 262       let ml2 = matchlist( rest , '^'.indent.contPat )
 263       while ml2 != []
 264         let [_,c,rest;x] = ml2
 265         let type .= c
 266         let ml2 = matchlist( rest , '^'.indent.contPat )
 267       endwhile
 268       let id   = substitute( id, '^(\(.*\))$', '\1', '')
 269       let type = substitute( type, '\s\+', " ", "g" )
 270       " using :browse! *<current>, we get both unqualified and qualified ids
 271       let qualified = (id =~ '\.') && (id =~ '[A-Z]')
 272       let b:ghc_types[id] = type
 273       if !qualified
 274         for qual in qualifiers
 275           let b:ghc_types[qual.'.'.id] = type
 276         endfor
 277       endif
 278     else
 279       let mlImported = matchlist( l, importedPat )
 280       let mlDefined  = matchlist( l, definedPat )
 281       if mlImported != []
 282         let [_,modules;x] = mlImported
 283         let qualifiers = split( modules, ', ' )
 284       elseif mlDefined != []
 285         let qualifiers = [module]
 286       endif
 287     endif
 288     let ml = matchlist( rest , linePat )
 289   endwhile
 290   return 1
 291 endfunction
 292
 293 function! GHC_Process(imports,output)
 294   let b       = a:output
 295   let imports = a:imports
 296   let linePat = '^\(.\{-}\)\n\(.*\)'
 297   let contPat = '\s\+\(.\{-}\)\n\(.*\)'
 298   let typePat = '^\(\s*\)\(\S*\)\s*::\(.*\)'
 299   let modPat  = '^-- \(\S*\)'
 300   " add '-- defined locally' and '-- imported via ..'
 301   if !(b=~modPat)
 302     echo s:scriptname.": GHCi reports errors (try :make?)"
 303     return 0
 304   endif
 305   let b:ghc_types = {}
 306   let ml = matchlist( b , linePat )
 307   while ml != []
 308     let [_,l,rest;x] = ml
 309     let mlDecl = matchlist( l, typePat )
 310     if mlDecl != []
 311       let [_,indent,id,type;x] = mlDecl
 312       let ml2 = matchlist( rest , '^'.indent.contPat )
 313       while ml2 != []
 314         let [_,c,rest;x] = ml2
 315         let type .= c
 316         let ml2 = matchlist( rest , '^'.indent.contPat )
 317       endwhile
 318       let id   = substitute(id, '^(\(.*\))$', '\1', '')
 319       let type = substitute( type, '\s\+', " ", "g" )
 320       " using :browse *<current>, we get both unqualified and qualified ids
 321       if current_module " || has_key(imports[0],module)
 322         if has_key(b:ghc_types,id) && !(matchstr(b:ghc_types[id],escape(type,'[].'))==type)
 323           let b:ghc_types[id] .= ' -- '.type
 324         else
 325           let b:ghc_types[id] = type
 326         endif
 327       endif
 328       if 0 " has_key(imports[1],module)
 329         let qualid = module.'.'.id
 330         let b:ghc_types[qualid] = type
 331       endif
 332     else
 333       let mlMod = matchlist( l, modPat )
 334       if mlMod != []
 335         let [_,module;x] = mlMod
 336         let current_module = module[0]=='*'
 337         let module = current_module ? module[1:] : module
 338       endif
 339     endif
 340     let ml = matchlist( rest , linePat )
 341   endwhile
 342   return 1
 343 endfunction
 344
 345 let s:ghc_templates = ["module _ () where","class _ where","class _ => _ where","instance _ where","instance _ => _ where","type family _","type instance _ = ","data _ = ","newtype _ = ","type _ = "]
 346
 347 " use ghci :browse index for insert mode omnicompletion (CTRL-X CTRL-O)
 348 function! GHC_CompleteImports(findstart, base)
 349   if a:findstart
 350     let namsym   = haskellmode#GetNameSymbol(getline('.'),col('.'),-1) " insert-mode: we're 1 beyond the text
 351     if namsym==[]
 352       redraw
 353       echo 'no name/symbol under cursor!'
 354       return -1
 355     endif
 356     let [start,symb,qual,unqual] = namsym
 357     return (start-1)
 358   else " find keys matching with "a:base"
 359     let res = []
 360     let l   = len(a:base)-1
 361     call GHC_HaveTypes()
 362     for key in keys(b:ghc_types)
 363       if key[0 : l]==a:base
 364         let res += [{"word":key,"menu":":: ".b:ghc_types[key],"dup":1}]
 365       endif
 366     endfor
 367     return res
 368   endif
 369 endfunction
 370 set omnifunc=GHC_CompleteImports
 371 "
 372 " Vim's default completeopt is menu,preview
 373 " you probably want at least menu, or you won't see alternatives listed
 374 " setlocal completeopt+=menu
 375
 376 " menuone is useful, but other haskellmode menus will try to follow your choice here in future
 377 " setlocal completeopt+=menuone
 378
 379 " longest sounds useful, but doesn't seem to do what it says, and interferes with CTRL-E
 380 " setlocal completeopt-=longest
 381
 382 map <LocalLeader>ct :call GHC_CreateTagfile()<cr>
 383 function! GHC_CreateTagfile()
 384   redraw
 385   echo "creating tags file"
 386   let output = system(g:ghc . ' ' . b:ghc_staticoptions . ' -e ":ctags" ' . expand("%"))
 387   " for ghcs older than 6.6, you would need to call another program
 388   " here, such as hasktags
 389   echo output
 390 endfunction
 391
 392 command! -nargs=1 GHCi redraw | echo system(g:ghc. ' ' . b:ghc_staticoptions .' '.expand("%").' -e "'.escape(<f-args>,'"').'"')
 393
 394 " use :make 'not in scope' errors to explicitly list imported ids
 395 " cursor needs to be on import line, in correctly loadable module
 396 map <LocalLeader>ie :call GHC_MkImportsExplicit()<cr>
 397 function! GHC_MkImportsExplicit()
 398   let save_cursor = getpos(".")
 399   let line   = getline('.')
 400   let lineno = line('.')
 401   let ml     = matchlist(line,'^import\(\s*qualified\)\?\s*\([^( ]\+\)')
 402   if ml!=[]
 403     let [_,q,mod;x] = ml
 404     silent make
 405     if getqflist()==[]
 406       if line=~"import[^(]*Prelude"
 407         call setline(lineno,substitute(line,"(.*","","").'()')
 408       else
 409         call setline(lineno,'-- '.line)
 410       endif
 411       silent write
 412       silent make
 413       let qflist = getqflist()
 414       call setline(lineno,line)
 415       silent write
 416       let ids = {}
 417       for d in qflist
 418         let ml = matchlist(d.text,'Not in scope: \([^`]*\)`\([^'']*\)''')
 419         if ml!=[]
 420           let [_,what,qid;x] = ml
 421           let id  = ( qid =~ "^[A-Z]" ? substitute(qid,'.*\.\([^.]*\)$','\1','') : qid )
 422           let pid = ( id =~ "[a-zA-Z0-9_']\\+" ? id : '('.id.')' )
 423           if what =~ "data"
 424             call GHC_HaveTypes()
 425             if has_key(b:ghc_types,id)
 426               let pid = substitute(b:ghc_types[id],'^.*->\s*\(\S*\).*$','\1','').'('.pid.')'
 427             else
 428               let pid = '???('.pid.')'
 429             endif
 430           endif
 431           let ids[pid] = 1
 432         endif
 433       endfor
 434       call setline(lineno,'import'.q.' '.mod.'('.join(keys(ids),',').')')
 435     else
 436       copen
 437     endif
 438   endif
 439   call setpos('.', save_cursor)
 440 endfunction
 441
 442 " no need to ask GHC about its supported languages and
 443 " options with every editing session. cache the info in
 444 " ~/.vim/haskellmode.config
 445 " TODO: should we store more info (see haskell_doc.vim)?
 446 "       move to autoload?
 447 "       should we keep a history of GHC versions encountered?
 448 function! GHC_SaveConfig()
 449   let vimdir = expand('~').'/'.'.vim'
 450   let config = vimdir.'/haskellmode.config'
 451   if !isdirectory(vimdir)
 452     call mkdir(vimdir)
 453   endif
 454   let entries = ['-- '.g:ghc_version]
 455   for l in s:ghc_supported_languages
 456     let entries += [l]
 457   endfor
 458   let entries += ['--']
 459   for l in s:opts
 460     let entries += [l]
 461   endfor
 462   call writefile(entries,config)
 463 endfunction
 464
 465 " reuse cached GHC configuration info, if using the same
 466 " GHC version.
 467 function! GHC_LoadConfig()
 468   let vimdir = expand('~').'/'.'.vim'
 469   let config = vimdir.'/haskellmode.config'
 470   if filereadable(config)
 471     let lines = readfile(config)
 472     if lines[0]=='-- '.g:ghc_version
 473       let i=1
 474       let s:ghc_supported_languages = []
 475       while i<len(lines) && lines[i]!='--'
 476         let s:ghc_supported_languages += [lines[i]]
 477         let i+=1
 478       endwhile
 479       let i+=1
 480       let s:opts = []
 481       while i<len(lines)
 482         let s:opts += [lines[i]]
 483         let i+=1
 484       endwhile
 485       return 1
 486     else
 487       return 0
 488     endif
 489   else
 490     return 0
 491   endif
 492 endfunction
 493
 494 let s:GHC_CachedConfig = haskellmode#GHC_VersionGE([6,8]) && GHC_LoadConfig()
 495
 496 if haskellmode#GHC_VersionGE([6,8,2])
 497   if !s:GHC_CachedConfig
 498     let s:opts = filter(split(substitute(system(g:ghc . ' -v0 --interactive', ':set'), '  ', '','g'), '\n'), 'v:val =~ "-f"')
 499   endif
 500 else
 501   let s:opts = ["-fglasgow-exts","-fallow-undecidable-instances","-fallow-overlapping-instances","-fno-monomorphism-restriction","-fno-mono-pat-binds","-fno-cse","-fbang-patterns","-funbox-strict-fields"]
 502 endif
 503 let s:opts = sort(s:opts)
 504
 505 amenu ]OPTIONS_GHC.- :echo '-'<cr>
 506 aunmenu ]OPTIONS_GHC
 507 for o in s:opts
 508   exe 'amenu ]OPTIONS_GHC.'.o.' :call append(0,"{-# OPTIONS_GHC '.o.' #-}")<cr>'
 509 endfor
 510 if has("gui_running")
 511   map <LocalLeader>opt :popup ]OPTIONS_GHC<cr>
 512 else
 513   map <LocalLeader>opt :emenu ]OPTIONS_GHC.
 514 endif
 515
 516 amenu ]LANGUAGES_GHC.- :echo '-'<cr>
 517 aunmenu ]LANGUAGES_GHC
 518 if haskellmode#GHC_VersionGE([6,8])
 519   if !s:GHC_CachedConfig
 520     let s:ghc_supported_languages = sort(split(system(g:ghc . ' --supported-languages'),'\n'))
 521   endif
 522   for l in s:ghc_supported_languages
 523     exe 'amenu ]LANGUAGES_GHC.'.l.' :call append(0,"{-# LANGUAGE '.l.' #-}")<cr>'
 524   endfor
 525   if has("gui_running")
 526     map <LocalLeader>lang :popup ]LANGUAGES_GHC<cr>
 527   else
 528     map <LocalLeader>lang :emenu ]LANGUAGES_GHC.
 529   endif
 530 endif
 531
 532 if !s:GHC_CachedConfig
 533   call GHC_SaveConfig()
 534 endif
 535