Skip to content

Commit 9dd1ba8

Browse files
drsoochdrsooch
committed
Removed dead code.
PrimLiterals were defined originally, however GHC source doesn't provide the source text. This is one of the needs of the plugin so we don't provide duplicate suggestions. Swapped `Maybe Text` to `Text`. Similar to above we now ignore all literals that have no source text attached. Swapped `Maybe SrcSpan` to `RealSrcSpan`. Again, similar to the previous points we now ignore literals that don't get a sourceSpan attached. Similarly, we drop any `UselessSpan`'s as those are also not very helpful.
1 parent 7689e74 commit 9dd1ba8

File tree

3 files changed

+60
-60
lines changed

3 files changed

+60
-60
lines changed

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

Lines changed: 13 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -15,9 +15,9 @@ import qualified Data.Text as T
1515
import Development.IDE (GetParsedModule (GetParsedModule),
1616
IdeState, RuleResult,
1717
Rules, define, ideLogger,
18-
isInsideSrcSpan, noRange,
19-
runAction,
20-
srcSpanToRange, use,
18+
noRange,
19+
realSrcSpanToRange,
20+
runAction, use,
2121
useWithStale)
2222
import Development.IDE.Core.PositionMapping (PositionMapping)
2323
import Development.IDE.GHC.Compat hiding (getSrcSpan)
@@ -77,7 +77,7 @@ codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $
7777
nfp <- getNormalizedFilePath docId
7878
CLR{..} <- requestLiterals state nfp
7979
-- remove any invalid literals (see validTarget comment)
80-
let litsInRange = filter validTarget literals
80+
let litsInRange = filter inCurrentRange literals
8181
-- generate alternateFormats and zip with the literal that generated the alternates
8282
literalPairs = map (\lit -> (lit, alternateFormat formatTypes lit)) litsInRange
8383
-- make a code action for every literal and its' alternates (then flatten the result)
@@ -88,17 +88,13 @@ codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $
8888

8989
pure $ List actions
9090
where
91-
getSrcTextDefault = fromMaybe "" . getSrcText
92-
-- for now we ignore literals with no attached source text/span (TH I believe)
93-
validTarget :: Literal -> Bool
94-
validTarget lit = let srcSpan = getSrcSpan lit
91+
inCurrentRange :: Literal -> Bool
92+
inCurrentRange lit = let srcSpan = getSrcSpan lit
9593
in currRange `contains` srcSpan
96-
&& isJust (getSrcText lit)
97-
&& isRealSrcSpan srcSpan
9894

