"
" use haddock docs and index files
" show documentation, complete & qualify identifiers 
"
" (Claus Reinke; last modified: 13/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
"   :ExportDocIndex saves g:docindex to cache file
"   :ImportDocIndex reloads g:docindex from cache file
"
" 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
"
" _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

" 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

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

" program to open urls
let g:docbrowser = "C:/Program Files/Opera/Opera.exe"

if (!exists("g:ghc") || !executable(g:ghc)) 
  if !executable('ghc') 
    echoerr "can't find ghc. please set g:ghc, or extend $PATH"
    finish
  else
    let g:ghc = 'ghc'
  endif
endif    

if !executable('ghc-pkg')
  echoerr "can't find ghc-pkg."
  finish
endif

if !executable(g:docbrowser)
  echoerr "can't find documentation browser. please set g:docbrowser"
  finish
endif

let s:ghc_libdir   = substitute(system(g:ghc . ' --print-libdir'),'\n','','')
let s:docdir       = s:ghc_libdir . '/doc/html/'
let s:libraries    = s:docdir . 'libraries/'
let s:guide        = s:docdir . 'users_guide/'
let s:index        = 'index.html'
let s:docindexfile = s:libraries . 'docindex.vim'

command! DocSettings call DocSettings()
function! DocSettings()
  for v in ["g:docbrowser","s:ghc_libdir","s:docdir","s:libraries","s:guide","s:docindexfile"]
    echo v '=' eval(v)
  endfor
endfunction

function! DocBrowser(url)
    " start browser to open url
    exe '!start ' . g:docbrowser . ' ' . escape(a:url,'#%')

    " what if we don't have a browser? viewing the html isn't readable..
    "let relative = match(a:url,'#')
    "echo 'split file://' . a:url[0: relative-1] . ' ' . a:url[relative :]
    "exe 'split file://' . a:url[0: relative-1] . '| /' . a:url[relative :]
endfunction

"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 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
  echo path
  call DocBrowser(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,...) 
  call HaveIndex()
  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 = s:libraries . values(choices)[choice]
  echo path
  call DocBrowser(path)
endfunction

" create a dictionary g:docindex, containing the haddoc index
command! DocIndex call DocIndex()
function! DocIndex()
  let files   = split(globpath(s:libraries,'doc-index-*.html'),'\n')
  "let files   = [s:libraries.'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 ' s:libraries
  for file in files  
    echo file[len(s:libraries):]
    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
  return 1
endfunction

command! ExportDocIndex call ExportDocIndex()
function! ExportDocIndex()
  let entries = []
  for key in keys(g:docindex)
    let entries += [key,string(g:docindex[key])]
  endfor
  call writefile(entries,s:docindexfile)
  redir end
endfunction

command! ImportDocIndex call ImportDocIndex()
function! ImportDocIndex()
  if filereadable(s:docindexfile)
    let lines = readfile(s:docindexfile)
    let i=0
    while i<len(lines)
      let [key,dict] = [lines[i],lines[i+1]]
      " can we avoid the exe here?
      exe 'let g:docindex[key] = '.dict 
      let i+=2
    endwhile
    return 1
  else
    return 0
  endif
endfunction

function! HaveIndex()
  return (g:docindex!={} || ImportDocIndex() || DocIndex() )
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 _? :call Popup()<cr>
function! Popup()
  amenu ]Popup.- :echo '-'<cr>
  aunmenu ]Popup
  call HaveIndex()
  let namsym   = GetNameSymbol(0)
  if namsym==[]
    return 0
  endif
  let [_,name] = namsym
  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(off)
  let name    = "[a-zA-Z0-9_']"
  let symbol  = "[-!#$%&\*\+/<=>\?@\\^|~:.]"
  let line    = getline('.')
  let start   = (col('.') - 1) + a:off
  "echo start line
  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 namsym   = GetNameSymbol(-1) " insert-mode: we're 1 beyond the text
    if namsym==[]
      return -1
    endif
    let [start,_] = namsym
    return start
  else " find keys matching with "a:base"
    let res = []
    let l   = len(a:base)-1
    call HaveIndex()
    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 _. :call Qualify()<cr>
function! Qualify()
  amenu ]Popup.- :echo '-'<cr>
  aunmenu ]Popup
  call HaveIndex()
  let namsym   = GetNameSymbol(0)
  if namsym==[]
    return 0
  endif
  let [start,name] = namsym
  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)
    let lhs=escape(prefix.name,'/')
    let rhs=escape(prefix.key.'.'.name,'/&')
    exe 'amenu ]Popup.'.escape(key,'\.').' :'.line.'s/'.lhs.'/'.rhs.'/<cr>'
    let i+=1
  endfor
  popup ]Popup
endfunction

" gather imports
function! GatherImports()
  let modules={}
  let i=1
  while i<=line('$')
    let ml = matchlist(getline(i),"import\\s*\\([a-zA-Z0-9_'.]\\+\\)")
    if !empty(ml)
      let modules[ml[1]] = i
    endif
    let i+=1
  endwhile
  return modules
endfunction

" create import for an unqualified name
map _i :call Import(0)<cr>
map _im :call Import(1)<cr>
function! Import(module)
  amenu ]Popup.- :echo '-'<cr>
  aunmenu ]Popup
  call HaveIndex()
  let namsym   = GetNameSymbol(0)
  if namsym==[]
    return 0
  endif
  let [start,name] = namsym
  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 dict   =g:docindex[name]
  if a:module
    let importlist = ''
  else
    let importlist = '('.name.')'
  endif
  for key in keys(dict)
    exe 'amenu ]Popup.'.escape(key,'\.').' :call append(search("\\%1c\\(import\\\\|module\\)","nb"),"import '.key.importlist.'")<cr>'
  endfor
  popup ]Popup
endfunction

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