{-# 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 qualified Data.List.NonEmpty as NE
import qualified Data.Map 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.
   [(String, String, [Located (StmtLR GhcPs GhcPs (LHsExpr GhcPs))])]
-> [Idea]
forall e.
(Outputable e, Data e) =>
[(String, String, [Located e])] -> [Idea]
dupes [ (String
m, String
d, [Located (StmtLR GhcPs GhcPs (LHsExpr GhcPs))]
y)
         | (String
m, String
d, HsDecl GhcPs
x) <- [(String, String, HsDecl GhcPs)]
ds
         , HsDo XDo GhcPs
_ HsStmtContext GhcRn
_ (L SrcSpan
_ [Located (StmtLR GhcPs GhcPs (LHsExpr GhcPs))]
y) :: HsExpr GhcPs <- HsDecl GhcPs -> [HsExpr GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi HsDecl GhcPs
x
         ] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  -- Bindings in a 'let' expression or a 'where' clause.
   [(String, String, [Located (HsBindLR GhcPs GhcPs)])] -> [Idea]
forall e.
(Outputable e, Data e) =>
[(String, String, [Located e])] -> [Idea]
dupes [ (String
m, String
d, [Located (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 <- HsDecl GhcPs -> [HsLocalBinds GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi HsDecl GhcPs
x
         , let y :: [Located (HsBindLR GhcPs GhcPs)]
y = LHsBindsLR GhcPs GhcPs -> [Located (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
b
         ]
    where
      ds :: [(String, String, HsDecl GhcPs)]
ds = [(Located HsModule -> String
modName Located HsModule
m, String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (LHsDecl GhcPs -> Maybe String
declName LHsDecl GhcPs
d), LHsDecl GhcPs -> HsDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LHsDecl GhcPs
d)
           | ModuleEx Located HsModule
m ApiAnns
_ <- ((Scope, ModuleEx) -> ModuleEx)
-> [(Scope, ModuleEx)] -> [ModuleEx]
forall a b. (a -> b) -> [a] -> [b]
map (Scope, ModuleEx) -> ModuleEx
forall a b. (a, b) -> b
snd [(Scope, ModuleEx)]
ms
           , LHsDecl GhcPs
d <- HsModule -> [LHsDecl GhcPs]
hsmodDecls (Located HsModule -> HsModule
forall l e. GenLocated l e -> e
unLoc Located HsModule
m)]

dupes :: (Outputable e, Data e) => [(String, String, [Located e])] -> [Idea]
dupes :: [(String, String, [Located e])] -> [Idea]
dupes [(String, String, [Located e])]
ys =
    [(Severity
-> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea
rawIdeaN
        (if [HsExtendInstances (Located e)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HsExtendInstances (Located e)]
xs Int -> Int -> Bool
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 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (HsExtendInstances (Located e) -> String)
-> [HsExtendInstances (Located e)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map HsExtendInstances (Located e) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint [HsExtendInstances (Located e)]
xs)
        (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Combine with " String -> String -> String
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 (Located e)]
xs) <- Int
-> [[((String, String, SrcSpanD), HsExtendInstances (Located e))]]
-> [((String, String, SrcSpanD), (String, String, SrcSpanD),
     [HsExtendInstances (Located e)])]
forall pos val.
(Ord pos, Default pos, Ord val) =>
Int -> [[(pos, val)]] -> [(pos, pos, [val])]
duplicateOrdered Int
3 ([[((String, String, SrcSpanD), HsExtendInstances (Located e))]]
 -> [((String, String, SrcSpanD), (String, String, SrcSpanD),
      [HsExtendInstances (Located e)])])
-> [[((String, String, SrcSpanD), HsExtendInstances (Located e))]]
-> [((String, String, SrcSpanD), (String, String, SrcSpanD),
     [HsExtendInstances (Located e)])]
forall a b. (a -> b) -> a -> b
$ ((String, String, [Located e])
 -> [((String, String, SrcSpanD), HsExtendInstances (Located e))])
-> [(String, String, [Located e])]
-> [[((String, String, SrcSpanD), HsExtendInstances (Located e))]]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, [Located e])
-> [((String, String, SrcSpanD), HsExtendInstances (Located e))]
forall e a b.
Data e =>
(a, b, [GenLocated SrcSpan e])
-> [((a, b, SrcSpanD), HsExtendInstances (GenLocated SrcSpan e))]
f [(String, String, [Located e])]
ys]
    where
      f :: (a, b, [GenLocated SrcSpan e])
-> [((a, b, SrcSpanD), HsExtendInstances (GenLocated SrcSpan e))]
f (a
m, b
d, [GenLocated SrcSpan e]
xs) =
        [((a
m, b
d, SrcSpan -> SrcSpanD
SrcSpanD (GenLocated SrcSpan e -> SrcSpan
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpan e
x)), GenLocated SrcSpan e -> HsExtendInstances (GenLocated SrcSpan e)
forall a. a -> HsExtendInstances a
extendInstances (GenLocated SrcSpan e -> GenLocated SrcSpan e
forall from. Data from => from -> from
stripLocs GenLocated SrcSpan e
x)) | GenLocated SrcSpan e
x <- [GenLocated SrcSpan 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 :: [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 <- 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
+Int
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 [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 :: 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) = 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 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 :: forall pos val.
  (Ord pos, Default pos, Ord val) => Int -> [[(pos,val)]] -> [(pos,pos,[val])]
duplicateOrdered :: Int -> [[(pos, val)]] -> [(pos, pos, [val])]
duplicateOrdered Int
threshold [[(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])]])
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 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 = ([[(pos, pos, [val])]] -> [[(pos, pos, [val])]])
-> (Dupe pos val, [[(pos, pos, [val])]])
-> (Dupe pos val, [[(pos, pos, [val])]])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second [[(pos, pos, [val])]] -> [[(pos, pos, [val])]]
forall (t :: * -> *) a b a.
Foldable t =>
[[(a, b, t a)]] -> [[(a, b, t a)]]
overlaps ((Dupe pos val, [[(pos, pos, [val])]])
 -> (Dupe pos val, [[(pos, pos, [val])]]))
-> (Dupe pos val, [[(pos, pos, [val])]])
-> (Dupe pos val, [[(pos, pos, [val])]])
forall a b. (a -> b) -> a -> b
$ (Dupe pos val
 -> NonEmpty (pos, val) -> (Dupe pos val, [(pos, pos, [val])]))
-> Dupe pos val
-> [NonEmpty (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 (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)] -> (Dupe pos val, [[(pos, pos, [val])]]))
-> [NonEmpty (pos, val)] -> (Dupe pos val, [[(pos, pos, [val])]])
forall a b. (a -> b) -> a -> b
$ Int -> [[(pos, val)]] -> [NonEmpty (pos, val)]
forall a. Int -> [[a]] -> [NonEmpty a]
onlyAtLeast Int
threshold ([[(pos, val)]] -> [NonEmpty (pos, val)])
-> [[(pos, val)]] -> [NonEmpty (pos, val)]
forall a b. (a -> b) -> a -> b
$ [(pos, val)] -> [[(pos, val)]]
forall a. [a] -> [[a]]
tails [(pos, val)]
xs
            where pos :: Map pos Int
pos = [(pos, Int)] -> Map pos Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(pos, Int)] -> Map pos Int) -> [(pos, Int)] -> Map pos Int
forall a b. (a -> b) -> a -> b
$ [pos] -> [Int] -> [(pos, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((pos, val) -> pos) -> [(pos, val)] -> [pos]
forall a b. (a -> b) -> [a] -> [b]
map (pos, val) -> pos
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,Int -> [val] -> [val]
forall a. Int -> [a] -> [a]
take Int
mx [val]
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 (\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 pos Int
pos Map pos Int -> pos -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! pos
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
$ pos -> Map pos Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup pos
p Map pos Int
pos
                      ,Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
threshold]
                vs :: [val]
vs = NonEmpty val -> [val]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty val -> [val]) -> NonEmpty val -> [val]
forall a b. (a -> b) -> a -> b
$ (pos, val) -> val
forall a b. (a, b) -> b
snd ((pos, val) -> val) -> NonEmpty (pos, val) -> NonEmpty val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (pos, val)
xs
                (pos
p,Int
i) = [val] -> Dupe pos val -> (pos, Int)
forall val pos. Ord val => [val] -> Dupe pos val -> (pos, Int)
find [val]
vs Dupe pos val
d
                pme :: pos
pme = (pos, val) -> pos
forall a b. (a, b) -> a
fst ((pos, val) -> pos) -> (pos, val) -> pos
forall a b. (a -> b) -> a -> b
$ NonEmpty (pos, val) -> (pos, val)
forall a. NonEmpty a -> a
NE.head NonEmpty (pos, val)
xs
                d2 :: Dupe pos val
d2 = pos -> [val] -> Dupe pos val -> Dupe pos val
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 = ([a] -> Maybe (NonEmpty a)) -> [[a]] -> [NonEmpty a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (([a] -> Maybe (NonEmpty a)) -> [[a]] -> [NonEmpty a])
-> ([a] -> Maybe (NonEmpty a)) -> [[a]] -> [NonEmpty a]
forall a b. (a -> b) -> a -> b
$ \[a]
l -> case [a]
l of
           a
x:[a]
xs | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n -> NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NE.:| [a]
xs)
           [a]
_ -> Maybe (NonEmpty 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 [(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
- Int
1) [[(a, b, t a)]]
xs)
        overlaps ([(a, b, t a)]
x:[[(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 [] = []