Skip to content

Commit a832491

Browse files
drsoochmergify[bot]
drsooch
and
mergify[bot]
authored
Provide all format suggestions in AlternatFormat Code Action (#2790)
* Insert Language Extensions when required - Add new function that converts a NextPragmaInfo (identifies the location to insert a new Pragma) into an Insertion that will insert the new Extension - Provide all format choices instead of only currently active extensions * Update Test Suite * Update Documentation * Miscellaneous Cleanup * Push extraneous functions into where bindings * Remove unneeded logging * Add Haskell2010 pragma to fix 9.2 tests Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent 1314748 commit a832491

19 files changed

+193
-151
lines changed

Diff for: ‎ghcide/src/Development/IDE/Spans/Pragmas.hs

+11-2
Original file line numberDiff line numberDiff line change
@@ -5,17 +5,19 @@
55
module Development.IDE.Spans.Pragmas
66
( NextPragmaInfo(..)
77
, LineSplitTextEdits(..)
8-
, getNextPragmaInfo ) where
8+
, getNextPragmaInfo
9+
, insertNewPragma ) where
910

1011
import Data.Bits (Bits (setBit))
1112
import Data.Function ((&))
1213
import qualified Data.List as List
1314
import qualified Data.Maybe as Maybe
14-
import Data.Text (Text)
15+
import Data.Text (Text, pack)
1516
import qualified Data.Text as Text
1617
import Development.IDE (srcSpanToRange)
1718
import Development.IDE.GHC.Compat
1819
import Development.IDE.GHC.Compat.Util
20+
import GHC.LanguageExtensions.Type (Extension)
1921
import qualified Language.LSP.Types as LSP
2022

2123
getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo
@@ -29,6 +31,13 @@ getNextPragmaInfo dynFlags sourceText =
2931
| otherwise
3032
-> NextPragmaInfo 0 Nothing
3133

34+
insertNewPragma :: NextPragmaInfo -> Extension -> LSP.TextEdit
35+
insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins { LSP._newText = "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n" } :: LSP.TextEdit
36+
insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit pragmaInsertRange $ "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n"
37+
where
38+
pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0
39+
pragmaInsertRange = LSP.Range pragmaInsertPosition pragmaInsertPosition
40+
3241
-- Pre-declaration comments parser -----------------------------------------------------
3342

3443
-- | Each mode represents the "strongest" thing we've seen so far.

Diff for: ‎haskell-language-server.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -290,7 +290,7 @@ common splice
290290

291291
common alternateNumberFormat
292292
if flag(alternateNumberFormat)
293-
build-depends: hls-alternate-number-format-plugin ^>=1.0.0.0
293+
build-depends: hls-alternate-number-format-plugin ^>=1.1.0.0
294294
cpp-options: -DalternateNumberFormat
295295

296296
common qualifyImportedNames

Diff for: ‎plugins/hls-alternate-number-format-plugin/HLSAll.gif

-222 KB
Loading

Diff for: ‎plugins/hls-alternate-number-format-plugin/README.md

+7-11
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
The alternate number format plugin provides alternative formatting for Numeric Literals in source code.
44
These can be any numeric literal such as `123`, `0x45` or any of the other numeric formats.
5-
The plugin is context aware and will provide suggestions based on currently active GHC extensions.
5+
The Code Action will provide all possible formatting suggestions (and when required insert the associated Language Extension)
66

77
## Setup
88

