hls-alternate-number-format-plugin 1.0.1.0 → 1.1.0.0

raw patch · 28 files changed

+234/−234 lines, 28 filesdep ~ghc-boot-thdep ~ghcidedep ~hls-plugin-apinew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc-boot-th, ghcide, hls-plugin-api, hls-test-utils

API changes (from Hackage documentation)

Files

• README.md +17/−11
• hls-alternate-number-format-plugin.cabal +5/−4
• src/Ide/Plugin/AlternateNumberFormat.hs +74/−35
• src/Ide/Plugin/Conversion.hs +63/−79
• src/Ide/Plugin/Literals.hs +30/−41
• test/Main.hs +22/−38
• test/Properties/Conversion.hs +1/−1
• test/testdata/TExpectBinaryFormat.hs +0/−4
• test/testdata/TExpectHexFloatFormat.hs +0/−4
• test/testdata/TExpectNoBinaryFormat.hs +0/−3
• test/testdata/TExpectNoHexFloatFormat.hs +0/−3
• test/testdata/TExpectNoNumDecimalFormat.hs +0/−3
• test/testdata/TExpectNumDecimalFormat.hs +0/−4
• test/testdata/TFindLiteralDoLet.hs +1/−0
• test/testdata/TFindLiteralDoReturn.hs +1/−0
• test/testdata/TFindLiteralIntCase.hs +1/−0
• test/testdata/TFindLiteralIntCase2.hs +1/−0
• test/testdata/TFindLiteralIntPattern.hs +1/−0
• test/testdata/TFindLiteralList.hs +1/−0
• test/testdata/TFracDtoHF.expected.hs +1/−0
• test/testdata/TFracDtoHF.hs +1/−1
• test/testdata/TFracDtoHFWithPragma.expected.hs +4/−0
• test/testdata/TFracDtoHFWithPragma.hs +4/−0
• test/testdata/TIntDtoB.expected.hs +1/−0
• test/testdata/TIntDtoB.hs +1/−1
• test/testdata/TIntDtoND.expected.hs +2/−1
• test/testdata/TIntDtoND.hs +1/−1
• test/testdata/hie.yaml +1/−0

@@ -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,19 +22,25 @@ 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 - First Release++### 1.0.1.0+- Dependency upgrades++### 1.0.1.1+- Buildable with GHC 9.2++### 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

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               hls-alternate-number-format-plugin-version:            1.0.1.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>@@ -21,14 +21,15 @@   exposed-modules:  Ide.Plugin.AlternateNumberFormat, Ide.Plugin.Conversion   other-modules:    Ide.Plugin.Literals   hs-source-dirs:   src+  ghc-options:      -Wall   build-depends:       aeson     , base                 >=4.12 && < 5     , containers-    , ghcide               ^>=1.6+    , ghcide               ^>=1.6 || ^>=1.7     , ghc-boot-th     , hls-graph-    , hls-plugin-api       ^>=1.3+    , hls-plugin-api       ^>=1.3 || ^>=1.4     , hie-compat     , lens     , lsp@@ -56,7 +57,7 @@     , base                 >=4.12 && < 5     , filepath     , hls-alternate-number-format-plugin-    , hls-test-utils       ^>=1.2+    , hls-test-utils       ^>=1.3     , lsp     , QuickCheck     , regex-tdfa

