Accept the legacy "languageServerHaskell" config name

This also requires a bump to lsp-test to fix a test, and drops the
trick that the wrapper tests used to find the wrapper executable since
it was just confusing

Author: lukel97

cabal.project

@@ -14,4 +14,4 @@ package ghcide
 
 write-ghc-environment-files: never
 
-index-state: 2020-07-16T17:24:10Z
+index-state: 2020-07-27T12:40:45Z

haskell-language-server.cabal

@@ -215,7 +215,7 @@ common hls-test-utils
                      , hslogger
                      , hspec
                      , hspec-core
-                     , lsp-test
+                     , lsp-test >= 0.11.0.3
                      , stm
                      , tasty-hunit
                      , temporary
@@ -245,7 +245,7 @@ test-suite func-test
                       , haskell-lsp-types
                       , hspec-expectations
                       , lens
-                      , lsp-test >= 0.10.0.0
+                      , lsp-test >= 0.10.0.3
                       , tasty
                       , tasty-ant-xml >= 1.1.6
                       , tasty-expected-failure

src/Ide/Plugin/Config.hs

@@ -10,6 +10,7 @@ module Ide.Plugin.Config
     , Config(..)
     ) where
 
+import           Control.Applicative
 import qualified Data.Aeson                    as A
 import           Data.Aeson              hiding ( Error )
 import           Data.Default
@@ -70,7 +71,9 @@ instance Default Config where
 -- TODO: Add API for plugins to expose their own LSP config options
 instance A.FromJSON Config where
   parseJSON = A.withObject "Config" $ \v -> do
-    s <- v .: "haskell"
+    -- Officially, we use "haskell" as the section name but for
+    -- backwards compatibility we also accept "languageServerHaskell"
+    s <- v .: "haskell" <|> v .: "languageServerHaskell"
     flip (A.withObject "Config.settings") s $ \o -> Config
       <$> o .:? "hlintOn"                     .!= hlintOn def
       <*> o .:? "diagnosticsOnChange"         .!= diagnosticsOnChange def

stack-8.10.1.yaml

@@ -15,7 +15,7 @@ extra-deps:
 - floskell-0.10.3
 - ghc-exactprint-0.6.3
 - lens-4.19.1
-- lsp-test-0.11.0.2
+- lsp-test-0.11.0.3
 - monad-dijkstra-0.1.1.2
 - optics-core-0.3
 - ormolu-0.1.2.0

stack-8.6.4.yaml

@@ -39,7 +39,7 @@ extra-deps:
 - HsYAML-0.2.1.0@rev:1
 - HsYAML-aeson-0.2.0.0@rev:1
 - lens-4.18
-- lsp-test-0.11.0.2
+- lsp-test-0.11.0.3
 - microlens-th-0.4.2.3@rev:1
 - monad-dijkstra-0.1.1.2
 - monad-memo-0.4.1

stack-8.6.5.yaml

@@ -31,7 +31,7 @@ extra-deps:
 - HsYAML-aeson-0.2.0.0@rev:1
 - indexed-profunctors-0.1
 - lens-4.18
-- lsp-test-0.11.0.2
+- lsp-test-0.11.0.3
 - monad-dijkstra-0.1.1.2
 - opentelemetry-0.4.2
 - optics-core-0.2

stack-8.8.2.yaml

@@ -31,7 +31,7 @@ extra-deps:
 - HsYAML-0.2.1.0@rev:1
 - HsYAML-aeson-0.2.0.0@rev:1
 - ilist-0.3.1.0
-- lsp-test-0.11.0.2
+- lsp-test-0.11.0.3
 - monad-dijkstra-0.1.1.2
 - opentelemetry-0.4.2
 - ormolu-0.1.2.0

stack-8.8.3.yaml

@@ -22,7 +22,7 @@ extra-deps:
 - hoogle-5.0.17.11
 - hsimport-0.11.0
 - ilist-0.3.1.0
-- lsp-test-0.11.0.2
+- lsp-test-0.11.0.3
 - monad-dijkstra-0.1.1.2
 - semigroups-0.18.5
 # - github: wz1000/shake

stack-8.8.4.yaml

@@ -24,7 +24,7 @@ extra-deps:
 - hoogle-5.0.17.11
 - hsimport-0.11.0
 - ilist-0.3.1.0
-- lsp-test-0.11.0.2
+- lsp-test-0.11.0.3
 - monad-dijkstra-0.1.1.2
 - semigroups-0.18.5
 # - github: wz1000/shake

stack.yaml

@@ -31,7 +31,7 @@ extra-deps:
 - HsYAML-aeson-0.2.0.0@rev:1
 - indexed-profunctors-0.1
 - lens-4.18
-- lsp-test-0.11.0.2
+- lsp-test-0.11.0.3
 - monad-dijkstra-0.1.1.2
 - opentelemetry-0.4.2
 - optics-core-0.2

test/functional/Format.hs

@@ -10,7 +10,6 @@ import Language.Haskell.LSP.Test
 import Language.Haskell.LSP.Types
 import Test.Hls.Util
 import Test.Tasty
