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

ghcide/exe/Arguments.hs

@@ -1,41 +1,52 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
-module Arguments(Arguments(..), getArguments) where
+module Arguments(Arguments, Arguments'(..), getArguments, IdeCmd(..)) where
 
 import Options.Applicative
+import HieDb.Run
 
+type Arguments = Arguments' IdeCmd
 
-data Arguments = Arguments
+data IdeCmd = Typecheck [FilePath] | DbCmd Command | LSP
+
+data Arguments' a = Arguments
     {argLSP :: Bool
     ,argsCwd :: Maybe FilePath
-    ,argFiles :: [FilePath]
     ,argsVersion :: Bool
     ,argsShakeProfiling :: Maybe FilePath
     ,argsOTMemoryProfiling :: Bool
     ,argsTesting :: Bool
     ,argsDisableKick :: Bool
     ,argsThreads :: Int
     ,argsVerbose :: Bool
+    ,argFilesOrCmd :: a
     }
 
 getArguments :: IO Arguments
 getArguments = execParser opts
   where
     opts = info (arguments <**> helper)
       ( fullDesc
-     <> progDesc "Used as a test bed to check your IDE will work"
      <> header "ghcide - the core of a Haskell IDE")
 
 arguments :: Parser Arguments
 arguments = Arguments
       <$> switch (long "lsp" <> help "Start talking to an LSP server")
       <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")
-      <*> many (argument str (metavar "FILES/DIRS..."))
       <*> switch (long "version" <> help "Show ghcide and GHC versions")
       <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory")
       <*> switch (long "ot-memory-profiling" <> help "Record OpenTelemetry info to the eventlog. Needs the -l RTS flag to have an effect")
       <*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite")
       <*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation")
       <*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault)
       <*> switch (long "verbose" <> help "Include internal events in logging output")
+      <*> ( hsubparser (command "typecheck" (info (Typecheck <$> fileCmd) fileInfo)
+                   <> command "hiedb" (info (DbCmd <$> cmdParser <**> helper) hieInfo)
+                   <> command "lsp" (info (pure LSP <**> helper) lspInfo)  )
+         <|> Typecheck <$> fileCmd )
+  where
+    fileCmd = many (argument str (metavar "FILES/DIRS..."))
+    lspInfo = fullDesc <> progDesc "Start talking to an LSP server"
+    fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work"
+    hieInfo = fullDesc <> progDesc "Query .hie files"

ghcide/exe/Main.hs