@@ -2,7 +2,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies  #-} {-# LANGUAGE TypeOperators #-}-module Ide.Plugin.AlternateNumberFormat (descriptor) where+{-# LANGUAGE ViewPatterns  #-}+module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where  import           Control.Lens                    ((^.)) import           Control.Monad.Except            (ExceptT, MonadIO, liftIO)@@ -10,29 +11,42 @@ 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           Ide.Plugin.Literals             (Literal (..), collectLiterals,-                                                  getSrcSpan, getSrcText)+import           GHC.LanguageExtensions.Type     (Extension)+import           Ide.Plugin.Conversion           (AlternateFormat,+                                                  ExtensionNeeded (NeedsExtension, NoExtension),+                                                  alternateFormat)+import           Ide.Plugin.Literals import           Ide.PluginUtils                 (handleMaybe, handleMaybeM,                                                   response) import           Ide.Types import           Language.LSP.Types import           Language.LSP.Types.Lens         (uri) -descriptor :: PluginId -> PluginDescriptor IdeState-descriptor plId = (defaultPluginDescriptor plId)+newtype Log = LogShake Shake.Log deriving Show++instance Pretty Log where+  pretty = \case+    LogShake log -> pretty log++descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState+descriptor recorder plId = (defaultPluginDescriptor plId)     { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler-    , pluginRules = collectLiteralsRule+    , pluginRules = collectLiteralsRule recorder     }  data CollectLiterals = CollectLiterals@@ -44,38 +58,42 @@ 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>"  instance NFData CollectLiteralsResult -collectLiteralsRule :: Rules ()-collectLiteralsRule = define $ \CollectLiterals nfp -> do+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@@ -83,24 +101,41 @@         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 contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSrcSpan _end x@@ -108,6 +143,15 @@ 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@@ -118,8 +162,3 @@                 . 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-

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric    #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns     #-} module Ide.Plugin.Conversion (     alternateFormat     , hexRegex@@ -8,20 +10,19 @@     , decimalRegex     , numDecimalRegex     , matchLineRegex-    , toFormatTypes-    , FormatType-    , generateNumDecimal-    , toNumDecimal-    , toBinary     , toOctal+    , toDecimal+    , toBinary     , toHex-    , toHexFloat     , toFloatDecimal     , toFloatExpDecimal+    , toHexFloat+    , AlternateFormat+    , ExtensionNeeded(..) ) where  import           Data.Char                     (toUpper)-import           Data.List                     (delete, dropWhileEnd)+import           Data.List                     (delete) import           Data.Maybe                    (mapMaybe) import           Data.Ratio                    (denominator, numerator) import           Data.Text                     (Text)@@ -36,60 +37,82 @@  data FormatType = IntFormat IntFormatType                 | FracFormat FracFormatType-                | AnyFormat AnyFormatType                 | NoFormat                 deriving (Show, Eq, Generic)  instance NFData FormatType -data IntFormatType = HexFormat+data IntFormatType = IntDecimalFormat+                   | HexFormat                    | OctalFormat                    | BinaryFormat                    | NumDecimalFormat-                   deriving (Show, Eq, Generic)+                   deriving (Show, Eq, Generic, Bounded, Enum)  instance NFData IntFormatType -data FracFormatType = HexFloatFormat+data FracFormatType = FracDecimalFormat+                    | HexFloatFormat                     | ExponentFormat-                    deriving (Show, Eq, Generic)+                    deriving (Show, Eq, Generic, Bounded, Enum)  instance NFData FracFormatType -data AnyFormatType = DecimalFormat-                   deriving (Show, Eq, Generic)+data ExtensionNeeded = NoExtension+                     | NeedsExtension Extension -instance NFData AnyFormatType+type AlternateFormat = (Text, ExtensionNeeded)  -- | Generate alternate formats for a single Literal based on FormatType's given.-alternateFormat :: [FormatType] -> Literal -> [Text]-alternateFormat fmts lit = case lit of-  IntLiteral _ _ val  -> concatMap (alternateIntFormat val) (removeCurrentFormat lit fmts)+alternateFormat :: Literal -> [AlternateFormat]+alternateFormat lit = case lit of+  IntLiteral _ _ val   -> map (alternateIntFormat val) (removeCurrentFormatInt lit)   FracLiteral _ _  val -> if denominator val == 1 -- floats that can be integers we can represent as ints-      then concatMap (alternateIntFormat (numerator val)) (removeCurrentFormat lit fmts)-      else concatMap (alternateFracFormat val) (removeCurrentFormat lit fmts)+      then map (alternateIntFormat (numerator val)) (removeCurrentFormatInt lit)+      else map (alternateFracFormat val) (removeCurrentFormatFrac lit) -alternateIntFormat :: Integer -> FormatType -> [Text]-alternateIntFormat val fmt = case fmt of-  IntFormat ift           -> case ift of-    HexFormat        -> [T.pack $ toHex val]-    OctalFormat      -> [T.pack $ toOctal val]-    BinaryFormat     -> [T.pack $ toBinary val]-    NumDecimalFormat -> generateNumDecimal val  -- this is the only reason we return List of Text :/-  AnyFormat DecimalFormat -> [T.pack $ toDecimal val]-  _                       -> []+alternateIntFormat :: Integer -> IntFormatType -> AlternateFormat+alternateIntFormat val = \case+    IntDecimalFormat -> (T.pack $ toDecimal val, NoExtension)+    HexFormat        -> (T.pack $ toHex val, NoExtension)+    OctalFormat      -> (T.pack $ toOctal val, NoExtension)+    BinaryFormat     -> (T.pack $ toBinary val, NeedsExtension BinaryLiterals)+    NumDecimalFormat -> (T.pack $ toFloatExpDecimal (fromInteger @Double val), NeedsExtension NumDecimals) -alternateFracFormat :: Rational -> FormatType -> [Text]-alternateFracFormat val fmt = case fmt of-  AnyFormat DecimalFormat   -> [T.pack $ toFloatDecimal (fromRational val)]-  FracFormat ExponentFormat -> [T.pack $ toFloatExpDecimal (fromRational val)]-  FracFormat HexFloatFormat -> [T.pack $ toHexFloat (fromRational val)]-  _                         -> []+alternateFracFormat :: Rational -> FracFormatType -> AlternateFormat+alternateFracFormat val = \case+  FracDecimalFormat -> (T.pack $ toFloatDecimal (fromRational @Double val), NoExtension)+  ExponentFormat    -> (T.pack $ toFloatExpDecimal (fromRational @Double val), NoExtension)+  HexFloatFormat    -> (T.pack $ toHexFloat (fromRational @Double val), NeedsExtension HexFloatLiterals) -removeCurrentFormat :: Literal -> [FormatType] -> [FormatType]-removeCurrentFormat lit fmts = let srcText = getSrcText lit-                                in foldl (flip delete) fmts (sourceToFormatType srcText)+-- given a Literal compute it's current Format and delete it from the list of available formats+removeCurrentFormat :: (Foldable t, Eq a) => [a] -> t a -> [a]+removeCurrentFormat fmts toRemove = foldl (flip delete) fmts toRemove +removeCurrentFormatInt :: Literal -> [IntFormatType]+removeCurrentFormatInt (getSrcText -> srcText) = removeCurrentFormat intFormats (filterIntFormats $ sourceToFormatType srcText)++removeCurrentFormatFrac :: Literal -> [FracFormatType]+removeCurrentFormatFrac (getSrcText -> srcText) = removeCurrentFormat fracFormats (filterFracFormats $ sourceToFormatType srcText)++filterIntFormats :: [FormatType] -> [IntFormatType]+filterIntFormats = mapMaybe getIntFormat+    where+        getIntFormat (IntFormat f) = Just f+        getIntFormat _             = Nothing++filterFracFormats :: [FormatType] -> [FracFormatType]+filterFracFormats = mapMaybe getFracFormat+    where+        getFracFormat (FracFormat f) = Just f+        getFracFormat _              = Nothing++intFormats :: [IntFormatType]+intFormats = [minBound .. maxBound]++fracFormats :: [FracFormatType]+fracFormats = [minBound .. maxBound]+ -- | Regex to match a Haskell Hex Literal hexRegex :: Text hexRegex = "0[xX][a-fA-F0-9]+"@@ -130,46 +153,7 @@     -- otherwise we wouldn't need to return a list     | srcText =~ matchLineRegex numDecimalRegex  = [IntFormat NumDecimalFormat, FracFormat ExponentFormat]     -- just assume we are in base 10 with no decimals-    | otherwise = [AnyFormat DecimalFormat]---- | Translate a list of Extensions into Format Types (plus a base set of Formats)-toFormatTypes :: [Extension] -> [FormatType]-toFormatTypes =  (<>) baseFormatTypes . mapMaybe (`lookup` numericPairs)-    where-        baseFormatTypes = [IntFormat HexFormat, IntFormat OctalFormat, FracFormat ExponentFormat, AnyFormat DecimalFormat]---- current list of Numeric related extensions--- LexicalNegation --- 9.0.1 > --- superset of NegativeLiterals-numericPairs :: [(Extension, FormatType)]-numericPairs = [(NumericUnderscores, NoFormat), (NegativeLiterals, NoFormat)] <> intPairs <> fracPairs--intPairs :: [(Extension, FormatType)]-intPairs = [(BinaryLiterals, IntFormat BinaryFormat), (NumDecimals, IntFormat NumDecimalFormat)]--fracPairs :: [(Extension, FormatType)]-fracPairs = [(HexFloatLiterals, FracFormat HexFloatFormat)]---- Generate up to 3 possible choices where:--- dropWhile (\d -> val `div` d) > 1000) implies we want at MOST 3 digits to left of decimal--- takeWhile (val >) implies we want to stop once we start to get numbers like: 0.1e[N]--- take 3 implies we want at most three choices which will center around the format:---    - 500.123e4---    - 50.0123e5---    - 5e.00123e6--- NOTE: showEFloat would also work, but results in only one option-generateNumDecimal :: Integer -> [Text]-generateNumDecimal val = map (toNumDecimal val) $ take 3 $ takeWhile (val >= ) $ dropWhile (\d -> (val `div` d) > 1000) divisors-    where-        divisors = 10 : map (*10) divisors--toNumDecimal :: Integer -> Integer -> Text-toNumDecimal val divisor = let (q, r) = val `quotRem` divisor-                               numExponent = length $ filter (== '0') $ show divisor-                               -- remove unnecessary trailing zeroes from output-                               r' = dropWhileEnd (== '0') $ show r-                               -- but make sure there are still digits left!!!-                               r'' = if null r' then "0" else r'-                               in T.pack $ show q <> "." <> r'' <> "e" <> show numExponent+    | otherwise = [IntFormat IntDecimalFormat, FracFormat FracDecimalFormat]  toBase :: (Num a, Ord a) => (a -> ShowS) -> String -> a -> String toBase conv header n