-import Test.Tasty.ExpectedFailure (ignoreTestBecause)
 import Test.Tasty.Golden
 import Test.Tasty.HUnit
 import Test.Hspec.Expectations
@@ -56,7 +55,7 @@ providerTests = testGroup "formatting provider" [
         formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10))
         documentContents doc >>= liftIO . (`shouldBe` orig)
 
-    , ignoreTestBecause "Broken" $ testCase "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do
+    , testCase "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do
         doc <- openDoc "Format.hs" "haskell"
 
         sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
@@ -70,6 +69,17 @@ providerTests = testGroup "formatting provider" [
         sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
         formatDoc doc (FormattingOptions 2 True)
         documentContents doc >>= liftIO . (`shouldBe` formattedBrittanyPostFloskell)
+    , testCase "supports both new and old configuration sections" $ runSession hieCommand fullCaps "test/testdata" $ do
+       doc <- openDoc "Format.hs" "haskell"
+
+       sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "brittany"))
+       formatDoc doc (FormattingOptions 2 True)
+       documentContents doc >>= liftIO . (`shouldBe` formattedBrittany)
+
+       sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "floskell"))
+       formatDoc doc (FormattingOptions 2 True)
+       documentContents doc >>= liftIO . (`shouldBe` formattedFloskell)
+
     ]
 
 stylishHaskellTests :: TestTree
@@ -89,22 +99,26 @@ stylishHaskellTests = testGroup "stylish-haskell" [
 brittanyTests :: TestTree
 brittanyTests = testGroup "brittany" [
     goldenVsStringDiff "formats a document with LF endings" goldenGitDiff "test/testdata/BrittanyLF.formatted_document.hs" $ runSession hieCommand fullCaps "test/testdata" $ do
+        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
         doc <- openDoc "BrittanyLF.hs" "haskell"
         formatDoc doc (FormattingOptions 4 True)
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
     , goldenVsStringDiff "formats a document with CRLF endings" goldenGitDiff "test/testdata/BrittanyCRLF.formatted_document.hs" $ runSession hieCommand fullCaps "test/testdata" $ do
+        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
         doc <- openDoc "BrittanyCRLF.hs" "haskell"
         formatDoc doc (FormattingOptions 4 True)
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
     , goldenVsStringDiff "formats a range with LF endings" goldenGitDiff "test/testdata/BrittanyLF.formatted_range.hs" $ runSession hieCommand fullCaps "test/testdata" $ do
+        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
         doc <- openDoc "BrittanyLF.hs" "haskell"
         let range = Range (Position 1 0) (Position 2 22)
         formatRange doc (FormattingOptions 4 True) range
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
     , goldenVsStringDiff "formats a range with CRLF endings" goldenGitDiff "test/testdata/BrittanyCRLF.formatted_range.hs" $ runSession hieCommand fullCaps "test/testdata" $ do
+        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
         doc <- openDoc "BrittanyCRLF.hs" "haskell"
         let range = Range (Position 1 0) (Position 2 22)
         formatRange doc (FormattingOptions 4 True) range
@@ -114,8 +128,6 @@ brittanyTests = testGroup "brittany" [
 ormoluTests :: TestTree
 ormoluTests = testGroup "ormolu" [
     goldenVsStringDiff "formats correctly" goldenGitDiff ("test/testdata/Format.ormolu." ++ ormoluGoldenSuffix ++ ".hs") $ runSession hieCommand fullCaps "test/testdata" $ do
-        let formatLspConfig provider =
-                object [ "haskell" .= object ["formattingProvider" .= (provider :: Value)] ]
         sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu"))
         doc <- openDoc "Format.hs" "haskell"
         formatDoc doc (FormattingOptions 2 True)
@@ -131,6 +143,10 @@ ormoluTests = testGroup "ormolu" [
 formatLspConfig :: Value -> Value
 formatLspConfig provider = object [ "haskell" .= object ["formattingProvider" .= (provider :: Value)] ]
 
+-- | The same as 'formatLspConfig' but using the legacy section name
+formatLspConfigOld :: Value -> Value
+formatLspConfigOld provider = object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ]
+
 formatConfig :: Value -> SessionConfig
 formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provider) }
 

test/utils/Test/Hls/Util.hs

@@ -14,91 +14,28 @@ module Test.Hls.Util
     , noLogConfig
     , setupBuildToolFiles
     , withFileLogging
-    , findExe
     , withCurrentDirectoryInTmp
-  -- , makeRequest
-  -- , runIGM
-  -- , runIGM'
-  -- , runSingle
-  -- , runSingle'
-  -- , runSingleReq
-  -- , testCommand
-  -- , testOptions
   )
 where
 
-import Control.Applicative
--- import           Control.Concurrent.STM
 import           Control.Monad
-import           Control.Monad.Trans.Maybe
 import           Data.Default
 import           Data.List (intercalate)
--- import           Data.Typeable
--- import qualified Data.Map as Map
 import           Data.Maybe
 import           Language.Haskell.LSP.Core
 import           Language.Haskell.LSP.Types
 import qualified Language.Haskell.LSP.Test as T
 import qualified Language.Haskell.LSP.Types.Capabilities as C
--- import           Haskell.Ide.Engine.MonadTypes hiding (withProgress, withIndefiniteProgress)
--- import qualified Ide.Cradle as Bios
--- import qualified Ide.Engine.Config as Config
 import           System.Directory
 import           System.Environment
 import           System.FilePath
 import qualified System.Log.Logger as L
 import           System.IO.Temp
--- import           Test.Hspec
 import           Test.Hspec.Runner
 import           Test.Hspec.Core.Formatters
 import           Text.Blaze.Renderer.String (renderMarkup)
 import           Text.Blaze.Internal
--- import qualified Haskell.Ide.Engine.PluginApi as HIE (BiosOptions, defaultOptions)
--- import HIE.Bios.Types
 
--- testOptions :: HIE.BiosOptions
--- testOptions = HIE.defaultOptions { cradleOptsVerbosity = Verbose }
-
--- ---------------------------------------------------------------------
-
-
--- testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b)
---             => IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> PluginId -> CommandId -> a -> IdeResult b -> IO ()
--- testCommand testPlugins fp act plugin cmd arg res = do
---   flushStackEnvironment
---   (newApiRes, oldApiRes) <- runIGM testPlugins fp $ do
---     new <- act
---     old <- makeRequest plugin cmd arg
---     return (new, old)
---   newApiRes `shouldBe` res
---   fmap fromDynJSON oldApiRes `shouldBe` fmap Just res
-
--- runSingle :: IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b)
--- runSingle = runSingle' id
-
--- runSingle' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b)
--- runSingle' modifyConfig testPlugins fp act = runIGM' modifyConfig testPlugins fp act
-
--- runSingleReq :: ToJSON a
---              => IdePlugins -> FilePath -> PluginId -> CommandId -> a -> IO (IdeResult DynamicJSON)
--- runSingleReq testPlugins fp plugin com arg = runIGM testPlugins fp (makeRequest plugin com arg)
-
--- makeRequest :: ToJSON a => PluginId -> CommandId -> a -> IdeGhcM (IdeResult DynamicJSON)
--- makeRequest plugin com arg = runPluginCommand plugin com (toJSON arg)
-
--- runIGM :: IdePlugins -> FilePath -> IdeGhcM a -> IO a
--- runIGM = runIGM' id
-
--- runIGM' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM a -> IO a
--- runIGM' modifyConfig testPlugins fp f = do
---   stateVar <- newTVarIO $ IdeState emptyModuleCache Map.empty Map.empty Nothing
---   crdl <- Bios.findLocalCradle fp
---   mlibdir <- Bios.getProjectGhcLibDir crdl
---   let tmpFuncs :: LspFuncs Config.Config
---       tmpFuncs = dummyLspFuncs
---       lspFuncs :: LspFuncs Config.Config
---       lspFuncs = tmpFuncs { config = (fmap . fmap) modifyConfig (config tmpFuncs)}
---   runIdeGhcM mlibdir testPlugins lspFuncs stateVar f
 
 noLogConfig :: T.SessionConfig
 noLogConfig = T.defaultConfig { T.logMessages = False }
