Merge branch 'master' into bug-fix/pragma-before-shebang

Author: ishmum123

.github/mergify.yml

@@ -7,6 +7,8 @@ pull_request_rules:
   conditions:
   - status-success=bench-example (8.10.4, ubuntu-latest, Cabal-3.0.0.0)
   - status-success=bench-example (8.10.4, ubuntu-latest, lsp-types-1.0.0.1)
+  # disabled (too slow, ~4h) until hie-bios >0.7.2 is released
+  # - status-success=bench-example (8.10.4, ubuntu-latest, bench_example_HLS)
 
   - status-success=nix (default, ubuntu-latest)
   - status-success=nix (default, macOS-latest)

.github/workflows/bench.yml

@@ -12,6 +12,9 @@ jobs:
         os: [ubuntu-latest]
 
     steps:
+    # Cancel queued workflows from earlier commits in this branch
+    - uses: fkirc/skip-duplicate-actions@master
+
     - uses: actions/checkout@v2
     - run: git fetch origin master # check the master branch for benchmarking
     - uses: haskell/actions/setup@v1
@@ -78,9 +81,12 @@ jobs:
       matrix:
         ghc: ['8.10.4']
         os: [ubuntu-latest]
-        example: ['Cabal-3.0.0.0', 'lsp-types-1.0.0.1']
+        example: ['Cabal-3.0.0.0', 'lsp-types-1.0.0.1', 'bench_example_HLS']
 
     steps:
+    # Cancel queued workflows from earlier commits in this branch
+    - uses: fkirc/skip-duplicate-actions@master
+
     - uses: haskell/actions/setup@v1
       with:
         ghc-version: ${{ matrix.ghc }}

cabal.project

@@ -12,7 +12,6 @@ packages:
          ./plugins/hls-retrie-plugin
          ./plugins/hls-haddock-comments-plugin
          ./plugins/hls-splice-plugin
-
 tests: true
 
 package *
@@ -25,7 +24,7 @@ package ghcide
 
 write-ghc-environment-files: never
 
-index-state: 2021-02-08T19:11:03Z
+index-state: 2021-02-15T19:11:03Z
 
 allow-newer:
 	active:base,

fmt.sh

@@ -1,3 +1,3 @@
 #!/usr/bin/env bash
 set -eou pipefail
-curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s ghcide/src ghcide/exe ghcide/bench shake-bench/src ghcide/test/exe --with-group=extra --hint=ghcide/.hlint.yaml
+curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s ghcide/src ghcide/exe ghcide/bench/lib ghcide/bench/exe ghcide/bench/hist shake-bench/src ghcide/test/exe --with-group=extra --hint=ghcide/.hlint.yaml

ghcide/.hlint.yaml

@@ -98,6 +98,7 @@
   - default: false
   - {name: [-Wno-missing-signatures, -Wno-orphans, -Wno-overlapping-patterns, -Wno-incomplete-patterns, -Wno-missing-fields, -Wno-unused-matches]}
   - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat, Development.Benchmark.Rules]}
+  - {name: [-Wno-deprecations, -Wno-unticked-promoted-constructors], within: [Main, Experiments]}
 # - modules:
 #   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
 #   - {name: Control.Arrow, within: []} # Certain modules are banned entirely

ghcide/CHANGELOG.md

