{-
    Suggest the usage of underscore when NumericUnderscores is enabled.

<TEST>
123456
{-# LANGUAGE NumericUnderscores #-} \
1234
{-# LANGUAGE NumericUnderscores #-} \
12345 -- @Suggestion 12_345 @NoRefactor
{-# LANGUAGE NumericUnderscores #-} \
123456789.0441234e-123456 -- @Suggestion 123_456_789.044_123_4e-123_456 @NoRefactor
{-# LANGUAGE NumericUnderscores #-} \
0x12abc.523defp+172345 -- @Suggestion 0x1_2abc.523d_efp+172_345 @NoRefactor
{-# LANGUAGE NumericUnderscores #-} \
3.14159265359 -- @Suggestion 3.141_592_653_59 @NoRefactor
{-# LANGUAGE NumericUnderscores #-} \
12_33574_56
</TEST>

-}

module Hint.NumLiteral (numLiteralHint) where

import GHC.Hs
import GHC.LanguageExtensions.Type (Extension (..))
import GHC.Types.SrcLoc
import GHC.Types.SourceText
import GHC.Util.ApiAnnotation (extensions)
import Data.Char (isDigit, isOctDigit, isHexDigit)
import Data.List (intercalate)
import Data.Set (union)
import Data.Generics.Uniplate.DataOnly (universeBi)
import Refact.Types

import Hint.Type (DeclHint, toSSA, modComments, firstDeclComments)
import Idea (Idea, suggest)

numLiteralHint :: DeclHint
numLiteralHint :: DeclHint
numLiteralHint Scope
_ ModuleEx
modu =
  -- Comments appearing without an empty line before the first
  -- declaration in a module are now associated with the declaration
  -- not the module so to be safe, look also at `firstDeclComments
  -- modu` (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).
  let exts :: Set Extension
exts = forall a. Ord a => Set a -> Set a -> Set a
union (EpAnnComments -> Set Extension
extensions (ModuleEx -> EpAnnComments
modComments ModuleEx
modu)) (EpAnnComments -> Set Extension
extensions (ModuleEx -> EpAnnComments
firstDeclComments ModuleEx
modu)) in
  if Extension
NumericUnderscores forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Extension
exts then
     forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsExpr GhcPs -> [Idea]
suggestUnderscore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. Biplate from to => from -> [to]
universeBi
  else
     forall a b. a -> b -> a
const []

suggestUnderscore :: LHsExpr GhcPs -> [Idea]
suggestUnderscore :: LHsExpr GhcPs -> [Idea]
suggestUnderscore x :: LHsExpr GhcPs
x@(L SrcSpanAnnA
_ (HsOverLit XOverLitE GhcPs
_ ol :: HsOverLit GhcPs
ol@(OverLit XOverLit GhcPs
_ (HsIntegral intLit :: IntegralLit
intLit@(IL (SourceText String
srcTxt) Bool
_ Integer
_))))) =
  [ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use underscore" (forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
x) (forall a e. LocatedAn a e -> Located e
reLoc forall an. LocatedAn an (HsExpr GhcPs)
y) [Refactoring SrcSpan
r] | Char
'_' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
srcTxt, String
srcTxt forall a. Eq a => a -> a -> Bool
/= String
underscoredSrcTxt ]
  where
    underscoredSrcTxt :: String
underscoredSrcTxt = String -> String
addUnderscore String
srcTxt
    y :: LocatedAn an (HsExpr GhcPs)
    y :: forall an. LocatedAn an (HsExpr GhcPs)
y = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit forall ann. EpAnn ann
EpAnnNotUsed forall a b. (a -> b) -> a -> b
$ HsOverLit GhcPs
ol{ol_val :: OverLitVal
ol_val = IntegralLit -> OverLitVal
HsIntegral IntegralLit
intLit{il_text :: SourceText
il_text = String -> SourceText
SourceText String
underscoredSrcTxt}}
    r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
x) [(String
"a", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA forall an. LocatedAn an (HsExpr GhcPs)
y)] String
"a"
suggestUnderscore x :: LHsExpr GhcPs
x@(L SrcSpanAnnA
_ (HsOverLit XOverLitE GhcPs
_ ol :: HsOverLit GhcPs
ol@(OverLit XOverLit GhcPs
_ (HsFractional fracLit :: FractionalLit
fracLit@(FL (SourceText String
srcTxt) Bool
_ Rational
_ Integer
_ FractionalExponentBase
_))))) =
  [ forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use underscore" (forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
x) (forall a e. LocatedAn a e -> Located e
reLoc forall an. LocatedAn an (HsExpr GhcPs)
y) [Refactoring SrcSpan
r] | Char
'_' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
srcTxt, String
srcTxt forall a. Eq a => a -> a -> Bool
/= String
underscoredSrcTxt ]
  where
    underscoredSrcTxt :: String
underscoredSrcTxt = String -> String
addUnderscore String
srcTxt
    y :: LocatedAn an (HsExpr GhcPs)
    y :: forall an. LocatedAn an (HsExpr GhcPs)
y = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit forall ann. EpAnn ann
EpAnnNotUsed forall a b. (a -> b) -> a -> b
$ HsOverLit GhcPs
ol{ol_val :: OverLitVal
ol_val = FractionalLit -> OverLitVal
HsFractional FractionalLit
fracLit{fl_text :: SourceText
fl_text = String -> SourceText
SourceText String
underscoredSrcTxt}}
    r :: Refactoring SrcSpan
r = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
x) [(String
"a", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA forall an. LocatedAn an (HsExpr GhcPs)
y)] String
"a"
suggestUnderscore LHsExpr GhcPs
_ = forall a. Monoid a => a
mempty

addUnderscore :: String -> String
addUnderscore :: String -> String
addUnderscore String
intStr = NumLiteral -> String
numLitToStr NumLiteral
underscoredNumLit
 where
   numLit :: NumLiteral
numLit = String -> NumLiteral
toNumLiteral String
intStr
   underscoredNumLit :: NumLiteral
underscoredNumLit = NumLiteral
numLit{ nl_intPart :: String
nl_intPart = Int -> String -> String
underscoreFromRight Int
chunkSize forall a b. (a -> b) -> a -> b
$ NumLiteral -> String
nl_intPart NumLiteral
numLit
                             , nl_fracPart :: String
nl_fracPart = Int -> String -> String
underscore Int
chunkSize forall a b. (a -> b) -> a -> b
$ NumLiteral -> String
nl_fracPart NumLiteral
numLit
                             , nl_exp :: String
nl_exp = Int -> String -> String
underscoreFromRight Int
3 forall a b. (a -> b) -> a -> b
$ NumLiteral -> String
nl_exp NumLiteral
numLit -- Exponential part is always decimal
                             }
   chunkSize :: Int
chunkSize = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (NumLiteral -> String
nl_prefix NumLiteral
numLit) then Int
3 else Int
4

   underscore :: Int -> String -> String
underscore Int
chunkSize = forall a. [a] -> [[a]] -> [a]
intercalate String
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Int -> [a] -> [[a]]
chunk Int
chunkSize
   underscoreFromRight :: Int -> String -> String
underscoreFromRight Int
chunkSize String
str
     | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str forall a. Ord a => a -> a -> Bool
< Int
5 = String
str
     | Bool
otherwise = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
underscore Int
chunkSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String
str
   chunk :: Int -> [a] -> [[a]]
chunk Int
chunkSize [] = []
   chunk Int
chunkSize [a]
xs = [a]
aforall a. a -> [a] -> [a]
:Int -> [a] -> [[a]]
chunk Int
chunkSize [a]
b where ([a]
a, [a]
b) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
chunkSize [a]
xs

data NumLiteral = NumLiteral
  { NumLiteral -> String
nl_prefix :: String
  , NumLiteral -> String
nl_intPart :: String
  , NumLiteral -> String
nl_decSep :: String -- decimal separator
  , NumLiteral -> String
nl_fracPart :: String
  , NumLiteral -> String
nl_expSep :: String -- e, e+, e-, p, p+, p-
  , NumLiteral -> String
nl_exp :: String
  } deriving (Int -> NumLiteral -> String -> String
[NumLiteral] -> String -> String
NumLiteral -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NumLiteral] -> String -> String
$cshowList :: [NumLiteral] -> String -> String
show :: NumLiteral -> String
$cshow :: NumLiteral -> String
showsPrec :: Int -> NumLiteral -> String -> String
$cshowsPrec :: Int -> NumLiteral -> String -> String
Show, NumLiteral -> NumLiteral -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumLiteral -> NumLiteral -> Bool
$c/= :: NumLiteral -> NumLiteral -> Bool
== :: NumLiteral -> NumLiteral -> Bool
$c== :: NumLiteral -> NumLiteral -> Bool
Eq)

toNumLiteral :: String -> NumLiteral
toNumLiteral :: String -> NumLiteral
toNumLiteral String
str = case String
str of
  Char
'0':Char
'b':String
digits -> ((Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isBinDigit String
digits){nl_prefix :: String
nl_prefix = String
"0b"}
  Char
'0':Char
'B':String
digits -> ((Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isBinDigit String
digits){nl_prefix :: String
nl_prefix = String
"0B"}
  Char
'0':Char
'o':String
digits -> ((Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isOctDigit String
digits){nl_prefix :: String
nl_prefix = String
"0o"}
  Char
'0':Char
'O':String
digits -> ((Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isOctDigit String
digits){nl_prefix :: String
nl_prefix = String
"0O"}
  Char
'0':Char
'x':String
digits -> ((Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isHexDigit String
digits){nl_prefix :: String
nl_prefix = String
"0x"}
  Char
'0':Char
'X':String
digits -> ((Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isHexDigit String
digits){nl_prefix :: String
nl_prefix = String
"0X"}
  String
_              -> (Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isDigit String
str
  where
    isBinDigit :: Char -> Bool
isBinDigit Char
x = Char
x forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'1'

    afterPrefix :: (Char -> Bool) -> String -> NumLiteral
afterPrefix Char -> Bool
isDigit String
str = ((Char -> Bool) -> String -> NumLiteral
afterIntPart Char -> Bool
isDigit String
suffix){nl_intPart :: String
nl_intPart = String
intPart}
      where (String
intPart, String
suffix) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
str

    afterIntPart :: (Char -> Bool) -> String -> NumLiteral
afterIntPart Char -> Bool
isDigit (Char
'.':String
suffix) = ((Char -> Bool) -> String -> NumLiteral
afterDecSep Char -> Bool
isDigit String
suffix){nl_decSep :: String
nl_decSep = String
"."}
    afterIntPart Char -> Bool
isDigit String
str = String -> NumLiteral
afterFracPart String
str

    afterDecSep :: (Char -> Bool) -> String -> NumLiteral
afterDecSep Char -> Bool
isDigit String
str = (String -> NumLiteral
afterFracPart String
suffix){nl_fracPart :: String
nl_fracPart = String
fracPart}
      where (String
fracPart, String
suffix) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
str

    afterFracPart :: String -> NumLiteral
afterFracPart String
str = String
-> String -> String -> String -> String -> String -> NumLiteral
NumLiteral String
"" String
"" String
"" String
"" String
expSep String
exp
      where (String
expSep, String
exp) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isDigit String
str

numLitToStr :: NumLiteral -> String
numLitToStr :: NumLiteral -> String
numLitToStr (NumLiteral String
p String
ip String
ds String
fp String
es String
e) = String
p forall a. [a] -> [a] -> [a]
++ String
ip forall a. [a] -> [a] -> [a]
++ String
ds forall a. [a] -> [a] -> [a]
++ String
fp forall a. [a] -> [a] -> [a]
++ String
es forall a. [a] -> [a] -> [a]
++ String
e