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

<TEST>
123456
{-# 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.Generics.Uniplate.DataOnly (universeBi)
import Refact.Types

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

numLiteralHint :: DeclHint
numLiteralHint :: DeclHint
numLiteralHint Scope
_ ModuleEx
modu =
  if Extension
NumericUnderscores Extension -> Set Extension -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` EpAnnComments -> Set Extension
extensions (ModuleEx -> EpAnnComments
modComments ModuleEx
modu) then
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> [Idea])
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsExpr (GhcPass 'Parsed) -> [Idea]
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> [Idea]
suggestUnderscore ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))] -> [Idea])
-> (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
    -> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
forall from to. Biplate from to => from -> [to]
universeBi
  else
     [Idea]
-> GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)) -> [Idea]
forall a b. a -> b -> a
const []

suggestUnderscore :: LHsExpr GhcPs -> [Idea]
suggestUnderscore :: LHsExpr (GhcPass 'Parsed) -> [Idea]
suggestUnderscore x :: LHsExpr (GhcPass 'Parsed)
x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _)) _))) =
  [ String
-> Located (HsExpr (GhcPass 'Parsed))
-> Located (HsExpr (GhcPass 'Parsed))
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use underscore" (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Located (HsExpr (GhcPass 'Parsed))
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x) (LocatedAn Any (HsExpr (GhcPass 'Parsed))
-> Located (HsExpr (GhcPass 'Parsed))
forall a e. LocatedAn a e -> Located e
reLoc LocatedAn Any (HsExpr (GhcPass 'Parsed))
forall an. LocatedAn an (HsExpr (GhcPass 'Parsed))
y) [Refactoring SrcSpan
r] | Char
'_' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
srcTxt, String
srcTxt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
underscoredSrcTxt ]
  where
    underscoredSrcTxt :: String
underscoredSrcTxt = String -> String
addUnderscore String
srcTxt
    y :: LocatedAn an (HsExpr (GhcPass 'Parsed))
y = HsExpr (GhcPass 'Parsed) -> LocatedAn an (HsExpr (GhcPass 'Parsed))
forall a an. a -> LocatedAn an a
noLocA (HsExpr (GhcPass 'Parsed)
 -> LocatedAn an (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed)
-> LocatedAn an (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XOverLitE (GhcPass 'Parsed)
-> HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE (GhcPass 'Parsed)
forall ann. EpAnn ann
EpAnnNotUsed (HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsOverLit (GhcPass 'Parsed)
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 = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x) [(String
"a", LocatedAn Any (HsExpr (GhcPass 'Parsed)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedAn Any (HsExpr (GhcPass 'Parsed))
forall an. LocatedAn an (HsExpr (GhcPass 'Parsed))
y)] String
"a"
suggestUnderscore x :: LHsExpr (GhcPass 'Parsed)
x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL (SourceText srcTxt) _ _ _ _)) _))) =
  [ String
-> Located (HsExpr (GhcPass 'Parsed))
-> Located (HsExpr (GhcPass 'Parsed))
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use underscore" (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Located (HsExpr (GhcPass 'Parsed))
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x) (LocatedAn Any (HsExpr (GhcPass 'Parsed))
-> Located (HsExpr (GhcPass 'Parsed))
forall a e. LocatedAn a e -> Located e
reLoc LocatedAn Any (HsExpr (GhcPass 'Parsed))
forall an. LocatedAn an (HsExpr (GhcPass 'Parsed))
y) [Refactoring SrcSpan
r] | Char
'_' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
srcTxt, String
srcTxt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
underscoredSrcTxt ]
  where
    underscoredSrcTxt :: String
underscoredSrcTxt = String -> String
addUnderscore String
srcTxt
    y :: LocatedAn an (HsExpr (GhcPass 'Parsed))
y = HsExpr (GhcPass 'Parsed) -> LocatedAn an (HsExpr (GhcPass 'Parsed))
forall a an. a -> LocatedAn an a
noLocA (HsExpr (GhcPass 'Parsed)
 -> LocatedAn an (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed)
-> LocatedAn an (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XOverLitE (GhcPass 'Parsed)
-> HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE (GhcPass 'Parsed)
forall ann. EpAnn ann
EpAnnNotUsed (HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsOverLit (GhcPass 'Parsed)
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 = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x) [(String
"a", LocatedAn Any (HsExpr (GhcPass 'Parsed)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedAn Any (HsExpr (GhcPass 'Parsed))
forall an. LocatedAn an (HsExpr (GhcPass 'Parsed))
y)] String
"a"
suggestUnderscore LHsExpr (GhcPass 'Parsed)
_ = [Idea]
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 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ NumLiteral -> String
nl_intPart NumLiteral
numLit
                             , nl_fracPart :: String
nl_fracPart = Int -> String -> String
underscore Int
chunkSize (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ NumLiteral -> String
nl_fracPart NumLiteral
numLit
                             , nl_exp :: String
nl_exp = Int -> String -> String
underscoreFromRight Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ NumLiteral -> String
nl_exp NumLiteral
numLit -- Exponential part is always decimal
                             }
   chunkSize :: Int
chunkSize = if String -> Bool
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"_" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
forall a. Int -> [a] -> [[a]]
chunk Int
chunkSize
   underscoreFromRight :: Int -> String -> String
underscoreFromRight Int
chunkSize = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
underscore Int
chunkSize (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
   chunk :: Int -> [a] -> [[a]]
chunk Int
chunkSize [] = []
   chunk Int
chunkSize [a]
xs = [a]
a[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:Int -> [a] -> [[a]]
chunk Int
chunkSize [a]
b where ([a]
a, [a]
b) = Int -> [a] -> ([a], [a])
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
(Int -> NumLiteral -> String -> String)
-> (NumLiteral -> String)
-> ([NumLiteral] -> String -> String)
-> Show NumLiteral
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
(NumLiteral -> NumLiteral -> Bool)
-> (NumLiteral -> NumLiteral -> Bool) -> Eq NumLiteral
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
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) = (Char -> Bool) -> String -> (String, String)
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) = (Char -> Bool) -> String -> (String, String)
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) = (Char -> Bool) -> String -> (String, String)
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ip String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
es String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e