Skip to content

Commit 54dfefb

Browse files
wz1000wz1000
committed
References Use db for findDef
save source file location to db Find source for boot files Use DynFlags from HieDb instead of unsafeGlobalDynFlags Return multiple definitions don't typecheck files on load Add support for persistent stale values Add persistent hie file rule docs wip better typedef defs for deps update hiedb Fix for files with errors Fix build integrate hiedb commands and set dynflags on boot workspace symbol tweaks, cabal.project Write ifaces on save use real mtime for saved files safe indexing bump hiedb Proper refs for FOIs hlint Update exe/Main.hs Co-authored-by: Pepe Iborra <[email protected]> Review comments update hiedb Update src/Development/IDE/Core/Shake.hs Co-authored-by: Pepe Iborra <[email protected]> Update src/Development/IDE/Core/Rules.hs Co-authored-by: Pepe Iborra <[email protected]> Update src/Development/IDE/Core/Rules.hs Co-authored-by: Pepe Iborra <[email protected]> Update src/Development/IDE/Spans/AtPoint.hs Co-authored-by: Pepe Iborra <[email protected]> Update src/Development/IDE/Core/Rules.hs Co-authored-by: Pepe Iborra <[email protected]> Apply suggestions from code review Co-authored-by: Pepe Iborra <[email protected]> more careful re-indexing update for hiedb-0.1.0.0 Remove cached-deps stuff for now explicit showSDoc docs in AtPoint add doc comment about database consistency add TODO for better position mapping from diff
1 parent 66ada8c commit 54dfefb

24 files changed

+693
-255
lines changed

‎ghcide/exe/Arguments.hs

+16-5
Original file line numberDiff line numberDiff line change
@@ -1,41 +1,52 @@
11
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22
-- SPDX-License-Identifier: Apache-2.0
33

4-
module Arguments(Arguments(..), getArguments) where
4+
module Arguments(Arguments, Arguments'(..), getArguments, IdeCmd(..)) where
55

66
import Options.Applicative
7+
import HieDb.Run
78

9+
type Arguments = Arguments' IdeCmd
810

9-
data Arguments = Arguments
11+
data IdeCmd = Typecheck [FilePath] | DbCmd Command | LSP
12+
13+
data Arguments' a = Arguments
1014
{argLSP :: Bool
1115
,argsCwd :: Maybe FilePath
12-
,argFiles :: [FilePath]
1316
,argsVersion :: Bool
1417
,argsShakeProfiling :: Maybe FilePath
1518
,argsOTMemoryProfiling :: Bool
1619
,argsTesting :: Bool
1720
,argsDisableKick :: Bool
1821
,argsThreads :: Int
1922
,argsVerbose :: Bool
23+
,argFilesOrCmd :: a
2024
}
2125

2226
getArguments :: IO Arguments
2327
getArguments = execParser opts
2428
where
2529
opts = info (arguments <**> helper)
2630
( fullDesc
27-
<> progDesc "Used as a test bed to check your IDE will work"
2831
<> header "ghcide - the core of a Haskell IDE")
2932

3033
arguments :: Parser Arguments
3134
arguments = Arguments
3235
<$> switch (long "lsp" <> help "Start talking to an LSP server")
3336
<*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")
34-
<*> many (argument str (metavar "FILES/DIRS..."))
3537
<*> switch (long "version" <> help "Show ghcide and GHC versions")
3638
<*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory")
3739
<*> switch (long "ot-memory-profiling" <> help "Record OpenTelemetry info to the eventlog. Needs the -l RTS flag to have an effect")
3840
<*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite")
3941
<*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation")
4042
<*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault)
4143
<*> switch (long "verbose" <> help "Include internal events in logging output")
44+
<*> ( hsubparser (command "typecheck" (info (Typecheck <$> fileCmd) fileInfo)
45+
<> command "hiedb" (info (DbCmd <$> cmdParser <**> helper) hieInfo)
46+
<> command "lsp" (info (pure LSP <**> helper) lspInfo) )
47+
<|> Typecheck <$> fileCmd )
48+
where
49+
fileCmd = many (argument str (metavar "FILES/DIRS..."))
50+
lspInfo = fullDesc <> progDesc "Start talking to an LSP server"
51+
fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work"
52+
hieInfo = fullDesc <> progDesc "Query .hie files"

‎ghcide/exe/Main.hs

