From 64e6e7e550de887ece2087d92e0e30f386787e2b Mon Sep 17 00:00:00 2001
From: Marc Weber <marco-oweber@gmx.de>
Date: Tue, 27 Jan 2009 16:06:47 +0100
Subject: [PATCH] Added experimental cmdThingAtPointMoreInfo.

To returns info about the module exporting the thing in a hacky way.
---
 server/Scion/Server/Protocol/Vim.hs   | 35 +++++++++++++++++++++++++++
 vim_runtime_path/ftplugin/haskell.vim |  6 +++++
 2 files changed, 41 insertions(+)

diff --git a/server/Scion/Server/Protocol/Vim.hs b/server/Scion/Server/Protocol/Vim.hs
index 741448e..850f517 100644
--- a/server/Scion/Server/Protocol/Vim.hs
+++ b/server/Scion/Server/Protocol/Vim.hs
@@ -64,6 +64,7 @@ import Text.ParserCombinators.Parsec
 import Text.ParserCombinators.Parsec.Char
 
 import Text.ParserCombinators.ReadP (skipSpaces)
+import qualified Data.Set as Set
 
 log = HL.logM __FILE__
 logInfo = log HL.INFO
@@ -88,6 +89,9 @@ vimCommands =
     , cmdForceUnload
     , cmdAddCmdLineFlag
     , cmdThingAtPoint
+    -- for testing. I'd like to get the module which is exporting the thing one day.. 
+    -- basically its the same as cmdThingAtPoint
+    , cmdThingAtPointMoreInfo
     -- , cmdDumpSources
     ]
 
@@ -244,6 +248,37 @@ cmdThingAtPoint = VimCommand "cmdThingAtPoint" $ \map' -> do
                   _ -> return (Just (O.showSDocDebug (O.ppr x O.$$ O.ppr xs )))
         _ -> return Nothing
 
+cmdThingAtPointMoreInfo = VimCommand "cmdThingAtPointMoreInfo" $ \map' -> do
+  file <- requireArg map' "file"
+  line <- lookupAndReadFail map' "line"
+  col <- lookupAndReadFail map' "col"
+  liftM toVim $ cmd file line col
+  where
+    -- TODO remove this code duplication ! 
+    cmd fname line col = do
+      let loc = srcLocSpan $ mkSrcLoc (fsLit fname) line col
+      tc_res <- gets bgTcCache
+      case tc_res of
+        Just (Typechecked tcm) -> do
+            --let Just (src, _, _, _, _) = renamedSource tcm
+            let src = typecheckedSource tcm
+            --let in_range = const True
+            let in_range = overlaps loc
+            let r = findHsThing in_range src
+            return (Just (O.showSDoc (O.ppr $ Set.toList r)))
+            -- unqual <- unqualifiedForModule tcm
+            -- case pathToDeepest r of
+            --   Nothing -> return (Just "no info")
+            --   Just (x,xs) ->
+            --     --return $ Just (O.showSDoc (O.ppr x O.$$ O.ppr xs))
+            --     case typeOf (x,xs) of
+            --       Just t ->
+            --           return $ Just $ O.showSDocForUser unqual
+            --             (prettyResult x O.<+> O.dcolon O.<+> 
+            --               pprTypeForUser True t)
+            --       _ -> return (Just (O.showSDocDebug (O.ppr x O.$$ O.ppr xs )))
+        _ -> return Nothing
+
 -- cmdDumpSources = VimCommand "cmdDumpSources" $ \map -> do
 --   liftM toVim $ do
 --     tc_res <- gets bgTcCache
diff --git a/vim_runtime_path/ftplugin/haskell.vim b/vim_runtime_path/ftplugin/haskell.vim
index 700581b..9a78a5d 100644
--- a/vim_runtime_path/ftplugin/haskell.vim
+++ b/vim_runtime_path/ftplugin/haskell.vim
@@ -78,6 +78,12 @@ command! -buffer -nargs=* -complete=file BackgroundTypecheckFile
   \ call s:BackgroundTypecheckFile(<f-args>)
 command! -buffer ThingAtPoint
   \ echo haskellcomplete#EvalScion({'request' : 'cmdThingAtPoint', 'file' : expand('%:p'), 'line' : line('.').'', 'col' : col('.').''})
+command! -buffer ThingAtPointExportedByHack
+  \ echo filter(
+      \ split(haskellcomplete#EvalScion({'request' : 'cmdThingAtPointMoreInfo'
+        \, 'file' : expand('%:p')
+        \, 'line' : line('.').'', 'col' : col('.').''})['Just'],"\n")
+      \ , 'v:val =~ '.string(expand('<cword>').' ='))[0]
 
 command! -buffer ListRdrNamesInScope
   \ echo haskellcomplete#EvalScion({'request' : 'cmdListRdrNamesInScope'})