Provide all format suggestions in AlternatFormat Code Action

ghcide/src/Development/IDE/Spans/Pragmas.hs

@@ -5,17 +5,19 @@
 module Development.IDE.Spans.Pragmas
   ( NextPragmaInfo(..)
   , LineSplitTextEdits(..)
-  , getNextPragmaInfo ) where
+  , getNextPragmaInfo
+  , insertNewPragma ) where
 
 import           Data.Bits                       (Bits (setBit))
 import           Data.Function                   ((&))
 import qualified Data.List                       as List
 import qualified Data.Maybe                      as Maybe
-import           Data.Text                       (Text)
+import           Data.Text                       (Text, pack)
 import qualified Data.Text                       as Text
 import           Development.IDE                 (srcSpanToRange)
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.Compat.Util
+import           GHC.LanguageExtensions.Type     (Extension)
 import qualified Language.LSP.Types              as LSP
 
 getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo
@@ -29,6 +31,13 @@ getNextPragmaInfo dynFlags sourceText =
      | otherwise
      -> NextPragmaInfo 0 Nothing
 
+insertNewPragma :: NextPragmaInfo -> Extension -> LSP.TextEdit
+insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins { LSP._newText = "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n" } :: LSP.TextEdit
+insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma =  LSP.TextEdit pragmaInsertRange $ "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n"
+    where
+        pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0
+        pragmaInsertRange = LSP.Range pragmaInsertPosition pragmaInsertPosition
+
 -- Pre-declaration comments parser -----------------------------------------------------
 
 -- | Each mode represents the "strongest" thing we've seen so far.

haskell-language-server.cabal

@@ -290,7 +290,7 @@ common splice
 
 common alternateNumberFormat
   if flag(alternateNumberFormat)
-    build-depends: hls-alternate-number-format-plugin ^>=1.0.0.0
+    build-depends: hls-alternate-number-format-plugin ^>=1.1.0.0
     cpp-options: -DalternateNumberFormat
 
 common qualifyImportedNames

plugins/hls-alternate-number-format-plugin/README.md

@@ -2,7 +2,7 @@
 
 The alternate number format plugin provides alternative formatting for Numeric Literals in source code.
 These can be any numeric literal such as `123`, `0x45` or any of the other numeric formats.
-The plugin is context aware and will provide suggestions based on currently active GHC extensions.
+The Code Action will provide all possible formatting suggestions (and when required insert the associated Language Extension)
 
 ## Setup
 
@@ -22,18 +22,10 @@ The plugin requires no extra setup to work. Simply place your cursor on top of a
 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.
 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.
 
-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.
-
-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).
+To generate suggestions, the plugin leverages the `Numeric` package which provides a multitude of conversion functions to and from strings/numerics. 
 
 ### Known Quirks
-- 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.
-
-- 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.
-
-- `PrimLiterals` are currently ignored. GHC API does not attach Source Text to Primitive Literal Nodes. As such these are ignored in the plugin.
-
-- Similarly, anything that produces a bad Source Span (i.e. can't be easily replaced by an edit) is ignored as well.
+- Anything that produces a bad Source Span (i.e. can't be easily replaced by an edit) is ignored as well.
 
 ## Changelog
 ### 1.0.0.0
@@ -48,3 +40,7 @@ To generate suggestions, the plugin leverages the `Numeric` package which provid
 ### 1.0.2.0
 - Test Suite upgraded for 9.2 semantics (GHC2021)
 - Fix SYB parsing with GHC 9.2
+
+### 1.1.0.0
+- Provide ALL possible formats as suggestions
+- Insert Language Extensions when needed

plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal

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

plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TypeFamilies  #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ViewPatterns  #-}
 module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where
 
 import           Control.Lens                    ((^.))
@@ -10,18 +11,25 @@ import qualified Data.HashMap.Strict             as HashMap
 import           Data.Text                       (Text)
 import qualified Data.Text                       as T
 import           Development.IDE                 (GetParsedModule (GetParsedModule),
+                                                  GhcSession (GhcSession),
                                                   IdeState, RuleResult, Rules,
-                                                  define, ideLogger,
+                                                  define, getFileContents,
+                                                  hscEnv, ideLogger,
                                                   realSrcSpanToRange, runAction,
-                                                  use)
+                                                  use, useWithStale)
 import qualified Development.IDE.Core.Shake      as Shake
 import           Development.IDE.GHC.Compat      hiding (getSrcSpan)
 import           Development.IDE.GHC.Compat.Util (toList)
-import           Development.IDE.Graph.Classes   (Hashable, NFData)
+import           Development.IDE.Graph.Classes   (Hashable, NFData, rnf)
+import           Development.IDE.Spans.Pragmas   (NextPragmaInfo,
+                                                  getNextPragmaInfo,
+                                                  insertNewPragma)
 import           Development.IDE.Types.Logger    as Logger
 import           GHC.Generics                    (Generic)
-import           Ide.Plugin.Conversion           (FormatType, alternateFormat,
-                                                  toFormatTypes)
+import           GHC.LanguageExtensions.Type     (Extension)
+import           Ide.Plugin.Conversion           (AlternateFormat,
+                                                  ExtensionNeeded (NeedsExtension, NoExtension),
+                                                  alternateFormat)
 import           Ide.Plugin.Literals
 import           Ide.PluginUtils                 (handleMaybe, handleMaybeM,
                                                   response)
@@ -50,10 +58,15 @@ instance NFData CollectLiterals
 type instance RuleResult CollectLiterals = CollectLiteralsResult
 
 data CollectLiteralsResult = CLR
-    { literals    :: [Literal]
-    , formatTypes :: [FormatType]
+    { literals          :: [Literal]
+    , enabledExtensions :: [GhcExtension]
     } deriving (Generic)
 
+newtype GhcExtension = GhcExtension { unExt :: Extension }
+
+instance NFData GhcExtension where
+    rnf x = x `seq` ()
+
 instance Show CollectLiteralsResult where
     show _ = "<CollectLiteralResult>"
 
@@ -63,49 +76,65 @@ collectLiteralsRule :: Recorder (WithPriority Log) -> Rules ()
 collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectLiterals nfp -> do
     pm <- use GetParsedModule nfp
     -- get the current extensions active and transform them into FormatTypes
-    let fmts = getFormatTypes <$> pm
+    let exts = getExtensions <$> pm
         -- collect all the literals for a file
         lits = collectLiterals . pm_parsed_source <$> pm
-    pure ([], CLR <$> lits <*> fmts)
+    pure ([], CLR <$> lits <*> exts)
     where
-        getFormatTypes = toFormatTypes . toList . extensionFlags . ms_hspp_opts . pm_mod_summary
+        getExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary
 
 codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
 codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $ do
     nfp <- getNormalizedFilePath docId
     CLR{..} <- requestLiterals state nfp
+    pragma <- getFirstPragma state nfp
         -- remove any invalid literals (see validTarget comment)
     let litsInRange = filter inCurrentRange literals
         -- generate alternateFormats and zip with the literal that generated the alternates
-        literalPairs = map (\lit -> (lit, alternateFormat formatTypes lit)) litsInRange
+        literalPairs = map (\lit -> (lit, alternateFormat lit)) litsInRange
         -- make a code action for every literal and its' alternates (then flatten the result)
-        actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit) alts) literalPairs
-
-    logIO state $ "Literals: " <> show literals
+        actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit enabledExtensions pragma) alts) literalPairs
 
     pure $ List actions
     where
         inCurrentRange :: Literal -> Bool
         inCurrentRange lit = let srcSpan = getSrcSpan lit
                               in currRange `contains` srcSpan
 
