{-# LANGUAGE ViewPatterns #-}

module Hint.Smell (
  smellModuleHint,
  smellHint
  ) where

{-
<TEST> [{smell: { type: many arg functions, limit: 2 }}]
f :: Int -> Int \
f = undefined

f :: Int -> Int -> Int \
f = undefined --
</TEST>

<TEST>
f :: Int -> Int \
f = undefined

f :: Int -> Int -> Int \
f = undefined
</TEST>

<TEST> [{smell: { type: long functions, limit: 3}}]
f = do \
 x <- y \
 return x --

f = do \
  return z \
\
  where \
   z = do \
    a \
    b --

f = do \
  return z \
\
  where \
   z = a

f = Con \
  { a = x \
  , b = y \
  , c = z \
  }

f = return x
</TEST>

<TEST>
f = do \
 x <- y \
 return x

f = return x
</TEST>

<TEST> [{smell: { type: long type lists, limit: 2}}]
f :: Bool -> Int -> (Int -> Proxy '[a, b]) --
f :: Proxy '[a]
</TEST>

<TEST>
f :: Proxy '[a, b]
f :: Proxy '[a]
</TEST>

<TEST> [{smell: { type: many imports, limit: 2}}]
import A; import B --
import A
</TEST>

<TEST>
import A; import B
import A
</TEST>
-}

import Hint.Type
import Config.Type
import Data.List.Extra
import qualified Data.Map as Map

smellModuleHint :: [Setting] -> ModuHint
smellModuleHint :: [Setting] -> ModuHint
smellModuleHint settings :: [Setting]
settings scope :: Scope
scope m :: Module_
m@(Module_ -> [ImportDecl S]
moduleImports -> [ImportDecl S]
imports) = case SmellType -> Map SmellType Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SmellType
SmellManyImports ([Setting] -> Map SmellType Int
smells [Setting]
settings) of
  Just n :: Int
n | [ImportDecl S] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ImportDecl S]
imports Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n ->
           let span :: SrcSpan
span = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SrcSpan -> SrcSpan -> SrcSpan
mergeSrcSpan ([SrcSpan] -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a b. (a -> b) -> a -> b
$ S -> SrcSpan
srcInfoSpan (S -> SrcSpan) -> (ImportDecl S -> S) -> ImportDecl S -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl S -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann (ImportDecl S -> SrcSpan) -> [ImportDecl S] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportDecl S]
imports
               displayImports :: String
displayImports = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ImportDecl S -> String
f (ImportDecl S -> String) -> [ImportDecl S] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportDecl S]
imports
           in [Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Warning "Many imports" SrcSpan
span String
displayImports  Maybe String
forall a. Maybe a
Nothing [] [] ]
    where
      f :: ImportDecl S -> String
f = String -> String
trimStart (String -> String)
-> (ImportDecl S -> String) -> ImportDecl S -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl S -> String
forall a. Pretty a => a -> String
prettyPrint
  _ -> []

smellHint :: [Setting] -> DeclHint
smellHint :: [Setting] -> DeclHint
smellHint settings :: [Setting]
settings scope :: Scope
scope m :: Module_
m d :: Decl_
d =
  (Decl_ -> Int -> [Idea]) -> SmellType -> [Idea]
sniff Decl_ -> Int -> [Idea]
smellLongFunctions SmellType
SmellLongFunctions [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  (Decl_ -> Int -> [Idea]) -> SmellType -> [Idea]
sniff Decl_ -> Int -> [Idea]
smellLongTypeLists SmellType
SmellLongTypeLists [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  (Decl_ -> Int -> [Idea]) -> SmellType -> [Idea]
sniff Decl_ -> Int -> [Idea]
smellManyArgFunctions SmellType
SmellManyArgFunctions
  where
    sniff :: (Decl_ -> Int -> [Idea]) -> SmellType -> [Idea]
sniff f :: Decl_ -> Int -> [Idea]
f t :: SmellType
t = (Idea -> Idea) -> [Idea] -> [Idea]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\i :: Idea
i -> Idea
i {ideaTo :: Maybe String
ideaTo = Maybe String
forall a. Maybe a
Nothing }) ([Idea] -> [Idea]) -> ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Idea] -> [Idea]
forall a. Int -> [a] -> [a]
take 1 ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ [Idea] -> (Int -> [Idea]) -> Maybe Int -> [Idea]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Decl_ -> Int -> [Idea]
f Decl_
d) (Maybe Int -> [Idea]) -> Maybe Int -> [Idea]
forall a b. (a -> b) -> a -> b
$ SmellType -> Map SmellType Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SmellType
t ([Setting] -> Map SmellType Int
smells [Setting]
settings)

smellLongFunctions :: Decl_ -> Int -> [Idea]
smellLongFunctions :: Decl_ -> Int -> [Idea]
smellLongFunctions d :: Decl_
d n :: Int
n = [ Idea
idea
                         | (span :: S
span, idea :: Idea
idea) <- Decl_ -> [(S, Idea)]
declSpans Decl_
d
                         , S -> Int
spanLength S
span Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
                         ]

