mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-11 08:45:35 +03:00
d0e3e0fe3f
* extract ghcide:experiments-types * extract haskell-language-server:plugins and let go of examples The main goal here is to move the Plugins module into an internal library so that it can be reused from the benchmark suite. In order to make that easier, and since they hardly serve a purpose in a repository with 25 plugins, I delete the Example and Example2 plugin descriptors and their dependencies. * HLS benchmark suite Port the ghcide benchmark suite to HLS and benchmark plugin "configurations" independently. This includes the following changes to the ghcide benchmark suite and HLS: - Support for "configurations" which are defined as sets of plugin ids. The benchmark will be run with only these plugins enabled and all others disabled - Support for configurable concurrency. This relies on RTS -ol and -po flags to place the RTS traces in the target location rather than in the cwd This change requires two commits, the next one places ghcide/bench/hist/Main.hs into its final location to help 'git' recognize the change as a file move * ghcide/bench/hist/Main.hs -> bench/Main.hs * CI - fix artifact names for uniqueness * disable shorten HLS step * Do not store eventlogs to avoid out of disk space * render durations up to milliseconds * shorten titles Goal is to display the formatted CSV (via column) one row per line * exclude formatting plugin configurations * Extract ghcide-bench to a standalone package * ghcide-bench: fix stderr capturing * Fix mem stats We parse maxResidency and allocatedBytes from the RTS -S output, but runSessionWithHandles kills the server without waiting for it to exit and these stats don't get logged. The solution is to use runSessionWithHandles', but unfortunately it is internal and not exposed. I have raised a PR to expose it and in the meantime we need a source repo package. * feedbacks * delete Example plugins
109 lines
5.2 KiB
Haskell
109 lines
5.2 KiB
Haskell
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
|
|
-- SPDX-License-Identifier: Apache-2.0
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main(main) where
|
|
|
|
import Control.Arrow ((&&&))
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Data.Function ((&))
|
|
import Data.Text (Text)
|
|
import qualified Development.IDE.Main as GhcideMain
|
|
import Development.IDE.Types.Logger (Doc,
|
|
Priority (Debug, Error, Info),
|
|
WithPriority (WithPriority, priority),
|
|
cfilter, cmapWithPrio,
|
|
defaultLayoutOptions,
|
|
layoutPretty,
|
|
makeDefaultStderrRecorder,
|
|
payload, renderStrict,
|
|
withDefaultRecorder)
|
|
import qualified Development.IDE.Types.Logger as Logger
|
|
import qualified HlsPlugins as Plugins
|
|
import Ide.Arguments (Arguments (..),
|
|
GhcideArguments (..),
|
|
getArguments)
|
|
import Ide.Main (defaultMain)
|
|
import qualified Ide.Main as IdeMain
|
|
import Ide.PluginUtils (pluginDescToIdePlugins)
|
|
import Ide.Types (PluginDescriptor (pluginNotificationHandlers),
|
|
defaultPluginDescriptor,
|
|
mkPluginNotificationHandler)
|
|
import Language.LSP.Server as LSP
|
|
import Language.LSP.Types as LSP
|
|
#if MIN_VERSION_prettyprinter(1,7,0)
|
|
import Prettyprinter (Pretty (pretty), vsep)
|
|
#else
|
|
import Data.Text.Prettyprint.Doc (Pretty (pretty), vsep)
|
|
#endif
|
|
|
|
data Log
|
|
= LogIdeMain IdeMain.Log
|
|
| LogPlugins Plugins.Log
|
|
|
|
instance Pretty Log where
|
|
pretty log = case log of
|
|
LogIdeMain ideMainLog -> pretty ideMainLog
|
|
LogPlugins pluginsLog -> pretty pluginsLog
|
|
|
|
main :: IO ()
|
|
main = do
|
|
-- plugin cli commands use stderr logger for now unless we change the args
|
|
-- parser to get logging arguments first or do more complicated things
|
|
pluginCliRecorder <- cmapWithPrio pretty <$> makeDefaultStderrRecorder Nothing Info
|
|
args <- getArguments "haskell-language-server" (Plugins.idePlugins (cmapWithPrio LogPlugins pluginCliRecorder))
|
|
|
|
(lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder
|
|
(lspMessageRecorder, cb2) <- Logger.withBacklog Logger.lspClientMessageRecorder
|
|
-- This plugin just installs a handler for the `initialized` notification, which then
|
|
-- picks up the LSP environment and feeds it to our recorders
|
|
let lspRecorderPlugin = (defaultPluginDescriptor "LSPRecorderCallback")
|
|
{ pluginNotificationHandlers = mkPluginNotificationHandler LSP.SInitialized $ \_ _ _ _ -> do
|
|
env <- LSP.getLspEnv
|
|
liftIO $ (cb1 <> cb2) env
|
|
}
|
|
|
|
let (argsTesting, minPriority, logFilePath) =
|
|
case args of
|
|
Ghcide GhcideArguments{ argsTesting, argsDebugOn, argsLogFile} ->
|
|
let minPriority = if argsDebugOn || argsTesting then Debug else Info
|
|
in (argsTesting, minPriority, argsLogFile)
|
|
_ -> (False, Info, Nothing)
|
|
|
|
withDefaultRecorder logFilePath Nothing minPriority $ \textWithPriorityRecorder -> do
|
|
let
|
|
recorder = cmapWithPrio (pretty &&& id) $ mconcat
|
|
[textWithPriorityRecorder
|
|
& cfilter (\WithPriority{ priority } -> priority >= minPriority)
|
|
& cmapWithPrio fst
|
|
, lspMessageRecorder
|
|
& cfilter (\WithPriority{ priority } -> priority >= Error)
|
|
& cmapWithPrio (renderDoc . fst)
|
|
, lspLogRecorder
|
|
& cfilter (\WithPriority{ priority } -> priority >= minPriority)
|
|
& cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions . fst)
|
|
-- do not log heap stats to the LSP log as they interfere with the
|
|
-- ability of lsp-test to detect a stuck server in tests and benchmarks
|
|
& if argsTesting then cfilter (not . heapStats . snd . payload) else id
|
|
]
|
|
plugins = (Plugins.idePlugins (cmapWithPrio LogPlugins recorder))
|
|
|
|
defaultMain
|
|
(cmapWithPrio LogIdeMain recorder)
|
|
args
|
|
(plugins <> pluginDescToIdePlugins [lspRecorderPlugin])
|
|
|
|
renderDoc :: Doc a -> Text
|
|
renderDoc d = renderStrict $ layoutPretty defaultLayoutOptions $ vsep
|
|
["Error condition, please check your setup and/or the [issue tracker](" <> issueTrackerUrl <> "): "
|
|
,d
|
|
]
|
|
|
|
issueTrackerUrl :: Doc a
|
|
issueTrackerUrl = "https://github.com/haskell/haskell-language-server/issues"
|
|
|
|
heapStats :: Log -> Bool
|
|
heapStats (LogIdeMain (IdeMain.LogIDEMain (GhcideMain.LogHeapStats _))) = True
|
|
heapStats _ = False
|