Skip to content

Commit 5570da9

Browse files
alanzalanz
authored
Merge pull request #61 from jneira/minor-changes
Some minor changes
2 parents 86fe4eb + baec2f5 commit 5570da9

File tree

6 files changed

+51
-40
lines changed

6 files changed

+51
-40
lines changed

‎exe/Arguments.hs

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,8 +36,8 @@ data Arguments = Arguments
3636
-- them to just change the name of the exe and still work.
3737
, argsDebugOn :: Bool
3838
, argsLogFile :: Maybe String
39-
40-
}
39+
, argsThread :: Int
40+
} deriving Show
4141

4242
getArguments :: String -> IO Arguments
4343
getArguments exeName = execParser opts
@@ -73,6 +73,13 @@ arguments exeName = Arguments
7373
<> metavar "LOGFILE"
7474
<> help "File to log to, defaults to stdout"
7575
))
76+
<*> option auto
77+
(short 'j'
78+
<> help "Number of threads (0: automatic)"
79+
<> metavar "NUM"
80+
<> value 1
81+
<> showDefault
82+
)
7683

7784
-- ---------------------------------------------------------------------
7885
-- Set the GHC libdir to the nix libdir if it's present.

‎exe/Main.hs

Lines changed: 24 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -48,24 +48,25 @@ import Development.IDE.Types.Diagnostics
4848
import Development.IDE.Types.Location
4949
import Development.IDE.Types.Logger
5050
import Development.IDE.Types.Options
51-
import Development.Shake (Action, action)
52-
import DynFlags (gopt_set, gopt_unset,
51+
import Development.Shake (Action, action)
52+
import DynFlags (gopt_set, gopt_unset,
5353
updOptLevel)
54-
import DynFlags (PackageFlag(..), PackageArg(..))
55-
import GHC hiding (def)
54+
import DynFlags (PackageFlag(..), PackageArg(..))
55+
import GHC hiding (def)
5656
import GHC.Check (runTimeVersion, compileTimeVersionFromLibdir)
5757
-- import GhcMonad
5858
import HIE.Bios.Cradle
59-
import HIE.Bios.Environment (addCmdOpts)
59+
import HIE.Bios.Environment (addCmdOpts)
6060
import HIE.Bios.Types
61-
import HscTypes (HscEnv(..), ic_dflags)
61+
import HscTypes (HscEnv(..), ic_dflags)
6262
import qualified Language.Haskell.LSP.Core as LSP
6363
import Ide.Logger
6464
import Ide.Plugin
6565
import Ide.Plugin.Config
66+
import Ide.Types (IdePlugins, ipMap)
6667
import Language.Haskell.LSP.Messages
67-
import Language.Haskell.LSP.Types (LspId(IdInt))
68-
import Linker (initDynLinker)
68+
import Language.Haskell.LSP.Types (LspId(IdInt))
69+
import Linker (initDynLinker)
6970
import Module
7071
import NameCache
7172
import Packages
@@ -96,15 +97,16 @@ import Ide.Plugin.Pragmas as Pragmas
9697

9798
-- ---------------------------------------------------------------------
9899

100+
101+
99102
-- | The plugins configured for use in this instance of the language
100103
-- server.
101104
-- These can be freely added or removed to tailor the available
102105
-- features of the server.
103-
idePlugins :: T.Text -> Bool -> (Plugin Config, [T.Text])
104-
idePlugins pid includeExamples
105-
= (asGhcIdePlugin ps, allLspCmdIds' pid ps)
106+
107+
idePlugins :: Bool -> IdePlugins
108+
idePlugins includeExamples = pluginDescToIdePlugins allPlugins
106109
where
107-
ps = pluginDescToIdePlugins allPlugins
108110
allPlugins = if includeExamples
109111
then basePlugins ++ examplePlugins
110112
else basePlugins
@@ -113,7 +115,7 @@ idePlugins pid includeExamples
113115
-- applyRefactDescriptor "applyrefact"
114116
-- , brittanyDescriptor "brittany"
115117
-- , haddockDescriptor "haddock"
116-
-- -- , hareDescriptor "hare"
118+
-- , hareDescriptor "hare"
117119
-- , hsimportDescriptor "hsimport"
118120
-- , liquidDescriptor "liquid"
119121
-- , packageDescriptor "package"
@@ -130,6 +132,8 @@ idePlugins pid includeExamples
130132
-- ,hfaAlignDescriptor "hfaa"
131133
]
132134

135+
ghcIdePlugins :: T.Text -> IdePlugins -> (Plugin Config, [T.Text])
136+
ghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps)
133137

