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

Commit e5713e0

Browse files
mpickeringfendor
authored andcommitted
Change HsImport to use the configured FormattingProvider
Includes changes from bubba.
1 parent e1b3157 commit e5713e0

File tree

7 files changed

+151
-89
lines changed

7 files changed

+151
-89
lines changed

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

Lines changed: 15 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

@@ -75,6 +74,7 @@ module Haskell.Ide.Engine.PluginsIdeMonads
7574
, PublishDiagnosticsParams(..)
7675
, List(..)
7776
, FormattingOptions(..)
77+
, FormatTextCmdParams(..)
7878
)
7979
where
8080

@@ -208,6 +208,16 @@ type HoverProvider = Uri -> Position -> IdeM (IdeResult [Hover])
208208

209209
type SymbolProvider = Uri -> IdeDeferM (IdeResult [DocumentSymbol])
210210

211+
-- | Format Paramaters for Cmd.
212+
-- Can be used to send messages to formatters
213+
data FormatTextCmdParams = FormatTextCmdParams
214+
{ fmtText :: T.Text -- ^ Text to format
215+
, fmtResultRange :: Range -- ^ Range where the text will be inserted.
216+
, fmtTextOptions :: FormattingOptions -- ^ Options for the formatter
217+
}
218+
deriving (Eq, Show, Generic, FromJSON, ToJSON)
219+
220+
211221
-- | Format the document either as a whole or only a given Range of it.
212222
data FormattingType = FormatDocument
213223
| FormatRange Range
@@ -218,10 +228,11 @@ data FormattingType = FormatDocument
218228
-- Failing menas here that a IdeResultFail is returned.
219229
-- This can be used to display errors to the user, unless the error is an Internal one.
220230
-- The record 'IdeError' and 'IdeErrorCode' can be used to determine the type of error.
221-
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
222233
-> FormattingType -- ^ How much to format
223234
-> FormattingOptions -- ^ Options for the formatter
224-
-> IdeDeferM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
235+
-> IdeM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
225236

226237
data PluginDescriptor =
227238
PluginDescriptor { pluginId :: PluginId
@@ -272,7 +283,7 @@ runPluginCommand p com arg = do
272283
case Map.lookup p m of
273284
Nothing -> return $
274285
IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p <> " doesn't exist") Null
275-
Just (PluginDescriptor { pluginCommands = xs }) -> case List.find ((com ==) . commandName) xs of
286+
Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
276287
Nothing -> return $ IdeResultFail $
277288
IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
278289
Just (PluginCommand _ _ (CmdSync f)) -> case fromJSON arg of

src/Haskell/Ide/Engine/LSP/Reactor.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,8 @@ data REnv = REnv
4040
, hoverProviders :: [HoverProvider]
4141
, symbolProviders :: [SymbolProvider]
4242
, formattingProviders :: Map.Map PluginId FormattingProvider
43+
-- | Ide Plugins that are available
44+
, idePlugins :: IdePlugins
4345
-- TODO: Add code action providers here
4446
}
4547

@@ -61,11 +63,12 @@ runReactor
6163
-> [HoverProvider]
6264
-> [SymbolProvider]
6365
-> Map.Map PluginId FormattingProvider
66+
-> IdePlugins
6467
-> R a
6568
-> IO a
66-
runReactor lf sc dps hps sps fps f = do
69+
runReactor lf sc dps hps sps fps plugins f = do
6770
pid <- getProcessID
68-
runReaderT f (REnv sc lf pid dps hps sps fps)
71+
runReaderT f (REnv sc lf pid dps hps sps fps plugins)
6972

7073
-- ---------------------------------------------------------------------
7174

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

Lines changed: 42 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -25,47 +25,60 @@ data FormatParams = FormatParams Int Uri (Maybe Range)
2525