@@ -22,18 +22,10 @@ The plugin requires no extra setup to work. Simply place your cursor on top of a
2222
The plugin is relatively simple, it traverses a files source contents using the GHC API. As it encounters Literals (of the type `HsExpr` with the constructor of either `HsLit` or `HsOverLit`), it will construct an internal `Literal` datatype that has additional information for use to generate suggestions.
2323
Currently, the traversal is done in the file, `Literal.hs`, using the package [SYB](https://hackage.haskell.org/package/syb) for most of the heavy lifting.
2424

25-
The plugin extends on top of SYB as the traversal done by basic combinators is not perfect. For whatever reason, when starting at the root `ParsedModule` the SYB traversal ignores Pattern Binds (`LPat GhcPs`). As a result, a combinator was created to match on TWO separate underlying types to dispatch on.
26-
27-
To generate suggestions, the plugin leverages the `Numeric` package which provides a multitude of conversion functions to and from strings/numerics. The only slight change is the addition of extra work when using `NumDecimals` extension. The plugin will attempt to generate 3 choices for the user (this choice is not given for `Fractional` numerics).
25+
To generate suggestions, the plugin leverages the `Numeric` package which provides a multitude of conversion functions to and from strings/numerics.
2826

2927
### Known Quirks
30-
- Currently (and probably inefficiently), a Set is used as general accumulator for all Literals being captured. This is because again, through the intricacies of using SYB, we somehow will traverse Source Text multiple times and collect duplicate literals.
31-
32-
- In the Test Suite, we are required to be explicit in where our `codeActions` will occur. Otherwise, a simple call to `getAllCodeActions` will not work, for whatever reason, there is not enough time to generate the code actions.
33-
34-
- `PrimLiterals` are currently ignored. GHC API does not attach Source Text to Primitive Literal Nodes. As such these are ignored in the plugin.
35-
36-
- Similarly, anything that produces a bad Source Span (i.e. can't be easily replaced by an edit) is ignored as well.
28+
- Anything that produces a bad Source Span (i.e. can't be easily replaced by an edit) is ignored as well.
3729

3830
## Changelog
3931
### 1.0.0.0
@@ -48,3 +40,7 @@ To generate suggestions, the plugin leverages the `Numeric` package which provid
4840
### 1.0.2.0
4941
- Test Suite upgraded for 9.2 semantics (GHC2021)
5042
- Fix SYB parsing with GHC 9.2
43+
44+
### 1.1.0.0
45+
- Provide ALL possible formats as suggestions
46+
- Insert Language Extensions when needed

Diff for: ‎plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.4
22
name: hls-alternate-number-format-plugin
3-
version: 1.0.2.0
3+
version: 1.1.0.0
44
synopsis: Provide Alternate Number Formats plugin for Haskell Language Server
55
description:
66
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>

Diff for: ‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs

+60-26
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE TypeFamilies #-}
44
{-# LANGUAGE TypeOperators #-}
5+
{-# LANGUAGE ViewPatterns #-}
56
module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where
67

78
import Control.Lens ((^.))
@@ -10,18 +11,25 @@ import qualified Data.HashMap.Strict as HashMap
1011
import Data.Text (Text)
1112
import qualified Data.Text as T
1213
import Development.IDE (GetParsedModule (GetParsedModule),
14+
GhcSession (GhcSession),
1315
IdeState, RuleResult, Rules,
14-
define, ideLogger,
16+
define, getFileContents,
17+
hscEnv, ideLogger,
1518
realSrcSpanToRange, runAction,
16-
use)
19+
use, useWithStale)
1720
import qualified Development.IDE.Core.Shake as Shake
1821
import Development.IDE.GHC.Compat hiding (getSrcSpan)
1922
import Development.IDE.GHC.Compat.Util (toList)
20-
import Development.IDE.Graph.Classes (Hashable, NFData)
23+
import Development.IDE.Graph.Classes (Hashable, NFData, rnf)
24+
import Development.IDE.Spans.Pragmas (NextPragmaInfo,
25+
getNextPragmaInfo,
26+
insertNewPragma)
2127
import Development.IDE.Types.Logger as Logger
2228
import GHC.Generics (Generic)
23-
import Ide.Plugin.Conversion (FormatType, alternateFormat,
24-
toFormatTypes)
29+
import GHC.LanguageExtensions.Type (Extension)
30+
import Ide.Plugin.Conversion (AlternateFormat,
31+
ExtensionNeeded (NeedsExtension, NoExtension),
32+
alternateFormat)
2533
import Ide.Plugin.Literals
2634
import Ide.PluginUtils (handleMaybe, handleMaybeM,
2735
response)
@@ -50,10 +58,15 @@ instance NFData CollectLiterals
5058
type instance RuleResult CollectLiterals = CollectLiteralsResult
5159

5260
data CollectLiteralsResult = CLR
53-
{ literals :: [Literal]
54-
, formatTypes :: [FormatType]
61+
{ literals :: [Literal]
62+
, enabledExtensions :: [GhcExtension]
5563
} deriving (Generic)
5664

65+
newtype GhcExtension = GhcExtension { unExt :: Extension }
66+
67+
instance NFData GhcExtension where
68+
rnf x = x `seq` ()
69+
5770
instance Show CollectLiteralsResult where
5871
show _ = "<CollectLiteralResult>"
5972

@@ -63,49 +76,65 @@ collectLiteralsRule :: Recorder (WithPriority Log) -> Rules ()
6376
collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectLiterals nfp -> do
6477
pm <- use GetParsedModule nfp
6578
-- get the current extensions active and transform them into FormatTypes
66-
let fmts = getFormatTypes <$> pm
79+
let exts = getExtensions <$> pm
6780
-- collect all the literals for a file
6881
lits = collectLiterals . pm_parsed_source <$> pm
69-
pure ([], CLR <$> lits <*> fmts)
82+
pure ([], CLR <$> lits <*> exts)
7083
where
71-
getFormatTypes = toFormatTypes . toList . extensionFlags . ms_hspp_opts . pm_mod_summary
84+
getExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary
7285

7386
codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
7487
codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $ do
7588
nfp <- getNormalizedFilePath docId
7689
CLR{..} <- requestLiterals state nfp
90+
pragma <- getFirstPragma state nfp
7791
-- remove any invalid literals (see validTarget comment)
7892
let litsInRange = filter inCurrentRange literals
7993
-- generate alternateFormats and zip with the literal that generated the alternates
80-
literalPairs = map (\lit -> (lit, alternateFormat formatTypes lit)) litsInRange
94+
literalPairs = map (\lit -> (lit, alternateFormat lit)) litsInRange
8195
-- make a code action for every literal and its' alternates (then flatten the result)
82-
actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit) alts) literalPairs
83-
84-
logIO state $ "Literals: " <> show literals
96+
actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit enabledExtensions pragma) alts) literalPairs
8597

8698
pure $ List actions
8799
where
88100
inCurrentRange :: Literal -> Bool
89101
inCurrentRange lit = let srcSpan = getSrcSpan lit
90102
in currRange `contains` srcSpan
91103

92-
mkCodeAction :: NormalizedFilePath -> Literal -> Text -> Command |? CodeAction
93-
mkCodeAction nfp lit alt = InR CodeAction {
94-
_title = "Convert " <> getSrcText lit <> " into " <> alt
104+
mkCodeAction :: NormalizedFilePath -> Literal -> [GhcExtension] -> NextPragmaInfo -> AlternateFormat -> Command |? CodeAction
105+
mkCodeAction nfp lit enabled npi af@(alt, ext) = InR CodeAction {
106+
_title = mkCodeActionTitle lit af enabled
95107
, _kind = Just $ CodeActionUnknown "quickfix.literals.style"
96108
, _diagnostics = Nothing
97109
, _isPreferred = Nothing
98110
, _disabled = Nothing
99-
, _edit = Just $ mkWorkspaceEdit nfp lit alt
111+
, _edit = Just $ mkWorkspaceEdit nfp edits
100112
, _command = Nothing
101113
, _xdata = Nothing
102114
}
115+
where
116+
edits = [TextEdit (realSrcSpanToRange $ getSrcSpan lit) alt] <> pragmaEdit
117+
pragmaEdit = case ext of
118+
NeedsExtension ext' -> [insertNewPragma npi ext' | needsExtension ext' enabled]
119+
NoExtension -> []
103120

104-
mkWorkspaceEdit :: NormalizedFilePath -> Literal -> Text -> WorkspaceEdit
105-
mkWorkspaceEdit nfp lit alt = WorkspaceEdit changes Nothing Nothing
121+
mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit
122+
mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing
106123
where
107-
txtEdit = TextEdit (realSrcSpanToRange $ getSrcSpan lit) alt
108-
changes = Just $ HashMap.fromList [( filePathToUri $ fromNormalizedFilePath nfp, List [txtEdit])]
124+
changes = Just $ HashMap.fromList [(filePathToUri $ fromNormalizedFilePath nfp, List edits)]
125+
126+
mkCodeActionTitle :: Literal -> AlternateFormat -> [GhcExtension] -> Text
127+
mkCodeActionTitle lit (alt, ext) ghcExts
128+
| (NeedsExtension ext') <- ext
129+
, needsExtension ext' ghcExts = title <> " (needs extension: " <> T.pack (show ext') <> ")"
130+
| otherwise = title
131+
where
132+
title = "Convert " <> getSrcText lit <> " into " <> alt
133+
134+
135+
-- | Checks whether the extension given is already enabled
136+
needsExtension :: Extension -> [GhcExtension] -> Bool
137+
needsExtension ext ghcExts = ext `notElem` map unExt ghcExts
109138

110139
-- from HaddockComments.hs
111140
contains :: Range -> RealSrcSpan -> Bool
@@ -114,6 +143,15 @@ contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSr
114143
isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
115144
p `isInsideRealSrcSpan` r = let (Range sp ep) = realSrcSpanToRange r in sp <= p && p <= ep
116145

146+
getFirstPragma :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
147+
getFirstPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ do
148+
ghcSession <- liftIO $ runAction "AlternateNumberFormat.GhcSession" state $ useWithStale GhcSession nfp
149+
(_, fileContents) <- liftIO $ runAction "AlternateNumberFormat.GetFileContents" state $ getFileContents nfp
150+
case ghcSession of
151+
Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
152+
Nothing -> pure Nothing
153+
154+
117155
getNormalizedFilePath :: Monad m => TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
118156
getNormalizedFilePath docId = handleMaybe "Error: converting to NormalizedFilePath"
119157
$ uriToNormalizedFilePath
@@ -124,7 +162,3 @@ requestLiterals state = handleMaybeM "Error: Could not Collect Literals"
124162
. liftIO
125163
. runAction "AlternateNumberFormat.CollectLiterals" state
126164
. use CollectLiterals
127-
128-
logIO :: (MonadIO m, Show a) => IdeState -> a -> m ()
129-
logIO state = liftIO . Logger.logDebug (ideLogger state) . T.pack . show
130-

0 commit comments

Comments
 (0)