Skip to content

Some minor changes #61

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Apr 10, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 9 additions & 2 deletions exe/Arguments.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,8 +36,8 @@ data Arguments = Arguments
-- them to just change the name of the exe and still work.
, argsDebugOn :: Bool
, argsLogFile :: Maybe String

}
, argsThread :: Int
} deriving Show

getArguments :: String -> IO Arguments
getArguments exeName = execParser opts
Expand Down Expand Up @@ -73,6 +73,13 @@ arguments exeName = Arguments
<> metavar "LOGFILE"
<> help "File to log to, defaults to stdout"
))
<*> option auto
(short 'j'
<> help "Number of threads (0: automatic)"
<> metavar "NUM"
<> value 1
<> showDefault
)

-- ---------------------------------------------------------------------
-- Set the GHC libdir to the nix libdir if it's present.
Expand Down
44 changes: 24 additions & 20 deletions exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,24 +48,25 @@ import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Types.Options
import Development.Shake (Action, action)
import DynFlags (gopt_set, gopt_unset,
import Development.Shake (Action, action)
import DynFlags (gopt_set, gopt_unset,
updOptLevel)
import DynFlags (PackageFlag(..), PackageArg(..))
import GHC hiding (def)
import DynFlags (PackageFlag(..), PackageArg(..))
import GHC hiding (def)
import GHC.Check (runTimeVersion, compileTimeVersionFromLibdir)
-- import GhcMonad
import HIE.Bios.Cradle
import HIE.Bios.Environment (addCmdOpts)
import HIE.Bios.Environment (addCmdOpts)
import HIE.Bios.Types
import HscTypes (HscEnv(..), ic_dflags)
import HscTypes (HscEnv(..), ic_dflags)
import qualified Language.Haskell.LSP.Core as LSP
import Ide.Logger
import Ide.Plugin
import Ide.Plugin.Config
import Ide.Types (IdePlugins, ipMap)
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Types (LspId(IdInt))
import Linker (initDynLinker)
import Language.Haskell.LSP.Types (LspId(IdInt))
import Linker (initDynLinker)
import Module
import NameCache
import Packages
Expand Down Expand Up @@ -96,15 +97,16 @@ import Ide.Plugin.Pragmas as Pragmas

-- ---------------------------------------------------------------------



-- | The plugins configured for use in this instance of the language
-- server.
-- These can be freely added or removed to tailor the available
-- features of the server.
idePlugins :: T.Text -> Bool -> (Plugin Config, [T.Text])
idePlugins pid includeExamples
= (asGhcIdePlugin ps, allLspCmdIds' pid ps)

idePlugins :: Bool -> IdePlugins
idePlugins includeExamples = pluginDescToIdePlugins allPlugins
where
ps = pluginDescToIdePlugins allPlugins
allPlugins = if includeExamples
then basePlugins ++ examplePlugins
else basePlugins
Expand All @@ -113,7 +115,7 @@ idePlugins pid includeExamples
-- applyRefactDescriptor "applyrefact"
-- , brittanyDescriptor "brittany"
-- , haddockDescriptor "haddock"
-- -- , hareDescriptor "hare"
-- , hareDescriptor "hare"
-- , hsimportDescriptor "hsimport"
-- , liquidDescriptor "liquid"
-- , packageDescriptor "package"
Expand All @@ -130,6 +132,8 @@ idePlugins pid includeExamples
-- ,hfaAlignDescriptor "hfaa"
]

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

-- ---------------------------------------------------------------------

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

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

-- LSP.setupLogger (optLogFile opts) ["hie", "hie-bios"]
-- $ if optDebugOn opts then L.DEBUG else L.INFO
LSP.setupLogger argsLogFile ["hie", "hie-bios"]
LSP.setupLogger argsLogFile ["hls", "hie-bios"]
$ if argsDebugOn then L.DEBUG else L.INFO

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

pid <- getPid
let
(ps, commandIds) = idePlugins pid argsExamplePlugin
-- (ps, commandIds) = idePlugins pid True
idePlugins' = idePlugins argsExamplePlugin
(ps, commandIds) = ghcIdePlugins pid idePlugins'
plugins = Completions.plugin <> CodeAction.plugin <>
Plugin mempty HoverDefinition.setHandlersDefinition <>
ps
Expand All @@ -174,6 +176,8 @@ main = do
if argLSP then do
t <- offsetTime
hPutStrLn stderr "Starting (haskell-language-server)LSP server..."
hPutStrLn stderr $ " with arguments: " <> show args
hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins')
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps -> do
t <- t
Expand All @@ -183,7 +187,7 @@ main = do
, optShakeProfiling = argsShakeProfiling
, optTesting = argsTesting
, optInterfaceLoadingDiagnostics = argsTesting
, optThreads = 1
, optThreads = argsThread
}
debouncer <- newAsyncDebouncer
initialise caps (mainRule >> pluginRules plugins >> action kick)
Expand Down
8 changes: 4 additions & 4 deletions exe/Wrapper.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ main = do