2626
brittanyDescriptor :: PluginId -> PluginDescriptor
2727
brittanyDescriptor plId = PluginDescriptor
28-
{ pluginId = plId
29-
, pluginName = "Brittany"
30-
, pluginDesc = "Brittany is a tool to format source code."
31-
, pluginCommands = []
28+
{ pluginId = plId
29+
, pluginName = "Brittany"
30+
, pluginDesc = "Brittany is a tool to format source code."
31+
, pluginCommands = [ ]
3232
, pluginCodeActionProvider = Nothing
3333
, pluginDiagnosticProvider = Nothing
34-
, pluginHoverProvider = Nothing
35-
, pluginSymbolProvider = Nothing
34+
, pluginHoverProvider = Nothing
35+
, pluginSymbolProvider = Nothing
3636
, pluginFormattingProvider = Just provider
3737
}
3838

3939
-- | Formatter provider of Brittany.
4040
-- Formats the given source in either a given Range or the whole Document.
4141
-- If the provider fails an error is returned that can be displayed to the user.
42-
provider :: FormattingProvider
43-
provider uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \file -> do
44-
confFile <- liftIO $ getConfFile file
45-
mtext <- readVFS uri
46-
case mtext of
47-
Nothing -> return $ IdeResultFail (IdeError InternalError "File was not open" Null)
48-
Just text -> case formatType of
49-
FormatRange r -> do
50-
res <- liftIO $ runBrittany tabSize confFile $ extractRange r text
51-
case res of
52-
Left err -> return $ IdeResultFail (IdeError PluginError
53-
(T.pack $ "brittanyCmd: " ++ unlines (map showErr err)) Null)
54-
Right newText -> do
55-
let textEdit = J.TextEdit (normalize r) newText
56-
return $ IdeResultOk [textEdit]
57-
FormatDocument -> do
58-
res <- liftIO $ runBrittany tabSize confFile text
59-
case res of
60-
Left err -> return $ IdeResultFail (IdeError PluginError
61-
(T.pack $ "brittanyCmd: " ++ unlines (map showErr err)) Null)
62-
Right newText ->
63-
return $ IdeResultOk [J.TextEdit (fullRange text) newText]
42+
provider
43+
:: MonadIO m
44+
=> Text
45+
-> Uri
46+
-> FormattingType
47+
-> FormattingOptions
48+
-> m (IdeResult [TextEdit])
49+
provider text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
50+
confFile <- liftIO $ getConfFile fp
51+
let (range, selectedContents) = case formatType of
52+
FormatDocument -> (fullRange text, text)
53+
FormatRange r -> (normalize r, extractRange r text)
54+
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]
65+
66+
-- | Primitive to format text with the given option.
67+
-- May not throw exceptions but return a Left value.
68+
-- Errors may be presented to the user.
69+
formatText
70+
:: MonadIO m
71+
=> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
72+
-> FormattingOptions -- ^ Options for the formatter such as indentation.
73+
-> Text -- ^ Text to format
74+
-> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.
75+
formatText confFile opts text =
76+
liftIO $ runBrittany tabSize confFile text
6477
where tabSize = opts ^. J.tabSize
6578

79+
-- | Extend to the line below to replace newline character, as above.
6680
normalize :: Range -> Range
6781
normalize (Range (Position sl _) (Position el _)) =
68-
-- Extend to the line below to replace newline character, as above
6982
Range (Position sl 0) (Position (el + 1) 0)
7083

7184
-- | Recursively search in every directory of the given filepath for brittany.yaml

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

Lines changed: 9 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ floskellDescriptor plId = PluginDescriptor
1919
{ pluginId = plId
2020
, pluginName = "Floskell"
2121
, pluginDesc = "A flexible Haskell source code pretty printer."
22-
, pluginCommands = []
22+
, pluginCommands = []
2323
, pluginCodeActionProvider = Nothing
2424
, pluginDiagnosticProvider = Nothing
2525
, pluginHoverProvider = Nothing
@@ -31,20 +31,16 @@ floskellDescriptor plId = PluginDescriptor
3131
-- Formats the given source in either a given Range or the whole Document.
3232
-- If the provider fails an error is returned that can be displayed to the user.
3333
provider :: FormattingProvider
34-
provider uri typ _opts =
34+
provider contents uri typ _opts =
3535
pluginGetFile "Floskell: " uri $ \file -> do
3636
config <- liftIO $ findConfigOrDefault file
37-
mContents <- readVFS uri
38-
case mContents of
39-
Nothing -> return $ IdeResultFail (IdeError InternalError "File was not open" Null)
40-
Just contents ->
41-
let (range, selectedContents) = case typ of
42-
FormatDocument -> (fullRange contents, contents)
43-
FormatRange r -> (r, extractRange r contents)
44-
result = reformat config (uriToFilePath uri) (BS.fromStrict (T.encodeUtf8 selectedContents))
45-
in case result of
46-
Left err -> return $ IdeResultFail (IdeError PluginError (T.pack err) Null)
47-
Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
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))]
4844

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

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

