hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix find being slow on legacy-interactive

Browse Source
This commit is contained in:
Daniel Gröber 2015-08-14 06:48:56 +02:00
parent 887ab3c599
commit 623cddd8ca
3 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Language/Haskell/GhcMod/Find.hs
View File

@ -56,7 +56,9 @@ isOutdated db =
-- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\] -- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
-- which will be concatenated. 'loadSymbolDb' is called internally. -- which will be concatenated. 'loadSymbolDb' is called internally.
findSymbol :: IOish m => Symbol -> GhcModT m String findSymbol :: IOish m => Symbol -> GhcModT m String
findSymbol sym = loadSymbolDb >>= lookupSymbol sym findSymbol sym = do
tmpdir <- cradleTempDir <$> cradle
loadSymbolDb tmpdir >>= lookupSymbol sym
-- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\] -- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
-- which will be concatenated. -- which will be concatenated.
@ -69,12 +71,11 @@ lookupSym sym db = M.findWithDefault [] sym $ table db
--------------------------------------------------------------- ---------------------------------------------------------------
-- | Loading a file and creates 'SymbolDb'. -- | Loading a file and creates 'SymbolDb'.
loadSymbolDb :: IOish m => GhcModT m SymbolDb loadSymbolDb :: IOish m => FilePath -> GhcModT m SymbolDb
loadSymbolDb = do loadSymbolDb dir = do
ghcMod <- liftIO ghcModExecutable ghcMod <- liftIO ghcModExecutable
tmpdir <- cradleTempDir <$> cradle
readProc <- gmReadProcess readProc <- gmReadProcess
file <- liftIO $ chop <$> readProc ghcMod ["dumpsym", tmpdir] "" file <- liftIO $ chop <$> readProc ghcMod ["dumpsym", dir] ""
!db <- M.fromAscList . map conv . lines <$> liftIO (readFile file) !db <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
return $ SymbolDb return $ SymbolDb
{ table = db { table = db

3
src/GHCMod.hs
View File

@ -373,7 +373,8 @@ legacyInteractive :: IOish m => GhcModT m ()
legacyInteractive = do legacyInteractive = do
opt <- options opt <- options
prepareCabalHelper prepareCabalHelper
symdbreq <- liftIO $ newSymDbReq opt tmpdir <- cradleTempDir <$> cradle
symdbreq <- liftIO $ newSymDbReq opt tmpdir
world <- getCurrentWorld world <- getCurrentWorld
legacyInteractiveLoop symdbreq world legacyInteractiveLoop symdbreq world

6
src/Misc.hs
View File

@ -20,9 +20,9 @@ import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
type SymDbReqAction = (Either GhcModError SymbolDb, GhcModLog) type SymDbReqAction = (Either GhcModError SymbolDb, GhcModLog)
data SymDbReq = SymDbReq (IORef (Async SymDbReqAction)) (IO SymDbReqAction) data SymDbReq = SymDbReq (IORef (Async SymDbReqAction)) (IO SymDbReqAction)
newSymDbReq :: Options -> IO SymDbReq newSymDbReq :: Options -> FilePath -> IO SymDbReq
newSymDbReq opt = do newSymDbReq opt dir = do
let act = runGhcModT opt loadSymbolDb let act = runGhcModT opt $ loadSymbolDb dir
req <- async act req <- async act
ref <- newIORef req ref <- newIORef req
return $ SymDbReq ref act return $ SymDbReq ref act