@@ -1,3 +1,6 @@
+### 0.7.5 (2021-02-??)
+* Added Development.IDE.Main (#1338) - Pepe Iborra
+
 ### 0.7.4 (2021-02-08)
 * Support for references via hiedb (#704) - wz1000
 * Fix space leak on cradle reloads (#1316) - Pepe Iborra

ghcide/bench/config.yaml

@@ -23,6 +23,16 @@ examples:
     modules:
         - src/Language/LSP/VFS.hs
         - src/Language/LSP/Types/Lens.hs
+  # Small but heavily multi-component example
+  - path: bench/example/HLS
+    modules:
+        - hls-plugin-api/src/Ide/Plugin/Config.hs
+        - ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
+        # Things get too slow with more than 2 components, hie-bios 0.7.3 will help here
+        # - ghcide/bench/hist/Main.hs
+        # - ghcide/bench/lib/Experiments/Types.hs
+        # - ghcide/test/exe/Main.hs
+        # - exe/Plugins.hs
 
 # The set of experiments to execute
 experiments:

ghcide/bench/example/HLS

@@ -0,0 +1 @@
+../../..

ghcide/bench/lib/Experiments.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE ImpredicativeTypes #-}
+{-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-}
 
 module Experiments
 ( Bench(..)
@@ -20,19 +22,19 @@ module Experiments
 , exampleToOptions
 ) where
 import Control.Applicative.Combinators (skipManyTill)
-import Control.Exception.Safe
+import Control.Exception.Safe (IOException, handleAny, try)
 import Control.Monad.Extra
 import Control.Monad.IO.Class
-import Data.Aeson (Value(Null))
+import Data.Aeson (Value(Null), toJSON)
 import Data.List
 import Data.Maybe
 import qualified Data.Text as T
 import Data.Version
 import Development.IDE.Plugin.Test
 import Experiments.Types
-import Language.Haskell.LSP.Test
-import Language.Haskell.LSP.Types
-import Language.Haskell.LSP.Types.Capabilities
+import Language.LSP.Test
+import Language.LSP.Types
+import Language.LSP.Types.Capabilities
 import Numeric.Natural
 import Options.Applicative
 import System.Directory
@@ -41,6 +43,7 @@ import System.FilePath ((</>), (<.>))
 import System.Process
 import System.Time.Extra
 import Text.ParserCombinators.ReadP (readP_to_S)
+import Development.Shake (cmd_, CmdOption (Cwd, FileStdout))
 
 charEdit :: Position -> TextDocumentContentChangeEvent
 charEdit p =
@@ -78,13 +81,13 @@ experiments =
           isJust <$> getHover doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "getDefinition" $ allWithIdentifierPos $ \DocumentPositions{..} ->
-        not . null <$> getDefinitions doc (fromJust identifierP),
+        either (not . null) (not . null) . toEither <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "getDefinition after edit" $ \docs -> do
           forM_ docs $ \DocumentPositions{..} ->
             changeDoc doc [charEdit stringLiteralP]
           flip allWithIdentifierPos docs $ \DocumentPositions{..} ->
-            not . null <$> getDefinitions doc (fromJust identifierP),
+            either (not . null) (not . null) . toEither <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "documentSymbols" $ allM $ \DocumentPositions{..} -> do
         fmap (either (not . null) (not . null)) . getDocumentSymbols $ doc,
@@ -147,7 +150,7 @@ experiments =
         ( \docs -> do
             Just hieYaml <- uriToFilePath <$> getDocUri "hie.yaml"
             liftIO $ appendFile hieYaml "##\n"
-            sendNotification WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
+            sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
                 List [ FileEvent (filePathToUri "hie.yaml") FcChanged ]
             forM_ docs $ \DocumentPositions{..} ->
               changeDoc doc [charEdit stringLiteralP]
@@ -162,7 +165,7 @@ experiments =
         (\docs -> do
             Just hieYaml <- uriToFilePath <$> getDocUri "hie.yaml"
             liftIO $ appendFile hieYaml "##\n"
-            sendNotification WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
+            sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
                 List [ FileEvent (filePathToUri "hie.yaml") FcChanged ]
             flip allWithIdentifierPos docs $ \DocumentPositions{..} -> isJust <$> getHover doc (fromJust identifierP)
         )
@@ -358,7 +361,9 @@ waitForProgressDone :: Session ()
 waitForProgressDone = loop
   where
     loop = do
-      void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
+      ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case
+        FromServerMess SProgress (NotificationMessage _ _ (ProgressParams _ (End _))) -> Just ()
+        _ -> Nothing
       done <- null <$> getIncompleteProgressSessions
       unless done loop
 
@@ -392,8 +397,9 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
             else do
                 output (showDuration t)
                 -- Wait for the delayed actions to finish
-                waitId <- sendRequest (CustomClientMethod "test") WaitForShakeQueue
-                (td, resp) <- duration $ skipManyTill anyMessage $ responseForId waitId
+                let m = SCustomMethod "test"
+                waitId <- sendRequest m (toJSON WaitForShakeQueue)
+                (td, resp) <- duration $ skipManyTill anyMessage $ responseForId m waitId
                 case resp of
                     ResponseMessage{_result=Right Null} -> do
                       loop (userWaits+t) (delayedWork+td) (n -1)
@@ -423,19 +429,24 @@ setup :: HasConfig => IO SetupResult
 setup = do
 --   when alreadyExists $ removeDirectoryRecursive examplesPath
   benchDir <- case example ?config of
-      UsePackage{..} -> return examplePath
+      UsePackage{..} -> do
+          let hieYamlPath = examplePath </> "hie.yaml"
+          alreadyExists <- doesFileExist hieYamlPath
+          unless alreadyExists $
+                cmd_ (Cwd examplePath) (FileStdout hieYamlPath) ("gen-hie"::String)
+          return examplePath
       GetPackage{..} -> do
         let path = examplesPath </> package
             package = exampleName <> "-" <> showVersion exampleVersion
+            hieYamlPath = path </> "hie.yaml"
         alreadySetup <- doesDirectoryExist path
         unless alreadySetup $
           case buildTool ?config of
             Cabal -> do
                 let cabalVerbosity = "-v" ++ show (fromEnum (verbose ?config))
                 callCommandLogging $ "cabal get " <> cabalVerbosity <> " " <> package <> " -d " <> examplesPath
-                writeFile
-                    (path </> "hie.yaml")
-                    ("cradle: {cabal: {component: " <> exampleName <> "}}")
+                let hieYamlPath = path </> "hie.yaml"
+                cmd_ (Cwd path) (FileStdout hieYamlPath) ("gen-hie"::String)
                 -- Need this in case there is a parent cabal.project somewhere
                 writeFile
                     (path </> "cabal.project")
@@ -464,9 +475,7 @@ setup = do
                             ]
                         )
 
-                writeFile
-                    (path </> "hie.yaml")
-                    ("cradle: {stack: {component: " <> show (exampleName <> ":lib") <> "}}")
+                cmd_ (Cwd path) (FileStdout hieYamlPath) ("gen-hie"::String) ["--stack"::String]
         return path
 
   whenJust (shakeProfiling ?config) $ createDirectoryIfMissing True
@@ -498,22 +507,21 @@ setupDocumentContents config =
 
         -- Find an identifier defined in another file in this project
         symbols <- getDocumentSymbols doc
-        case symbols of
-            Left [DocumentSymbol{_children = Just (List symbols)}] -> do
-                let endOfImports = case symbols of
-                        DocumentSymbol{_kind = SkModule, _name = "imports", _range } : _ ->
-                            Position (succ $ _line $ _end _range) 4
-                        DocumentSymbol{_range} : _ -> _start _range
-                        [] -> error "Module has no symbols"
-                contents <- documentContents doc
-
-                identifierP <- searchSymbol doc contents endOfImports
-
-                return $ DocumentPositions{..}
-            other ->
-                error $ "symbols: " <> show other
-
-
+        let endOfImports = case symbols of
+                Left symbols | Just x <- findEndOfImports symbols -> x
+                _ -> error $ "symbols: " <> show symbols
+        contents <- documentContents doc
+        identifierP <- searchSymbol doc contents endOfImports
+        return $ DocumentPositions{..}
+
+findEndOfImports :: [DocumentSymbol] -> Maybe Position
+findEndOfImports (DocumentSymbol{_kind = SkModule, _name = "imports", _range} : _) =
+    Just $ Position (succ $ _line $ _end _range) 4
+findEndOfImports [DocumentSymbol{_kind = SkFile, _children = Just (List cc)}] =
+    findEndOfImports cc
+findEndOfImports (DocumentSymbol{_range} : _) =
+    Just $ _start _range
+findEndOfImports _ = Nothing
 
 --------------------------------------------------------------------------------------------
 
@@ -559,7 +567,7 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
       checkDefinitions pos = do
         defs <- getDefinitions doc pos
         case defs of
-            [Location uri _] -> return $ uri /= _uri
+            (InL [Location uri _]) -> return $ uri /= _uri
             _ -> return False
       checkCompletions pos =
         not . null <$> getCompletions doc pos