9995
mkCodeAction :: NormalizedFilePath -> Literal -> Text -> Command |? CodeAction
10096
mkCodeAction nfp lit alt = InR CodeAction {
101-
_title = "Convert " <> getSrcTextDefault lit <> " into " <> alt
97+
_title = "Convert " <> getSrcText lit <> " into " <> alt
10298
-- what should this actually be?
10399
, _kind = Just $ CodeActionUnknown "alternate.style"
104100
, _diagnostics = Nothing
@@ -113,12 +109,15 @@ codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $
113109
mkWorkspaceEdit nfp lit alt = WorkspaceEdit changes Nothing Nothing
114110
where
115111
-- NOTE: currently our logic filters our any noRange possibilities
116-
txtEdit = TextEdit (fromMaybe noRange $ srcSpanToRange $ getSrcSpan lit) alt
112+
txtEdit = TextEdit (realSrcSpanToRange $ getSrcSpan lit) alt
117113
changes = Just $ HashMap.fromList [( filePathToUri $ fromNormalizedFilePath nfp, List [txtEdit])]
118114

119115
-- from HaddockComments.hs
120-
contains :: Range -> SrcSpan -> Bool
121-
contains Range {_start, _end} x = isInsideSrcSpan _start x || isInsideSrcSpan _end x
116+
contains :: Range -> RealSrcSpan -> Bool
117+
contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSrcSpan _end x
118+
119+
isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
120+
p `isInsideRealSrcSpan` r = let (Range sp ep) = realSrcSpanToRange r in sp <= p && p <= ep
122121

123122
-- a source span that provides no meaningful information is NOT a valid source span for our use case
124123
isRealSrcSpan :: SrcSpan -> Bool

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

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -64,11 +64,10 @@ instance NFData AnyFormatType
6464
-- | Generate alternate formats for a single Literal based on FormatType's given.
6565
alternateFormat :: [FormatType] -> Literal -> [Text]
6666
alternateFormat fmts lit = case lit of
67-
IntLiteral _ (Just _) val -> concatMap (alternateIntFormat val) (removeCurrentFormat lit fmts)
68-
FracLiteral _ (Just _) val -> if denominator val == 1 -- floats that can be integers we can represent as ints
67+
IntLiteral _ _ val -> concatMap (alternateIntFormat val) (removeCurrentFormat lit fmts)
68+
FracLiteral _ _ val -> if denominator val == 1 -- floats that can be integers we can represent as ints
6969
then concatMap (alternateIntFormat (numerator val)) (removeCurrentFormat lit fmts)
7070
else concatMap (alternateFracFormat val) (removeCurrentFormat lit fmts)
71-
_ -> [] -- This means there is no Source Text so we just ignore it
7271

7372
alternateIntFormat :: Integer -> FormatType -> [Text]
7473
alternateIntFormat val fmt = case fmt of
@@ -88,9 +87,8 @@ alternateFracFormat val fmt = case fmt of
8887
_ -> []
8988

9089
removeCurrentFormat :: Literal -> [FormatType] -> [FormatType]
91-
removeCurrentFormat lit fmts = case getSrcText lit of
92-
Just src -> foldl (flip delete) fmts (sourceToFormatType src)
93-
Nothing -> fmts
90+
removeCurrentFormat lit fmts = let srcText = getSrcText lit
91+
in foldl (flip delete) fmts (sourceToFormatType srcText)
9492

9593
-- | Regex to match a Haskell Hex Literal
9694
hexRegex :: Text
@@ -136,8 +134,9 @@ sourceToFormatType srcText
136134

137135
-- | Translate a list of Extensions into Format Types (plus a base set of Formats)
138136
toFormatTypes :: [Extension] -> [FormatType]
139-
toFormatTypes = (<>) [IntFormat HexFormat, IntFormat OctalFormat, FracFormat ExponentFormat, AnyFormat DecimalFormat]
140-
. mapMaybe (`lookup` numericPairs)
137+
toFormatTypes = (<>) baseFormatTypes . mapMaybe (`lookup` numericPairs)
138+
where
139+
baseFormatTypes = [IntFormat HexFormat, IntFormat OctalFormat, FracFormat ExponentFormat, AnyFormat DecimalFormat]
141140

142141
-- current list of Numeric related extensions
143142
-- LexicalNegation --- 9.0.1 > --- superset of NegativeLiterals

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

Lines changed: 40 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -3,40 +3,37 @@
33
{-# LANGUAGE FlexibleInstances #-}
44
{-# LANGUAGE RankNTypes #-}
55
module Ide.Plugin.Literals where
6-
import Data.Maybe (maybeToList)
6+
import Data.Maybe (fromMaybe, maybeToList)
77
import Data.Text (Text)
88
import qualified Data.Text as T
99
import Development.IDE.GHC.Compat
1010
import Development.IDE.GHC.Util (unsafePrintSDoc)
11-
import Development.IDE.Graph.Classes (NFData)
11+
import Development.IDE.Graph.Classes (NFData (rnf))
1212
import qualified GHC.Generics as GHC
13-
import Generics.SYB
13+
import Generics.SYB (Data, Typeable, cast,
14+
everything)
1415

1516
-- data type to capture what type of literal we are dealing with
1617
-- provides location and possibly source text (for OverLits) as well as it's value
1718
-- we currently don't have any use for PrimLiterals. They never have source text so we always drop them
18-
data Literal = IntLiteral SrcSpan (Maybe Text) Integer
19-
| FracLiteral SrcSpan (Maybe Text) Rational
20-
| IntPrimLiteral SrcSpan (Maybe Text) Integer
21-
| FracPrimLiteral SrcSpan (Maybe Text) Rational
19+
data Literal = IntLiteral RealSrcSpan Text Integer
20+
| FracLiteral RealSrcSpan Text Rational
2221
deriving (GHC.Generic, Show)
2322

23+
instance NFData RealSrcSpan where
24+
rnf x = x `seq` ()
25+
2426
instance NFData Literal
2527

26-
getSrcText :: Literal -> Maybe Text
28+
getSrcText :: Literal -> Text
2729
getSrcText = \case
28-
IntLiteral _ txt _ -> txt
29-
FracLiteral _ txt _ -> txt
30-
IntPrimLiteral _ txt _ -> txt
31-
FracPrimLiteral _ txt _ -> txt
30+
IntLiteral _ txt _ -> txt
31+
FracLiteral _ txt _ -> txt
3232

33-
getSrcSpan :: Literal -> SrcSpan
33+
getSrcSpan :: Literal -> RealSrcSpan
3434
getSrcSpan = \case
35-
IntLiteral ss _ _ -> ss
36-
FracLiteral ss _ _ -> ss
37-
IntPrimLiteral ss _ _ -> ss
38-
FracPrimLiteral ss _ _ -> ss
39-
35+
IntLiteral ss _ _ -> ss
36+
FracLiteral ss _ _ -> ss
4037

4138
-- | Find all literals in a Parsed Source File
4239
collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal]
@@ -74,37 +71,42 @@ traverseExpr sSpan = \case
7471
expr -> collectLiterals expr
7572

7673
getLiteralAsList :: SrcSpan -> HsLit GhcPs -> [Literal]
77-
getLiteralAsList sSpan = maybeToList . getLiteral sSpan
74+
getLiteralAsList sSpan lit = case sSpan of
75+
RealSrcSpan rss _ -> getLiteralAsList' lit rss
76+
_ -> []
77+
78+
getLiteralAsList' :: HsLit GhcPs -> RealSrcSpan -> [Literal]
79+
getLiteralAsList' lit = maybeToList . flip getLiteral lit
7880

7981
-- Translate from Hs Type to our Literal type
80-
getLiteral :: SrcSpan -> HsLit GhcPs -> Maybe Literal
82+
getLiteral :: RealSrcSpan -> HsLit GhcPs -> Maybe Literal
8183
getLiteral sSpan = \case
82-
HsInt _ val -> Just $ fromIntegralLit sSpan val
83-
HsIntPrim _ val -> Just $ IntPrimLiteral sSpan Nothing val
84-
HsWordPrim _ val -> Just $ IntPrimLiteral sSpan Nothing val
85-
HsInt64Prim _ val -> Just $ IntPrimLiteral sSpan Nothing val
86-
HsWord64Prim _ val -> Just $ IntPrimLiteral sSpan Nothing val
87-
HsInteger _ val _ -> Just $ IntLiteral sSpan Nothing val
88-
HsRat _ val _ -> Just $ fromFractionalLit sSpan val
89-
HsFloatPrim _ (FL _ _ val) -> Just $ FracPrimLiteral sSpan Nothing val
90-
HsDoublePrim _ (FL _ _ val) -> Just $ FracPrimLiteral sSpan Nothing val
91-
_ -> Nothing
84+
HsInt _ val -> fromIntegralLit sSpan val
85+
-- Ignore this case for now
86+
-- HsInteger _ val _ -> Just $ IntLiteral sSpan Nothing val
87+
HsRat _ val _ -> fromFractionalLit sSpan val
88+
_ -> Nothing
9289

9390
getOverLiteralAsList :: SrcSpan -> HsOverLit GhcPs -> [Literal]
94-
getOverLiteralAsList sSpan = maybeToList . getOverLiteral sSpan
91+
getOverLiteralAsList sSpan lit = case sSpan of
92+
RealSrcSpan rss _ -> getOverLiteralAsList' lit rss
93+
_ -> []
94+
95+
getOverLiteralAsList' :: HsOverLit GhcPs -> RealSrcSpan -> [Literal]
96+
getOverLiteralAsList' lit = maybeToList . flip getOverLiteral lit
9597

96-
getOverLiteral :: SrcSpan -> HsOverLit GhcPs -> Maybe Literal
98+
getOverLiteral :: RealSrcSpan -> HsOverLit GhcPs -> Maybe Literal
9799
getOverLiteral sSpan OverLit{..} = case ol_val of
98-
HsIntegral il -> Just $ fromIntegralLit sSpan il
99-
HsFractional fl -> Just $ fromFractionalLit sSpan fl
100+
HsIntegral il -> fromIntegralLit sSpan il
101+
HsFractional fl -> fromFractionalLit sSpan fl
100102
_ -> Nothing
101103
getOverLiteral _ _ = Nothing
102104

103-
fromIntegralLit :: SrcSpan -> IntegralLit -> Literal
104-
fromIntegralLit s (IL txt _ val) = IntLiteral s (fromSourceText txt) val
105+
fromIntegralLit :: RealSrcSpan -> IntegralLit -> Maybe Literal
106+
fromIntegralLit s (IL txt _ val) = fmap (\txt' -> IntLiteral s txt' val) (fromSourceText txt)
105107

106-
fromFractionalLit :: SrcSpan -> FractionalLit -> Literal
107-
fromFractionalLit s (FL txt _ val) = FracLiteral s (fromSourceText txt) val
108+
fromFractionalLit :: RealSrcSpan -> FractionalLit -> Maybe Literal
109+
fromFractionalLit s (FL txt _ val) = fmap (\txt' -> FracLiteral s txt' val) (fromSourceText txt)
108110

109111
fromSourceText :: SourceText -> Maybe Text
110112
fromSourceText = \case

0 commit comments

Comments
 (0)