diff --git a/exe/Main.hs b/exe/Main.hs index 6a2ec8c3e3..19b1534ff2 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -94,6 +94,7 @@ import Ide.Plugin.Example2 as Example2 import Ide.Plugin.GhcIde as GhcIde import Ide.Plugin.Floskell as Floskell import Ide.Plugin.Ormolu as Ormolu +import Ide.Plugin.StylishHaskell as StylishHaskell #if AGPL import Ide.Plugin.Brittany as Brittany #endif @@ -129,6 +130,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins -- , genericDescriptor "generic" -- , ghcmodDescriptor "ghcmod" , Ormolu.descriptor "ormolu" + , StylishHaskell.descriptor "stylish-haskell" #if AGPL , Brittany.descriptor "brittany" #endif diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d76451a0a5..bfb3916baf 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -49,6 +49,7 @@ library Ide.Plugin.Pragmas Ide.Plugin.Floskell Ide.Plugin.Formatter + Ide.Plugin.StylishHaskell Ide.PluginUtils Ide.Types Ide.Version @@ -84,6 +85,7 @@ library , process , regex-tdfa >= 1.3.1.0 , shake >= 0.17.5 + , stylish-haskell == 0.11.* , text , transformers , unordered-containers diff --git a/src/Ide/Plugin/Config.hs b/src/Ide/Plugin/Config.hs index d4898169d3..7b8e372b28 100644 --- a/src/Ide/Plugin/Config.hs +++ b/src/Ide/Plugin/Config.hs @@ -64,6 +64,7 @@ instance Default Config where -- , formattingProvider = "brittany" , formattingProvider = "ormolu" -- , formattingProvider = "floskell" + -- , formattingProvider = "stylish-haskell" } -- TODO: Add API for plugins to expose their own LSP config options diff --git a/src/Ide/Plugin/StylishHaskell.hs b/src/Ide/Plugin/StylishHaskell.hs new file mode 100644 index 0000000000..3fab035b91 --- /dev/null +++ b/src/Ide/Plugin/StylishHaskell.hs @@ -0,0 +1,59 @@ +module Ide.Plugin.StylishHaskell + ( + descriptor + , provider + ) +where + +import Control.Monad.IO.Class +import Data.Text (Text) +import qualified Data.Text as T +import Ide.Plugin.Formatter +import Ide.PluginUtils +import Ide.Types +import Language.Haskell.Stylish +import Language.Haskell.LSP.Types as J + +import System.Directory +import System.FilePath + +descriptor :: PluginId -> PluginDescriptor +descriptor plId = (defaultPluginDescriptor plId) + { pluginFormattingProvider = Just provider + } + +-- | Formatter provider of stylish-haskell. +-- Formats the given source in either a given Range or the whole Document. +-- If the provider fails an error is returned that can be displayed to the user. +provider :: FormattingProvider IO +provider _lf _ideState typ contents fp _opts = do + let file = fromNormalizedFilePath fp + config <- liftIO $ loadConfigFrom file + let (range, selectedContents) = case typ of + FormatText -> (fullRange contents, contents) + FormatRange r -> (normalize r, extractRange r contents) + result = runStylishHaskell file config selectedContents + case result of + Left err -> return $ Left $ responseError $ T.pack $ "stylishHaskellCmd: " ++ err + Right new -> return $ Right $ J.List [TextEdit range new] + +-- | Recursively search in every directory of the given filepath for .stylish-haskell.yaml. +-- If no such file has been found, return default config. +loadConfigFrom :: FilePath -> IO Config +loadConfigFrom file = do + currDir <- getCurrentDirectory + setCurrentDirectory (takeDirectory file) + config <- loadConfig (makeVerbose False) Nothing + setCurrentDirectory currDir + return config + +-- | Run stylish-haskell on the given text with the given configuration. +runStylishHaskell :: FilePath -- ^ Location of the file being formatted. Used for error message + -> Config -- ^ Configuration for stylish-haskell + -> Text -- ^ Text to format + -> Either String Text -- ^ Either formatted Text or an error message +runStylishHaskell file config = fmap fromLines . fmt . toLines + where + fromLines = T.pack . unlines + fmt = runSteps (configLanguageExtensions config) (Just file) (configSteps config) + toLines = lines . T.unpack diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 44aad13daa..b45f9048a5 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -33,6 +33,8 @@ extra-deps: - hlint-2.2.8 - hoogle-5.0.17.11 - hsimport-0.11.0@rev:2 +- HsYAML-0.2.1.0@rev:1 +- HsYAML-aeson-0.2.0.0@rev:1 - lens-4.18 - lsp-test-0.10.3.0 - microlens-th-0.4.2.3@rev:1 @@ -48,6 +50,7 @@ extra-deps: # - shake-0.18.5 - github: wz1000/shake commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef +- stylish-haskell-0.11.0.0 - syz-0.2.0.0 - tasty-rerun-1.1.17 - temporary-1.2.1.1 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 8112ee1950..f30a7efe53 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -25,6 +25,8 @@ extra-deps: - haskell-lsp-0.22.0.0 - haskell-lsp-types-0.22.0.0 - hie-bios-0.5.0 +- HsYAML-0.2.1.0@rev:1 +- HsYAML-aeson-0.2.0.0@rev:1 - indexed-profunctors-0.1 - lens-4.18 - lsp-test-0.10.3.0 @@ -40,6 +42,7 @@ extra-deps: - semialign-1.1 - github: wz1000/shake commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef +- stylish-haskell-0.11.0.0 - tasty-rerun-1.1.17 - temporary-1.2.1.1 - type-equality-1 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index 390910a08e..ea55a65fb0 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -23,6 +23,8 @@ extra-deps: - hlint-2.2.8 - hoogle-5.0.17.11 - hsimport-0.11.0 +- HsYAML-0.2.1.0@rev:1 +- HsYAML-aeson-0.2.0.0@rev:1 - ilist-0.3.1.0 - lsp-test-0.10.3.0 - monad-dijkstra-0.1.1.2 @@ -31,6 +33,7 @@ extra-deps: - semigroups-0.18.5 - github: wz1000/shake commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef +- stylish-haskell-0.11.0.0 - temporary-1.2.1.1 flags: diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 7ddd544644..a8d218f591 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -30,6 +30,7 @@ extra-deps: - semigroups-0.18.5 - github: wz1000/shake commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef +- stylish-haskell-0.11.0.0 - temporary-1.2.1.1 flags: diff --git a/stack.yaml b/stack.yaml index 814a85fa0d..b2e872a84e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -25,6 +25,8 @@ extra-deps: - haskell-lsp-0.22.0.0 - haskell-lsp-types-0.22.0.0 - hie-bios-0.5.0 +- HsYAML-0.2.1.0@rev:1 +- HsYAML-aeson-0.2.0.0@rev:1 - indexed-profunctors-0.1 - lens-4.18 - lsp-test-0.10.3.0 @@ -40,6 +42,7 @@ extra-deps: - semialign-1.1 - github: wz1000/shake commit: fb3859dca2e54d1bbb2c873e68ed225fa179fbef +- stylish-haskell-0.11.0.0 - tasty-rerun-1.1.17 - temporary-1.2.1.1 - type-equality-1 diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 733614ed2b..e23c5a6eb1 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -24,6 +24,7 @@ tests = testGroup "format document" [ documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize5) , rangeTests , providerTests + , stylishHaskellTests , brittanyTests , ormoluTests ] @@ -68,6 +69,38 @@ providerTests = testGroup "formatting provider" [ documentContents doc >>= liftIO . (`shouldBe` formattedBrittanyPostFloskell) ] +stylishHaskellTests :: TestTree +stylishHaskellTests = testGroup "stylish-haskell" [ + testCase "formats a file" $ runSession hieCommand fullCaps "test/testdata" $ do + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell")) + doc <- openDoc "StylishHaskell.hs" "haskell" + formatDoc doc (FormattingOptions 2 True) + contents <- documentContents doc + liftIO $ contents `shouldBe` + "import Data.Char\n\ + \import qualified Data.List\n\ + \import Data.String\n\ + \\n\ + \bar :: Maybe (Either String Integer) -> Integer\n\ + \bar Nothing = 0\n\ + \bar (Just (Left _)) = 0\n\ + \bar (Just (Right x)) = x\n" + , testCase "formats a range" $ runSession hieCommand fullCaps "test/testdata" $ do + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell")) + doc <- openDoc "StylishHaskell.hs" "haskell" + formatRange doc (FormattingOptions 2 True) (Range (Position 0 0) (Position 2 21)) + contents <- documentContents doc + liftIO $ contents `shouldBe` + "import Data.Char\n\ + \import qualified Data.List\n\ + \import Data.String\n\ + \\n\ + \bar :: Maybe (Either String Integer) -> Integer\n\ + \bar Nothing = 0\n\ + \bar (Just (Left _)) = 0\n\ + \bar (Just (Right x)) = x\n" + ] + brittanyTests :: TestTree brittanyTests = testGroup "brittany" [ ignoreTestBecause "Broken" $ testCase "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do diff --git a/test/testdata/StylishHaskell.hs b/test/testdata/StylishHaskell.hs new file mode 100644 index 0000000000..8e389300b9 --- /dev/null +++ b/test/testdata/StylishHaskell.hs @@ -0,0 +1,8 @@ +import Data.Char +import qualified Data.List +import Data.String + +bar :: Maybe (Either String Integer) -> Integer +bar Nothing = 0 +bar (Just (Left _)) = 0 +bar (Just (Right x)) = x