diff --git a/hls-alternate-number-format-plugin.cabal b/hls-alternate-number-format-plugin.cabal --- a/hls-alternate-number-format-plugin.cabal +++ b/hls-alternate-number-format-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-alternate-number-format-plugin -version: 1.2.0.0 +version: 1.3.0.0 synopsis: Provide Alternate Number Formats plugin for Haskell Language Server description: Please see the README on GitHub at @@ -17,6 +17,10 @@ test/testdata/*.hs test/testdata/*.yaml +source-repository head + type: git + location: https://github.com/haskell/haskell-language-server.git + library buildable: True exposed-modules: Ide.Plugin.AlternateNumberFormat, Ide.Plugin.Conversion @@ -27,10 +31,11 @@ aeson , base >=4.12 && < 5 , containers - , ghcide ^>= 1.8 + , extra + , ghcide ^>= 1.9 , ghc-boot-th , hls-graph - , hls-plugin-api ^>= 1.5 + , hls-plugin-api ^>= 1.6 , hie-compat , lens , lsp ^>=1.6 @@ -59,7 +64,7 @@ , base >=4.12 && < 5 , filepath , hls-alternate-number-format-plugin - , hls-test-utils ^>=1.3 || ^>= 1.4 + , hls-test-utils ^>=1.5 , lsp , QuickCheck , regex-tdfa diff --git a/src/Ide/Plugin/AlternateNumberFormat.hs b/src/Ide/Plugin/AlternateNumberFormat.hs --- a/src/Ide/Plugin/AlternateNumberFormat.hs +++ b/src/Ide/Plugin/AlternateNumberFormat.hs @@ -2,40 +2,36 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where -import Control.Lens ((^.)) -import Control.Monad.Except (ExceptT, MonadIO, liftIO) -import qualified Data.HashMap.Strict as HashMap -import Data.String (IsString) -import Data.Text (Text) -import qualified Data.Text as T -import Development.IDE (GetParsedModule (GetParsedModule), - GhcSession (GhcSession), - IdeState, RuleResult, Rules, - define, getFileContents, - hscEnv, realSrcSpanToRange, - runAction, 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, rnf) -import Development.IDE.Spans.Pragmas (NextPragmaInfo, - getNextPragmaInfo, - insertNewPragma) -import Development.IDE.Types.Logger as Logger -import GHC.Generics (Generic) -import GHC.LanguageExtensions.Type (Extension) -import Ide.Plugin.Conversion (AlternateFormat, - ExtensionNeeded (NeedsExtension, NoExtension), - alternateFormat) +import Control.Lens ((^.)) +import Control.Monad.Except (ExceptT, MonadIO, liftIO) +import qualified Data.HashMap.Strict as HashMap +import Data.Text (Text, unpack) +import qualified Data.Text as T +import Development.IDE (GetParsedModule (GetParsedModule), + IdeState, RuleResult, Rules, + define, realSrcSpanToRange, + runAction, use) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.GHC.Compat hiding (getSrcSpan) +import Development.IDE.GHC.Util (getExtensions) +import Development.IDE.Graph.Classes (Hashable, NFData, rnf) +import Development.IDE.Spans.Pragmas (NextPragmaInfo, getFirstPragma, + insertNewPragma) +import Development.IDE.Types.Logger as Logger +import GHC.Generics (Generic) +import Ide.Plugin.Conversion (AlternateFormat, + ExtensionNeeded (NeedsExtension, NoExtension), + alternateFormat) import Ide.Plugin.Literals -import Ide.PluginUtils (getNormalizedFilePath, - handleMaybeM, pluginResponse) +import Ide.Plugin.RangeMap (RangeMap) +import qualified Ide.Plugin.RangeMap as RangeMap +import Ide.PluginUtils (getNormalizedFilePath, + handleMaybeM, pluginResponse) import Ide.Types import Language.LSP.Types -import qualified Language.LSP.Types.Lens as L +import qualified Language.LSP.Types.Lens as L newtype Log = LogShake Shake.Log deriving Show @@ -43,11 +39,8 @@ pretty = \case LogShake log -> pretty log -alternateNumberFormatId :: IsString a => a -alternateNumberFormatId = "alternateNumberFormat" - -descriptor :: Recorder (WithPriority Log) -> PluginDescriptor IdeState -descriptor recorder = (defaultPluginDescriptor alternateNumberFormatId) +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder pId = (defaultPluginDescriptor pId) { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler , pluginRules = collectLiteralsRule recorder } @@ -61,7 +54,7 @@ type instance RuleResult CollectLiterals = CollectLiteralsResult data CollectLiteralsResult = CLR - { literals :: [Literal] + { literals :: RangeMap Literal , enabledExtensions :: [GhcExtension] } deriving (Generic) @@ -79,30 +72,25 @@ collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectLiterals nfp -> do pm <- use GetParsedModule nfp -- get the current extensions active and transform them into FormatTypes - let exts = getExtensions <$> pm + let exts = map GhcExtension . getExtensions <$> pm -- collect all the literals for a file lits = collectLiterals . pm_parsed_source <$> pm - pure ([], CLR <$> lits <*> exts) - where - getExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary + litMap = RangeMap.fromList (realSrcSpanToRange . getSrcSpan) <$> lits + pure ([], CLR <$> litMap <*> exts) codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction -codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = pluginResponse $ do +codeActionHandler state pId (CodeActionParams _ _ docId currRange _) = pluginResponse $ do nfp <- getNormalizedFilePath (docId ^. L.uri) - CLR{..} <- requestLiterals state nfp - pragma <- getFirstPragma state nfp + CLR{..} <- requestLiterals pId state nfp + pragma <- getFirstPragma pId state nfp -- remove any invalid literals (see validTarget comment) - let litsInRange = filter inCurrentRange literals + let litsInRange = RangeMap.filterByRange currRange literals -- generate alternateFormats and zip with the literal that generated the alternates 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 enabledExtensions pragma) alts) literalPairs pure $ List actions where - inCurrentRange :: Literal -> Bool - inCurrentRange lit = let srcSpan = getSrcSpan lit - in currRange `contains` srcSpan - mkCodeAction :: NormalizedFilePath -> Literal -> [GhcExtension] -> NextPragmaInfo -> AlternateFormat -> Command |? CodeAction mkCodeAction nfp lit enabled npi af@(alt, ext) = InR CodeAction { _title = mkCodeActionTitle lit af enabled @@ -138,23 +126,8 @@ needsExtension :: Extension -> [GhcExtension] -> Bool needsExtension ext ghcExts = ext `notElem` map unExt ghcExts --- from HaddockComments.hs -contains :: Range -> RealSrcSpan -> Bool -contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSrcSpan _end x - -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 (alternateNumberFormatId <> ".GhcSession") state $ useWithStale GhcSession nfp - (_, fileContents) <- liftIO $ runAction (alternateNumberFormatId <> ".GetFileContents") state $ getFileContents nfp - case ghcSession of - Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents - Nothing -> pure Nothing - -requestLiterals :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult -requestLiterals state = handleMaybeM "Error: Could not Collect Literals" +requestLiterals :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult +requestLiterals (PluginId pId) state = handleMaybeM "Could not Collect Literals" . liftIO - . runAction (alternateNumberFormatId <> ".CollectLiterals") state + . runAction (unpack pId <> ".CollectLiterals") state . use CollectLiterals diff --git a/src/Ide/Plugin/Conversion.hs b/src/Ide/Plugin/Conversion.hs --- a/src/Ide/Plugin/Conversion.hs +++ b/src/Ide/Plugin/Conversion.hs @@ -23,6 +23,7 @@ import Data.Char (toUpper) import Data.List (delete) +import Data.List.Extra (enumerate, upper) import Data.Maybe (mapMaybe) import Data.Ratio (denominator, numerator) import Data.Text (Text) @@ -108,10 +109,10 @@ getFracFormat _ = Nothing intFormats :: [IntFormatType] -intFormats = [minBound .. maxBound] +intFormats = enumerate fracFormats :: [FracFormatType] -fracFormats = [minBound .. maxBound] +fracFormats = enumerate -- | Regex to match a Haskell Hex Literal hexRegex :: Text @@ -157,8 +158,8 @@ toBase :: (Num a, Ord a) => (a -> ShowS) -> String -> a -> String toBase conv header n - | n < 0 = '-' : header <> map toUpper (conv (abs n) "") - | otherwise = header <> map toUpper (conv n "") + | n < 0 = '-' : header <> upper (conv (abs n) "") + | otherwise = header <> upper (conv n "") toOctal :: (Integral a, Show a) => a -> String toOctal = toBase showOct "0o" diff --git a/src/Ide/Plugin/Literals.hs b/src/Ide/Plugin/Literals.hs --- a/src/Ide/Plugin/Literals.hs +++ b/src/Ide/Plugin/Literals.hs @@ -62,17 +62,8 @@ _ -> Nothing getLiteral _ = Nothing - - --- GHC 8.8 typedefs LPat = Pat -#if __GLASGOW_HASKELL__ == 808 -type LocPat a = GenLocated SrcSpan (Pat a) -#else -type LocPat a = LPat a -#endif - -- | Destructure Patterns to unwrap any Literals -getPattern :: LocPat GhcPs -> Maybe Literal +getPattern :: LPat GhcPs -> Maybe Literal getPattern (L (locA -> (RealSrcSpan patSpan _)) pat) = case pat of LitPat _ lit -> case lit of HsInt _ val -> fromIntegralLit patSpan val diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -19,8 +19,8 @@ main :: IO () main = defaultTestRunner test -alternateNumberFormatPlugin :: PluginDescriptor IdeState -alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty +alternateNumberFormatPlugin :: PluginTestDescriptor AlternateNumberFormat.Log +alternateNumberFormatPlugin = mkPluginTestDescriptor AlternateNumberFormat.descriptor "alternateNumberFormat" -- NOTE: For whatever reason, this plugin does not play nice with creating Code Actions on time. -- As a result tests will mostly pass if `import Prelude` is added at the top. We (mostly fendor) surmise this has something @@ -29,7 +29,7 @@ test = testGroup "alternateNumberFormat" [ codeActionHex "TIntDtoH" 3 13 , codeActionOctal "TIntDtoO" 3 13 - , codeActionBinary "TIntDtoB" 4 12 + , codeActionBinary "TIntDtoB" 4 13 , codeActionNumDecimal "TIntDtoND" 5 13 , codeActionFracExp "TFracDtoE" 3 13 , codeActionFloatHex "TFracDtoHF" 4 13