-
-
Notifications
You must be signed in to change notification settings - Fork 346
/
Main.hs
119 lines (101 loc) · 4.72 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
{-# LANGUAGE TemplateHaskell #-}
module Main(main) where
import Arguments ( Arguments'(..), IdeCmd(..), getArguments )
import Control.Concurrent.Extra ( newLock, withLock )
import Control.Monad.Extra ( unless, when, whenJust )
import Data.Default ( Default(def) )
import Data.List.Extra ( upper )
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Version ( showVersion )
import Development.GitRev ( gitHash )
import Development.IDE ( Logger(Logger), Priority(Info), action )
import Development.IDE.Core.OfInterest (kick)
import Development.IDE.Core.Rules (mainRule)
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
import qualified Development.IDE.Plugin.Test as Test
import Development.IDE.Session (setInitialDynFlags, getHieDbLoc, runWithDb)
import Development.IDE.Types.Options
import qualified Development.IDE.Main as Main
import Development.Shake (ShakeOptions(shakeThreads))
import Ide.Plugin.Config (Config(checkParents, checkProject))
import Ide.PluginUtils (pluginDescToIdePlugins)
import HieDb.Run (Options(..), runCommand)
import Paths_ghcide ( version )
import qualified System.Directory.Extra as IO
import System.Environment ( getExecutablePath )
import System.Exit ( ExitCode(ExitFailure), exitSuccess, exitWith )
import System.Info ( compilerVersion )
import System.IO ( stderr, hPutStrLn )
ghcideVersion :: IO String
ghcideVersion = do
path <- getExecutablePath
let gitHashSection = case $(gitHash) of
x | x == "UNKNOWN" -> ""
x -> " (GIT hash: " <> x <> ")"
return $ "ghcide version: " <> showVersion version
<> " (GHC: " <> showVersion compilerVersion
<> ") (PATH: " <> path <> ")"
<> gitHashSection
main :: IO ()
main = do
-- WARNING: If you write to stdout before runLanguageServer
-- then the language server will not work
Arguments{..} <- getArguments
if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
whenJust argsCwd IO.setCurrentDirectory
dir <- IO.getCurrentDirectory
dbLoc <- getHieDbLoc dir
-- lock to avoid overlapping output on stdout
lock <- newLock
let logger = Logger $ \pri msg -> when (pri >= logLevel) $ withLock lock $
T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg
logLevel = if argsVerbose then minBound else Info
case argFilesOrCmd of
DbCmd opts cmd -> do
mlibdir <- setInitialDynFlags
case mlibdir of
Nothing -> exitWith $ ExitFailure 1
Just libdir -> runCommand libdir opts{database = dbLoc} cmd
_ -> do
case argFilesOrCmd of
LSP -> do
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!"
_ -> return ()
runWithDb dbLoc $ \hiedb hiechan ->
Main.defaultMain (Main.defArguments hiedb hiechan)
{Main.argFiles = case argFilesOrCmd of
Typecheck x | not argLSP -> Just x
_ -> Nothing
,Main.argsLogger = logger
,Main.argsRules = do
-- install the main and ghcide-plugin rules
mainRule
-- install the kick action, which triggers a typecheck on every
-- Shake database restart, i.e. on every user edit.
unless argsDisableKick $
action kick
,Main.argsHlsPlugins =
pluginDescToIdePlugins $
GhcIde.descriptors
++ [Test.blockCommandDescriptor "block-command" | argsTesting]
,Main.argsGhcidePlugin = if argsTesting
then Test.plugin
else mempty
,Main.argsIdeOptions = \(fromMaybe def -> config) sessionLoader ->
let defOptions = defaultIdeOptions sessionLoader
in defOptions
{ optShakeProfiling = argsShakeProfiling
, optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
, optTesting = IdeTesting argsTesting
, optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
, optCheckParents = checkParents config
, optCheckProject = checkProject config
}
}