134138
-- ---------------------------------------------------------------------
135139

@@ -141,14 +145,12 @@ main :: IO ()
141145
main = do
142146
-- WARNING: If you write to stdout before runLanguageServer
143147
-- then the language server will not work
144-
Arguments{..} <- getArguments "haskell-language-server"
148+
args@Arguments{..} <- getArguments "haskell-language-server"
145149

146150
if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
147151
else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
148152

149-
-- LSP.setupLogger (optLogFile opts) ["hie", "hie-bios"]
150-
-- $ if optDebugOn opts then L.DEBUG else L.INFO
151-
LSP.setupLogger argsLogFile ["hie", "hie-bios"]
153+
LSP.setupLogger argsLogFile ["hls", "hie-bios"]
152154
$ if argsDebugOn then L.DEBUG else L.INFO
153155

154156
-- lock to avoid overlapping output on stdout
@@ -162,8 +164,8 @@ main = do
162164

163165
pid <- getPid
164166
let
165-
(ps, commandIds) = idePlugins pid argsExamplePlugin
166-
-- (ps, commandIds) = idePlugins pid True
167+
idePlugins' = idePlugins argsExamplePlugin
168+
(ps, commandIds) = ghcIdePlugins pid idePlugins'
167169
plugins = Completions.plugin <> CodeAction.plugin <>
168170
Plugin mempty HoverDefinition.setHandlersDefinition <>
169171
ps
@@ -174,6 +176,8 @@ main = do
174176
if argLSP then do
175177
t <- offsetTime
176178
hPutStrLn stderr "Starting (haskell-language-server)LSP server..."
179+
hPutStrLn stderr $ " with arguments: " <> show args
180+
hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins')
177181
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
178182
runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps -> do
179183
t <- t
@@ -183,7 +187,7 @@ main = do
183187
, optShakeProfiling = argsShakeProfiling
184188
, optTesting = argsTesting
185189
, optInterfaceLoadingDiagnostics = argsTesting
186-
, optThreads = 1
190+
, optThreads = argsThread
187191
}
188192
debouncer <- newAsyncDebouncer
189193
initialise caps (mainRule >> pluginRules plugins >> action kick)

‎exe/Wrapper.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ main = do
5757

5858
progName <- getProgName
5959
logm $ "run entered for haskell-language-server-wrapper(" ++ progName ++ ") "
60-
++ hieVersion
60+
++ hlsVersion
6161
d <- getCurrentDirectory
6262
logm $ "Current directory:" ++ d
6363
logm $ "Operating system:" ++ os
@@ -74,12 +74,12 @@ main = do
7474
logm $ "Project GHC version:" ++ ghcVersion
7575

7676
let
77-
hieBin = "haskell-language-server-" ++ ghcVersion
78-
backupHieBin =
77+
hlsBin = "haskell-language-server-" ++ ghcVersion
78+
backupHlsBin =
7979
case dropWhileEnd (/='.') ghcVersion of
8080
[] -> "haskell-language-server"
8181
xs -> "haskell-language-server-" ++ init xs
82-
candidates' = [hieBin, backupHieBin, "haskell-language-server"]
82+
candidates' = [hlsBin, backupHlsBin, "haskell-language-server"]
8383
candidates = map (++ exeExtension) candidates'
8484

