{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
module Hint.Duplicate(duplicateHint) where
import Hint.Type (CrossHint, ModuleEx(..), Idea(..),rawIdeaN',Severity(Suggestion,Warning))
import Data.Data
import Data.Generics.Uniplate.Operations
import Data.Default
import Data.Maybe
import Data.Tuple.Extra
import Data.List hiding (find)
import qualified Data.Map as Map
import SrcLoc
import GHC.Hs
import Outputable
import Bag
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
duplicateHint :: CrossHint
duplicateHint ms =
dupes [ (m, d, y)
| (m, d, x) <- ds
, HsDo _ _ (L _ y) :: HsExpr GhcPs <- universeBi x
] ++
dupes [ (m, d, y)
| (m, d, x) <- ds
, HsValBinds _ (ValBinds _ b _ ) :: HsLocalBinds GhcPs <- universeBi x
, let y = bagToList b
]
where
ds = [(modName m, fromMaybe "" (declName d), unLoc d)
| ModuleEx m _ <- map snd ms
, d <- hsmodDecls (unLoc m)]
dupes :: (Outputable e, Data e) => [(String, String, [Located e])] -> [Idea]
dupes ys =
[(rawIdeaN'
(if length xs >= 5 then Hint.Type.Warning else Suggestion)
"Reduce duplication" p1
(unlines $ map unsafePrettyPrint xs)
(Just $ "Combine with " ++ showSrcSpan' p2)
[]
){ideaModule = [m1, m2], ideaDecl = [d1, d2]}
| ((m1, d1, SrcSpanD p1), (m2, d2, SrcSpanD p2), xs) <- duplicateOrdered 3 $ map f ys]
where
f (m, d, xs) =
[((m, d, SrcSpanD (getLoc x)), extendInstances (stripLocs' x)) | x <- xs]
data Dupe pos val = Dupe pos (Map.Map val (Dupe pos val))
find :: Ord val => [val] -> Dupe pos val -> (pos, Int)
find (v:vs) (Dupe p mp) | Just d <- Map.lookup v mp = second (+1) $ find vs d
find _ (Dupe p mp) = (p, 0)
add :: Ord val => pos -> [val] -> Dupe pos val -> Dupe pos val
add pos [] d = d
add pos (v:vs) (Dupe p mp) = Dupe p $ Map.insertWith f v (add pos vs $ Dupe pos Map.empty) mp
where f new = add pos vs
duplicateOrdered :: forall pos val.
(Ord pos, Default pos, Ord val) => Int -> [[(pos,val)]] -> [(pos,pos,[val])]
duplicateOrdered threshold xs = concat $ concat $ snd $ mapAccumL f (Dupe def Map.empty) xs
where
f :: Dupe pos val -> [(pos, val)] -> (Dupe pos val, [[(pos, pos, [val])]])
f d xs = second overlaps $ mapAccumL (g pos) d $ takeWhile ((>= threshold) . length) $ tails xs
where pos = Map.fromList $ zip (map fst xs) [0..]
g :: Map.Map pos Int -> Dupe pos val -> [(pos, val)] -> (Dupe pos val, [(pos, pos, [val])])
g pos d xs = (d2, res)
where
res = [(p,pme,take mx vs) | i >= threshold
,let mx = maybe i (\x -> min i $ (pos Map.! pme) - x) $ Map.lookup p pos
,mx >= threshold]
vs = map snd xs
(p,i) = find vs d
pme = fst $ head xs
d2 = add pme vs d
overlaps (x@((_,_,n):_):xs) = x : overlaps (drop (length n - 1) xs)
overlaps (x:xs) = x : overlaps xs
overlaps [] = []