@@ -2,6 +2,8 @@
 -- SPDX-License-Identifier: Apache-2.0
 {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP #-}
+#include "ghc-api-version.h"
 
 module Main(main) where
 
@@ -31,7 +33,7 @@ import Development.IDE.Plugin
 import Development.IDE.Plugin.Completions as Completions
 import Development.IDE.Plugin.CodeAction as CodeAction
 import Development.IDE.Plugin.Test as Test
-import Development.IDE.Session (loadSession)
+import Development.IDE.Session (loadSession, cacheDir)
 import qualified Language.Haskell.LSP.Core as LSP
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types
@@ -55,6 +57,23 @@ import Text.Printf
 import Development.IDE.Core.Tracing
 import Development.IDE.Types.Shake (Key(Key))
 
+import HieDb.Create
+import HieDb.Types
+import HieDb.Utils
+import Database.SQLite.Simple
+import qualified Data.ByteString.Char8 as B
+import qualified Crypto.Hash.SHA1 as H
+import Control.Concurrent.Async
+import Control.Exception
+import System.Directory
+import Data.ByteString.Base16
+import HieDb.Run (Options(..), runCommand)
+import Maybes (MaybeT(runMaybeT))
+import HIE.Bios.Types (CradleLoadResult(..))
+import HIE.Bios.Environment (getRuntimeGhcLibDir)
+import DynFlags
+
+
 ghcideVersion :: IO String
 ghcideVersion = do
   path <- getExecutablePath
@@ -66,6 +85,31 @@ ghcideVersion = do
              <> ") (PATH: " <> path <> ")"
              <> gitHashSection
 
+-- | Wraps `withHieDb` to provide a database connection for reading, and a `HieWriterChan` for
+-- writing. Actions are picked off one by one from the `HieWriterChan` and executed in serial
+-- by a worker thread using a dedicated database connection.
+-- This is done in order to serialize writes to the database, or else SQLite becomes unhappy
+runWithDb :: FilePath -> (HieDb -> HieWriterChan -> IO ()) -> IO ()
+runWithDb fp k =
+  withHieDb fp $ \writedb -> do
+    execute_ (getConn writedb) "PRAGMA journal_mode=WAL;"
+    initConn writedb
+    chan <- newChan
+    race_ (writerThread writedb chan) (withHieDb fp (flip k chan))
+  where
+    writerThread db chan = forever $ do
+      k <- readChan chan
+      k db `catch` \e@SQLError{} -> do
+        hPutStrLn stderr $ "Error in worker, ignoring: " ++ show e
+
+getHieDbLoc :: FilePath -> IO FilePath
+getHieDbLoc dir = do
+  let db = dirHash++"-"++takeBaseName dir++"-"++VERSION_ghc <.> "hiedb"
+      dirHash = B.unpack $ encode $ H.hash $ B.pack dir
+  cDir <- IO.getXdgDirectory IO.XdgCache cacheDir
+  createDirectoryIfMissing True cDir
+  pure (cDir </> db)
+
 main :: IO ()
 main = do
     -- WARNING: If you write to stdout before runLanguageServer
@@ -75,15 +119,47 @@ main = do
     if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
     else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
 
+    whenJust argsCwd IO.setCurrentDirectory
+
+    -- We want to set the global DynFlags right now, so that we can use
+    -- `unsafeGlobalDynFlags` even before the project is configured
+    dir <- IO.getCurrentDirectory
+    dbLoc <- getHieDbLoc dir
+    hieYaml <- runMaybeT $ yamlConfig dir
+    cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
+    libDirRes <- getRuntimeGhcLibDir cradle
+    libdir <- case libDirRes of
+        CradleSuccess libdir -> pure $ Just libdir
+        CradleFail err -> do
+          hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show err
+          return Nothing
+        CradleNone -> return Nothing
+    dynFlags <- mapM (dynFlagsForPrinting . LibDir) libdir
+    mapM_ setUnsafeGlobalDynFlags dynFlags
+
+    case argFilesOrCmd of
+      DbCmd cmd -> do
+        let opts :: Options
+            opts = Options
+              { database = dbLoc
+              , trace = False
+              , quiet = False
+              , virtualFile = False
+              }
+        runCommand (LibDir $ fromJust libdir) opts cmd
+      Typecheck (Just -> argFilesOrCmd) | not argLSP -> runWithDb dbLoc $ runIde dir Arguments{..}
+      _ -> let argFilesOrCmd = Nothing in runWithDb dbLoc $ runIde dir Arguments{..}
+
+
+runIde :: FilePath -> Arguments' (Maybe [FilePath]) -> HieDb -> HieWriterChan -> IO ()
+runIde dir Arguments{..} hiedb hiechan = do
+    command <- makeLspCommandId "typesignature.add"
+
     -- lock to avoid overlapping output on stdout
     lock <- newLock
     let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $
             T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg
 
-    whenJust argsCwd IO.setCurrentDirectory
-
-    dir <- IO.getCurrentDirectory
-    command <- makeLspCommandId "typesignature.add"
 
     let plugins = Completions.plugin <> CodeAction.plugin
             <> if argsTesting then Test.plugin else mempty
@@ -97,8 +173,8 @@ main = do
         options = def { LSP.executeCommandCommands = Just [command]
                       , LSP.completionTriggerCharacters = Just "."
                       }
-
-    if argLSP then do
+    case argFilesOrCmd of
+      Nothing -> do
         t <- offsetTime
         hPutStrLn stderr "Starting LSP server..."
         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
                   unless argsDisableKick $
                     action kick
             initialise caps rules
-                getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs
-    else do
+                getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs hiedb hiechan
+      Just argFiles -> do
         -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error
         hSetEncoding stdout utf8
         hSetEncoding stderr utf8
@@ -162,7 +238,7 @@ main = do
                     , optCheckProject      = CheckProject False
                     }
             logLevel = if argsVerbose then minBound else Info
-        ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs
+        ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs hiedb hiechan
 
         putStrLn "\nStep 4/4: Type checking the files"
         setFilesOfInterest ide $ HashMap.fromList $ map ((, OnDisk) . toNormalizedFilePath') files

ghcide/ghcide.cabal

@@ -56,6 +56,7 @@ library
         haskell-lsp-types == 0.22.*,
         haskell-lsp == 0.22.*,
         hie-compat,
+        hiedb,
         mtl,
         network-uri,
         parallel,
@@ -239,6 +240,8 @@ executable ghcide
     if flag(ghc-lib)
       buildable: False
     default-language:   Haskell2010
+    include-dirs:
+        include
     hs-source-dirs:     exe
     ghc-options:
                 -threaded
@@ -253,13 +256,21 @@ executable ghcide
                 "-with-rtsopts=-I0 -qg -A128M"
     main-is: Main.hs
     build-depends:
+        time,
+        async,
+        bytestring,
+        base16-bytestring,
+        cryptohash-sha1,
+        hslogger,
+        hiedb,
         aeson,
         base == 4.*,
         data-default,
         directory,
         extra,
         filepath,
         gitrev,
+        ghc,
         hashable,
         haskell-lsp,
         haskell-lsp-types,
@@ -269,7 +280,8 @@ executable ghcide
         lens,
         optparse-applicative,
         text,
-        unordered-containers
+        unordered-containers,
+        sqlite-simple
     other-modules:
         Arguments
         Paths_ghcide

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

@@ -8,6 +8,7 @@ module Development.IDE.Session
   ,defaultLoadingOptions
   ,loadSession
   ,loadSessionWithOptions
+  ,cacheDir
   ) where
 
 -- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses

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