-        mkCodeAction :: NormalizedFilePath -> Literal -> Text -> Command |? CodeAction
-        mkCodeAction nfp lit alt = InR CodeAction {
-            _title = "Convert " <> getSrcText lit <> " into " <> alt
+        mkCodeAction :: NormalizedFilePath -> Literal -> [GhcExtension] -> NextPragmaInfo -> AlternateFormat -> Command |? CodeAction
+        mkCodeAction nfp lit enabled npi af@(alt, ext) = InR CodeAction {
+            _title = mkCodeActionTitle lit af enabled
             , _kind = Just $ CodeActionUnknown "quickfix.literals.style"
             , _diagnostics = Nothing
             , _isPreferred = Nothing
             , _disabled = Nothing
-            , _edit = Just $ mkWorkspaceEdit nfp lit alt
+            , _edit = Just $ mkWorkspaceEdit nfp edits
             , _command = Nothing
             , _xdata = Nothing
             }
+            where
+                edits =  [TextEdit (realSrcSpanToRange $ getSrcSpan lit) alt] <> pragmaEdit
+                pragmaEdit = case ext of
+                    NeedsExtension ext' -> [insertNewPragma npi ext' | needsExtension ext' enabled]
+                    NoExtension         -> []
 
-        mkWorkspaceEdit :: NormalizedFilePath -> Literal -> Text -> WorkspaceEdit
-        mkWorkspaceEdit nfp lit alt = WorkspaceEdit changes Nothing Nothing
+        mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit
+        mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing
             where
-                txtEdit = TextEdit (realSrcSpanToRange $ getSrcSpan lit) alt
-                changes = Just $ HashMap.fromList [( filePathToUri $ fromNormalizedFilePath nfp, List [txtEdit])]
+                changes = Just $ HashMap.fromList [(filePathToUri $ fromNormalizedFilePath nfp, List edits)]
+
+mkCodeActionTitle :: Literal -> AlternateFormat -> [GhcExtension] -> Text
+mkCodeActionTitle lit (alt, ext) ghcExts
+    | (NeedsExtension ext') <- ext
+    , needsExtension ext' ghcExts = title <> " (needs extension: " <> T.pack (show ext') <> ")"
+    | otherwise = title
+    where
+        title = "Convert " <> getSrcText lit <> " into " <> alt
+
+
+-- | Checks whether the extension given is already enabled
+needsExtension :: Extension -> [GhcExtension] -> Bool
+needsExtension ext ghcExts = ext `notElem` map unExt ghcExts
 
 -- from HaddockComments.hs
 contains :: Range -> RealSrcSpan -> Bool
@@ -114,6 +143,15 @@ contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSr
 isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
 p `isInsideRealSrcSpan` r = let (Range sp ep) = realSrcSpanToRange r in sp <= p && p <= ep
 
+getFirstPragma :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
+getFirstPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ do
+      ghcSession <- liftIO $ runAction "AlternateNumberFormat.GhcSession" state $ useWithStale GhcSession nfp
+      (_, fileContents) <- liftIO $ runAction "AlternateNumberFormat.GetFileContents" state $ getFileContents nfp
+      case ghcSession of
+        Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
+        Nothing -> pure Nothing
+
+
 getNormalizedFilePath :: Monad m => TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
 getNormalizedFilePath docId = handleMaybe "Error: converting to NormalizedFilePath"
         $ uriToNormalizedFilePath
@@ -124,7 +162,3 @@ requestLiterals state = handleMaybeM "Error: Could not Collect Literals"
                 . liftIO
                 . runAction "AlternateNumberFormat.CollectLiterals" state
                 . use CollectLiterals
-
-logIO :: (MonadIO m, Show a) => IdeState -> a -> m ()
-logIO state = liftIO . Logger.logDebug (ideLogger state) . T.pack . show
-