Skip to content

Commit 6ad3d06

Browse files
committed
Index .hls/dependencies files in lookupMod
1 parent 13629b7 commit 6ad3d06

File tree

1 file changed

+46
-32
lines changed

1 file changed

+46
-32
lines changed

ghcide/src/Development/IDE/Core/Actions.hs

Lines changed: 46 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,10 @@ module Development.IDE.Core.Actions
1313
, lookupMod
1414
) where
1515

16+
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar)
17+
import Control.Concurrent.STM (atomically)
18+
import Control.Concurrent.STM.TQueue (unGetTQueue)
19+
import Control.Monad (unless)
1620
import Control.Monad.Reader
1721
import Control.Monad.Trans.Maybe
1822
import qualified Data.ByteString as BS
@@ -48,48 +52,58 @@ lookupMod
4852
-> Unit
4953
-> Bool -- ^ Is this file a boot file?
5054
-> MaybeT IdeAction Uri
51-
lookupMod _dbchan hieFile moduleName uid _boot = MaybeT $ do
55+
lookupMod HieDbWriter{indexQueue} hieFile moduleName uid _boot = MaybeT $ do
5256
mProjectRoot <- (resRootPath =<<) <$> asks lspEnv
5357
case mProjectRoot of
5458
Nothing -> pure Nothing
5559
Just projectRoot -> do
56-
let toFilePath :: ModuleName -> FilePath
57-
toFilePath = separateDirectories . prettyModuleName
58-
where
59-
separateDirectories :: FilePath -> FilePath
60-
separateDirectories moduleNameString =
61-
case breakOnDot moduleNameString of
62-
[] -> ""
63-
ms -> foldr1 (</>) ms
64-
breakOnDot :: FilePath -> [FilePath]
65-
breakOnDot = words . map replaceDotWithSpace
66-
replaceDotWithSpace :: Char -> Char
67-
replaceDotWithSpace '.' = ' '
68-
replaceDotWithSpace c = c
69-
prettyModuleName :: ModuleName -> String
70-
prettyModuleName = filter (/= '"')
71-
. concat
72-
. drop 1
73-
. words
74-
. show
75-
writeOutDir :: FilePath
76-
writeOutDir = projectRoot </> ".hls" </> "dependencies" </> show uid
77-
writeOutFile :: FilePath
78-
writeOutFile = toFilePath moduleName ++ ".hs"
79-
writeOutPath :: FilePath
80-
writeOutPath = writeOutDir </> writeOutFile
81-
moduleUri :: Uri
82-
moduleUri = AtPoint.toUri writeOutPath
60+
completionToken <- liftIO $ newEmptyMVar
61+
moduleUri <- writeAndIndexSource projectRoot completionToken
62+
liftIO $ readMVar completionToken
63+
pure $ Just moduleUri
64+
where
65+
writeAndIndexSource :: FilePath -> MVar () -> IdeAction Uri
66+
writeAndIndexSource projectRoot completionToken = do
8367
fileExists <- liftIO $ doesFileExist writeOutPath
84-
if fileExists
85-
then pure $ Just moduleUri
86-
else do
68+
unless fileExists $ do
8769
nc <- asks ideNc
8870
liftIO $ do
8971
createDirectoryIfMissing True $ takeDirectory writeOutPath
9072
moduleSource <- hie_hs_src <$> loadHieFile (mkUpdater nc) hieFile
9173
BS.writeFile writeOutPath moduleSource
92-
pure $ Just moduleUri
74+
liftIO $ atomically $
75+
unGetTQueue indexQueue $ \withHieDb -> withHieDb $ \db -> do
76+
HieDb.addSrcFile db hieFile writeOutPath False
77+
putMVar completionToken ()
78+
pure $ moduleUri
79+
where
80+
writeOutDir :: FilePath
81+
writeOutDir = projectRoot </> ".hls" </> "dependencies" </> show uid
82+
writeOutFile :: FilePath
83+
writeOutFile = toFilePath moduleName ++ ".hs"
84+
writeOutPath :: FilePath
85+
writeOutPath = writeOutDir </> writeOutFile
86+
moduleUri :: Uri
87+
moduleUri = AtPoint.toUri writeOutPath
88+
toFilePath :: ModuleName -> FilePath
89+
toFilePath = separateDirectories . prettyModuleName
90+
where
91+
separateDirectories :: FilePath -> FilePath
92+
separateDirectories moduleNameString =
93+
case breakOnDot moduleNameString of
94+
[] -> ""
95+
ms -> foldr1 (</>) ms
96+
breakOnDot :: FilePath -> [FilePath]
97+
breakOnDot = words . map replaceDotWithSpace
98+
replaceDotWithSpace :: Char -> Char
99+
replaceDotWithSpace '.' = ' '
100+
replaceDotWithSpace c = c
101+
prettyModuleName :: ModuleName -> String
102+
prettyModuleName = filter (/= '"')
103+
. concat
104+
. drop 1
105+
. words
106+
. show
93107

94108

95109

0 commit comments

Comments
 (0)