"
" use haddock docs and index files
" (Claus Reinke 04/03/2007)
"
" :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:docindex
"   :DocIndex populates g:docindex from haddock's index files
"
" all the following use the haddock index (g:docindex)
"
" _? 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
"
" CTRL-X CTRL-U (user-defined insert mode completion) 
"   suggests completions of unqualified names in popup menu

" windows/ghc/opera-specific code follows! 
"   there is probably nothing that precludes porting, but you'll
"   need to replace paths and start command for your systems/browsers

" nested dictionary, to be populated from haddock index files
" via :DocIndex
let g:docindex = {}

"usage examples:
" :Doc "length"
" :Doc "Control.Monad.when"
" :Doc "Data.List." 
" :Doc "Control.Monad.State.runState","mtl"
" :Doc "-top"
" :Doc "-libs"
" :Doc "-guide"
command! Doc  call Doc('v',<args>)
command! Doct call Doc('t',<args>)

function! Doc(kind,qualname,...) 
  let browser  = '"C:\Program Files\Opera\Opera.exe"'
  let top      = 'C:\ghc\ghc-6.4.1\doc\html\'
  let guide    = top . 'users_guide\'
  let haddocs  = top . 'libraries\'
  let index    = 'index.html'
  let suffix   = '.html'
  let relative = escape('#'.a:kind.'%3A','#%')

  if a:qualname=="-top"
    exe '!start ' . browser . ' ' . top . index
    return
  elseif a:qualname=="-libs"
    exe '!start ' . browser . ' ' . haddocs . index
    return
  elseif a:qualname=="-guide"
    exe '!start ' . browser . ' ' . guide . 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 = haddocs . package . file
  echo path
  exe '!start ' . browser . ' ' . path
endfunction

" indexed variant of Doc, looking up links in g:docindex
" usage:
"  1. :IDoc "length"
"  2. click on one of the choices, or select by number (starting from 0)
command! IDoc call IDoc(<args>)
function! IDoc(name,...) 
  let browser = '"C:\Program Files\Opera\Opera.exe"'
  let top     = 'C:\ghc\ghc-6.4.1\doc\html\libraries\'
  if g:docindex == {} " need to create index first?
    call DocIndex()
  endif
  if !has_key(g:docindex,a:name)
    echoerr a:name 'not found in haddock index'
    return
  endif
  let choices = g:docindex[a:name]
  if a:0==0
    let choice = inputlist(keys(choices))
  else
    let choice = a:1
  endif

  let path = escape(top . values(choices)[choice], '#%')
  echo path
  exe '!start ' . browser . ' ' . path
endfunction

" create a dictionary g:docindex, containing the haddoc index
command! DocIndex call DocIndex()
function! DocIndex()
  let top     = 'C:\ghc\ghc-6.4.1\doc\html\libraries\'
  let files   = split(globpath(top,'doc-index-*.html'),'\n')
  "let files   = [top.'doc-index-33.html']
  let entryPat= '.\{-}"indexentry"[^>]*>\([^<]*\)<\(\%([^=]\{-}TD CLASS="\%(indexentry\)\@!.\{-}</TD\)*\)[^=]\{-}\(\%(="indexentry\|TABLE\).*\)'
  let linkPat = '.\{-}HREF="\([^"]*\)".>\([^<]*\)<\(.*\)'
  let g:docindex = {}
  echo 'populating g:docindex from haddock index files in ' top
  for file in files  
    echo file[len(top):]
    let contents = join(readfile(file))
    let ml = matchlist(contents,entryPat)
    while ml!=[]
      let [_,entry,links,r;x] = ml
      "echo entry links
      let ml2 = matchlist(links,linkPat)
      let link = {}
      while ml2!=[]
        let [_,l,m,links;x] = ml2
        "echo l m
        let link[m] = l
        let ml2 = matchlist(links,linkPat)
      endwhile
      let g:docindex[DeHTML(entry)] = deepcopy(link)
      "echo entry g:docindex[entry]
      let ml = matchlist(r,entryPat)
    endwhile
  endfor
endfunction

" decode HTML symbol encodings (are these all we need?)
function! DeHTML(entry)
  let res = a:entry
  let decode = { '&lt;': '<', '&gt;': '>', '&amp;': '\\&' }
  for enc in keys(decode)
    exe 'let res = substitute(res,"'.enc.'","'.decode[enc].'","g")'
  endfor
  return res
endfunction

" find haddocks for word under cursor
" also lists possible definition sites
map _? :exe 'call Popup()'<cr>
function! Popup()
  amenu ]Popup.- :echo '-'<cr>
  aunmenu ]Popup
  if g:docindex == {} " need to create index first?
    call DocIndex()
  endif
  let [_,name] = GetNameSymbol()
  if !has_key(g:docindex,name)
    echoerr name 'not found in haddock index'
    return
  endif
  let i=0
  for key in keys(g:docindex[name])
    exe 'amenu ]Popup.'.escape(key,'\.').' :call IDoc("'.name.'",'.i.')<cr>'
    let i+=1
  endfor
  popup ]Popup
endfunction

" find start/extent of unqualified name/symbol under cursor
function! GetNameSymbol()
  let name    = "[a-zA-Z0-9_']"
  let symbol  = "[-!#$%&\*\+/<=>\?@\\^|~:.]"
  let line    = getline('.')
  let start   = col('.') - 1
  if line[start] =~ name
    let pattern = name
  elseif line[start] =~ symbol
    let pattern = symbol
  else
    echoerr 'no unqualified name/symbol under cursor!'
    return 
  endif
  while start > 0 && line[start - 1] =~ pattern
    let start -= 1
  endwhile
  return [start,matchstr(line[start :],pattern.'*')]
endfunction

" use haddock name index for insert mode completion (CTRL-X CTRL-U)
function! CompleteHaddock(findstart, base)
  if a:findstart 
    let [start,_] = GetNameSymbol()
    return start
  else " find keys matching with "a:base"
    let res = []
    let l   = len(a:base)-1
    if g:docindex == {} " need to create index first?
      echoerr 'need to create index! :DocIndex'
    endif
    for key in keys(g:docindex)
      if key[0 : l]==a:base
        let res += [key]
      endif
    endfor
    return res
  endif
endfunction
set completefunc=CompleteHaddock

" fully qualify an unqualified name
map _. :exe 'call Qualify()'<cr>
function! Qualify()
  amenu ]Popup.- :echo '-'<cr>
  aunmenu ]Popup
  if g:docindex == {} " need to create index first?
    call DocIndex()
  endif
  let [start,name] = GetNameSymbol()
  let line         = line('.')
  let prefix       = getline(line)[0:start-1]
  if !has_key(g:docindex,name)
    echoerr name 'not found in haddock index'
    return
  endif
  let i=0
  let dict=g:docindex[name]
  for key in keys(dict)
    "exe 'amenu ]Popup.'.escape(key,'\.').' :echo "'.key.'.'.name.'"<cr>'
    exe 'amenu ]Popup.'.escape(key,'\.').' :'.line.'s/'.prefix.name.'/'.prefix.key.'.'.name.'/<cr>'
    let i+=1
  endfor
  popup ]Popup
endfunction

" test area
"
" _? 
"   Monad length runState False
"
" i CTRL-X CTRL-U
"   pres
"   preservingMatrix
"   Graphics.Rendering.OpenGL.preservingMatrix