From 9d3d0e6f13fabfd089cfc7ef17186e49c274efa8 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 27 Jul 2020 14:02:20 +0100 Subject: [PATCH 1/2] 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 --- cabal.project | 2 +- haskell-language-server.cabal | 4 +- src/Ide/Plugin/Config.hs | 5 ++- stack-8.10.1.yaml | 2 +- stack-8.6.4.yaml | 2 +- stack-8.6.5.yaml | 2 +- stack-8.8.2.yaml | 2 +- stack-8.8.3.yaml | 2 +- stack-8.8.4.yaml | 2 +- stack.yaml | 2 +- test/functional/Format.hs | 24 ++++++++-- test/utils/Test/Hls/Util.hs | 85 ----------------------------------- test/wrapper/Main.hs | 5 +-- 13 files changed, 36 insertions(+), 103 deletions(-) diff --git a/cabal.project b/cabal.project index 7036da4eef..c063a3fc3e 100644 --- a/cabal.project +++ b/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 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index dbbfef3129..52f2cab6c3 100644 --- a/haskell-language-server.cabal +++ b/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 diff --git a/src/Ide/Plugin/Config.hs b/src/Ide/Plugin/Config.hs index a135f6e5a0..c28f2e489a 100644 --- a/src/Ide/Plugin/Config.hs +++ b/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 diff --git a/stack-8.10.1.yaml b/stack-8.10.1.yaml index 02f99032a0..bc51cd64b9 100644 --- a/stack-8.10.1.yaml +++ b/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 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index b3d09b090e..082611ddb4 100644 --- a/stack-8.6.4.yaml +++ b/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 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 4fda368fa4..771d6f3882 100644 --- a/stack-8.6.5.yaml +++ b/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 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index bc43e541b3..99e5c20f3b 100644 --- a/stack-8.8.2.yaml +++ b/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 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 0e3dbce818..b972a17e4e 100644 --- a/stack-8.8.3.yaml +++ b/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 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 97eb469e4e..59d3327346 100644 --- a/stack-8.8.4.yaml +++ b/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 diff --git a/stack.yaml b/stack.yaml index 69df69abb1..71c2bd1d51 100644 --- a/stack.yaml +++ b/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 diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 3c49ecc037..331e6925b7 100644 --- a/test/functional/Format.hs +++ b/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) } diff --git a/test/utils/Test/Hls/Util.hs b/test/utils/Test/Hls/Util.hs index c6b14a6ea1..a3abe97259 100644 --- a/test/utils/Test/Hls/Util.hs +++ b/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 diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs index 6f2795a579..74155ed485 100644 --- a/test/wrapper/Main.hs +++ b/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 From 95560b1daaa2e7af67d9c88df0136d6d50f3a69a Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 27 Jul 2020 20:42:10 +0100 Subject: [PATCH 2/2] Fix Brittany tests Need to read in those test results as a file, since the CPP preprocessor trips on those multiline strings Also use @?= instead of `shouldBe`, since the exception thrown by it gets caught by tasty and is pretty printed --- haskell-language-server.cabal | 2 +- test/functional/Format.hs | 80 +++++++------------ .../BrittanyCRLF.formatted_document.hs | 4 +- test/testdata/BrittanyCRLF.formatted_range.hs | 6 +- .../testdata/BrittanyLF.formatted_document.hs | 4 +- test/testdata/BrittanyLF.formatted_range.hs | 6 +- test/testdata/Format.brittany.formatted.hs | 11 +++ ...Format.brittany_post_floskell.formatted.hs | 13 +++ test/testdata/Format.floskell.formatted.hs | 13 +++ 9 files changed, 76 insertions(+), 63 deletions(-) create mode 100644 test/testdata/Format.brittany.formatted.hs create mode 100644 test/testdata/Format.brittany_post_floskell.formatted.hs create mode 100644 test/testdata/Format.floskell.formatted.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 52f2cab6c3..74f850bcc7 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -245,7 +245,7 @@ test-suite func-test , haskell-lsp-types , hspec-expectations , lens - , lsp-test >= 0.10.0.3 + , lsp-test >= 0.11.0.3 , tasty , tasty-ant-xml >= 1.1.6 , tasty-expected-failure diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 331e6925b7..f1f8e7c291 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -1,10 +1,9 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} module Format (tests) where import Control.Monad.IO.Class import Data.Aeson import qualified Data.ByteString.Lazy as BS -import qualified Data.Text as T import qualified Data.Text.Encoding as T import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types @@ -12,7 +11,11 @@ import Test.Hls.Util import Test.Tasty import Test.Tasty.Golden import Test.Tasty.HUnit -import Test.Hspec.Expectations + +#if MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) || !defined(AGPL) +#else +import qualified Data.Text.IO as T +#endif tests :: TestTree tests = testGroup "format document" [ @@ -27,7 +30,11 @@ tests = testGroup "format document" [ , rangeTests , providerTests , stylishHaskellTests +-- There's no Brittany formatter on the 8.10.1 builds (yet) +#if MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) || !defined(AGPL) +#else , brittanyTests +#endif , ormoluTests ] @@ -50,36 +57,46 @@ providerTests = testGroup "formatting provider" [ orig <- documentContents doc formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` orig) + documentContents doc >>= liftIO . (@?= orig) formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10)) - documentContents doc >>= liftIO . (`shouldBe` orig) + documentContents doc >>= liftIO . (@?= orig) +-- There's no Brittany formatter on the 8.10.1 builds (yet) +#if MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) || !defined(AGPL) +#else , testCase "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do + formattedBrittany <- liftIO $ T.readFile "test/testdata/Format.brittany.formatted.hs" + formattedFloskell <- liftIO $ T.readFile "test/testdata/Format.floskell.formatted.hs" + formattedBrittanyPostFloskell <- liftIO $ T.readFile "test/testdata/Format.brittany_post_floskell.formatted.hs" + doc <- openDoc "Format.hs" "haskell" sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedBrittany) + documentContents doc >>= liftIO . (@?= formattedBrittany) sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "floskell")) formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedFloskell) + documentContents doc >>= liftIO . (@?= formattedFloskell) sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedBrittanyPostFloskell) + documentContents doc >>= liftIO . (@?= formattedBrittanyPostFloskell) , testCase "supports both new and old configuration sections" $ runSession hieCommand fullCaps "test/testdata" $ do + formattedBrittany <- liftIO $ T.readFile "test/testdata/Format.brittany.formatted.hs" + formattedFloskell <- liftIO $ T.readFile "test/testdata/Format.floskell.formatted.hs" + doc <- openDoc "Format.hs" "haskell" sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "brittany")) formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedBrittany) + documentContents doc >>= liftIO . (@?= formattedBrittany) sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfigOld "floskell")) formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedFloskell) - + documentContents doc >>= liftIO . (@?= formattedFloskell) +#endif ] stylishHaskellTests :: TestTree @@ -152,44 +169,3 @@ formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provid goldenGitDiff :: FilePath -> FilePath -> [String] goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew] - - -formattedBrittany :: T.Text -formattedBrittany = - "module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n\ - \data Baz = Baz { a :: Int, b :: String }\n\n" - -formattedFloskell :: T.Text -formattedFloskell = - "module Format where\n\ - \\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n\ - \data Baz = Baz { a :: Int, b :: String }\n\n" - -formattedBrittanyPostFloskell :: T.Text -formattedBrittanyPostFloskell = - "module Format where\n\ - \\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n\ - \data Baz = Baz { a :: Int, b :: String }\n\n" diff --git a/test/testdata/BrittanyCRLF.formatted_document.hs b/test/testdata/BrittanyCRLF.formatted_document.hs index 13250a383e..5db4c2e08e 100644 --- a/test/testdata/BrittanyCRLF.formatted_document.hs +++ b/test/testdata/BrittanyCRLF.formatted_document.hs @@ -1,4 +1,4 @@ foo :: Int -> String -> IO () foo x y = do - print x - return 42 \ No newline at end of file + print x + return 42 diff --git a/test/testdata/BrittanyCRLF.formatted_range.hs b/test/testdata/BrittanyCRLF.formatted_range.hs index 13250a383e..ac47ea8499 100644 --- a/test/testdata/BrittanyCRLF.formatted_range.hs +++ b/test/testdata/BrittanyCRLF.formatted_range.hs @@ -1,4 +1,4 @@ -foo :: Int -> String -> IO () +foo :: Int -> String-> IO () foo x y = do - print x - return 42 \ No newline at end of file + print x + return 42 diff --git a/test/testdata/BrittanyLF.formatted_document.hs b/test/testdata/BrittanyLF.formatted_document.hs index 13250a383e..5db4c2e08e 100644 --- a/test/testdata/BrittanyLF.formatted_document.hs +++ b/test/testdata/BrittanyLF.formatted_document.hs @@ -1,4 +1,4 @@ foo :: Int -> String -> IO () foo x y = do - print x - return 42 \ No newline at end of file + print x + return 42 diff --git a/test/testdata/BrittanyLF.formatted_range.hs b/test/testdata/BrittanyLF.formatted_range.hs index 13250a383e..c2b791456b 100644 --- a/test/testdata/BrittanyLF.formatted_range.hs +++ b/test/testdata/BrittanyLF.formatted_range.hs @@ -1,4 +1,4 @@ -foo :: Int -> String -> IO () +foo :: Int -> String-> IO () foo x y = do - print x - return 42 \ No newline at end of file + print x + return 42 diff --git a/test/testdata/Format.brittany.formatted.hs b/test/testdata/Format.brittany.formatted.hs new file mode 100644 index 0000000000..d0bde680f2 --- /dev/null +++ b/test/testdata/Format.brittany.formatted.hs @@ -0,0 +1,11 @@ +module Format where +foo :: Int -> Int +foo 3 = 2 +foo x = x +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz { a :: Int, b :: String } + diff --git a/test/testdata/Format.brittany_post_floskell.formatted.hs b/test/testdata/Format.brittany_post_floskell.formatted.hs new file mode 100644 index 0000000000..208e754e24 --- /dev/null +++ b/test/testdata/Format.brittany_post_floskell.formatted.hs @@ -0,0 +1,13 @@ +module Format where + +foo :: Int -> Int +foo 3 = 2 +foo x = x + +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz { a :: Int, b :: String } + diff --git a/test/testdata/Format.floskell.formatted.hs b/test/testdata/Format.floskell.formatted.hs new file mode 100644 index 0000000000..208e754e24 --- /dev/null +++ b/test/testdata/Format.floskell.formatted.hs @@ -0,0 +1,13 @@ +module Format where + +foo :: Int -> Int +foo 3 = 2 +foo x = x + +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz { a :: Int, b :: String } +