Skip to content

Commit 513b0ce

Browse files
pepeiborrapepeiborra
committed
Added a command to index the database and exit
1 parent fc5a412 commit 513b0ce

File tree

3 files changed

+96
-67
lines changed

3 files changed

+96
-67
lines changed

‎ghcide/exe/Main.hs

Lines changed: 42 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -25,20 +25,16 @@ import Development.IDE.Core.Rules (mainRule)
2525
import qualified Development.IDE.Main as Main
2626
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
2727
import qualified Development.IDE.Plugin.Test as Test
28-
import Development.IDE.Session (getHieDbLoc,
29-
setInitialDynFlags)
3028
import Development.IDE.Types.Options
3129
import Development.Shake (ShakeOptions (shakeThreads))
32-
import HieDb.Run (Options (..), runCommand)
3330
import Ide.Plugin.Config (Config (checkParents, checkProject))
3431
import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig,
3532
pluginsToVSCodeExtensionSchema)
3633
import Ide.PluginUtils (pluginDescToIdePlugins)
3734
import Paths_ghcide (version)
3835
import qualified System.Directory.Extra as IO
3936
import System.Environment (getExecutablePath)
40-
import System.Exit (ExitCode (ExitFailure),
41-
exitSuccess, exitWith)
37+
import System.Exit (exitSuccess)
4238
import System.IO (hPutStrLn, stderr)
4339
import System.Info (compilerVersion)
4440

@@ -81,55 +77,45 @@ main = do
8177
logLevel = if argsVerbose then minBound else Info
8278

