Skip to content

Commit cfe4369

Browse files
alanzalanz
authored
Merge pull request #66 from fendor/brittany-plugin
Move Brittany plugin from HIE
2 parents 79c9626 + df144ea commit cfe4369

File tree

5 files changed

+179
-155
lines changed

5 files changed

+179
-155
lines changed

‎exe/Main.hs

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,9 @@ import Ide.Plugin.Example2 as Example2
9292
import Ide.Plugin.GhcIde as GhcIde
9393
import Ide.Plugin.Floskell as Floskell
9494
import Ide.Plugin.Ormolu as Ormolu
95+
#if AGPL
96+
import Ide.Plugin.Brittany as Brittany
97+
#endif
9598
import Ide.Plugin.Pragmas as Pragmas
9699

97100

@@ -113,18 +116,20 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
113116
basePlugins =
114117
[
115118
-- applyRefactDescriptor "applyrefact"
116-
-- , brittanyDescriptor "brittany"
117119
-- , haddockDescriptor "haddock"
118120
-- , hareDescriptor "hare"
119121
-- , hsimportDescriptor "hsimport"
120122
-- , liquidDescriptor "liquid"
121123
-- , packageDescriptor "package"
122-
GhcIde.descriptor "ghcide"
124+
GhcIde.descriptor "ghcide"
123125
, Pragmas.descriptor "pragmas"
124126
, Floskell.descriptor "floskell"
125127
-- , genericDescriptor "generic"
126128
-- , ghcmodDescriptor "ghcmod"
127129
, Ormolu.descriptor "ormolu"
130+
#if AGPL
131+
, Brittany.descriptor "brittany"
132+
#endif
128133
]
129134
examplePlugins =
130135
[Example.descriptor "eg"
@@ -172,7 +177,6 @@ main = do
172177
options = def { LSP.executeCommandCommands = Just commandIds
173178
, LSP.completionTriggerCharacters = Just "."
174179
}
175-
176180
if argLSP then do
177181
t <- offsetTime
178182
hPutStrLn stderr "Starting (haskell-language-server)LSP server..."

‎haskell-language-server.cabal

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
cabal-version: 1.12
1+
cabal-version: 2.2
22
category: Development
33
name: haskell-language-server
44
version: 0.1.0.0
@@ -16,6 +16,11 @@ extra-source-files:
1616
README.md
1717
ChangeLog.md
1818

19+
flag agpl
20+
Description: Enable AGPL dependencies
21+
Default: True
22+
Manual: False
23+
1924
flag pedantic
2025
Description: Enable -Werror
2126
Default: False
@@ -25,7 +30,13 @@ source-repository head
2530
type: git
2631
location: https://github.com/haskell/haskell-language-server
2732

33+
common agpl
34+
if flag(agpl)
35+
cpp-options:
36+
-DAGPL
37+
2838
library
39+
import: agpl
2940
exposed-modules:
3041
Ide.Cradle
3142
Ide.Logger
@@ -77,6 +88,12 @@ library
7788
build-depends: Win32
7889
else
7990
build-depends: unix
91+
if flag(agpl)
92+
build-depends:
93+
brittany
94+
exposed-modules:
95+
Ide.Plugin.Brittany
96+
8097
if impl(ghc >= 8.6)
8198
build-depends: ormolu >= 0.0.3.1
8299

@@ -90,6 +107,7 @@ library
90107
default-language: Haskell2010
91108

92109
executable haskell-language-server
110+
import: agpl
93111
main-is: Main.hs
94112
hs-source-dirs:
95113
exe
@@ -150,6 +168,7 @@ executable haskell-language-server
150168
default-language: Haskell2010
151169

152170
executable haskell-language-server-wrapper
171+
import: agpl
153172
main-is: Wrapper.hs
154173
hs-source-dirs:
155174
exe
@@ -187,6 +206,7 @@ executable haskell-language-server-wrapper
187206

188207

189208
test-suite func-test
209+
import: agpl
190210
type: exitcode-stdio-1.0
191211
default-language: Haskell2010
192212
build-tool-depends: hspec-discover:hspec-discover
@@ -244,6 +264,7 @@ test-suite func-test
244264
-- Development.IDE.Test.Runfiles
245265

246266
library hls-test-utils
267+
import: agpl
247268
hs-source-dirs: test/utils
248269
exposed-modules: TestUtils
249270
build-depends: base

‎src/Ide/Plugin/Brittany.hs

Lines changed: 112 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
module Ide.Plugin.Brittany where
2+
3+
import Control.Lens
4+
import Control.Monad.IO.Class
5+
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
6+
import Data.Coerce
7+
import Data.Semigroup
8+
import Data.Text (Text)
9+
import qualified Data.Text as T
10+
import Development.IDE.Types.Location
11+
import Language.Haskell.Brittany
12+
import Language.Haskell.LSP.Types as J
13+
import qualified Language.Haskell.LSP.Types.Lens as J
14+
import Ide.Plugin.Formatter
15+
import Ide.Types
16+
17+
import System.FilePath
18+
import Data.Maybe (maybeToList)
19+
20+
descriptor :: PluginId -> PluginDescriptor
21+
descriptor plId = PluginDescriptor
22+
{ pluginId = plId
23+
, pluginRules = mempty
24+
, pluginCommands = []
25+
, pluginCodeActionProvider = Nothing
26+
, pluginCodeLensProvider = Nothing
27+
, pluginDiagnosticProvider = Nothing
28+
, pluginHoverProvider = Nothing
29+
, pluginSymbolsProvider = Nothing
30+
, pluginFormattingProvider = Just provider
31+
, pluginCompletionProvider = Nothing
32+
}
33+
34+
-- | Formatter provider of Brittany.
35+
-- Formats the given source in either a given Range or the whole Document.
36+
-- If the provider fails an error is returned that can be displayed to the user.
37+
provider
38+
:: FormattingProvider IO
39+
provider _ideState typ contents fp opts = do
40+
-- text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
41+
confFile <- liftIO $ getConfFile fp
42+
let (range, selectedContents) = case typ of
43+
FormatText -> (fullRange contents, contents)
44+
FormatRange r -> (normalize r, extractRange r contents)
45+
46+
res <- formatText confFile opts selectedContents
47+
case res of
48+
Left err -> return $ Left $ responseError (T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
49+
Right newText -> return $ Right $ J.List [TextEdit range newText]
50+
51+
-- | Primitive to format text with the given option.
52+
-- May not throw exceptions but return a Left value.
53+
-- Errors may be presented to the user.
54+
formatText
55+
:: MonadIO m
56+
=> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
57+
-> FormattingOptions -- ^ Options for the formatter such as indentation.
58+
-> Text -- ^ Text to format
59+
-> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.
60+
formatText confFile opts text =
61+
liftIO $ runBrittany tabSize confFile text
62+
where tabSize = opts ^. J.tabSize
63+
64+
-- | Extend to the line below and above to replace newline character.
65+
normalize :: Range -> Range
66+
normalize (Range (Position sl _) (Position el _)) =
67+
Range (Position sl 0) (Position (el + 1) 0)
68+
69+
-- | Recursively search in every directory of the given filepath for brittany.yaml.
70+
-- If no such file has been found, return Nothing.
71+
getConfFile :: NormalizedFilePath -> IO (Maybe FilePath)
72+
getConfFile = findLocalConfigPath . takeDirectory . fromNormalizedFilePath
73+
74+
-- | Run Brittany on the given text with the given tab size and
75+
-- a configuration path. If no configuration path is given, a
76+
-- default configuration is chosen. The configuration may overwrite
77+
-- tab size parameter.
78+
--
79+
-- Returns either a list of Brittany Errors or the reformatted text.
80+
-- May not throw an exception.
81+
runBrittany :: Int -- ^ tab size
82+
-> Maybe FilePath -- ^ local config file
83+
-> Text -- ^ text to format
84+
-> IO (Either [BrittanyError] Text)
85+
runBrittany tabSize confPath text = do
86+
let cfg = mempty
87+
{ _conf_layout =
88+
mempty { _lconfig_indentAmount = opt (coerce tabSize)
89+
}
90+
, _conf_forward =
91+
(mempty :: CForwardOptions Option)
92+
{ _options_ghc = opt (runIdentity ( _options_ghc forwardOptionsSyntaxExtsEnabled))
93+
}
94+
}
95+
96+
config <- fromMaybeT (pure staticDefaultConfig) (readConfigsWithUserConfig cfg (maybeToList confPath))
97+
parsePrintModule config text
98+
99+
fromMaybeT :: Monad m => m a -> MaybeT m a -> m a
100+
fromMaybeT def act = runMaybeT act >>= maybe def return
101+
102+
opt :: a -> Option a
103+
opt = Option . Just
104+
105+
showErr :: BrittanyError -> String
106+
showErr (ErrorInput s) = s
107+
showErr (ErrorMacroConfig err input)
108+
= "Error: parse error in inline configuration: " ++ err ++ " in the string \"" ++ input ++ "\"."
109+
showErr (ErrorUnusedComment s) = s
110+
showErr (LayoutWarning s) = s
111+
showErr (ErrorUnknownNode s _) = s
112+
showErr ErrorOutputCheck = "Brittany error - invalid output"

‎test/functional/FormatSpec.hs

Lines changed: 35 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -84,36 +84,41 @@ spec = do
8484
-- formatDoc doc (FormattingOptions 2 True)
8585
-- documentContents doc >>= liftIO . (`shouldBe` formattedBrittanyPostFloskell)
8686

87-
-- describe "brittany" $ do
88-
-- it "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
89-
-- doc <- openDoc "BrittanyLF.hs" "haskell"
90-
-- let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing
91-
-- ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts
92-
-- liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0))
93-
-- "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"]
94-
95-
-- it "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
96-
-- doc <- openDoc "BrittanyCRLF.hs" "haskell"
97-
-- let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing
98-
-- ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts
99-
-- liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0))
100-
-- "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"]
101-
102-
-- it "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
103-
-- doc <- openDoc "BrittanyLF.hs" "haskell"
104-
-- let range = Range (Position 1 0) (Position 2 22)
105-
-- opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing
106-
-- ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts
107-
-- liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0))
108-
-- "foo x y = do\n print x\n return 42\n"]
109-
110-
-- it "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
111-
-- doc <- openDoc "BrittanyCRLF.hs" "haskell"
112-
-- let range = Range (Position 1 0) (Position 2 22)
113-
-- opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing
114-
-- ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts
115-
-- liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0))
116-
-- "foo x y = do\n print x\n return 42\n"]
87+
describe "brittany" $ do
88+
let formatLspConfig provider =
89+
object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ]
90+
it "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
91+
doc <- openDoc "BrittanyLF.hs" "haskell"
92+
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
93+
let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing
94+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts
95+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0))
96+
"foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"]
97+
98+
it "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
99+
doc <- openDoc "BrittanyCRLF.hs" "haskell"
100+
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
101+
let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing
102+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts
103+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0))
104+
"foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"]
105+
106+
it "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
107+
doc <- openDoc "BrittanyLF.hs" "haskell"
108+
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
109+
let range = Range (Position 1 0) (Position 2 22)
110+
opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing
111+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts
112+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0))
113+
"foo x y = do\n print x\n return 42\n"]
114+
115+
it "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
116+
doc <- openDoc "BrittanyCRLF.hs" "haskell"
117+
let range = Range (Position 1 0) (Position 2 22)
118+
opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing
119+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts
120+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0))
121+
"foo x y = do\n print x\n return 42\n"]
117122

118123
-- ---------------------------------
119124

0 commit comments

Comments
 (0)