Skip to content

Commit eed4f41

Browse files
committed
Generalize formatter plugin support, add Floskell
First pass only, need to (re-)enable tests, and find a way of selecting between multiple formatters. Apart from only installing a single formatter plugin.
1 parent 9625e18 commit eed4f41

File tree

5 files changed

+211
-0
lines changed

5 files changed

+211
-0
lines changed

haskell-language-server.cabal

+4
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,8 @@ library
3030
Ide.Cradle
3131
Ide.Plugin.Example
3232
Ide.Plugin.Ormolu
33+
Ide.Plugin.Floskell
34+
Ide.Plugin.Formatter
3335
Ide.Version
3436
other-modules:
3537
Paths_haskell_language_server
@@ -39,12 +41,14 @@ library
3941
base >=4.7 && <5
4042
, aeson
4143
, binary
44+
, bytestring
4245
, Cabal
4346
, cabal-helper >= 1.0
4447
, containers
4548
, deepseq
4649
, directory
4750
, filepath
51+
, floskell == 0.10.*
4852
, ghc
4953
, ghcide >= 0.1
5054
, gitrev

src/Ide/Plugin/Floskell.hs

+97
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
{-# LANGUAGE CPP #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module Ide.Plugin.Floskell
9+
(
10+
plugin
11+
)
12+
where
13+
14+
#if __GLASGOW_HASKELL__ >= 806
15+
#if __GLASGOW_HASKELL__ >= 808
16+
import Control.Monad.IO.Class ( MonadIO(..) )
17+
#else
18+
import Control.Monad.IO.Class ( liftIO
19+
, MonadIO(..)
20+
)
21+
#endif
22+
import qualified Data.Text as T
23+
#endif
24+
25+
import qualified Data.ByteString.Lazy as BS
26+
import qualified Data.Text.Encoding as T
27+
import Development.IDE.Plugin
28+
import Development.IDE.Types.Diagnostics as D
29+
import Development.IDE.Types.Location
30+
import Floskell
31+
import Ide.Plugin.Formatter
32+
import Language.Haskell.LSP.Types
33+
import Text.Regex.TDFA.Text()
34+
35+
-- ---------------------------------------------------------------------
36+
-- New style plugin
37+
38+
plugin :: Plugin
39+
plugin = formatterPlugin provider
40+
41+
-- ---------------------------------------------------------------------
42+
-- ---------------------------------------------------------------------
43+
-- ---------------------------------------------------------------------
44+
45+
-- | Format provider of Floskell.
46+
-- Formats the given source in either a given Range or the whole Document.
47+
-- If the provider fails an error is returned that can be displayed to the user.
48+
provider :: FormattingProvider IO
49+
provider _ideState typ contents fp _ = do
50+
let file = fromNormalizedFilePath fp
51+
config <- liftIO $ findConfigOrDefault file
52+
let (range, selectedContents) = case typ of
53+
FormatText -> (fullRange contents, contents)
54+
FormatRange r -> (r, extractRange r contents)
55+
result = reformat config (Just file) (BS.fromStrict (T.encodeUtf8 selectedContents))
56+
case result of
57+
Left err -> return $ Left $ responseError (T.pack $ "floskellCmd: " ++ err)
58+
Right new -> return $ Right $ List [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
59+
60+
-- | Find Floskell Config, user and system wide or provides a default style.
61+
-- Every directory of the filepath will be searched to find a user configuration.
62+
-- Also looks into places such as XDG_CONFIG_DIRECTORY<https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html>.
63+
-- This function may not throw an exception and returns a default config.
64+
findConfigOrDefault :: FilePath -> IO AppConfig
65+
findConfigOrDefault file = do
66+
mbConf <- findAppConfigIn file
67+
case mbConf of
68+
Just confFile -> readAppConfig confFile
69+
Nothing ->
70+
let gibiansky = head (filter (\s -> styleName s == "gibiansky") styles)
71+
in return $ defaultAppConfig { appStyle = gibiansky }
72+
73+
-- ---------------------------------------------------------------------
74+
-- ---------------------------------------------------------------------
75+
-- ---------------------------------------------------------------------
76+
77+
78+
extractRange :: Range -> T.Text -> T.Text
79+
extractRange (Range (Position sl _) (Position el _)) s = newS
80+
where focusLines = take (el-sl+1) $ drop sl $ T.lines s
81+
newS = T.unlines focusLines
82+
83+
-- | Gets the range that covers the entire text
84+
fullRange :: T.Text -> Range
85+
fullRange s = Range startPos endPos
86+
where startPos = Position 0 0
87+
endPos = Position lastLine 0
88+
{-
89+
In order to replace everything including newline characters,
90+
the end range should extend below the last line. From the specification:
91+
"If you want to specify a range that contains a line including
92+
the line ending character(s) then use an end position denoting
93+
the start of the next line"
94+
-}
95+
lastLine = length $ T.lines s
96+
97+
-- ---------------------------------------------------------------------

src/Ide/Plugin/Formatter.hs

+107
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,107 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
{-# LANGUAGE CPP #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module Ide.Plugin.Formatter
9+
(
10+
formatterPlugin
11+
, FormattingType(..)
12+
, FormattingProvider
13+
, responseError
14+
)
15+
where
16+
17+
import qualified Data.Text as T
18+
import Development.IDE.Core.FileStore
19+
import Development.IDE.Core.Rules
20+
import Development.IDE.LSP.Server
21+
import Development.IDE.Plugin
22+
import Development.IDE.Types.Diagnostics as D
23+
import Development.IDE.Types.Location
24+
import Development.Shake hiding ( Diagnostic )
25+
import qualified Language.Haskell.LSP.Core as LSP
26+
import Language.Haskell.LSP.Messages
27+
import Language.Haskell.LSP.Types
28+
import Text.Regex.TDFA.Text()
29+
30+
-- ---------------------------------------------------------------------
31+
32+
formatterPlugin :: FormattingProvider IO -> Plugin
33+
formatterPlugin provider = Plugin rules (handlers provider)
34+
35+
-- ---------------------------------------------------------------------
36+
-- New style plugin
37+
38+
rules :: Rules ()
39+
rules = mempty
40+
41+
handlers :: FormattingProvider IO -> PartialHandlers
42+
handlers provider = PartialHandlers $ \WithMessage{..} x -> return x
43+
{ LSP.documentFormattingHandler
44+
= withResponse RspDocumentFormatting (formatting provider)
45+
, LSP.documentRangeFormattingHandler
46+
= withResponse RspDocumentRangeFormatting (rangeFormatting provider)
47+
}
48+
49+
-- ---------------------------------------------------------------------
50+
51+
formatting :: FormattingProvider IO
52+
-> LSP.LspFuncs () -> IdeState -> DocumentFormattingParams
53+
-> IO (Either ResponseError (List TextEdit))
54+
formatting provider _lf ideState
55+
(DocumentFormattingParams (TextDocumentIdentifier uri) params _mprogress)
56+
= doFormatting provider ideState FormatText uri params
57+
58+
-- ---------------------------------------------------------------------
59+
60+
rangeFormatting :: FormattingProvider IO
61+
-> LSP.LspFuncs () -> IdeState -> DocumentRangeFormattingParams
62+
-> IO (Either ResponseError (List TextEdit))
63+
rangeFormatting provider _lf ideState
64+
(DocumentRangeFormattingParams (TextDocumentIdentifier uri) range params _mprogress)
65+
= doFormatting provider ideState (FormatRange range) uri params
66+
67+
-- ---------------------------------------------------------------------
68+
69+
doFormatting :: FormattingProvider IO
70+
-> IdeState -> FormattingType -> Uri -> FormattingOptions
71+
-> IO (Either ResponseError (List TextEdit))
72+
doFormatting provider ideState ft uri params
73+
= case uriToFilePath uri of
74+
Just (toNormalizedFilePath -> fp) -> do
75+
(_, mb_contents) <- runAction ideState $ getFileContents fp
76+
case mb_contents of
77+
Just contents -> provider ideState ft contents fp params
78+
Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri
79+
Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri
80+
81+
-- ---------------------------------------------------------------------
82+
83+
-- | Format the given Text as a whole or only a @Range@ of it.
84+
-- Range must be relative to the text to format.
85+
-- To format the whole document, read the Text from the file and use 'FormatText'
86+
-- as the FormattingType.
87+
data FormattingType = FormatText
88+
| FormatRange Range
89+
90+
91+
-- | To format a whole document, the 'FormatText' @FormattingType@ can be used.
92+
-- It is required to pass in the whole Document Text for that to happen, an empty text
93+
-- and file uri, does not suffice.
94+
type FormattingProvider m
95+
= IdeState
96+
-> FormattingType -- ^ How much to format
97+
-> T.Text -- ^ Text to format
98+
-> NormalizedFilePath -- ^ location of the file being formatted
99+
-> FormattingOptions -- ^ Options for the formatter
100+
-> m (Either ResponseError (List TextEdit)) -- ^ Result of the formatting
101+
102+
-- ---------------------------------------------------------------------
103+
104+
responseError :: T.Text -> ResponseError
105+
responseError txt = ResponseError InvalidParams txt Nothing
106+
107+
-- ---------------------------------------------------------------------

stack-8.6.5.yaml

+1
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ extra-deps:
1010
- cabal-helper-1.0.0.0
1111
- cabal-plan-0.6.2.0
1212
- clock-0.7.2
13+
- floskell-0.10.2
1314
- ghcide-0.1.0
1415
- fuzzy-0.1.0.0
1516
- ghc-lib-parser-8.8.2

stack.yaml

+2
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ extra-deps:
1010
- cabal-helper-1.0.0.0
1111
- cabal-plan-0.6.2.0
1212
- clock-0.7.2
13+
- floskell-0.10.2
1314
- fuzzy-0.1.0.0
1415
- ghcide-0.1.0
1516
- ghc-lib-parser-8.8.2
@@ -19,6 +20,7 @@ extra-deps:
1920
- hie-bios-0.4.0
2021
- indexed-profunctors-0.1
2122
- lsp-test-0.10.0.0
23+
- monad-dijkstra-0.1.1.2
2224
- optics-core-0.2
2325
- optparse-applicative-0.15.1.0
2426
- ormolu-0.0.3.1

0 commit comments

Comments
 (0)