Skip to content

Commit 53035c9

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 <pepeiborra@me.com> Review comments update hiedb Update src/Development/IDE/Core/Shake.hs Co-authored-by: Pepe Iborra <pepeiborra@me.com> Update src/Development/IDE/Core/Rules.hs Co-authored-by: Pepe Iborra <pepeiborra@me.com> Update src/Development/IDE/Core/Rules.hs Co-authored-by: Pepe Iborra <pepeiborra@me.com> Update src/Development/IDE/Spans/AtPoint.hs Co-authored-by: Pepe Iborra <pepeiborra@me.com> Update src/Development/IDE/Core/Rules.hs Co-authored-by: Pepe Iborra <pepeiborra@me.com> Apply suggestions from code review Co-authored-by: Pepe Iborra <pepeiborra@me.com> 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 6b0740c commit 53035c9

25 files changed

+694
-251
lines changed

Diff for: ‎cabal.project

+1-1
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ package ghcide
2323

2424
write-ghc-environment-files: never
2525

26-
index-state: 2020-12-13T11:31:58Z
26+
index-state: 2020-12-29T11:31:58Z
2727

2828
allow-newer:
2929
active:base,

Diff for: ‎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"

Diff for: ‎ghcide/exe/Main.hs

+86-6
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

@@ -29,7 +31,7 @@ import Development.IDE.Types.Options
2931
import Development.IDE.Types.Logger
3032
import Development.IDE.Plugin
3133
import Development.IDE.Plugin.Test as Test
32-
import Development.IDE.Session (loadSession)
34+
import Development.IDE.Session (loadSession, cacheDir)
3335
import qualified Language.Haskell.LSP.Core as LSP
3436
import Language.Haskell.LSP.Messages
3537
import Language.Haskell.LSP.Types
@@ -57,6 +59,23 @@ import Development.IDE.Plugin.HLS.GhcIde as GhcIde
5759
import Ide.Plugin.Config
5860
import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins)
5961

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

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

124+
whenJust argsCwd IO.setCurrentDirectory
125+
126+
-- We want to set the global DynFlags right now, so that we can use
127+
-- `unsafeGlobalDynFlags` even before the project is configured
128+
dir <- IO.getCurrentDirectory
129+
dbLoc <- getHieDbLoc dir
130+
hieYaml <- runMaybeT $ yamlConfig dir
131+
cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
132+
libDirRes <- getRuntimeGhcLibDir cradle
133+
libdir <- case libDirRes of
134+
CradleSuccess libdir -> pure $ Just libdir
135+
CradleFail err -> do
136+
hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show err
137+
return Nothing
138+
CradleNone -> return Nothing
139+
dynFlags <- mapM (dynFlagsForPrinting . LibDir) libdir
140+
mapM_ setUnsafeGlobalDynFlags dynFlags
141+
142+
case argFilesOrCmd of
143+
DbCmd cmd -> do
144+
let opts :: Options
145+
opts = Options
146+
{ database = dbLoc
147+
, trace = False
148+
, quiet = False
149+
, virtualFile = False
150+
}
151+
runCommand (LibDir $ fromJust libdir) opts cmd
152+
Typecheck (Just -> argFilesOrCmd) | not argLSP -> runWithDb dbLoc $ runIde dir Arguments{..}
153+
_ -> let argFilesOrCmd = Nothing in runWithDb dbLoc $ runIde dir Arguments{..}
154+
155+
156+
runIde :: FilePath -> Arguments' (Maybe [FilePath]) -> HieDb -> HieWriterChan -> IO ()
157+
runIde dir Arguments{..} hiedb hiechan = do
158+
command <- makeLspCommandId "typesignature.add"
159+
80160
-- lock to avoid overlapping output on stdout
81161
lock <- newLock
82162
let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $
@@ -104,8 +184,8 @@ main = do
104184
options = def { LSP.executeCommandCommands = Just hlsCommands
105185
, LSP.completionTriggerCharacters = Just "."
106186
}
107-
108-
if argLSP then do
187+
case argFilesOrCmd of
188+
Nothing -> do
109189
t <- offsetTime
110190
hPutStrLn stderr "Starting LSP server..."
111191
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
@@ -134,8 +214,8 @@ main = do
134214
unless argsDisableKick $
135215
action kick
136216
initialise caps rules
137-
getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs
138-
else do
217+
getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs hiedb hiechan
218+
Just argFiles -> do
139219
-- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error
140220
hSetEncoding stdout utf8
141221
hSetEncoding stderr utf8
@@ -169,7 +249,7 @@ main = do
169249
, optCheckProject = False
170250
}
171251
logLevel = if argsVerbose then minBound else Info
172-
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs
252+
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs hiedb hiechan
173253

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

Diff for: ‎ghcide/ghcide.cabal

+13-1
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ library
5858
hie-compat,
5959
hls-plugin-api,
6060
lens,
61+
hiedb,
6162
mtl,
6263
network-uri,
6364
parallel,
@@ -243,6 +244,8 @@ executable ghcide
243244
if flag(ghc-lib)
244245
buildable: False
245246
default-language: Haskell2010
247+
include-dirs:
248+
include
246249
hs-source-dirs: exe
247250
ghc-options:
248251
-threaded
@@ -257,13 +260,21 @@ executable ghcide
257260
"-with-rtsopts=-I0 -qg -A128M"
258261
main-is: Main.hs
259262
build-depends:
263+
time,
264+
async,
265+
bytestring,
266+
base16-bytestring,
267+
cryptohash-sha1,
268+
hslogger,
269+
hiedb,
260270
aeson,
261271
base == 4.*,
262272
data-default,
263273
directory,
264274
extra,
265275
filepath,
266276
gitrev,
277+
ghc,
267278
hashable,
268279
haskell-lsp,
269280
haskell-lsp-types,
@@ -274,7 +285,8 @@ executable ghcide
274285
lens,
275286
optparse-applicative,
276287
text,
277-
unordered-containers
288+
unordered-containers,
289+
sqlite-simple
278290
other-modules:
279291
Arguments
280292
Paths_ghcide

Diff for: ‎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

Diff for: ‎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

Diff for: ‎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

Diff for: ‎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)