From 491d13a27696a26b3e3ef1a04200320287d637bb Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Fri, 9 Aug 2019 12:48:05 +0200 Subject: [PATCH] Add an ide-debug-driver to make it easier to find leaks (#2472) --- compiler/damlc/ide-debug-driver/BUILD.bazel | 24 ++++ compiler/damlc/ide-debug-driver/README.md | 10 ++ .../damlc/ide-debug-driver/sample-config.yaml | 18 +++ .../ide-debug-driver/src/IdeDebugDriver.hs | 106 ++++++++++++++++++ .../src/Development/IDE/LSP/Notifications.hs | 2 - 5 files changed, 158 insertions(+), 2 deletions(-) create mode 100644 compiler/damlc/ide-debug-driver/BUILD.bazel create mode 100644 compiler/damlc/ide-debug-driver/README.md create mode 100644 compiler/damlc/ide-debug-driver/sample-config.yaml create mode 100644 compiler/damlc/ide-debug-driver/src/IdeDebugDriver.hs diff --git a/compiler/damlc/ide-debug-driver/BUILD.bazel b/compiler/damlc/ide-debug-driver/BUILD.bazel new file mode 100644 index 0000000000..19834411f0 --- /dev/null +++ b/compiler/damlc/ide-debug-driver/BUILD.bazel @@ -0,0 +1,24 @@ +# Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +load("//bazel_tools:haskell.bzl", "da_haskell_binary") + +da_haskell_binary( + name = "ide-debug-driver", + srcs = glob(["src/**/*.hs"]), + hazel_deps = [ + "aeson", + "base", + "haskell-lsp", + "haskell-lsp-types", + "lens", + "lsp-test", + "optparse-applicative", + "parser-combinators", + "text", + "yaml", + ], + main_function = "IdeDebugDriver.main", + src_strip_prefix = "src", + visibility = ["//visibility:public"], +) diff --git a/compiler/damlc/ide-debug-driver/README.md b/compiler/damlc/ide-debug-driver/README.md new file mode 100644 index 0000000000..27059e1096 --- /dev/null +++ b/compiler/damlc/ide-debug-driver/README.md @@ -0,0 +1,10 @@ +# ide-debug-driver + +`ide-debug-driver` can be used to automate an IDE session. This is +particularly useful for profiling where you often want to test +long-running sessions to ensure that there are no leaks. + +Sessions are configured using a YAML file, see +[sample-config.yaml](sample-config.yaml) for an example. + +You can then run `ide-debug-driver` as `ide-debug-driver -c sample-config.yaml`. diff --git a/compiler/damlc/ide-debug-driver/sample-config.yaml b/compiler/damlc/ide-debug-driver/sample-config.yaml new file mode 100644 index 0000000000..bdcbafbef9 --- /dev/null +++ b/compiler/damlc/ide-debug-driver/sample-config.yaml @@ -0,0 +1,18 @@ +ide-cmd: daml-head ide --debug +project-root: /home/moritz/quickstart-java +commands: + - cmd: repeat + count: 100 + cmds: + - cmd: open + file: daml/Iou.daml + - cmd: wait + - cmd: open + file: daml/Main.daml + - cmd: wait + - cmd: close + file: daml/Iou.daml + - cmd: wait + - cmd: close + file: daml/Main.daml + - cmd: wait diff --git a/compiler/damlc/ide-debug-driver/src/IdeDebugDriver.hs b/compiler/damlc/ide-debug-driver/src/IdeDebugDriver.hs new file mode 100644 index 0000000000..d92d53f8f6 --- /dev/null +++ b/compiler/damlc/ide-debug-driver/src/IdeDebugDriver.hs @@ -0,0 +1,106 @@ +-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module IdeDebugDriver (main) where + +import Control.Applicative.Combinators +import Control.Lens +import Control.Monad +import Data.Aeson +import Data.Foldable +import qualified Data.Text as T +import qualified Data.Yaml as Yaml +import qualified Language.Haskell.LSP.Test as LSP +import Language.Haskell.LSP.Messages +import Language.Haskell.LSP.Types hiding (Command) +import Language.Haskell.LSP.Types.Lens +import qualified Language.Haskell.LSP.Types.Lens as LSP +import Options.Applicative + +-- | We all love programming in YAML, don’t we? :) +data Command + = OpenFile FilePath + | CloseFile FilePath + | WaitForCompletion + | Repeat Int [Command] + deriving Show + +instance FromJSON Command where + parseJSON = withObject "Command" $ \o -> do + cmd <- o .: "cmd" + case cmd :: T.Text of + "open" -> OpenFile <$> o .: "file" + "close" -> CloseFile <$> o.: "file" + "wait" -> pure WaitForCompletion + "repeat" -> Repeat <$> o .: "count" <*> o .: "cmds" + _ -> fail $ "Unknown command " <> show cmd + +data SessionConfig = SessionConfig + { ideShellCommand :: String + , ideRoot :: FilePath + , ideCommands :: [Command] + } deriving Show + +instance FromJSON SessionConfig where + parseJSON = withObject "SessionConfig" $ \o -> + SessionConfig + <$> o .: "ide-cmd" + <*> o .: "project-root" + <*> o .: "commands" + +data Opts = Opts + { optConfigPath :: FilePath + , optVerbose :: Verbose + } deriving Show + +newtype Verbose = Verbose Bool + deriving Show + +optsInfo :: ParserInfo Opts +optsInfo = info (parser <**> helper) fullDesc + where + parser = Opts + <$> strOption (long "config" <> short 'c' <> metavar "FILE" <> help "Path to config file") + <*> flag (Verbose False) (Verbose True) (long "verbose" <> short 'v' <> help "Enable verbose output") + +main :: IO () +main = do + opts <- execParser optsInfo + conf <- Yaml.decodeFileThrow (optConfigPath opts) + runSession (optVerbose opts) (conf :: SessionConfig) + +damlLanguageId :: String +damlLanguageId = "daml" + +runSession :: Verbose -> SessionConfig -> IO () +runSession (Verbose verbose) SessionConfig{..} = + LSP.runSessionWithConfig cnf ideShellCommand LSP.fullCaps ideRoot $ traverse_ interpretCommand ideCommands + where cnf = LSP.defaultConfig { LSP.logStdErr = verbose, LSP.logMessages = verbose } + +progressStart :: LSP.Session ProgressStartNotification +progressStart = do + NotProgressStart msg <- LSP.satisfy $ \case + NotProgressStart _ -> True + _ -> False + pure msg + +progressDone :: LSP.Session ProgressDoneNotification +progressDone = do + NotProgressDone msg <- LSP.satisfy $ \case + NotProgressDone _ -> True + _ -> False + pure msg + +interpretCommand :: Command -> LSP.Session () +interpretCommand = \case + OpenFile f -> void $ LSP.openDoc f damlLanguageId + CloseFile f -> do + uri <- LSP.getDocUri f + LSP.closeDoc (TextDocumentIdentifier uri) + WaitForCompletion -> do + start <- progressStart + skipManyTill LSP.anyMessage $ do + done <- progressDone + guard $ done ^. params . LSP.id == start ^. params . LSP.id + Repeat count cmds -> replicateM_ count $ traverse_ interpretCommand cmds + diff --git a/compiler/hie-core/src/Development/IDE/LSP/Notifications.hs b/compiler/hie-core/src/Development/IDE/LSP/Notifications.hs index f4d0f20b04..bce4ec0319 100644 --- a/compiler/hie-core/src/Development/IDE/LSP/Notifications.hs +++ b/compiler/hie-core/src/Development/IDE/LSP/Notifications.hs @@ -32,7 +32,6 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x {LSP.didOpenTextDocumentNotificationHandler = withNotification (LSP.didOpenTextDocumentNotificationHandler x) $ \_ ide (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> do updatePositionMapping ide (VersionedTextDocumentIdentifier _uri (Just _version)) (List []) - setSomethingModified ide whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (S.insert file) logInfo (ideLogger ide) $ "Opened text document: " <> getUri _uri @@ -50,7 +49,6 @@ setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x ,LSP.didCloseTextDocumentNotificationHandler = withNotification (LSP.didCloseTextDocumentNotificationHandler x) $ \_ ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> do - setSomethingModified ide whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (S.delete file) logInfo (ideLogger ide) $ "Closed text document: " <> getUri _uri