declSpans :: Decl_ -> [(SrcSpanInfo, Idea)]
declSpans :: Decl_ -> [(S, Idea)]
declSpans (FunBind _ [Match _ _ _ rhs :: Rhs S
rhs where_ :: Maybe (Binds S)
where_]) = Rhs S -> [(S, Idea)]
rhsSpans Rhs S
rhs [(S, Idea)] -> [(S, Idea)] -> [(S, Idea)]
forall a. [a] -> [a] -> [a]
++ Maybe (Binds S) -> [(S, Idea)]
whereSpans Maybe (Binds S)
where_
declSpans f :: Decl_
f@(FunBind  l :: S
l match :: [Match S]
match)         = [(S
l, String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Long function" Decl_
f Decl_
f [])] -- count where clauses
declSpans (PatBind _ _ rhs :: Rhs S
rhs where_ :: Maybe (Binds S)
where_) = Rhs S -> [(S, Idea)]
rhsSpans Rhs S
rhs [(S, Idea)] -> [(S, Idea)] -> [(S, Idea)]
forall a. [a] -> [a] -> [a]
++ Maybe (Binds S) -> [(S, Idea)]
whereSpans Maybe (Binds S)
where_
declSpans _                          = []

whereSpans :: Maybe (Binds SrcSpanInfo) ->  [(SrcSpanInfo, Idea)]
whereSpans :: Maybe (Binds S) -> [(S, Idea)]
whereSpans (Just (BDecls _ decls :: [Decl_]
decls)) = (Decl_ -> [(S, Idea)]) -> [Decl_] -> [(S, Idea)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl_ -> [(S, Idea)]
declSpans [Decl_]
decls
whereSpans _ = []

rhsSpans :: Rhs SrcSpanInfo -> [(SrcSpanInfo, Idea)]
rhsSpans :: Rhs S -> [(S, Idea)]
rhsSpans (UnGuardedRhs l :: S
l RecConstr{}) = [] --- record constructors get a pass
rhsSpans r :: Rhs S
r@(UnGuardedRhs l :: S
l _) = [(S
l, String -> Rhs S -> Rhs S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Long function" Rhs S
r Rhs S
r [])]
rhsSpans r :: Rhs S
r@(GuardedRhss l :: S
l _) = [(S
l, String -> Rhs S -> Rhs S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Long function" Rhs S
r Rhs S
r [])]

spanLength :: SrcSpanInfo -> Int
spanLength :: S -> Int
spanLength (SrcSpanInfo span :: SrcSpan
span _) = SrcSpan -> Int
srcSpanEndLine SrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
- SrcSpan -> Int
srcSpanStartLine SrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1

smellLongTypeLists :: Decl_ -> Int -> [Idea]
smellLongTypeLists :: Decl_ -> Int -> [Idea]
smellLongTypeLists d :: Decl_
d@(TypeSig _ _ t :: Type S
t) n :: Int
n = String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Long type list" Decl_
d Decl_
d [] Idea -> [Type S] -> [Idea]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Type S -> Bool) -> [Type S] -> [Type S]
forall a. (a -> Bool) -> [a] -> [a]
filter Type S -> Bool
forall l. Type l -> Bool
longTypeList (Type S -> [Type S]
forall on. Uniplate on => on -> [on]
universe Type S
t)
  where
    longTypeList :: Type l -> Bool
longTypeList (TyPromoted _ (PromotedList _ _ x :: [Type l]
x)) = [Type l] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type l]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
    longTypeList _ = Bool
False
smellLongTypeLists _ _ = []

smellManyArgFunctions :: Decl_ -> Int -> [Idea]
smellManyArgFunctions :: Decl_ -> Int -> [Idea]
smellManyArgFunctions d :: Decl_
d@(TypeSig _ _ t :: Type S
t) n :: Int
n = String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
String -> ast S -> a -> [Refactoring SrcSpan] -> Idea
warn "Many arg function" Decl_
d Decl_
d [] Idea -> [Type S] -> [Idea]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  (Type S -> Bool) -> [Type S] -> [Type S]
forall a. (a -> Bool) -> [a] -> [a]
filter Type S -> Bool
forall l. Type l -> Bool
manyArgFunction (Type S -> [Type S]
forall on. Uniplate on => on -> [on]
universe Type S
t)
  where
    manyArgFunction :: Type l -> Bool
manyArgFunction x :: Type l
x = Type l -> Int
forall l. Type l -> Int
countFunctionArgs Type l
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
smellManyArgFunctions _ _ = []

countFunctionArgs :: Type l -> Int
countFunctionArgs :: Type l -> Int
countFunctionArgs (TyFun _ _ b :: Type l
b) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Type l -> Int
forall l. Type l -> Int
countFunctionArgs Type l
b
countFunctionArgs (TyParen _ t :: Type l
t) = Type l -> Int
forall l. Type l -> Int
countFunctionArgs Type l
t
countFunctionArgs _ = 0

smells :: [Setting] -> Map.Map SmellType Int
smells :: [Setting] -> Map SmellType Int
smells settings :: [Setting]
settings = [(SmellType, Int)] -> Map SmellType Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (SmellType
smellType, Int
smellLimit) | SettingSmell smellType :: SmellType
smellType smellLimit :: Int
smellLimit  <- [Setting]
settings]