progName <- getProgName
logm $ "run entered for haskell-language-server-wrapper(" ++ progName ++ ") "
++ hieVersion
++ hlsVersion
d <- getCurrentDirectory
logm $ "Current directory:" ++ d
logm $ "Operating system:" ++ os
Expand All @@ -74,12 +74,12 @@ main = do
logm $ "Project GHC version:" ++ ghcVersion

let
hieBin = "haskell-language-server-" ++ ghcVersion
backupHieBin =
hlsBin = "haskell-language-server-" ++ ghcVersion
backupHlsBin =
case dropWhileEnd (/='.') ghcVersion of
[] -> "haskell-language-server"
xs -> "haskell-language-server-" ++ init xs
candidates' = [hieBin, backupHieBin, "haskell-language-server"]
candidates' = [hlsBin, backupHlsBin, "haskell-language-server"]
candidates = map (++ exeExtension) candidates'

logm $ "haskell-language-server exe candidates :" ++ show candidates
Expand Down
8 changes: 4 additions & 4 deletions src/Ide/Logger.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,15 +29,15 @@ hlsLogger = L.Logger $ \pri txt ->
-- ---------------------------------------------------------------------

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

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

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

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

-- ---------------------------------------------------------------------
6 changes: 3 additions & 3 deletions src/Ide/Plugin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -137,7 +137,7 @@ makeCodeAction cas lf ideState (CodeActionParams docId range context _) = do
case literalSupport of
Nothing -> do
let cmdParams = [J.toJSON (FallbackCodeActionParams (action ^. edit) (action ^. command))]
cmd <- mkLspCommand "hie" "fallbackCodeAction" (action ^. title) (Just cmdParams)
cmd <- mkLspCommand "hls" "fallbackCodeAction" (action ^. title) (Just cmdParams)
return $ Just (CACommand cmd)
Just _ -> return $ Just (CACodeAction action)

Expand Down Expand Up @@ -224,7 +224,7 @@ makeExecuteCommands ecs lf ide = do

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

Expand Down Expand Up @@ -289,7 +289,7 @@ makeExecuteCommands ecs lf ide = do

case parseCmdId cmdId of
-- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions
Just ("hie", "fallbackCodeAction") -> do
Just ("hls", "fallbackCodeAction") -> do
case A.fromJSON cmdParams of
A.Success (FallbackCodeActionParams mEdit mCmd) -> do

Expand Down
14 changes: 7 additions & 7 deletions src/Ide/Version.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,8 @@ import qualified Paths_haskell_language_server as Meta
import System.Directory
import System.Info

hieVersion :: String
hieVersion =
hlsVersion :: String
hlsVersion =
let commitCount = $gitCommitCount
in concat $ concat
[ [$(simpleVersion Meta.version)]
Expand All @@ -27,13 +27,13 @@ hieVersion =
, [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) &&
commitCount /= ("UNKNOWN" :: String)]
, [" ", display buildArch]
, [" ", hieGhcDisplayVersion]
, [" ", hlsGhcDisplayVersion]
]

-- ---------------------------------------------------------------------

hieGhcDisplayVersion :: String
hieGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc
hlsGhcDisplayVersion :: String
hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc

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


hieGhcVersion :: String
hieGhcVersion = VERSION_ghc
hlsGhcVersion :: String
hlsGhcVersion = VERSION_ghc

-- ---------------------------------------------------------------------

Expand Down