path: root/.vim/ftplugin/haskell_doc.vim

"
" use haddock docs and index files
" show documentation, complete & qualify identifiers 
"
" (Claus Reinke; last modified: 17/06/2009)
" 
" part of haskell plugins: http://projects.haskell.org/haskellmode-vim
" please send patches to <claus.reinke@talk21.com>

" :Doc <name> and :IDoc <name> open haddocks for <name> in opera
"
"   :Doc needs qualified name (default Prelude) and package (default base)
"   :IDoc needs unqualified name, looks up possible links in g:haddock_index
"
"   :DocIndex populates g:haddock_index from haddock's index files
"   :ExportDocIndex saves g:haddock_index to cache file
"   :ImportDocIndex reloads g:haddock_index from cache file
"
" all the following use the haddock index (g:haddock_index)
"
" _? opens haddocks for unqualified name under cursor, 
"    suggesting alternative full qualifications in popup menu
"
" _. fully qualifies unqualified name under cursor,
"    suggesting alternative full qualifications in popup menu
"
" _i  add import <module>(<name>) statement for unqualified <name> under cursor,
" _im add import <module>         statement for unqualified <name> under cursor,
"    suggesting alternative full qualifications in popup menu
"    (this currently adds one statement per call, instead of
"     merging into existing import statements, but it's a start;-)
"
" CTRL-X CTRL-U (user-defined insert mode completion) 
"   suggests completions of unqualified names in popup menu

let s:scriptname = "haskell_doc.vim"

" script parameters
"   g:haddock_browser            *mandatory* which browser to call
"   g:haddock_browser_callformat [optional] how to call browser
"   g:haddock_indexfiledir       [optional] where to put 'haddock_index.vim'
"   g:haddock_docdir             [optional] where to find html docs
"   g:ghc                        [optional] which ghc to call
"   g:ghc_pkg                    [optional] which ghc_pkg to call

" been here before?
if exists("g:haddock_index")
  finish
endif

" initialise nested dictionary, to be populated 
" - from haddock index files via :DocIndex
" - from previous cached version via :ImportDocIndex
let g:haddock_index = {}

" initialise dictionary, mapping modules with haddocks to their packages,
" populated via MkHaddockModuleIndex() or HaveModuleIndex()
let g:haddock_moduleindex = {}

" program to open urls, please set this in your vimrc
  "examples (for windows):
  "let g:haddock_browser = "C:/Program Files/Opera/Opera.exe"
  "let g:haddock_browser = "C:/Program Files/Mozilla Firefox/firefox.exe"
  "let g:haddock_browser = "C:/Program Files/Internet Explorer/IEXPLORE.exe"
if !exists("g:haddock_browser")
  echoerr s:scriptname." WARNING: please set g:haddock_browser!"
endif

if !haskellmode#GHC() | finish | endif

if (!exists("g:ghc_pkg") || !executable(g:ghc_pkg))
  let g:ghc_pkg = substitute(g:ghc,'\(.*\)ghc','\1ghc-pkg','')
endif

if exists("g:haddock_docdir") && isdirectory(g:haddock_docdir)
  let s:docdir = g:haddock_docdir
elseif executable(g:ghc_pkg)
" try to figure out location of html docs
" first choice: where the base docs are (from the first base listed)
  let [field;x] = split(system(g:ghc_pkg . ' field base haddock-html'),'\n')
  " path changes in ghc-6.12.*
  " let field = substitute(field,'haddock-html: \(.*\)libraries.base','\1','')
  let field = substitute(field,'haddock-html: \(.*\)lib\(raries\)\?.base.*$','\1','')
  let field = substitute(field,'\\','/','g')
  " let alternate = substitute(field,'html','doc/html','')
  " changes for ghc-6.12.*: check for doc/html/ first
  let alternate = field.'doc/html/'
  if isdirectory(alternate)
    let s:docdir = alternate
  elseif isdirectory(field)
    let s:docdir = field
  endif
else
  echoerr s:scriptname." can't find ghc-pkg (set g:ghc_pkg ?)."
endif

" second choice: try some known suspects for windows/unix
if !exists('s:docdir') || !isdirectory(s:docdir)
  let s:ghc_libdir = substitute(system(g:ghc . ' --print-libdir'),'\n','','')
  let location1a = s:ghc_libdir . '/doc/html/'
  let location1b = s:ghc_libdir . '/doc/'
  let location2 = '/usr/share/doc/ghc-' . haskellmode#GHC_Version() . '/html/' 
  if isdirectory(location1a)
    let s:docdir = location1a
  elseif isdirectory(location1b)
    let s:docdir = location1b
  elseif isdirectory(location2)
    let s:docdir = location2
  else " give up
    echoerr s:scriptname." can't find locaton of html documentation (set g:haddock_docdir)."
    finish
  endif
endif

" todo: can we turn s:docdir into a list of paths, and
" include docs for third-party libs as well?

let s:libraries         = s:docdir . 'libraries/'
let s:guide             = s:docdir . 'users_guide/'
let s:index             = 'index.html'
if exists("g:haddock_indexfiledir") && filewritable(g:haddock_indexfiledir)
  let s:haddock_indexfiledir = g:haddock_indexfiledir 
elseif filewritable(s:libraries)
  let s:haddock_indexfiledir = s:libraries
elseif filewritable($HOME)
  let s:haddock_indexfiledir = $HOME.'/'
else "give up
  echoerr s:scriptname." can't locate index file. please set g:haddock_indexfiledir"
  finish
endif
let s:haddock_indexfile = s:haddock_indexfiledir . 'haddock_index.vim'

