{-# LANGUAGE ViewPatterns #-}
module Hint.Smell (
smellModuleHint,
smellHint
) where
{-
[{smell: { type: many arg functions, limit: 2 }}]
f :: Int -> Int \
f = undefined
f :: Int -> Int -> Int \
f = undefined --
f :: Int -> Int \
f = undefined
f :: Int -> Int -> Int \
f = undefined
[{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
f = do \
x <- y \
return x
f = return x
[{smell: { type: long type lists, limit: 2}}]
f :: Bool -> Int -> (Int -> Proxy '[a, b]) --
f :: Proxy '[a]
f :: Proxy '[a, b]
f :: Proxy '[a]
[{smell: { type: many imports, limit: 2}}]
import A; import B --
import A
import A; import B
import A
-}
import Hint.Type
import Config.Type
import Data.List.Extra
import qualified Data.Map as Map
smellModuleHint :: [Setting] -> ModuHint
smellModuleHint settings scope (moduleImports . hseModule -> imports) = case Map.lookup SmellManyImports (smells settings) of
Just n | length imports >= n ->
let span = foldl1 mergeSrcSpan $ srcInfoSpan . ann <$> imports
displayImports = unlines $ f <$> imports
in [rawIdea Warning "Many imports" span displayImports Nothing [] [] ]
where
f = trimStart . prettyPrint
_ -> []
smellHint :: [Setting] -> DeclHint
smellHint settings scope m d =
sniff smellLongFunctions SmellLongFunctions ++
sniff smellLongTypeLists SmellLongTypeLists ++
sniff smellManyArgFunctions SmellManyArgFunctions
where
sniff f t = fmap (\i -> i {ideaTo = Nothing }) . take 1 $ maybe [] (f d) $ Map.lookup t (smells settings)
smellLongFunctions :: Decl_ -> Int -> [Idea]
smellLongFunctions d n = [ idea
| (span, idea) <- declSpans d
, spanLength span >= n
]
declSpans :: Decl_ -> [(SrcSpanInfo, Idea)]
declSpans (FunBind _ [Match _ _ _ rhs where_]) = rhsSpans rhs ++ whereSpans where_
declSpans f@(FunBind l match) = [(l, warn "Long function" f f [])] -- count where clauses
declSpans (PatBind _ _ rhs where_) = rhsSpans rhs ++ whereSpans where_
declSpans _ = []
whereSpans :: Maybe (Binds SrcSpanInfo) -> [(SrcSpanInfo, Idea)]
whereSpans (Just (BDecls _ decls)) = concatMap declSpans decls
whereSpans _ = []
rhsSpans :: Rhs SrcSpanInfo -> [(SrcSpanInfo, Idea)]
rhsSpans (UnGuardedRhs l RecConstr{}) = [] --- record constructors get a pass
rhsSpans r@(UnGuardedRhs l _) = [(l, warn "Long function" r r [])]
rhsSpans r@(GuardedRhss l _) = [(l, warn "Long function" r r [])]
spanLength :: SrcSpanInfo -> Int
spanLength (SrcSpanInfo span _) = srcSpanEndLine span - srcSpanStartLine span + 1
smellLongTypeLists :: Decl_ -> Int -> [Idea]
smellLongTypeLists d@(TypeSig _ _ t) n = warn "Long type list" d d [] <$ filter longTypeList (universe t)
where
longTypeList (TyPromoted _ (PromotedList _ _ x)) = length x >= n
longTypeList _ = False
smellLongTypeLists _ _ = []
smellManyArgFunctions :: Decl_ -> Int -> [Idea]
smellManyArgFunctions d@(TypeSig _ _ t) n = warn "Many arg function" d d [] <$ filter manyArgFunction (universe t)
where
manyArgFunction x = countFunctionArgs x >= n
smellManyArgFunctions _ _ = []
countFunctionArgs :: Type l -> Int
countFunctionArgs (TyFun _ _ b) = 1 + countFunctionArgs b
countFunctionArgs (TyParen _ t) = countFunctionArgs t
countFunctionArgs _ = 0
smells :: [Setting] -> Map.Map SmellType Int
smells settings = Map.fromList [ (smellType, smellLimit) | SettingSmell smellType smellLimit <- settings]