8379
case argFilesOrCmd of
84-
DbCmd opts cmd -> do
85-
dir <- IO.getCurrentDirectory
86-
dbLoc <- getHieDbLoc dir
87-
mlibdir <- setInitialDynFlags def
88-
case mlibdir of
89-
Nothing -> exitWith $ ExitFailure 1
90-
Just libdir -> runCommand libdir opts{database = dbLoc} cmd
91-
92-
_ -> do
93-
94-
case argFilesOrCmd of
95-
LSP -> do
96-
hPutStrLn stderr "Starting LSP server..."
97-
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
98-
_ -> return ()
99-
100-
Main.defaultMain def
101-
{Main.argFiles = case argFilesOrCmd of
102-
Typecheck x | not argLSP -> Just x
103-
_ -> Nothing
104-
105-
,Main.argsLogger = pure logger
106-
107-
,Main.argsRules = do
108-
-- install the main and ghcide-plugin rules
109-
mainRule
110-
-- install the kick action, which triggers a typecheck on every
111-
-- Shake database restart, i.e. on every user edit.
112-
unless argsDisableKick $
113-
action kick
114-
115-
,Main.argsHlsPlugins =
116-
pluginDescToIdePlugins $
117-
GhcIde.descriptors
118-
++ [Test.blockCommandDescriptor "block-command" | argsTesting]
119-
120-
,Main.argsGhcidePlugin = if argsTesting
121-
then Test.plugin
122-
else mempty
123-
124-
,Main.argsIdeOptions = \config sessionLoader ->
125-
let defOptions = defaultIdeOptions sessionLoader
126-
in defOptions
127-
{ optShakeProfiling = argsShakeProfiling
128-
, optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
129-
, optTesting = IdeTesting argsTesting
130-
, optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
131-
, optCheckParents = pure $ checkParents config
132-
, optCheckProject = pure $ checkProject config
133-
}
134-
}
80+
LSP -> do
81+
hPutStrLn stderr "Starting LSP server..."
82+
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
83+
_ -> return ()
84+
85+
Main.defaultMain def
86+
{Main.argCommand = case argFilesOrCmd of
87+
Typecheck x | not argLSP -> Main.Check x
88+
DbCmd x y -> Main.Db "." x y
89+
_ -> Main.Lsp
90+
91+
,Main.argsLogger = pure logger
92+
93+
,Main.argsRules = do
94+
-- install the main and ghcide-plugin rules
95+
mainRule
96+
-- install the kick action, which triggers a typecheck on every
97+
-- Shake database restart, i.e. on every user edit.
98+
unless argsDisableKick $
99+
action kick
100+
101+
,Main.argsHlsPlugins =
102+
pluginDescToIdePlugins $
103+
GhcIde.descriptors
104+
++ [Test.blockCommandDescriptor "block-command" | argsTesting]
105+
106+
,Main.argsGhcidePlugin = if argsTesting
107+
then Test.plugin
108+
else mempty
109+
110+
,Main.argsIdeOptions = \config sessionLoader ->
111+
let defOptions = defaultIdeOptions sessionLoader
112+
in defOptions
113+
{ optShakeProfiling = argsShakeProfiling
114+
, optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
115+
, optTesting = IdeTesting argsTesting
116+
, optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
117+
, optCheckParents = pure $ checkParents config
118+
, optCheckProject = pure $ checkProject config
119+
}
120+
}
135121

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 53 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,29 @@
1-
module Development.IDE.Main (Arguments(..), defaultMain) where
1+
module Development.IDE.Main
2+
(Arguments(..)
3+
,Command(..)
4+
,defaultMain
5+
) where
26
import Control.Concurrent.Extra (newLock, readVar,
37
withLock)
48
import Control.Exception.Safe (Exception (displayException),
59
catchAny)
610
import Control.Monad.Extra (concatMapM, unless,
711
when)
12+
import Control.Monad.IO.Class
813
import Data.Default (Default (def))
14+
import Data.Foldable (toList)
915
import qualified Data.HashMap.Strict as HashMap
1016
import Data.Hashable (hashed)
1117
import Data.List.Extra (intercalate, isPrefixOf,
1218
nub, nubOrd, partition)
1319
import Data.Maybe (catMaybes, fromMaybe,
14-
isJust)
20+
isJust, isNothing)
1521
import qualified Data.Text as T
1622
import qualified Data.Text.IO as T
17-
import Development.IDE (Action, Rules,
18-
hDuplicateTo')
23+
import Development.IDE (Action,
24+
GetKnownTargets (GetKnownTargets),
25+
GetModIfaceFromDiskAndIndex (GetModIfaceFromDiskAndIndex),
26+
Rules, hDuplicateTo')
1927
import Development.IDE.Core.Debouncer (Debouncer,
2028
newAsyncDebouncer)
2129
import Development.IDE.Core.FileStore (makeVFSHandle)
@@ -34,7 +42,8 @@ import Development.IDE.Core.Rules (GhcSessionIO (GhcSession
3442
import Development.IDE.Core.Service (initialise, runAction)
3543
import Development.IDE.Core.Shake (IdeState (shakeExtras),
3644
ShakeExtras (state),
37-
uses)
45+
toKnownFiles,
46+
useNoFile_, uses)
3847
import Development.IDE.Core.Tracing (measureMemory)
3948
import Development.IDE.LSP.LanguageServer (runLanguageServer)
4049
import Development.IDE.Plugin (Plugin (pluginHandlers, pluginRules))
@@ -57,6 +66,7 @@ import Development.Shake (action)
5766
import GHC.IO.Encoding (setLocaleEncoding)
5867
import GHC.IO.Handle (hDuplicate)
5968
import HIE.Bios.Cradle (findCradle)
69+
import qualified HieDb.Run as HieDb
6070
import Ide.Plugin.Config (CheckParents (NeverCheck),
6171
Config,
6272
getConfigFromNotification)
@@ -80,9 +90,15 @@ import System.Time.Extra (offsetTime,
8090
showDuration)
8191
import Text.Printf (printf)
8292

93+
data Command
94+
= Lsp -- ^ Run the LSP server
95+
| Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures
96+
| Index FilePath -- ^ Index the whole project and print the path to the database
97+
| Db FilePath HieDb.Options HieDb.Command -- ^ Run a command in the hiedb
98+
8399
data Arguments = Arguments
84100
{ argsOTMemoryProfiling :: Bool
85-
, argFiles :: Maybe [FilePath] -- ^ Nothing: lsp server ; Just: typecheck and exit
101+
, argCommand :: Command
86102
, argsLogger :: IO Logger
87103
, argsRules :: Rules ()
88104
, argsHlsPlugins :: IdePlugins IdeState
@@ -100,7 +116,7 @@ data Arguments = Arguments
100116
instance Default Arguments where
101117
def = Arguments
102118
{ argsOTMemoryProfiling = False
103-
, argFiles = Nothing
119+
, argCommand = Lsp
104120
, argsLogger = stderrLogger
105121
, argsRules = mainRule >> action kick
106122
, argsGhcidePlugin = mempty
@@ -153,8 +169,8 @@ defaultMain Arguments{..} = do
153169
inH <- argsHandleIn
154170
outH <- argsHandleOut
155171

156-
case argFiles of
157-
Nothing -> do
172+
case argCommand of
173+
Lsp -> do
158174
t <- offsetTime
159175
hPutStrLn stderr "Starting LSP server..."
160176
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
@@ -188,7 +204,7 @@ defaultMain Arguments{..} = do
188204
vfs
189205
hiedb
190206
hieChan
191-
Just argFiles -> do
207+
Check argFiles -> do
192208
dir <- IO.getCurrentDirectory
193209
dbLoc <- getHieDbLoc dir
194210
runWithDb dbLoc $ \hiedb hieChan -> do
@@ -249,8 +265,35 @@ defaultMain Arguments{..} = do
249265
measureMemory logger [keys] consoleObserver valuesRef
250266

251267
unless (null failed) (exitWith $ ExitFailure (length failed))
268+
Index dir -> do
269+
dbLoc <- getHieDbLoc dir
270+
runWithDb dbLoc $ \hiedb hieChan -> do
271+
vfs <- makeVFSHandle
272+
sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir
273+
let options = (argsIdeOptions argsDefaultHlsConfig sessionLoader)
274+
{ optCheckParents = pure NeverCheck
275+
, optCheckProject = pure False
276+
}
277+
ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan
278+
registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
279+
results <- runAction "Index" ide $ do
280+
allKnownTargets <- toKnownFiles <$> useNoFile_ GetKnownTargets
281+
liftIO $ hPutStrLn stderr $ "Found " <> show(length allKnownTargets) <> " targets"
282+
uses GetModIfaceFromDiskAndIndex $ toList allKnownTargets
283+
putStrLn dbLoc
284+
let nfailures = length $ filter isNothing results
285+
unless (nfailures == 0) $ exitWith $ ExitFailure nfailures
286+
Db dir opts cmd -> do
287+
dbLoc <- getHieDbLoc dir
288+
hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc
289+
mlibdir <- setInitialDynFlags def
290+
case mlibdir of
291+
Nothing -> exitWith $ ExitFailure 1
292+
Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd
293+
252294
{-# ANN defaultMain ("HLint: ignore Use nubOrd" :: String) #-}
253295

296+
254297
expandFiles :: [FilePath] -> IO [FilePath]
255298
expandFiles = concatMapM $ \x -> do
256299
b <- IO.doesFileExist x

‎src/Ide/Main.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do
101101
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
102102

103103
Main.defaultMain def
104-
{ Main.argFiles = if argLSP then Nothing else Just argFiles
104+
{ Main.argCommand = if argLSP then Main.Lsp else Main.Check argFiles
105105
, Main.argsHlsPlugins = idePlugins
106106
, Main.argsLogger = pure hlsLogger
107107
, Main.argsIdeOptions = \_config sessionLoader ->

0 commit comments

Comments
 (0)