" different browser setups require different call formats;
" you might want to call the browser synchronously or 
" asynchronously, and the latter is os-dependent;
"
" by default, the browser is started in the background when on 
" windows or if running in a gui, and in the foreground otherwise
" (eg, console-mode for remote sessions, with text-mode browsers).
"
" you can override these defaults in your vimrc, via a format 
" string including 2 %s parameters (the first being the browser 
" to call, the second being the url).
if !exists("g:haddock_browser_callformat")
  if has("win32") || has("win64")
    let g:haddock_browser_callformat = 'start %s "%s"'
  else
    if has("gui_running")
      let g:haddock_browser_callformat = '%s %s '.printf(&shellredir,'/dev/null').' &'
    else
      let g:haddock_browser_callformat = '%s %s'
    endif
  endif
endif

" allow map leader override
if !exists("maplocalleader")
  let maplocalleader='_'
endif

command! DocSettings call DocSettings()
function! DocSettings()
  for v in ["g:haddock_browser","g:haddock_browser_callformat","g:haddock_docdir","g:haddock_indexfiledir","s:ghc_libdir","g:ghc_version","s:docdir","s:libraries","s:guide","s:haddock_indexfile"]
    if exists(v)
      echo v '=' eval(v)
    else
      echo v '='
    endif
  endfor
endfunction

function! DocBrowser(url)
  "echomsg "DocBrowser(".url.")"
  if (!exists("g:haddock_browser") || !executable(g:haddock_browser))
    echoerr s:scriptname." can't find documentation browser. please set g:haddock_browser"
    return
  endif
  " start browser to open url, according to specified format
  let url = a:url=~'^\(file://\|http://\)' ? a:url : 'file://'.a:url
  silent exe '!'.printf(g:haddock_browser_callformat,g:haddock_browser,escape(url,'#%')) 
endfunction

"Doc/Doct are an old interface for documentation lookup
"(that is the reason they are not documented!-)
"
"These uses are still fine at the moment, and are the reason 
"that this command still exists at all
"
" :Doc -top
" :Doc -libs
" :Doc -guide
"
"These uses may or may not work, and shouldn't be relied on anymore
"(usually, you want _?/_?1/_?2 or :MDoc; there is also :IDoc)
"
" :Doc length
" :Doc Control.Monad.when
" :Doc Data.List.
" :Doc Control.Monad.State.runState mtl
command! -nargs=+ Doc  call Doc('v',<f-args>)
command! -nargs=+ Doct call Doc('t',<f-args>)

function! Doc(kind,qualname,...) 
  let suffix   = '.html'
  let relative = '#'.a:kind.'%3A'

  if a:qualname=="-top"
    call DocBrowser(s:docdir . s:index)
    return
  elseif a:qualname=="-libs"
    call DocBrowser(s:libraries . s:index)
    return
  elseif a:qualname=="-guide"
    call DocBrowser(s:guide . s:index)
    return
  endif

  if a:0==0 " no package specified
    let package = 'base/'
  else
    let package = a:1 . '/'
  endif

  if match(a:qualname,'\.')==-1 " unqualified name
    let [qual,name] = [['Prelude'],a:qualname]
    let file = join(qual,'-') . suffix . relative . name
  elseif a:qualname[-1:]=='.' " module qualifier only
    let parts = split(a:qualname,'\.')
    let quallen = len(parts)-1
    let [qual,name] = [parts[0:quallen],parts[-1]]
    let file = join(qual,'-') . suffix
  else " qualified name
    let parts = split(a:qualname,'\.')
    let quallen = len(parts)-2
    let [qual,name] = [parts[0:quallen],parts[-1]]
    let file = join(qual,'-') . suffix . relative . name
  endif

  let path = s:libraries . package . file
  call DocBrowser(path)
endfunction

" TODO: add commandline completion for :IDoc
"       switch to :emenu instead of inputlist?
" indexed variant of Doc, looking up links in g:haddock_index
" usage:
"  1. :IDoc length
"  2. click on one of the choices, or select by number (starting from 0)
command! -nargs=+ IDoc call IDoc(<f-args>)
function! IDoc(name,...) 
  let choices = HaddockIndexLookup(a:name)
  if choices=={} | return | endif
  if a:0==0
    let keylist = map(deepcopy(keys(choices)),'substitute(v:val,"\\[.\\]","","")')
    let choice = inputlist(keylist)
  else
    let choice = a:1
  endif
  let path = values(choices)[choice] " assumes same order for keys/values..
  call DocBrowser(path)
endfunction

let s:flagref = s:guide . 'flag-reference.html'
if filereadable(s:flagref)
  " extract the generated fragment ids for the 
  " flag reference sections 
  let s:headerPat     = '.\{-}<h3 class="title"><a name="\([^"]*\)"><\/a>\([^<]*\)<\/h3>\(.*\)'
  let s:flagheaders   = []
  let s:flagheaderids = {}
  let s:contents      = join(readfile(s:flagref))
  let s:ml = matchlist(s:contents,s:headerPat)
  while s:ml!=[]
    let [_,s:id,s:title,s:r;s:x] = s:ml
    let s:flagheaders            = add(s:flagheaders, s:title)
    let s:flagheaderids[s:title] = s:id
    let s:ml = matchlist(s:r,s:headerPat)
  endwhile
  command! -nargs=1 -complete=customlist,CompleteFlagHeaders FlagReference call FlagReference(<f-args>)
  function! FlagReference(section)
    let relativeUrl = a:section==""||!exists("s:flagheaderids['".a:section."']") ? 
                    \ "" : "#".s:flagheaderids[a:section]
    call DocBrowser(s:flagref.relativeUrl)
  endfunction
  function! CompleteFlagHeaders(al,cl,cp)
    let s:choic