@@ -316,28 +253,6 @@ dummyLspFuncs = LspFuncs { clientCapabilities = def
                          , withIndefiniteProgress = \_ _ f -> f
                          }
 
-findExeRecursive :: FilePath -> FilePath -> IO (Maybe FilePath)
-findExeRecursive exe dir = do
-  me <- listToMaybe <$> findExecutablesInDirectories [dir] exe
-  case me of
-    Just e -> return (Just e)
-    Nothing -> do
-      subdirs <- (fmap (dir </>)) <$> listDirectory dir >>= filterM doesDirectoryExist
-      foldM (\acc subdir -> case acc of
-                              Just y -> pure $ Just y
-                              Nothing -> findExeRecursive exe subdir)
-            Nothing
-            subdirs
-
--- | So we can find an executable with cabal run
--- since it doesnt put build tools on the path (only cabal test)
-findExe :: String -> IO FilePath
-findExe name = do
-  fp <- fmap fromJust $ runMaybeT $
-    MaybeT (findExecutable name) <|>
-    MaybeT (findExeRecursive name "dist-newstyle")
-  makeAbsolute fp
-
 -- | Like 'withCurrentDirectory', but will copy the directory over to the system
 -- temporary directory first to avoid haskell-language-server's source tree from
 -- interfering with the cradle

test/wrapper/Main.hs

@@ -23,10 +23,9 @@ projectGhcVersionTests = testGroup "--project-ghc-version"
   ]
 
 testDir :: FilePath -> String -> Assertion
-testDir dir expectedVer = do
-  wrapper <- findExe "haskell-language-server-wrapper"
+testDir dir expectedVer =
   withCurrentDirectoryInTmp dir $ do
-    actualVer <- trim <$> readProcess wrapper ["--project-ghc-version"] ""
+    actualVer <- trim <$> readProcess "haskell-language-server-wrapper" ["--project-ghc-version"] ""
     actualVer @?= expectedVer
 
 trim :: String -> String