    {-
        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.Data.FastString
    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 = Set Extension -> Set Extension -> Set Extension
    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 Extension -> Set Extension -> Bool
    forall a. Eq a => a -> Set a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Set Extension
    exts then
         (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea])
    -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Idea]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap LHsExpr GhcPs -> [Idea]
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
    suggestUnderscore ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Idea])
    -> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
        -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> [Idea]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    forall from to. Biplate from to => from -> [to]
    universeBi
      else
         [Idea] -> GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [Idea]
    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 FastString
    srcTxt) Bool
    _ Integer
    _))))) =
      [ String
    -> Located (HsExpr GhcPs)
    -> Located (HsExpr GhcPs)
    -> [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 GhcPs) -> Located (HsExpr GhcPs)
    forall a e b.
    (HasLoc (GenLocated a e), HasAnnotation b) =>
    GenLocated a e -> GenLocated b e
    reLoc LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x) (GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    -> Located (HsExpr GhcPs)
    forall a e b.
    (HasLoc (GenLocated a e), HasAnnotation b) =>
    GenLocated a e -> GenLocated b e
    reLoc GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    y) [Refactoring SrcSpan
    r] | Char
    '_' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` FastString -> String
    unpackFS FastString
    srcTxt, FastString -> String
    unpackFS FastString
    srcTxt String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    underscoredSrcTxt ]
      where
        underscoredSrcTxt :: String
    underscoredSrcTxt = String -> String
    addUnderscore (FastString -> String
    unpackFS FastString
    srcTxt)
        y :: LocatedAn NoEpAnns (HsExpr GhcPs)
        y :: GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    y = HsExpr GhcPs -> GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (HsExpr GhcPs -> GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs))
    -> HsExpr GhcPs -> GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit XOverLitE GhcPs
    NoExtField
    noExtField (HsOverLit GhcPs -> HsExpr GhcPs)
    -> HsOverLit GhcPs -> HsExpr GhcPs
    forall a b. (a -> b) -> a -> b
    $ HsOverLit GhcPs
    ol{ol_val = HsIntegral intLit{il_text = SourceText (fsLit 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 GhcPs) -> SrcSpan
    forall a e. GenLocated (EpAnn a) e -> SrcSpan
    toSSA LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x) [(String
    "a", GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs) -> SrcSpan
    forall a e. GenLocated (EpAnn a) e -> SrcSpan
    toSSA GenLocated (EpAnn NoEpAnns) (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 FastString
    srcTxt) Bool
    _ Rational
    _ Integer
    _ FractionalExponentBase
    _))))) =
      [ String
    -> Located (HsExpr GhcPs)
    -> Located (HsExpr GhcPs)
    -> [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 GhcPs) -> Located (HsExpr GhcPs)
    forall a e b.
    (HasLoc (GenLocated a e), HasAnnotation b) =>
    GenLocated a e -> GenLocated b e
    reLoc LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x) (GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    -> Located (HsExpr GhcPs)
    forall a e b.
    (HasLoc (GenLocated a e), HasAnnotation b) =>
    GenLocated a e -> GenLocated b e
    reLoc GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    y) [Refactoring SrcSpan
    r] | Char
    '_' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` FastString -> String
    unpackFS FastString
    srcTxt, FastString -> String
    unpackFS FastString
    srcTxt String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    underscoredSrcTxt ]
      where
        underscoredSrcTxt :: String
    underscoredSrcTxt = String -> String
    addUnderscore (FastString -> String
    unpackFS FastString
    srcTxt)
        y :: LocatedAn NoEpAnns (HsExpr GhcPs)
        y :: GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    y = HsExpr GhcPs -> GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (HsExpr GhcPs -> GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs))
    -> HsExpr GhcPs -> GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit XOverLitE GhcPs
    NoExtField
    noExtField (HsOverLit GhcPs -> HsExpr GhcPs)
    -> HsOverLit GhcPs -> HsExpr GhcPs
    forall a b. (a -> b) -> a -> b
    $ HsOverLit GhcPs
    ol{ol_val = HsFractional fracLit{fl_text = SourceText (fsLit 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 GhcPs) -> SrcSpan
    forall a e. GenLocated (EpAnn a) e -> SrcSpan
    toSSA LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x) [(String
    "a", GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs) -> SrcSpan
    forall a e. GenLocated (EpAnn a) e -> SrcSpan
    toSSA GenLocated (EpAnn NoEpAnns) (HsExpr GhcPs)
    y)] String
    "a"
    suggestUnderscore LHsExpr GhcPs
    _ = [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 = underscoreFromRight chunkSize $ nl_intPart numLit
                                 , nl_fracPart = underscore chunkSize $ nl_fracPart numLit
                                 , nl_exp = underscoreFromRight 3 $ nl_exp numLit -- Exponential part is always decimal
                                 }
       chunkSize :: Int
    chunkSize = if String -> Bool
    forall a. [a] -> 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
    str
         | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    5 = String
    str
         | Bool
    otherwise = 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 (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    str
       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
    $cshowsPrec :: Int -> NumLiteral -> String -> String
    showsPrec :: Int -> NumLiteral -> String -> String
    $cshow :: NumLiteral -> String
    show :: NumLiteral -> String
    $cshowList :: [NumLiteral] -> String -> String
    showList :: [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
    $c== :: NumLiteral -> NumLiteral -> Bool
    == :: NumLiteral -> NumLiteral -> Bool
    $c/= :: NumLiteral -> NumLiteral -> Bool
    /= :: 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 = "0b"}
      Char
    '0':Char
    'B':String
    digits -> ((Char -> Bool) -> String -> NumLiteral
    afterPrefix Char -> Bool
    isBinDigit String
    digits){nl_prefix = "0B"}
      Char
    '0':Char
    'o':String
    digits -> ((Char -> Bool) -> String -> NumLiteral
    afterPrefix Char -> Bool
    isOctDigit String
    digits){nl_prefix = "0o"}
      Char
    '0':Char
    'O':String
    digits -> ((Char -> Bool) -> String -> NumLiteral
    afterPrefix Char -> Bool
    isOctDigit String
    digits){nl_prefix = "0O"}
      Char
    '0':Char
    'x':String
    digits -> ((Char -> Bool) -> String -> NumLiteral
    afterPrefix Char -> Bool
    isHexDigit String
    digits){nl_prefix = "0x"}
      Char
    '0':Char
    'X':String
    digits -> ((Char -> Bool) -> String -> NumLiteral
    afterPrefix Char -> Bool
    isHexDigit String
    digits){nl_prefix = "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 = 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 = "."}
        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 = 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