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

Commit 93718bd

Browse files
alanzalanz
authored
Merge pull request #1167 from fendor/hsimport-use-formattingprovider
Change Hsimport to use configured Formatter on import
2 parents a48a02c + 7ef6e4b commit 93718bd

File tree

7 files changed

+157
-94
lines changed

7 files changed

+157
-94
lines changed

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

Lines changed: 13 additions & 6 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

@@ -212,16 +211,24 @@ type SymbolProvider = Uri -> IdeDeferM (IdeResult [DocumentSymbol])
212211
data FormattingType = FormatDocument
213212
| FormatRange Range
214213

215-
-- | Formats the given Uri with the given options.
214+
-- | Formats the given Text associated with the given Uri.
215+
-- Should, but might not, honor the provided formatting options (e.g. Floskell does not).
216216
-- A formatting type can be given to either format the whole document or only a Range.
217+
--
218+
-- Text to format, may or may not, originate from the associated Uri.
219+
-- E.g. it is ok, to modify the text and then reformat it through this API.
220+
--
221+
-- The Uri is mainly used to discover formatting configurations in the file's path.
222+
--
217223
-- Fails if the formatter can not parse the source.
218-
-- Failing menas here that a IdeResultFail is returned.
224+
-- Failing means here that a IdeResultFail is returned.
219225
-- This can be used to display errors to the user, unless the error is an Internal one.
220226
-- 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`
227+
type FormattingProvider = T.Text -- ^ Text to format
228+
-> Uri -- ^ Uri of the file being formatted
222229
-> FormattingType -- ^ How much to format
223230
-> FormattingOptions -- ^ Options for the formatter
224-
-> IdeDeferM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
231+
-> IdeM (IdeResult [TextEdit]) -- ^ Result of the formatting or the unchanged text.
225232

226233
data PluginDescriptor =
227234
PluginDescriptor { pluginId :: PluginId
@@ -272,7 +279,7 @@ runPluginCommand p com arg = do
272279
case Map.lookup p m of
273280
Nothing -> return $
274281
IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p <> " doesn't exist") Null
275-
Just (PluginDescriptor { pluginCommands = xs }) -> case List.find ((com ==) . commandName) xs of
282+
Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
276283
Nothing -> return $ IdeResultFail $
277284
IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
278285
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 & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
{-# LANGUAGE DeriveAnyClass #-}
2-
{-# LANGUAGE DeriveGeneric #-}
31
{-# LANGUAGE OverloadedStrings #-}
42
module Haskell.Ide.Engine.Plugin.Brittany where
53

@@ -11,7 +9,6 @@ import Data.Coerce
119
import Data.Semigroup
1210
import Data.Text (Text)
1311
import qualified Data.Text as T
14-
import GHC.Generics
1512
import Haskell.Ide.Engine.MonadTypes
1613
import Haskell.Ide.Engine.PluginUtils
1714
import Language.Haskell.Brittany
@@ -20,52 +17,62 @@ import qualified Language.Haskell.LSP.Types.Lens as J
2017
import System.FilePath (FilePath, takeDirectory)
2118
import Data.Maybe (maybeToList)
2219

23-
data FormatParams = FormatParams Int Uri (Maybe Range)
24-
deriving (Eq, Show, Generic, FromJSON, ToJSON)
25-
2620
brittanyDescriptor :: PluginId -> PluginDescriptor
2721
brittanyDescriptor plId = PluginDescriptor
28-
{ pluginId = plId
29-
, pluginName = "Brittany"
30-
, pluginDesc = "Brittany is a tool to format source code."
31-
, pluginCommands = []
22+
{ pluginId = plId
23+
, pluginName = "Brittany"
24+
, pluginDesc = "Brittany is a tool to format source code."
25+
, pluginCommands = []
3226
, pluginCodeActionProvider = Nothing
3327
, pluginDiagnosticProvider = Nothing
34-
, pluginHoverProvider = Nothing
35-
, pluginSymbolProvider = Nothing
28+
, pluginHoverProvider = Nothing
29+
, pluginSymbolProvider = Nothing
3630
, pluginFormattingProvider = Just provider
3731
}
3832

3933
-- | Formatter provider of Brittany.
4034
-- Formats the given source in either a given Range or the whole Document.
4135
-- 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]
36+
provider
37+
:: MonadIO m
38+
=> Text
39+
-> Uri
40+
-> FormattingType
41+
-> FormattingOptions
42+
-> m (IdeResult [TextEdit])
43+
provider text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> do
44+
confFile <- liftIO $ getConfFile fp
45+
let (range, selectedContents) = case formatType of
46+
FormatDocument -> (fullRange text, text)
47+
FormatRange r -> (normalize r, extractRange r text)
48+
49+
res <- formatText confFile opts selectedContents
50+
case res of
51+
Left err -> return $ IdeResultFail
52+
(IdeError PluginError
53+
(T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
54+
Null
55+
)
56+
Right newText -> do
57+
let textEdit = J.TextEdit range newText
58+
return $ IdeResultOk [textEdit]
59+
60+
-- | Primitive to format text with the given option.
61+
-- May not throw exceptions but return a Left value.
62+
-- Errors may be presented to the user.
63+
formatText
64+
:: MonadIO m
65+
=> Maybe FilePath -- ^ Path to configs. If Nothing, default configs will be used.
66+
-> FormattingOptions -- ^ Options for the formatter such as indentation.
67+
-> Text -- ^ Text to format
68+
-> m (Either [BrittanyError] Text) -- ^ Either formatted Text or a error from Brittany.
69+
formatText confFile opts text =
70+
liftIO $ runBrittany tabSize confFile text
6471
where tabSize = opts ^. J.tabSize
6572

73+
-- | Extend to the line below to replace newline character, as above.
6674
normalize :: Range -> Range
6775
normalize (Range (Position sl _) (Position el _)) =
68-
-- Extend to the line below to replace newline character, as above
6976
Range (Position sl 0) (Position (el + 1) 0)
7077

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

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

Lines changed: 8 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -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)