8585
logm $ "haskell-language-server exe candidates :" ++ show candidates

‎src/Ide/Logger.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -29,15 +29,15 @@ hlsLogger = L.Logger $ \pri txt ->
2929
-- ---------------------------------------------------------------------
3030

3131
logm :: MonadIO m => String -> m ()
32-
logm s = liftIO $ infoM "hie" s
32+
logm s = liftIO $ infoM "hls" s
3333

3434
debugm :: MonadIO m => String -> m ()
35-
debugm s = liftIO $ debugM "hie" s
35+
debugm s = liftIO $ debugM "hls" s
3636

3737
warningm :: MonadIO m => String -> m ()
38-
warningm s = liftIO $ warningM "hie" s
38+
warningm s = liftIO $ warningM "hls" s
3939

4040
errorm :: MonadIO m => String -> m ()
41-
errorm s = liftIO $ errorM "hie" s
41+
errorm s = liftIO $ errorM "hls" s
4242

4343
-- ---------------------------------------------------------------------

‎src/Ide/Plugin.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,7 @@ makeCodeAction cas lf ideState (CodeActionParams docId range context _) = do
137137
case literalSupport of
138138
Nothing -> do
139139
let cmdParams = [J.toJSON (FallbackCodeActionParams (action ^. edit) (action ^. command))]
140-
cmd <- mkLspCommand "hie" "fallbackCodeAction" (action ^. title) (Just cmdParams)
140+
cmd <- mkLspCommand "hls" "fallbackCodeAction" (action ^. title) (Just cmdParams)
141141
return $ Just (CACommand cmd)
142142
Just _ -> return $ Just (CACodeAction action)
143143

@@ -224,7 +224,7 @@ makeExecuteCommands ecs lf ide = do
224224

225225
case parseCmdId cmdId of
226226
-- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions
227-
Just ("hie", "fallbackCodeAction") ->
227+
Just ("hls", "fallbackCodeAction") ->
228228
case J.fromJSON cmdParams of
229229
J.Success (FallbackCodeActionParams mEdit mCmd) -> do
230230

@@ -289,7 +289,7 @@ makeExecuteCommands ecs lf ide = do
289289
290290
case parseCmdId cmdId of
291291
-- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions
292-
Just ("hie", "fallbackCodeAction") -> do
292+
Just ("hls", "fallbackCodeAction") -> do
293293
case A.fromJSON cmdParams of
294294
A.Success (FallbackCodeActionParams mEdit mCmd) -> do
295295

‎src/Ide/Version.hs

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,8 @@ import qualified Paths_haskell_language_server as Meta
1717
import System.Directory
1818
import System.Info
1919

20-
hieVersion :: String
21-
hieVersion =
20+
hlsVersion :: String
21+
hlsVersion =
2222
let commitCount = $gitCommitCount
2323
in concat $ concat
2424
[ [$(simpleVersion Meta.version)]
@@ -27,13 +27,13 @@ hieVersion =
2727
, [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) &&
2828
commitCount /= ("UNKNOWN" :: String)]
2929
, [" ", display buildArch]
30-
, [" ", hieGhcDisplayVersion]
30+
, [" ", hlsGhcDisplayVersion]
3131
]
3232

3333
-- ---------------------------------------------------------------------
3434

35-
hieGhcDisplayVersion :: String
36-
hieGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc
35+
hlsGhcDisplayVersion :: String
36+
hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc
3737

3838
getProjectGhcVersion :: Bios.Cradle Bios.CabalHelper -> IO String
3939
getProjectGhcVersion crdl =
@@ -42,8 +42,8 @@ getProjectGhcVersion crdl =
4242
(execProjectGhc crdl ["--numeric-version"])
4343

4444

45-
hieGhcVersion :: String
46-
hieGhcVersion = VERSION_ghc
45+
hlsGhcVersion :: String
46+
hlsGhcVersion = VERSION_ghc
4747

4848
-- ---------------------------------------------------------------------
4949

0 commit comments

Comments
 (0)