+86-10
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22
-- SPDX-License-Identifier: Apache-2.0
33
{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
44
{-# LANGUAGE TemplateHaskell #-}
5+
{-# LANGUAGE CPP #-}
6+
#include "ghc-api-version.h"
57

68
module Main(main) where
79

@@ -31,7 +33,7 @@ import Development.IDE.Plugin
3133
import Development.IDE.Plugin.Completions as Completions
3234
import Development.IDE.Plugin.CodeAction as CodeAction
3335
import Development.IDE.Plugin.Test as Test
34-
import Development.IDE.Session (loadSession)
36+
import Development.IDE.Session (loadSession, cacheDir)
3537
import qualified Language.Haskell.LSP.Core as LSP
3638
import Language.Haskell.LSP.Messages
3739
import Language.Haskell.LSP.Types
@@ -55,6 +57,23 @@ import Text.Printf
5557
import Development.IDE.Core.Tracing
5658
import Development.IDE.Types.Shake (Key(Key))
5759

60+
import HieDb.Create
61+
import HieDb.Types
62+
import HieDb.Utils
63+
import Database.SQLite.Simple
64+
import qualified Data.ByteString.Char8 as B
65+
import qualified Crypto.Hash.SHA1 as H
66+
import Control.Concurrent.Async
67+
import Control.Exception
68+
import System.Directory
69+
import Data.ByteString.Base16
70+
import HieDb.Run (Options(..), runCommand)
71+
import Maybes (MaybeT(runMaybeT))
72+
import HIE.Bios.Types (CradleLoadResult(..))
73+
import HIE.Bios.Environment (getRuntimeGhcLibDir)
74+
import DynFlags
75+
76+
5877
ghcideVersion :: IO String
5978
ghcideVersion = do
6079
path <- getExecutablePath
@@ -66,6 +85,31 @@ ghcideVersion = do
6685
<> ") (PATH: " <> path <> ")"
6786
<> gitHashSection
6887

88+
-- | Wraps `withHieDb` to provide a database connection for reading, and a `HieWriterChan` for
89+
-- writing. Actions are picked off one by one from the `HieWriterChan` and executed in serial
90+
-- by a worker thread using a dedicated database connection.
91+
-- This is done in order to serialize writes to the database, or else SQLite becomes unhappy
92+
runWithDb :: FilePath -> (HieDb -> HieWriterChan -> IO ()) -> IO ()
93+
runWithDb fp k =
94+
withHieDb fp $ \writedb -> do
95+
execute_ (getConn writedb) "PRAGMA journal_mode=WAL;"
96+
initConn writedb
97+
chan <- newChan
98+
race_ (writerThread writedb chan) (withHieDb fp (flip k chan))
99+
where
100+
writerThread db chan = forever $ do
101+
k <- readChan chan
102+
k db `catch` \e@SQLError{} -> do
103+
hPutStrLn stderr $ "Error in worker, ignoring: " ++ show e
104+
105+
getHieDbLoc :: FilePath -> IO FilePath
106+
getHieDbLoc dir = do
107+
let db = dirHash++"-"++takeBaseName dir++"-"++VERSION_ghc <.> "hiedb"
108+
dirHash = B.unpack $ encode $ H.hash $ B.pack dir
109+
cDir <- IO.getXdgDirectory IO.XdgCache cacheDir
110+
createDirectoryIfMissing True cDir
111+
pure (cDir </> db)
112+
69113
main :: IO ()
70114
main = do
71115
-- WARNING: If you write to stdout before runLanguageServer
@@ -75,15 +119,47 @@ main = do
75119
if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
76120
else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
77121

122+
whenJust argsCwd IO.setCurrentDirectory
123+
124+
-- We want to set the global DynFlags right now, so that we can use
125+
-- `unsafeGlobalDynFlags` even before the project is configured
126+
dir <- IO.getCurrentDirectory
127+
dbLoc <- getHieDbLoc dir
128+
hieYaml <- runMaybeT $ yamlConfig dir
129+
cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
130+
libDirRes <- getRuntimeGhcLibDir cradle
131+
libdir <- case libDirRes of
132+
CradleSuccess libdir -> pure $ Just libdir
133+
CradleFail err -> do
134+
hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show err
135+
return Nothing
136+
CradleNone -> return Nothing
137+
dynFlags <- mapM (dynFlagsForPrinting . LibDir) libdir
138+
mapM_ setUnsafeGlobalDynFlags dynFlags
139+
140+
case argFilesOrCmd of
141+
DbCmd cmd -> do
142+
let opts :: Options
143+
opts = Options
144+
{ database = dbLoc
145+
, trace = False
146+
, quiet = False
147+
, virtualFile = False
148+
}
149+
runCommand (LibDir $ fromJust libdir) opts cmd
150+
Typecheck (Just -> argFilesOrCmd) | not argLSP -> runWithDb dbLoc $ runIde dir Arguments{..}
151+
_ -> let argFilesOrCmd = Nothing in runWithDb dbLoc $ runIde dir Arguments{..}
152+
153+
154+
runIde :: FilePath -> Arguments' (Maybe [FilePath]) -> HieDb -> HieWriterChan -> IO ()
155+
runIde dir Arguments{..} hiedb hiechan = do
156+
command <- makeLspCommandId "typesignature.add"
157+
78158
-- lock to avoid overlapping output on stdout
79159
lock <- newLock
80160
let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $
81161
T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg
82162

83-
whenJust argsCwd IO.setCurrentDirectory
84-
85-
dir <- IO.getCurrentDirectory
86-
command <- makeLspCommandId "typesignature.add"
87163

88164
let plugins = Completions.plugin <> CodeAction.plugin
89165
<> if argsTesting then Test.plugin else mempty
@@ -97,8 +173,8 @@ main = do
97173
options = def { LSP.executeCommandCommands = Just [command]
98174
, LSP.completionTriggerCharacters = Just "."
99175
}
100-
101-
if argLSP then do
176+
case argFilesOrCmd of
177+
Nothing -> do
102178
t <- offsetTime
103179
hPutStrLn stderr "Starting LSP server..."
104180
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
@@ -127,8 +203,8 @@ main = do
127203
unless argsDisableKick $
128204
action kick
129205
initialise caps rules
130-
getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs
131-
else do
206+
getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs hiedb hiechan
207+
Just argFiles -> do
132208
-- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error
133209
hSetEncoding stdout utf8
134210
hSetEncoding stderr utf8
@@ -162,7 +238,7 @@ main = do
162238
, optCheckProject = CheckProject False
163239
}
164240
logLevel = if argsVerbose then minBound else Info
165-
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs
241+
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs hiedb hiechan
166242

167243
putStrLn "\nStep 4/4: Type checking the files"
168244
setFilesOfInterest ide $ HashMap.fromList $ map ((, OnDisk) . toNormalizedFilePath') files

‎ghcide/ghcide.cabal

+13-1
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ library
5656
haskell-lsp-types == 0.22.*,
5757
haskell-lsp == 0.22.*,
5858
hie-compat,
59+
hiedb,
5960
mtl,
6061
network-uri,
6162
parallel,
@@ -239,6 +240,8 @@ executable ghcide
239240
if flag(ghc-lib)
240241
buildable: False
241242
default-language: Haskell2010
243+
include-dirs:
244+
include
242245
hs-source-dirs: exe
243246
ghc-options:
244247
-threaded
@@ -253,13 +256,21 @@ executable ghcide
253256
"-with-rtsopts=-I0 -qg -A128M"
254257
main-is: Main.hs
255258
build-depends:
259+
time,
260+
async,
261+
bytestring,
262+
base16-bytestring,
263+
cryptohash-sha1,
264+
hslogger,
265+
hiedb,
256266
aeson,
257267
base == 4.*,
258268
data-default,
259269
directory,
260270
extra,
261271
filepath,
262272
gitrev,
273+
ghc,
263274
hashable,
264275
haskell-lsp,
265276
haskell-lsp-types,
@@ -269,7 +280,8 @@ executable ghcide
269280
lens,
270281
optparse-applicative,
271282
text,
272-
unordered-containers
283+
unordered-containers,
284+
sqlite-simple
273285
other-modules:
274286
Arguments
275287
Paths_ghcide

‎ghcide/session-loader/Development/IDE/Session.hs

+1
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module Development.IDE.Session
88
,defaultLoadingOptions
99
,loadSession
1010
,loadSessionWithOptions
11+
,cacheDir
1112
) where
1213

1314
-- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses

‎ghcide/src/Development/IDE/Core/Compile.hs

+31-5
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,8 @@ module Development.IDE.Core.Compile
2121
, generateObjectCode
2222
, generateByteCode
2323
, generateHieAsts
24-
, writeHieFile
24+
, writeAndIndexHieFile
25+
, indexHieFile
2526
, writeHiFile
2627
, getModSummaryFromImports
2728
, loadHieFile
@@ -37,11 +38,16 @@ import Development.IDE.Core.Preprocessor
3738
import Development.IDE.Core.Shake
3839
import Development.IDE.GHC.Error
3940
import Development.IDE.GHC.Warnings
41+
import Development.IDE.Spans.Common
4042
import Development.IDE.Types.Diagnostics
4143
import Development.IDE.GHC.Orphans()
4244
import Development.IDE.GHC.Util
4345
import Development.IDE.Types.Options
4446
import Development.IDE.Types.Location
47+
import Outputable
48+
import Control.Concurrent.Chan
49+
50+
import HieDb
4551

4652
import Language.Haskell.LSP.Types (DiagnosticTag(..))
4753

@@ -95,6 +101,9 @@ import PrelNames
95101
import HeaderInfo
96102
import Maybes (orElse)
97103

104+
import Control.Concurrent.Extra (modifyVar_,modifyVar)
105+
import qualified Data.HashSet as HashSet
106+
98107
-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
99108
parseModule
100109
:: IdeOptions
@@ -390,20 +399,37 @@ generateHieAsts hscEnv tcm =
390399
where
391400
dflags = hsc_dflags hscEnv
392401

393-
writeHieFile :: HscEnv -> ModSummary -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic]
394-
writeHieFile hscEnv mod_summary exports ast source =
402+
indexHieFile :: HieDbWriter -> ModSummary -> NormalizedFilePath -> Compat.HieFile -> IO ()
403+
indexHieFile dbwriter mod_summary srcPath hf = do
404+
index <- modifyVar (pendingIndexes dbwriter) $ \pending -> pure $
405+
if HashSet.member srcPath pending
406+
then (pending,False)
407+
else (HashSet.insert srcPath pending, True)
408+
when index $ writeChan (channel dbwriter) $ \db -> do
409+
hPutStrLn stderr $ "Started indexing .hie file: " ++ targetPath ++ " for: " ++ show srcPath
410+
addRefsFromLoaded db targetPath (Just $ fromNormalizedFilePath srcPath) True modtime hf
411+
modifyVar_ (pendingIndexes dbwriter) (pure . HashSet.delete srcPath)
412+
hPutStrLn stderr $ "Finished indexing .hie file: " ++ targetPath
413+
where
414+
modtime = ms_hs_date mod_summary
415+
mod_location = ms_location mod_summary
416+
targetPath = Compat.ml_hie_file mod_location
417+
418+
writeAndIndexHieFile :: HscEnv -> HieDbWriter -> ModSummary -> NormalizedFilePath -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic]
419+
writeAndIndexHieFile hscEnv hiechan mod_summary srcPath exports ast source =
395420
handleGenerationErrors dflags "extended interface write/compression" $ do
396421
hf <- runHsc hscEnv $
397422
GHC.mkHieFile' mod_summary exports ast source
398423
atomicFileWrite targetPath $ flip GHC.writeHieFile hf
424+
indexHieFile hiechan mod_summary srcPath hf
399425
where
400426
dflags = hsc_dflags hscEnv
401427
mod_location = ms_location mod_summary
402428
targetPath = Compat.ml_hie_file mod_location
403429

