Add an ide-debug-driver to make it easier to find leaks (#2472)

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"],
+)

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`.

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

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
+

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