@@ -21,7 +21,8 @@ module Development.IDE.Core.Compile
   , generateObjectCode
   , generateByteCode
   , generateHieAsts
-  , writeHieFile
+  , writeAndIndexHieFile
+  , indexHieFile
   , writeHiFile
   , getModSummaryFromImports
   , loadHieFile
@@ -37,11 +38,16 @@ import Development.IDE.Core.Preprocessor
 import Development.IDE.Core.Shake
 import Development.IDE.GHC.Error
 import Development.IDE.GHC.Warnings
+import Development.IDE.Spans.Common
 import Development.IDE.Types.Diagnostics
 import Development.IDE.GHC.Orphans()
 import Development.IDE.GHC.Util
 import Development.IDE.Types.Options
 import Development.IDE.Types.Location
+import Outputable
+import Control.Concurrent.Chan
+
+import HieDb
 
 import Language.Haskell.LSP.Types (DiagnosticTag(..))
 
@@ -95,6 +101,9 @@ import PrelNames
 import HeaderInfo
 import Maybes (orElse)
 
+import Control.Concurrent.Extra (modifyVar_,modifyVar)
+import qualified Data.HashSet as HashSet
+
 -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
 parseModule
     :: IdeOptions
@@ -390,20 +399,37 @@ generateHieAsts hscEnv tcm =
   where
     dflags = hsc_dflags hscEnv
 
-writeHieFile :: HscEnv -> ModSummary -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic]
-writeHieFile hscEnv mod_summary exports ast source =
+indexHieFile :: HieDbWriter -> ModSummary -> NormalizedFilePath -> Compat.HieFile -> IO ()
+indexHieFile dbwriter mod_summary srcPath hf = do
+  index <- modifyVar (pendingIndexes dbwriter) $ \pending -> pure $
+    if HashSet.member srcPath pending
+      then (pending,False)
+      else (HashSet.insert srcPath pending, True)
+  when index $ writeChan (channel dbwriter) $ \db -> do
+    hPutStrLn stderr $ "Started indexing .hie file: " ++ targetPath ++ " for: " ++ show srcPath
+    addRefsFromLoaded db targetPath (Just $ fromNormalizedFilePath srcPath) True modtime hf
+    modifyVar_ (pendingIndexes dbwriter) (pure . HashSet.delete srcPath)
+    hPutStrLn stderr $ "Finished indexing .hie file: " ++ targetPath
+  where
+    modtime      = ms_hs_date mod_summary
+    mod_location = ms_location mod_summary
+    targetPath   = Compat.ml_hie_file mod_location
+
+writeAndIndexHieFile :: HscEnv -> HieDbWriter -> ModSummary -> NormalizedFilePath -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic]
+writeAndIndexHieFile hscEnv hiechan mod_summary srcPath exports ast source =
   handleGenerationErrors dflags "extended interface write/compression" $ do
     hf <- runHsc hscEnv $
       GHC.mkHieFile' mod_summary exports ast source
     atomicFileWrite targetPath $ flip GHC.writeHieFile hf
+    indexHieFile hiechan mod_summary srcPath hf
   where
     dflags       = hsc_dflags hscEnv
     mod_location = ms_location mod_summary
     targetPath   = Compat.ml_hie_file mod_location
 
 writeHiFile :: HscEnv -> HiFileResult -> IO [FileDiagnostic]
 writeHiFile hscEnv tc =
-  handleGenerationErrors dflags "interface generation" $ do
+  handleGenerationErrors dflags "interface write" $ do
     atomicFileWrite targetPath $ \fp ->
       writeIfaceFile dflags fp modIface
   where
@@ -736,7 +762,7 @@ getDocsBatch hsc_env _mod _names = do
                else pure (Right ( Map.lookup name dmap
                                 , Map.findWithDefault Map.empty name amap))
     case res of
-        Just x -> return $ map (first prettyPrint) x
+        Just x -> return $ map (first $ T.unpack . showGhc) x
         Nothing -> throwErrors errs
   where
     throwErrors = liftIO . throwIO . mkSrcErr

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

@@ -6,6 +6,7 @@ module Development.IDE.Core.FileExists
   , modifyFileExists
   , getFileExists
   , watchedGlobs
+  , GetFileExists(..)
   )
 where
 

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

@@ -25,7 +25,7 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text as T
 import Data.Tuple.Extra
 import Development.Shake
-import Control.Monad (void)
+import Control.Monad
 
 import Development.IDE.Types.Exports
 import Development.IDE.Types.Location