404430
writeHiFile :: HscEnv -> HiFileResult -> IO [FileDiagnostic]
405431
writeHiFile hscEnv tc =
406-
handleGenerationErrors dflags "interface generation" $ do
432+
handleGenerationErrors dflags "interface write" $ do
407433
atomicFileWrite targetPath $ \fp ->
408434
writeIfaceFile dflags fp modIface
409435
where
@@ -736,7 +762,7 @@ getDocsBatch hsc_env _mod _names = do
736762
else pure (Right ( Map.lookup name dmap
737763
, Map.findWithDefault Map.empty name amap))
738764
case res of
739-
Just x -> return $ map (first prettyPrint) x
765+
Just x -> return $ map (first $ T.unpack . showGhc) x
740766
Nothing -> throwErrors errs
741767
where
742768
throwErrors = liftIO . throwIO . mkSrcErr

‎ghcide/src/Development/IDE/Core/FileExists.hs

+1
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module Development.IDE.Core.FileExists
66
, modifyFileExists
77
, getFileExists
88
, watchedGlobs
9+
, GetFileExists(..)
910
)
1011
where
1112

‎ghcide/src/Development/IDE/Core/OfInterest.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ import qualified Data.HashMap.Strict as HashMap
2525
import qualified Data.Text as T
2626
import Data.Tuple.Extra
2727
import Development.Shake
28-
import Control.Monad (void)
28+
import Control.Monad
2929

3030
import Development.IDE.Types.Exports
3131
import Development.IDE.Types.Location

0 commit comments

Comments
 (0)