@@ -1,7 +1,9 @@+{-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE FlexibleInstances  #-} {-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE ViewPatterns       #-} module Ide.Plugin.Literals (     collectLiterals     , Literal(..)@@ -13,7 +15,6 @@ import           Data.Text                     (Text) import qualified Data.Text                     as T import           Development.IDE.GHC.Compat    hiding (getSrcSpan)-import           Development.IDE.GHC.Util      (unsafePrintSDoc) import           Development.IDE.Graph.Classes (NFData (rnf)) import qualified GHC.Generics                  as GHC import           Generics.SYB                  (Data, Typeable, everything,@@ -23,15 +24,19 @@ -- provides location and possibly source text (for OverLits) as well as it's value -- we currently don't have any use for PrimLiterals. They never have source text so we always drop them -- | Captures a Numeric Literals Location, Source Text, and Value.-data Literal = IntLiteral  RealSrcSpan Text Integer-             | FracLiteral RealSrcSpan Text Rational+data Literal = IntLiteral  LiteralSrcSpan Text Integer+             | FracLiteral LiteralSrcSpan Text Rational              deriving (GHC.Generic, Show, Ord, Eq, Data) -instance NFData RealSrcSpan where+newtype LiteralSrcSpan = LiteralSrcSpan { unLit :: RealSrcSpan }+                        deriving (GHC.Generic, Show, Ord, Eq, Data)++instance NFData LiteralSrcSpan where     rnf x = x `seq` ()  instance NFData Literal + -- | Return a Literal's Source representation getSrcText :: Literal -> Text getSrcText = \case@@ -41,32 +46,43 @@ -- | Return a Literal's Real Source location getSrcSpan :: Literal -> RealSrcSpan getSrcSpan = \case-    IntLiteral ss _ _  -> ss-    FracLiteral ss _ _ -> ss+    IntLiteral ss _ _  -> unLit ss+    FracLiteral ss _ _ -> unLit ss  -- | Find all literals in a Parsed Source File collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal] collectLiterals = everything (<>) (maybeToList . (const Nothing `extQ` getLiteral `extQ` getPattern)) + -- | Translate from HsLit and HsOverLit Types to our Literal Type-getLiteral :: GenLocated SrcSpan (HsExpr GhcPs) -> Maybe Literal-getLiteral (L (UnhelpfulSpan _) _) = Nothing-getLiteral (L (RealSrcSpan sSpan _ ) expr) = case expr of+getLiteral :: LHsExpr GhcPs -> Maybe Literal+getLiteral (L (locA -> (RealSrcSpan sSpan _)) expr) = case expr of     HsLit _ lit         -> fromLit lit sSpan     HsOverLit _ overLit -> fromOverLit overLit sSpan     _                   -> 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 :: GenLocated SrcSpan (Pat GhcPs) -> Maybe Literal-getPattern (L (UnhelpfulSpan _) _)       = Nothing-getPattern (L (RealSrcSpan patSpan _) pat) = case pat of+getPattern :: LocPat GhcPs -> Maybe Literal+getPattern (L (locA -> (RealSrcSpan patSpan _)) pat) = case pat of     LitPat _ lit -> case lit of         HsInt _ val   -> fromIntegralLit patSpan val         HsRat _ val _ -> fromFractionalLit patSpan val         _             -> Nothing+    -- a located HsOverLit is (GenLocated SrcSpan HsOverLit) NOT (GenLocated SrcSpanAnn' a HsOverLit)     NPat _ (L (RealSrcSpan sSpan _) overLit) _ _ -> fromOverLit overLit sSpan     NPlusKPat _ _ (L (RealSrcSpan sSpan _) overLit1) _ _ _ -> fromOverLit overLit1 sSpan     _ -> Nothing+getPattern _ = Nothing  fromLit :: HsLit p -> RealSrcSpan -> Maybe Literal fromLit lit sSpan = case lit of@@ -82,39 +98,12 @@ fromOverLit _ _ = Nothing  fromIntegralLit :: RealSrcSpan -> IntegralLit -> Maybe Literal-fromIntegralLit s IL{..} = fmap (\txt' -> IntLiteral s txt' il_value) (fromSourceText il_text)+fromIntegralLit s IL{..} = fmap (\txt' -> IntLiteral (LiteralSrcSpan s) txt' il_value) (fromSourceText il_text)  fromFractionalLit  :: RealSrcSpan -> FractionalLit -> Maybe Literal-fromFractionalLit s FL{..} = fmap (\txt' -> FracLiteral s txt' fl_value) (fromSourceText fl_text)+fromFractionalLit s fl@FL{fl_text} = fmap (\txt' -> FracLiteral (LiteralSrcSpan s) txt' (rationalFromFractionalLit fl)) (fromSourceText fl_text)  fromSourceText :: SourceText -> Maybe Text fromSourceText = \case   SourceText s -> Just $ T.pack s   NoSourceText -> Nothing---- mostly for debugging purposes-literalToString :: HsLit p -> String-literalToString = \case-  HsChar _ c        -> "Char: " <> show c-  HsCharPrim _ c    -> "CharPrim: " <> show c-  HsString _ fs     -> "String: " <> show fs-  HsStringPrim _ bs -> "StringPrim: " <> show bs-  HsInt _ il        -> "Int: " <> show il-  HsIntPrim _ n     -> "IntPrim: " <> show n-  HsWordPrim _ n    -> "WordPrim: " <> show n-  HsInt64Prim _ n   -> "Int64Prim: " <> show n-  HsWord64Prim _ n  -> "Word64Prim: " <> show n-  HsInteger _ n ty  -> "Integer: " <> show n <> " Type: " <> tyToLiteral ty-  HsRat _ fl ty     -> "Rat: " <> show fl <> " Type: " <> tyToLiteral ty-  HsFloatPrim _ fl  -> "FloatPrim: " <> show fl-  HsDoublePrim _ fl -> "DoublePrim: " <>  show fl-  _                 -> "XHsLit"-  where-    tyToLiteral :: Type -> String-    tyToLiteral = unsafePrintSDoc .  ppr--overLitToString :: OverLitVal -> String-overLitToString = \case-     HsIntegral int -> case int of { IL{il_value} -> "IntegralOverLit: " <> show il_value}-     HsFractional frac -> case frac of { FL{fl_value} -> "RationalOverLit: " <> show fl_value}-     HsIsString _ str -> "HIsString: " <> show str

@@ -21,8 +21,7 @@ main = defaultTestRunner test  alternateNumberFormatPlugin :: PluginDescriptor IdeState-alternateNumberFormatPlugin = AlternateNumberFormat.descriptor "alternateNumberFormat"-+alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty "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@@ -31,42 +30,26 @@ test = testGroup "alternateNumberFormat" [     codeActionHex "TIntDtoH" 3 13     , codeActionOctal "TIntDtoO" 3 13-    , codeActionBinary "TIntDtoB" 4 13+    , codeActionBinary "TIntDtoB" 4 12     , codeActionNumDecimal "TIntDtoND" 5 13     , codeActionFracExp "TFracDtoE" 3 13     , codeActionFloatHex "TFracDtoHF" 4 13     , codeActionDecimal "TIntHtoD" 3 13     , codeActionDecimal "TFracHFtoD" 4 13-    , codeActionProperties "TFindLiteralIntPattern" [(3, 25), (4,25)] $ \actions -> do+    -- to test we don't duplicate pragmas+    , codeActionFloatHex "TFracDtoHFWithPragma" 4 13+    , codeActionProperties "TFindLiteralIntPattern" [(4, 25), (5,25)] $ \actions -> do+        liftIO $ length actions @?= 8+    , codeActionProperties "TFindLiteralIntCase" [(4, 29)] $ \actions -> do         liftIO $ length actions @?= 4-    , codeActionProperties "TFindLiteralIntCase" [(3, 29)] $ \actions -> do-        liftIO $ length actions @?= 2-    , codeActionProperties "TFindLiteralIntCase2" [(4, 21)] $ \actions -> do-        liftIO $ length actions @?= 2-    , codeActionProperties "TFindLiteralDoReturn" [(5, 10)] $ \actions -> do-        liftIO $ length actions @?= 2-    , codeActionProperties "TFindLiteralDoLet" [(5, 13), (6, 13)] $ \actions -> do+    , codeActionProperties "TFindLiteralIntCase2" [(5, 21)] $ \actions -> do         liftIO $ length actions @?= 4-    , codeActionProperties "TFindLiteralList" [(3, 28)] $ \actions -> do-        liftIO $ length actions @?= 2-    , codeActionProperties "TExpectNoBinaryFormat" [(3, 12)] $ \actions -> do-        liftIO $ length actions @?= 2-        liftIO $ actions `doesNotContain` binaryRegex @? "Contains binary codeAction"-    , codeActionProperties "TExpectBinaryFormat" [(4, 10)] $ \actions -> do-        liftIO $ length actions @?= 3-        liftIO $ actions `contains` binaryRegex @? "Does not contain binary codeAction"-    , codeActionProperties "TExpectNoHexFloatFormat" [(3, 14)] $ \actions -> do-        liftIO $ length actions @?= 1-        liftIO $ actions `doesNotContain` hexFloatRegex @? "Contains hex float codeAction"-    , codeActionProperties "TExpectHexFloatFormat" [(4, 12)] $ \actions -> do-        liftIO $ length actions @?= 2-        liftIO $ actions `contains` hexFloatRegex @? "Does not contain hex float codeAction"-    , codeActionProperties "TExpectNoNumDecimalFormat" [(3, 16)] $ \actions -> do-        liftIO $ length actions @?= 2-        liftIO $ actions `doesNotContain` numDecimalRegex @? "Contains numDecimal codeAction"-    , codeActionProperties "TExpectNumDecimalFormat" [(4, 14)] $ \actions -> do-        liftIO $ length actions @?= 5-        liftIO $ actions `contains` numDecimalRegex @? "Contains numDecimal codeAction"+    , codeActionProperties "TFindLiteralDoReturn" [(6, 10)] $ \actions -> do+        liftIO $ length actions @?= 4+    , codeActionProperties "TFindLiteralDoLet" [(6, 13), (7, 13)] $ \actions -> do+        liftIO $ length actions @?= 8+    , codeActionProperties "TFindLiteralList" [(4, 28)] $ \actions -> do+        liftIO $ length actions @?= 4     , conversions     ] @@ -143,15 +126,16 @@ doesNotContain :: [CodeAction] -> Text -> Bool acts `doesNotContain` regex = not $ acts `contains` regex -convertPrefix, intoInfix, hexRegex, hexFloatRegex, binaryRegex, octalRegex, numDecimalRegex, decimalRegex :: Text+convertPrefix, intoInfix, maybeExtension, hexRegex, hexFloatRegex, binaryRegex, octalRegex, numDecimalRegex, decimalRegex :: Text convertPrefix = "Convert (" <> T.intercalate "|" [Conversion.hexRegex, Conversion.hexFloatRegex, Conversion.binaryRegex, Conversion.octalRegex, Conversion.numDecimalRegex, Conversion.decimalRegex] <> ")" intoInfix = " into "-hexRegex = intoInfix <> Conversion.hexRegex-hexFloatRegex = intoInfix <> Conversion.hexFloatRegex-binaryRegex = intoInfix <> Conversion.binaryRegex-octalRegex = intoInfix <> Conversion.octalRegex-numDecimalRegex = intoInfix <> Conversion.numDecimalRegex-decimalRegex = intoInfix <> Conversion.decimalRegex+maybeExtension = "( \\(needs extension: .*)?"+hexRegex = intoInfix <> Conversion.hexRegex <> maybeExtension+hexFloatRegex = intoInfix <> Conversion.hexFloatRegex <> maybeExtension+binaryRegex = intoInfix <> Conversion.binaryRegex <> maybeExtension+octalRegex = intoInfix <> Conversion.octalRegex <> maybeExtension+numDecimalRegex = intoInfix <> Conversion.numDecimalRegex <> maybeExtension+decimalRegex = intoInfix <> Conversion.decimalRegex <> maybeExtension  isCodeAction :: Text -> Maybe Text -> Bool isCodeAction userRegex (Just txt) = txt =~ Conversion.matchLineRegex (convertPrefix <> userRegex)

@@ -17,7 +17,7 @@     ]  prop_regexMatchesNumDecimal :: Integer -> Bool-prop_regexMatchesNumDecimal = all (=~ numDecimalRegex) . generateNumDecimal+prop_regexMatchesNumDecimal = (=~ numDecimalRegex) . toFloatExpDecimal . fromInteger  prop_regexMatchesHex :: (Integral a, Show a) => a -> Bool prop_regexMatchesHex = (=~ hexRegex ) . toHex

@@ -1,4 +0,0 @@-{-# LANGUAGE BinaryLiterals #-}-module TExpectBinaryFormat where--binary = 459

@@ -1,4 +0,0 @@-{-# LANGUAGE HexFloatLiterals #-}-module TExpectHexFloatFormat where--hexFloat = 459.123

@@ -1,3 +0,0 @@-module TExpectNoBinaryFormat where--noBinary = 459

@@ -1,3 +0,0 @@-module TExpectNoHexFloatFormat where--noHexFloat = 459.123

@@ -1,3 +0,0 @@-module TExpectNoNumDecimalFormat where--noNumDecimal = 499999

@@ -1,4 +0,0 @@-{-# LANGUAGE NumDecimals #-}-module TExpectNumDecimalFormat where--numDecimal = 499999

@@ -1,3 +1,4 @@+{-# LANGUAGE NoBinaryLiterals #-} module TFindLiteralDoLet where  doLet :: IO ()

@@ -1,3 +1,4 @@+{-# LANGUAGE NoBinaryLiterals #-} module TFindLiteralDoReturn where  doReturn :: IO Integer

@@ -1,3 +1,4 @@+{-# LANGUAGE NoBinaryLiterals #-} module TFindLiteralIntCase where  caseExpression x = case x + 34 of

@@ -1,3 +1,4 @@+{-# LANGUAGE NoBinaryLiterals #-} module TFindLiteralIntCase where  caseExpression x = case x of

@@ -1,3 +1,4 @@+{-# LANGUAGE NoBinaryLiterals #-} module TFindLiteralIntPattern where  patternMatchingFunction 1 = "one"

@@ -1,3 +1,4 @@+{-# LANGUAGE NoBinaryLiterals #-} module TFindLiteralList where  listTest = [reverse $ show 57]

@@ -1,3 +1,4 @@+{-# LANGUAGE Haskell2010 #-} {-# LANGUAGE HexFloatLiterals #-} module TFracDtoHF where 

@@ -1,4 +1,4 @@-{-# LANGUAGE HexFloatLiterals #-}+{-# LANGUAGE Haskell2010 #-} module TFracDtoHF where  convertMe = 123.45

@@ -0,0 +1,4 @@+{-# LANGUAGE HexFloatLiterals #-}+module TFracDtoHFWithPragma where++convertMe = 0x1.edccccccccccdp6

@@ -0,0 +1,4 @@+{-# LANGUAGE HexFloatLiterals #-}+module TFracDtoHFWithPragma where++convertMe = 123.45

@@ -1,3 +1,4 @@+{-# LANGUAGE Haskell2010 #-} {-# LANGUAGE BinaryLiterals #-} module TIntDtoB where 

@@ -1,4 +1,4 @@-{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE Haskell2010 #-} module TIntDtoB where  convertMe = 12

@@ -1,5 +1,6 @@+{-# LANGUAGE Haskell2010 #-} {-# LANGUAGE NumDecimals #-} module TIntDtoND where  convertMe :: Integer-convertMe = 125.345e3+convertMe = 1.25345e5

@@ -1,4 +1,4 @@-{-# LANGUAGE NumDecimals #-}+{-# LANGUAGE Haskell2010 #-} module TIntDtoND where  convertMe :: Integer

@@ -9,6 +9,7 @@       - TIntDtoND       - TFracDtoE       - TFracDtoHF+      - TFracDtoHFWithPragma       - TIntHtoD       - TFracHFtoD       - TFindLiteralIntPattern