{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

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

<TEST>
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
foo = a where {a = 1; b = 2; c = 3}; bar = a where {a = 1; b = 2; c = 3} -- ???
{-# 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>
-}


module Hint.Duplicate(duplicateHint) where

import Hint.Type
import Data.Default
import Data.Tuple.Extra
import Data.List hiding (find)
import qualified Data.Map as Map


duplicateHint :: CrossHint
duplicateHint :: CrossHint
duplicateHint ms :: [(Scope, Module_)]
ms =
    [(String, String, [Stmt S])] -> [Idea]
forall (f :: * -> *).
(Pretty (f SrcSpan), Annotated f, Ord (f ())) =>
[(String, String, [f S])] -> [Idea]
dupes [(String
m,String
d,[Stmt S]
y) | (m :: String
m,d :: String
d,x :: Decl_
x) <- [(String, String, Decl_)]
ds, Do _ y :: [Stmt S]
y :: Exp S <- Decl_ -> [Exp S]
forall from to. Biplate from to => from -> [to]
universeBi Decl_
x] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    [(String, String, [Decl_])] -> [Idea]
forall (f :: * -> *).
(Pretty (f SrcSpan), Annotated f, Ord (f ())) =>
[(String, String, [f S])] -> [Idea]
dupes [(String
m,String
d,[Decl_]
y) | (m :: String
m,d :: String
d,x :: Decl_
x) <- [(String, String, Decl_)]
ds, BDecls _ y :: [Decl_]
y :: Binds S <- Decl_ -> [Binds S]
forall from to. Biplate from to => from -> [to]
universeBi Decl_
x]
    where ds :: [(String, String, Decl_)]
ds = [(Module_ -> String
moduleName Module_
m, Decl_ -> String
forall a. Named a => a -> String
fromNamed Decl_
d, Decl_
d) | Module_
m <- ((Scope, Module_) -> Module_) -> [(Scope, Module_)] -> [Module_]
forall a b. (a -> b) -> [a] -> [b]
map (Scope, Module_) -> Module_
forall a b. (a, b) -> b
snd [(Scope, Module_)]
ms, Decl_
d <- Module_ -> [Decl_]
moduleDecls Module_
m]


dupes :: (Pretty (f SrcSpan), Annotated f, Ord (f ())) => [(String, String, [f S])] -> [Idea]
dupes :: [(String, String, [f S])] -> [Idea]
dupes ys :: [(String, String, [f S])]
ys =
    [(Severity
-> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea
rawIdeaN
        (if [f ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [f ()]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 5 then Severity
Warning else Severity
Suggestion)
        "Reduce duplication" SrcSpan
p1
        ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (f () -> String) -> [f ()] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (f SrcSpan -> String
forall a. Pretty a => a -> String
prettyPrint (f SrcSpan -> String) -> (f () -> f SrcSpan) -> f () -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> SrcSpan) -> f () -> f SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan -> () -> SrcSpan
forall a b. a -> b -> a
const SrcSpan
p1)) [f ()]
xs)
        (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ "Combine with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
showSrcLoc (SrcSpan -> SrcLoc
forall si. SrcInfo si => si -> SrcLoc
getPointLoc SrcSpan
p2)) [])
      {ideaModule :: [String]
ideaModule = [String
m1,String
m2], ideaDecl :: [String]
ideaDecl = [String
d1,String
d2]}
    | ((m1 :: String
m1,d1 :: String
d1,p1 :: SrcSpan
p1),(m2 :: String
m2,d2 :: String
d2,p2 :: SrcSpan
p2),xs :: [f ()]
xs) <- Int
-> [[((String, String, SrcSpan), f ())]]
-> [((String, String, SrcSpan), (String, String, SrcSpan), [f ()])]
forall pos val.
(Ord pos, Default pos, Ord val) =>
Int -> [[(pos, val)]] -> [(pos, pos, [val])]
duplicateOrdered 3 ([[((String, String, SrcSpan), f ())]]
 -> [((String, String, SrcSpan), (String, String, SrcSpan),
      [f ()])])
-> [[((String, String, SrcSpan), f ())]]
-> [((String, String, SrcSpan), (String, String, SrcSpan), [f ()])]
forall a b. (a -> b) -> a -> b
$ ((String, String, [f S]) -> [((String, String, SrcSpan), f ())])
-> [(String, String, [f S])]
-> [[((String, String, SrcSpan), f ())]]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, [f S]) -> [((String, String, SrcSpan), f ())]
forall (f :: * -> *) a b.
Annotated f =>
(a, b, [f S]) -> [((a, b, SrcSpan), f ())]
f [(String, String, [f S])]
ys]
    where
        f :: (a, b, [f S]) -> [((a, b, SrcSpan), f ())]
f (m :: a
m,d :: b
d,xs :: [f S]
xs) = [((a
m,b
d,S -> SrcSpan
srcInfoSpan (S -> SrcSpan) -> S -> SrcSpan
forall a b. (a -> b) -> a -> b
$ f S -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann f S
x), f S -> f ()
forall (f :: * -> *). Functor f => f S -> f ()
dropAnn f S
x) | f S
x <- [f S]
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 :: [val] -> Dupe pos val -> (pos, Int)
find (v :: val
v:vs :: [val]
vs) (Dupe p :: pos
p mp :: Map val (Dupe pos val)
mp) | Just d :: Dupe pos val
d <- val -> Map val (Dupe pos val) -> Maybe (Dupe pos val)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup val
v Map val (Dupe pos val)
mp = (Int -> Int) -> (pos, Int) -> (pos, Int)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) ((pos, Int) -> (pos, Int)) -> (pos, Int) -> (pos, Int)
forall a b. (a -> b) -> a -> b
$ [val] -> Dupe pos val -> (pos, Int)
forall val pos. Ord val => [val] -> Dupe pos val -> (pos, Int)
find [val]
vs Dupe pos val
d
find _ (Dupe p :: pos
p mp :: Map val (Dupe pos val)
mp) = (pos
p, 0)


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


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

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

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