Skip to content

Commit

Permalink
Accept the legacy "languageServerHaskell" config name
Browse files Browse the repository at this point in the history
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
  • Loading branch information
lukel97 committed Jul 27, 2020
1 parent f2384e1 commit 9d3d0e6
Show file tree
Hide file tree
Showing 13 changed files with 36 additions and 103 deletions.
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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
4 changes: 2 additions & 2 deletions haskell-language-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -215,7 +215,7 @@ common hls-test-utils
, hslogger
, hspec
, hspec-core
, lsp-test
, lsp-test >= 0.11.0.3
, stm
, tasty-hunit
, temporary
Expand Down Expand Up @@ -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
Expand Down
5 changes: 4 additions & 1 deletion src/Ide/Plugin/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack-8.10.1.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack-8.6.4.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack-8.6.5.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack-8.8.2.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack-8.8.3.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack-8.8.4.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion stack.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
24 changes: 20 additions & 4 deletions test/functional/Format.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"))
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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) }

Expand Down
85 changes: 0 additions & 85 deletions test/utils/Test/Hls/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand Down Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions test/wrapper/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 9d3d0e6

Please sign in to comment.