{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

{-
Find bindings within a let, and lists of statements
If you have n the same, error out

<TEST_DISABLED_1150>
foo = a where {a = 1; b = 2; c = 3} \
bar = a where {a = 1; b = 2; c = 3} -- ???
main = do a; a; a; a
main = do a; a; a; a; a; a -- ???
main = do a; a; a; a; a; a; a -- ???
main = do (do b; a; a; a); do (do c; a; a; a) -- ???
main = do a; a; a; b; a; a; a -- ???
main = do a; a; a; b; a; a
{-# ANN main "HLint: ignore Reduce duplication" #-}; main = do a; a; a; a; a; a -- @Ignore ???
{-# HLINT ignore main "Reduce duplication" #-}; main = do a; a; a; a; a; a -- @Ignore ???
{- HLINT ignore main "Reduce duplication" -}; main = do a; a; a; a; a; a -- @Ignore ???
</TEST_DISABLED_1150>
-}


module Hint.Duplicate(duplicateHint) where

import Hint.Type (CrossHint, ModuleEx(..), Idea(..),rawIdeaN,Severity(Suggestion,Warning))
import Data.Data
import Data.Generics.Uniplate.DataOnly
import Data.Default
import Data.Maybe
import Data.Tuple.Extra
import Data.List hiding (find)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map

import GHC.Types.SrcLoc
import GHC.Hs
import GHC.Utils.Outputable
import GHC.Data.Bag
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable

duplicateHint :: CrossHint
duplicateHint :: CrossHint
duplicateHint [(Scope, ModuleEx)]
ms =
   -- Do expressions.
   forall e.
(Outputable e, Data e) =>
[(String, String, [LocatedA e])] -> [Idea]
dupes [ (String
m, String
d, [LocatedA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
y)
         | (String
m, String
d, HsDecl GhcPs
x) <- [(String, String, HsDecl GhcPs)]
ds
         , HsDo XDo GhcPs
_ HsDoFlavour
_ (L SrcSpanAnnL
_ [LocatedA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
y) :: HsExpr GhcPs <- forall from to. Biplate from to => from -> [to]
universeBi HsDecl GhcPs
x
         ] forall a. [a] -> [a] -> [a]
++
  -- Bindings in a 'let' expression or a 'where' clause.
   forall e.
(Outputable e, Data e) =>
[(String, String, [LocatedA e])] -> [Idea]
dupes [ (String
m, String
d, [LocatedA (HsBindLR GhcPs GhcPs)]
y)
         | (String
m, String
d, HsDecl GhcPs
x) <- [(String, String, HsDecl GhcPs)]
ds
         , HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
b [LSig GhcPs]
_ ) :: HsLocalBinds GhcPs <- forall from to. Biplate from to => from -> [to]
universeBi HsDecl GhcPs
x
         , let y :: [LocatedA (HsBindLR GhcPs GhcPs)]
y = forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
b
         ]
    where
      ds :: [(String, String, HsDecl GhcPs)]
ds = [(Located (HsModule GhcPs) -> String
modName Located (HsModule GhcPs)
m, forall a. a -> Maybe a -> a
fromMaybe String
"" (LHsDecl GhcPs -> Maybe String
declName GenLocated SrcSpanAnnA (HsDecl GhcPs)
d), forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsDecl GhcPs)
d)
           | ModuleEx Located (HsModule GhcPs)
m <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Scope, ModuleEx)]
ms
           , GenLocated SrcSpanAnnA (HsDecl GhcPs)
d <- forall p. HsModule p -> [LHsDecl p]
hsmodDecls (forall l e. GenLocated l e -> e
unLoc Located (HsModule GhcPs)
m)]

dupes :: (Outputable e, Data e) => [(String, String, [LocatedA e])] -> [Idea]
dupes :: forall e.
(Outputable e, Data e) =>
[(String, String, [LocatedA e])] -> [Idea]
dupes [(String, String, [GenLocated SrcSpanAnnA e])]
ys =
    [(Severity
-> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea
rawIdeaN
        (if forall (t :: * -> *) a. Foldable t => t a -> Int
length [HsExtendInstances (GenLocated SrcSpanAnnA e)]
xs forall a. Ord a => a -> a -> Bool
>= Int
5 then Severity
Hint.Type.Warning else Severity
Suggestion)
        String
"Reduce duplication" SrcSpan
p1
        ([String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> String
unsafePrettyPrint [HsExtendInstances (GenLocated SrcSpanAnnA e)]
xs)
        (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"Combine with " forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
showSrcSpan SrcSpan
p2)
        []
     ){ideaModule :: [String]
ideaModule = [String
m1, String
m2], ideaDecl :: [String]
ideaDecl = [String
d1, String
d2]}
    | ((String
m1, String
d1, SrcSpanD SrcSpan
p1), (String
m2, String
d2, SrcSpanD SrcSpan
p2), [HsExtendInstances (GenLocated SrcSpanAnnA e)]
xs) <- forall pos val.
(Ord pos, Default pos, Ord val) =>
Int -> [[(pos, val)]] -> [(pos, pos, [val])]
duplicateOrdered Int
3 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {e} {a} {b}.
(Data a, Data e) =>
(a, b, [GenLocated (SrcSpanAnn' a) e])
-> [((a, b, SrcSpanD),
     HsExtendInstances (GenLocated (SrcSpanAnn' a) e))]
f [(String, String, [GenLocated SrcSpanAnnA e])]
ys]
    where
      f :: (a, b, [GenLocated (SrcSpanAnn' a) e])
-> [((a, b, SrcSpanD),
     HsExtendInstances (GenLocated (SrcSpanAnn' a) e))]
f (a
m, b
d, [GenLocated (SrcSpanAnn' a) e]
xs) =
        [((a
m, b
d, SrcSpan -> SrcSpanD
SrcSpanD (forall a. SrcSpanAnn' a -> SrcSpan
locA (forall l e. GenLocated l e -> l
getLoc GenLocated (SrcSpanAnn' a) e
x))), forall a. a -> HsExtendInstances a
extendInstances (forall from. Data from => from -> from
stripLocs GenLocated (SrcSpanAnn' a) e
x)) | GenLocated (SrcSpanAnn' a) e
x <- [GenLocated (SrcSpanAnn' a) e]
xs]

---------------------------------------------------------------------
-- DUPLICATE FINDING

-- | The position to return if we match at this point, and the map of where to go next
--   If two runs have the same vals, always use the first pos you find
data Dupe pos val = Dupe pos (Map.Map val (Dupe pos val))


find :: Ord val => [val] -> Dupe pos val -> (pos, Int)
find :: forall val pos. Ord val => [val] -> Dupe pos val -> (pos, Int)
find (val
v:[val]
vs) (Dupe pos
p Map val (Dupe pos val)
mp) | Just Dupe pos val
d <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup val
v Map val (Dupe pos val)
mp = forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (forall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ forall val pos. Ord val => [val] -> Dupe pos val -> (pos, Int)
find [val]
vs Dupe pos val
d
find [val]
_ (Dupe pos
p Map val (Dupe pos val)
mp) = (pos
p, Int
0)


add :: Ord val => pos -> [val] -> Dupe pos val -> Dupe pos val
add :: forall val pos.
Ord val =>
pos -> [val] -> Dupe pos val -> Dupe pos val
add pos
pos [] Dupe pos val
d = Dupe pos val
d
add pos
pos (val
v:[val]
vs) (Dupe pos
p Map val (Dupe pos val)
mp) = forall pos val. pos -> Map val (Dupe pos val) -> Dupe pos val
Dupe pos
p forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall {p}. p -> Dupe pos val -> Dupe pos val
f val
v (forall val pos.
Ord val =>
pos -> [val] -> Dupe pos val -> Dupe pos val
add pos
pos [val]
vs forall a b. (a -> b) -> a -> b
$ forall pos val. pos -> Map val (Dupe pos val) -> Dupe pos val
Dupe pos
pos forall k a. Map k a
Map.empty) Map val (Dupe pos val)
mp
    where f :: p -> Dupe pos val -> Dupe pos val
f p
new = forall val pos.
Ord val =>
pos -> [val] -> Dupe pos val -> Dupe pos val
add pos
pos [val]
vs

duplicateOrdered :: forall pos val.
  (Ord pos, Default pos, Ord val) => Int -> [[(pos,val)]] -> [(pos,pos,[val])]
duplicateOrdered :: forall pos val.
(Ord pos, Default pos, Ord val) =>
Int -> [[(pos, val)]] -> [(pos, pos, [val])]
duplicateOrdered Int
threshold [[(pos, val)]]
xs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Dupe pos val
-> [(pos, val)] -> (Dupe pos val, [[(pos, pos, [val])]])
f (forall pos val. pos -> Map val (Dupe pos val) -> Dupe pos val
Dupe forall a. Default a => a
def forall k a. Map k a
Map.empty) [[(pos, val)]]
xs
    where
        f :: Dupe pos val -> [(pos, val)] -> (Dupe pos val, [[(pos, pos, [val])]])
        f :: Dupe pos val
-> [(pos, val)] -> (Dupe pos val, [[(pos, pos, [val])]])
f Dupe pos val
d [(pos, val)]
xs = forall b b' a. (b -> b') -> (a, b) -> (a, b')
second forall {t :: * -> *} {a} {b} {a}.
Foldable t =>
[[(a, b, t a)]] -> [[(a, b, t a)]]
overlaps forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Map pos Int
-> Dupe pos val
-> NonEmpty (pos, val)
-> (Dupe pos val, [(pos, pos, [val])])
g Map pos Int
pos) Dupe pos val
d forall a b. (a -> b) -> a -> b
$ forall {a}. Int -> [[a]] -> [NonEmpty a]
onlyAtLeast Int
threshold forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
tails [(pos, val)]
xs
            where pos :: Map pos Int
pos = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(pos, val)]
xs) [Int
0..]

        g :: Map.Map pos Int -> Dupe pos val -> NE.NonEmpty (pos, val) -> (Dupe pos val, [(pos, pos, [val])])
        g :: Map pos Int
-> Dupe pos val
-> NonEmpty (pos, val)
-> (Dupe pos val, [(pos, pos, [val])])
g Map pos Int
pos Dupe pos val
d NonEmpty (pos, val)
xs = (Dupe pos val
d2, [(pos, pos, [val])]
res)
            where
                res :: [(pos, pos, [val])]
res = [(pos
p,pos
pme,forall a. Int -> [a] -> [a]
take Int
mx [val]
vs) | Int
i forall a. Ord a => a -> a -> Bool
>= Int
threshold
                      ,let mx :: Int
mx = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
i (\Int
x -> forall a. Ord a => a -> a -> a
min Int
i forall a b. (a -> b) -> a -> b
$ (Map pos Int
pos forall k a. Ord k => Map k a -> k -> a
Map.! pos
pme) forall a. Num a => a -> a -> a
- Int
x) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup pos
p Map pos Int
pos
                      ,Int
mx forall a. Ord a => a -> a -> Bool
>= Int
threshold]
                vs :: [val]
vs = forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (pos, val)
xs
                (pos
p,Int
i) = forall val pos. Ord val => [val] -> Dupe pos val -> (pos, Int)
find [val]
vs Dupe pos val
d
                pme :: pos
pme = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head NonEmpty (pos, val)
xs
                d2 :: Dupe pos val
d2 = forall val pos.
Ord val =>
pos -> [val] -> Dupe pos val -> Dupe pos val
add pos
pme [val]
vs Dupe pos val
d

        onlyAtLeast :: Int -> [[a]] -> [NonEmpty a]
onlyAtLeast Int
n = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a -> b) -> a -> b
$ \[a]
l -> case [a]
l of
           a
x:[a]
xs | forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l forall a. Ord a => a -> a -> Bool
>= Int
n -> forall a. a -> Maybe a
Just (a
x forall a. a -> [a] -> NonEmpty a
NE.:| [a]
xs)
           [a]
_ -> forall a. Maybe a
Nothing

        overlaps :: [[(a, b, t a)]] -> [[(a, b, t a)]]
overlaps (x :: [(a, b, t a)]
x@((a
_,b
_,t a
n):[(a, b, t a)]
_):[[(a, b, t a)]]
xs) = [(a, b, t a)]
x forall a. a -> [a] -> [a]
: [[(a, b, t a)]] -> [[(a, b, t a)]]
overlaps (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
n forall a. Num a => a -> a -> a
- Int
1) [[(a, b, t a)]]
xs)
        overlaps ([(a, b, t a)]
x:[[(a, b, t a)]]
xs) = [(a, b, t a)]
x forall a. a -> [a] -> [a]
: [[(a, b, t a)]] -> [[(a, b, t a)]]
overlaps [[(a, b, t a)]]
xs
        overlaps [] = []