Lines changed: 34 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ import Control.Monad
1010
import Data.Aeson
1111
import Data.Bitraversable
1212
import Data.Bifunctor
13-
import Data.Either
1413
import Data.Foldable
1514
import Data.Maybe
1615
import Data.Monoid ( (<>) )
@@ -21,11 +20,10 @@ import qualified GhcMod.Utils as GM
2120
import HsImport
2221
import Haskell.Ide.Engine.Config
2322
import Haskell.Ide.Engine.MonadTypes
23+
import qualified Haskell.Ide.Engine.Support.HieExtras as Hie
2424
import qualified Language.Haskell.LSP.Types as J
2525
import qualified Language.Haskell.LSP.Types.Lens as J
2626
import Haskell.Ide.Engine.PluginUtils
27-
import qualified Haskell.Ide.Engine.Plugin.Brittany
28-
as Brittany
2927
import qualified Haskell.Ide.Engine.Plugin.Hoogle
3028
as Hoogle
3129
import System.Directory
@@ -54,12 +52,10 @@ importCmd :: CommandFunc ImportParams J.WorkspaceEdit
5452
importCmd = CmdSync $ \(ImportParams uri modName) -> importModule uri modName
5553

5654
importModule :: Uri -> T.Text -> IdeGhcM (IdeResult J.WorkspaceEdit)
57-
importModule uri modName =
58-
pluginGetFile "hsimport cmd: " uri $ \origInput -> do
59-
55+
importModule uri modName = pluginGetFile "hsimport cmd: " uri $ \origInput -> do
6056
shouldFormat <- formatOnImportOn <$> getConfig
6157

62-
fileMap <- GM.mkRevRedirMapFunc
58+
fileMap <- GM.mkRevRedirMapFunc
6359
GM.withMappedFile origInput $ \input -> do
6460

6561
tmpDir <- liftIO getTemporaryDirectory
@@ -79,25 +75,40 @@ importModule uri modName =
7975
Nothing -> do
8076
newText <- liftIO $ T.readFile output
8177
liftIO $ removeFile output
82-
J.WorkspaceEdit mChanges mDocChanges <- liftToGhc $ makeDiffResult input newText fileMap
78+
J.WorkspaceEdit mChanges mDocChanges <- liftToGhc
79+
$ makeDiffResult input newText fileMap
8380

8481
if shouldFormat
8582
then do
86-
-- Format the import with Brittany
87-
confFile <- liftIO $ Brittany.getConfFile origInput
88-
newChanges <- forM mChanges $ mapM $ mapM (formatTextEdit confFile)
89-
newDocChanges <- forM mDocChanges $ mapM $ \(J.TextDocumentEdit vDocId tes) -> do
90-
ftes <- forM tes (formatTextEdit confFile)
91-
return (J.TextDocumentEdit vDocId ftes)
92-
93-
return $ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
94-
else
95-
return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
96-
97-
where formatTextEdit confFile (J.TextEdit r t) = do
98-
-- TODO: This tab size of 2 spaces should probably be taken from a config
99-
ft <- fromRight t <$> liftIO (Brittany.runBrittany 2 confFile t)
100-
return (J.TextEdit r ft)
83+
config <- getConfig
84+
plugins <- getPlugins
85+
let mprovider = Hie.getFormattingPlugin config plugins
86+
case mprovider of
87+
Nothing ->
88+
return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
89+
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
102+
103+
newDocChanges <- forM mDocChanges $ \change -> do
104+
let cmd (J.TextDocumentEdit vids edits) = do
105+
newEdits <- mapM formatEdit edits
106+
return $ J.TextDocumentEdit vids newEdits
107+
mapM cmd change
108+
109+
return
110+
$ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
111+
else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
101112

102113
codeActionProvider :: CodeActionProvider
103114
codeActionProvider plId docId _ context = do

src/Haskell/Ide/Engine/Support/HieExtras.hs

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ module Haskell.Ide.Engine.Support.HieExtras
2222
, runGhcModCommand
2323
, splitCaseCmd'
2424
, splitCaseCmd
25+
, getFormattingPlugin
2526
) where
2627

2728
import ConLike
@@ -55,6 +56,7 @@ import qualified GhcMod.Gap as GM
5556
import qualified GhcMod.LightGhc as GM
5657
import qualified GhcMod.Utils as GM
5758
import Haskell.Ide.Engine.ArtifactMap
59+
import Haskell.Ide.Engine.Config
5860
import Haskell.Ide.Engine.Context
5961
import Haskell.Ide.Engine.MonadFunctions
6062
import Haskell.Ide.Engine.MonadTypes
@@ -799,3 +801,12 @@ prefixes =
799801
, "$c"
800802
, "$m"
801803
]
804+
805+
-- ---------------------------------------------------------------------
806+
807+
getFormattingPlugin :: Config -> IdePlugins -> Maybe (PluginDescriptor, FormattingProvider)
808+
getFormattingPlugin config plugins = do
809+
let providerName = formattingProvider config
810+
fmtPlugin <- Map.lookup providerName (ipMap plugins)
811+
fmtProvider <- pluginFormattingProvider fmtPlugin
812+
return (fmtPlugin, fmtProvider)

0 commit comments

Comments
 (0)