Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit d0ac0d2

Browse files
fendorfendor
authored
Merge pull request #1 from haskell/pr/fendor/1167
Use FormattingProviders directly
2 parents 3d77363 + cf58019 commit d0ac0d2

File tree

16 files changed

+95
-152
lines changed

16 files changed

+95
-152
lines changed

‎haskell-ide-engine.cabal‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,8 @@ library
7070
, gitrev >= 1.1
7171
, haddock-api
7272
, haddock-library
73-
, haskell-lsp >= 0.8
73+
, haskell-lsp >= 0.8.2
74+
, haskell-lsp-types >= 0.8.2
7475
, haskell-src-exts
7576
, hie-plugin-api
7677
, hlint >= 2.0.11

‎hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@
77
{-# LANGUAGE ScopedTypeVariables #-}
88
{-# LANGUAGE GADTs #-}
99
{-# LANGUAGE RankNTypes #-}
10-
{-# LANGUAGE TypeSynonymInstances #-}
1110
{-# LANGUAGE PatternSynonyms #-}
1211
{-# LANGUAGE OverloadedStrings #-}
1312

@@ -229,10 +228,11 @@ data FormattingType = FormatDocument
229228
-- Failing menas here that a IdeResultFail is returned.
230229
-- This can be used to display errors to the user, unless the error is an Internal one.
231230
-- The record 'IdeError' and 'IdeErrorCode' can be used to determine the type of error.
232-
type FormattingProvider = Uri -- ^ Uri to the file to format. Can be mapped to a file with `pluginGetFile`
231+
type FormattingProvider = T.Text -- ^ Text to format
232+
-> Uri -- ^ Uri of the file being formatted
233233
-> FormattingType -- ^ How much to format
234234
-> FormattingOptions -- ^ Options for the formatter
235-
-> IdeDeferM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
235+
-> IdeM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
236236

237237
data PluginDescriptor =
238238
PluginDescriptor { pluginId :: PluginId
@@ -283,7 +283,7 @@ runPluginCommand p com arg = do
283283
case Map.lookup p m of
284284
Nothing -> return $
285285
IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p <> " doesn't exist") Null
286-
Just (PluginDescriptor { pluginCommands = xs }) -> case List.find ((com ==) . commandName) xs of
286+
Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
287287
Nothing -> return $ IdeResultFail $
288288
IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
289289
Just (PluginCommand _ _ (CmdSync f)) -> case fromJSON arg of

‎src/Haskell/Ide/Engine/Plugin/Brittany.hs‎

Lines changed: 19 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -28,10 +28,7 @@ brittanyDescriptor plId = PluginDescriptor
2828
{ pluginId = plId
2929
, pluginName = "Brittany"
3030
, pluginDesc = "Brittany is a tool to format source code."
31-
, pluginCommands = [ PluginCommand "formatText"
32-
"Format the given Text with Brittany"
33-
formatCmd
34-
]
31+
, pluginCommands = [ ]
3532
, pluginCodeActionProvider = Nothing
3633
, pluginDiagnosticProvider = Nothing
3734
, pluginHoverProvider = Nothing
@@ -42,40 +39,29 @@ brittanyDescriptor plId = PluginDescriptor
4239
-- | Formatter provider of Brittany.
4340
-- Formats the given source in either a given Range or the whole Document.
4441
-- If the provider fails an error is returned that can be displayed to the user.
45-
provider :: FormattingProvider
46-
provider = format
47-
48-
-- |Formatter of Brittany.
49-
-- Formats the given source in either a given Range or the whole Document.
50-
-- If the provider fails an error is returned that can be displayed to the user.
51-
format
52-
:: (MonadIO m, MonadIde m)
53-
=> Uri
42+
provider
43+
:: MonadIO m
44+
=> Text
45+
-> Uri
5446
-> FormattingType
5547
-> FormattingOptions
5648
-> m (IdeResult [TextEdit])
57-
format uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
49+
provider text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
5850
confFile <- liftIO $ getConfFile fp
59-
mtext <- readVFS uri
60-
case mtext of
61-
-- Uri could not be read from the virtual file system.
62-
Nothing ->
63-
return $ IdeResultFail (IdeError InternalError "File was not open" Null)
64-
Just text -> do
65-
let (range, selectedContents) = case formatType of
66-
FormatDocument -> (fullRange text, text)
67-
FormatRange r -> (normalize r, extractRange r text)
51+
let (range, selectedContents) = case formatType of
52+
FormatDocument -> (fullRange text, text)
53+
FormatRange r -> (normalize r, extractRange r text)
6854

69-
res <- formatText confFile opts selectedContents
70-
case res of
71-
Left err -> return $ IdeResultFail
72-
(IdeError PluginError
73-
(T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
74-
Null
75-
)
76-
Right newText -> do
77-
let textEdit = J.TextEdit range newText
78-
return $ IdeResultOk [textEdit]
55+
res <- formatText confFile opts selectedContents
56+
case res of
57+
Left err -> return $ IdeResultFail
58+
(IdeError PluginError
59+
(T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
60+
Null
61+
)
62+
Right newText -> do
63+
let textEdit = J.TextEdit range newText
64+
return $ IdeResultOk [textEdit]
7965

8066
-- | Primitive to format text with the given option.
8167
-- May not throw exceptions but return a Left value.
@@ -90,30 +76,6 @@ formatText confFile opts text =
9076
liftIO $ runBrittany tabSize confFile text
9177
where tabSize = opts ^. J.tabSize
9278

93-
-- | Format a source with the given options.
94-
-- Synchronized command.
95-
-- Other plugins can use this Command it to execute formatters.
96-
-- Command can be run by
97-
-- ```
98-
-- runPluginCommand
99-
-- (pluginId plugin)
100-
-- "formatText"
101-
-- (dynToJSON $ toDynJSON $ FormatTextCmdParams t r (FormattingOptions 2 True))
102-
-- ```
103-
formatCmd :: CommandFunc FormatTextCmdParams [TextEdit]
104-
formatCmd = CmdSync $ \(FormatTextCmdParams text fmtRange fmtOpts) -> do
105-
rootPath <- getRootPath
106-
textEdit <- formatText rootPath fmtOpts text
107-
case textEdit of
108-
Left err -> return $ IdeResultFail
109-
(IdeError PluginError
110-
(T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
111-
Null
112-
)
113-
Right newText -> do
114-
let edit = J.TextEdit fmtRange newText
115-
return $ IdeResultOk [edit]
116-
11779
-- | Extend to the line below to replace newline character, as above.
11880
normalize :: Range -> Range
11981
normalize (Range (Position sl _) (Position el _)) =

‎src/Haskell/Ide/Engine/Plugin/Floskell.hs‎

Lines changed: 9 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -10,21 +10,16 @@ import Data.Aeson (Value (Null))
1010
import qualified Data.ByteString.Lazy as BS
1111
import qualified Data.Text as T
1212
import qualified Data.Text.Encoding as T
13-
import Data.Maybe
1413
import Floskell
1514
import Haskell.Ide.Engine.MonadTypes
1615
import Haskell.Ide.Engine.PluginUtils
17-
import qualified Language.Haskell.LSP.Types as J
1816

1917
floskellDescriptor :: PluginId -> PluginDescriptor
2018
floskellDescriptor plId = PluginDescriptor
2119
{ pluginId = plId
2220
, pluginName = "Floskell"
2321
, pluginDesc = "A flexible Haskell source code pretty printer."
24-
, pluginCommands = [ PluginCommand "formatText"
25-
"Format the given Text with Floskell"
26-
formatCmd
27-
]
22+
, pluginCommands = []
2823
, pluginCodeActionProvider = Nothing
2924
, pluginDiagnosticProvider = Nothing
3025
, pluginHoverProvider = Nothing
@@ -36,42 +31,16 @@ floskellDescriptor plId = PluginDescriptor
3631
-- Formats the given source in either a given Range or the whole Document.
3732
-- If the provider fails an error is returned that can be displayed to the user.
3833
provider :: FormattingProvider
39-
provider uri typ _opts =
34+
provider contents uri typ _opts =
4035
pluginGetFile "Floskell: " uri $ \file -> do
4136
config <- liftIO $ findConfigOrDefault file
42-
mContents <- readVFS uri
43-
case mContents of
44-
Nothing -> return $ IdeResultFail (IdeError InternalError "File was not open" Null)
45-
Just contents ->
46-
let (range, selectedContents) = case typ of
47-
FormatDocument -> (fullRange contents, contents)
48-
FormatRange r -> (r, extractRange r contents)
49-
result = reformat config (uriToFilePath uri) (BS.fromStrict (T.encodeUtf8 selectedContents))
50-
in case result of
51-
Left err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null)
52-
Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
53-
54-
-- | Format a source with the given options.
55-
-- Synchronized command.
56-
-- Other plugins can use this Command it to execute formatters.
57-
-- Command can be run by
58-
-- ```
59-
-- runPluginCommand
60-
-- (pluginId plugin)
61-
-- "formatText"
62-
-- (dynToJSON $ toDynJSON $ FormatTextCmdParams t r (FormattingOptions 2 True))
63-
-- ```
64-
formatCmd :: CommandFunc FormatTextCmdParams [TextEdit]
65-
formatCmd = CmdSync $ \(FormatTextCmdParams text fmtRange _) -> do
66-
rootPath <- getRootPath
67-
config <- liftIO $ findConfigOrDefault (fromMaybe "" rootPath)
68-
let textEdit = reformat config Nothing (BS.fromStrict (T.encodeUtf8 text))
69-
case textEdit of
70-
Left err -> return $ IdeResultFail
71-
(IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null)
72-
Right newText -> do
73-
let edit = J.TextEdit fmtRange (T.decodeUtf8 (BS.toStrict newText))
74-
return $ IdeResultOk [edit]
37+
let (range, selectedContents) = case typ of
38+
FormatDocument -> (fullRange contents, contents)
39+
FormatRange r -> (r, extractRange r contents)
40+
result = reformat config (uriToFilePath uri) (BS.fromStrict (T.encodeUtf8 selectedContents))
41+
case result of
42+
Left err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null)
43+
Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
7544

7645
-- | Find Floskell Config, user and system wide or provides a default style.
7746
-- Every directory of the filepath will be searched to find a user configuration.

‎src/Haskell/Ide/Engine/Plugin/HsImport.hs‎

Lines changed: 14 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -87,40 +87,29 @@ importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do
8787
Nothing ->
8888
return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
8989

90-
Just (plugin, _) -> do
91-
newChanges <- forM mChanges $ \change -> do
92-
let func = mapM (formatTextEdit plugin)
93-
res <- mapM func change
94-
return $ fmap flatten res
90+
Just (_, provider) -> do
91+
let formatEdit :: J.TextEdit -> IdeGhcM J.TextEdit
92+
formatEdit origEdit@(J.TextEdit _ t) = do
93+
-- TODO: are these default FormattingOptions ok?
94+
res <- liftToGhc $ provider t uri FormatDocument (FormattingOptions 2 True)
95+
let formatEdits = case res of
96+
IdeResultOk xs -> xs
97+
_ -> []
98+
return $ foldl' J.editTextEdit origEdit formatEdits
99+
100+
-- behold: the legendary triple mapM
101+
newChanges <- (mapM . mapM . mapM) formatEdit mChanges
95102

96103
newDocChanges <- forM mDocChanges $ \change -> do
97104
let cmd (J.TextDocumentEdit vids edits) = do
98-
newEdits <- mapM (formatTextEdit plugin) edits
99-
return $ J.TextDocumentEdit vids (flatten newEdits)
105+
newEdits <- mapM formatEdit edits
106+
return $ J.TextDocumentEdit vids newEdits
100107
mapM cmd change
101108

102109
return
103110
$ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
104111
else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
105112

106-
where
107-
flatten :: List [a] -> List a
108-
flatten (J.List list) = J.List (join list)
109-
110-
formatTextEdit :: PluginDescriptor -> J.TextEdit -> IdeGhcM [J.TextEdit]
111-
formatTextEdit plugin edit@(J.TextEdit r t) = do
112-
result <- runPluginCommand
113-
(pluginId plugin)
114-
"formatText"
115-
-- TODO: should this be in the configs?
116-
(dynToJSON $ toDynJSON $ FormatTextCmdParams t
117-
r
118-
(FormattingOptions 2 True)
119-
)
120-
return $ case result of
121-
IdeResultOk e -> fromMaybe [edit] (fromDynJSON e)
122-
_ -> [edit]
123-
124113
codeActionProvider :: CodeActionProvider
125114
codeActionProvider plId docId _ context = do
126115
let J.List diags = context ^. J.diagnostics

‎src/Haskell/Ide/Engine/Transport/LspStdio.hs‎

Lines changed: 27 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -734,9 +734,10 @@ reactor inp diagIn = do
734734
provider <- getFormattingProvider
735735
let params = req ^. J.params
736736
doc = params ^. J.textDocument . J.uri
737-
callback = reactorSend . RspDocumentFormatting . Core.makeResponseMessage req . J.List
738-
hreq = IReq tn (req ^. J.id) callback $ provider doc FormatDocument (params ^. J.options)
739-
makeRequest hreq
737+
withDocumentContents (req ^. J.id) doc $ \text ->
738+
let callback = reactorSend . RspDocumentFormatting . Core.makeResponseMessage req . J.List
739+
hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc FormatDocument (params ^. J.options)
740+
in makeRequest hreq
740741

741742
-- -------------------------------
742743

@@ -745,10 +746,11 @@ reactor inp diagIn = do
745746
provider <- getFormattingProvider
746747
let params = req ^. J.params
747748
doc = params ^. J.textDocument . J.uri
748-
range = params ^. J.range
749-
callback = reactorSend . RspDocumentRangeFormatting . Core.makeResponseMessage req . J.List
750-
hreq = IReq tn (req ^. J.id) callback $ provider doc (FormatRange range) (params ^. J.options)
751-
makeRequest hreq
749+
withDocumentContents (req ^. J.id) doc $ \text ->
750+
let range = params ^. J.range
751+
callback = reactorSend . RspDocumentRangeFormatting . Core.makeResponseMessage req . J.List
752+
hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc (FormatRange range) (params ^. J.options)
753+
in makeRequest hreq
752754

753755
-- -------------------------------
754756

@@ -806,11 +808,25 @@ reactor inp diagIn = do
806808

807809
-- ---------------------------------------------------------------------
808810

811+
withDocumentContents :: J.LspId -> J.Uri -> (T.Text -> R ()) -> R ()
812+
withDocumentContents reqId uri f = do
813+
vfsFunc <- asksLspFuncs Core.getVirtualFileFunc
814+
mvf <- liftIO $ vfsFunc uri
815+
lf <- asks lspFuncs
816+
case mvf of
817+
Nothing -> liftIO $
818+
Core.sendErrorResponseS (Core.sendFunc lf)
819+
(J.responseId reqId)
820+
J.InvalidRequest
821+
"Document was not open"
822+
Just (VFS.VirtualFile _ txt) -> f (Yi.toText txt)
823+
809824
getFormattingProvider :: R FormattingProvider
810825
getFormattingProvider = do
811826
plugins <- asks idePlugins
812-
config <- getClientConfig
813-
let
827+
lf <- asks lspFuncs
828+
mc <- liftIO $ Core.config lf
829+
let config = fromMaybe def mc
814830
-- LL: Is this overengineered? Do we need a pluginFormattingProvider
815831
-- or should we just call plugins straight from here based on the providerType?
816832
providerName = formattingProvider config
@@ -820,8 +836,8 @@ getFormattingProvider = do
820836
unless (providerName == "none") $ do
821837
let msg = providerName <> " is not a recognised plugin for formatting. Check your config"
822838
reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning msg
823-
reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning msg
824-
return (\_ _ _ -> return (IdeResultOk [])) -- nop formatter
839+
reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning msg
840+
return (\_ _ _ _ -> return (IdeResultOk [])) -- nop formatter
825841
Just (_, provider) -> return provider
826842

827843
-- ---------------------------------------------------------------------

‎stack-8.2.1.yaml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,8 @@ extra-deps:
1919
- ghc-exactprint-0.5.8.2
2020
- haddock-api-2.18.1
2121
- haddock-library-1.4.4
22-
- haskell-lsp-0.8.1.0
23-
- haskell-lsp-types-0.8.0.1
22+
- haskell-lsp-0.8.2.0
23+
- haskell-lsp-types-0.8.2.0
2424
- hlint-2.0.11
2525
- hsimport-0.8.6
2626
- lsp-test-0.5.1.0

‎stack-8.2.2.yaml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,8 @@ extra-deps:
2020
- ghc-exactprint-0.5.8.2
2121
- haddock-api-2.18.1
2222
- haddock-library-1.4.4
23-
- haskell-lsp-0.8.1.0
24-
- haskell-lsp-types-0.8.0.1
23+
- haskell-lsp-0.8.2.0
24+
- haskell-lsp-types-0.8.2.0
2525
- haskell-src-exts-1.21.0
2626
- hlint-2.1.15
2727
- hoogle-5.0.17.5

‎stack-8.4.2.yaml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,8 @@ extra-deps:
1818
- ghc-exactprint-0.5.8.2
1919
- haddock-api-2.20.0
2020
- haddock-library-1.6.0
21-
- haskell-lsp-0.8.1.0
22-
- haskell-lsp-types-0.8.0.1
21+
- haskell-lsp-0.8.2.0
22+
- haskell-lsp-types-0.8.2.0
2323
- haskell-src-exts-1.21.0
2424
- hlint-2.1.15
2525
- hoogle-5.0.17.5

‎stack-8.4.3.yaml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,8 @@ extra-deps:
1717
- ghc-exactprint-0.5.8.2
1818
- haddock-api-2.20.0
1919
- haddock-library-1.6.0
20-
- haskell-lsp-0.8.1.0
21-
- haskell-lsp-types-0.8.0.1
20+
- haskell-lsp-0.8.2.0
21+
- haskell-lsp-types-0.8.2.0
2222
- haskell-src-exts-1.21.0
2323
- hlint-2.1.15
2424
- hoogle-5.0.17.5

0 commit comments

Comments
 (0)