{-# LANGUAGE ImportQualifiedPost #-}

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(ModuHint,ModuleEx(..),DeclHint,Idea(..),rawIdea,warn)
import Config.Type

import Data.Generics.Uniplate.DataOnly
import Data.List.Extra
import Data.Map qualified as Map

import GHC.Utils.Outputable
import GHC.Types.Basic
import GHC.Hs
import GHC.Data.Bag
import GHC.Types.SrcLoc
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable

smellModuleHint :: [Setting] -> ModuHint
smellModuleHint :: [Setting] -> ModuHint
smellModuleHint [Setting]
settings Scope
scope ModuleEx
m =
  let (L SrcSpan
_ HsModule GhcPs
mod) = ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule ModuleEx
m
      imports :: [LImportDecl GhcPs]
imports = HsModule GhcPs -> [LImportDecl GhcPs]
forall p. HsModule p -> [LImportDecl p]
hsmodImports HsModule GhcPs
mod in
  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 Int
n | [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
imports Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n ->
             let span :: SrcSpan
span = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans ([SrcSpan] -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan)
-> (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
    -> SrcSpanAnn' (EpAnn AnnListItem))
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
-> SrcSpanAnn' (EpAnn AnnListItem)
forall l e. GenLocated l e -> l
getLoc (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
 -> SrcSpan)
-> [GenLocated
      (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
-> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
imports
                 displayImports :: String
displayImports = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ LImportDecl GhcPs -> String
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
-> String
f (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
 -> String)
-> [GenLocated
      (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
-> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)]
imports
             in [Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Config.Type.Warning String
"Many imports" SrcSpan
span String
displayImports  Maybe String
forall a. Maybe a
Nothing [] [] ]
      where
        f :: LImportDecl GhcPs -> String
        f :: LImportDecl GhcPs -> String
f = String -> String
trimStart (String -> String)
-> (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
    -> String)
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (ImportDecl GhcPs)
-> String
forall a. Outputable a => a -> String
unsafePrettyPrint
    Maybe Int
_ -> []

smellHint :: [Setting] -> DeclHint
smellHint :: [Setting] -> DeclHint
smellHint [Setting]
settings Scope
scope ModuleEx
m LHsDecl GhcPs
d =
  (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
 -> Int -> [Idea])
-> SmellType -> [Idea]
sniff LHsDecl GhcPs -> Int -> [Idea]
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Int -> [Idea]
smellLongFunctions SmellType
SmellLongFunctions [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
 -> Int -> [Idea])
-> SmellType -> [Idea]
sniff LHsDecl GhcPs -> Int -> [Idea]
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Int -> [Idea]
smellLongTypeLists SmellType
SmellLongTypeLists [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
  (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
 -> Int -> [Idea])
-> SmellType -> [Idea]
sniff LHsDecl GhcPs -> Int -> [Idea]
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Int -> [Idea]
smellManyArgFunctions SmellType
SmellManyArgFunctions
  where
    sniff :: (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
 -> Int -> [Idea])
-> SmellType -> [Idea]
sniff GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Int -> [Idea]
f SmellType
t = (Idea -> Idea) -> [Idea] -> [Idea]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Idea
i -> Idea
i {ideaTo = 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 Int
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 [] (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Int -> [Idea]
f LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
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 :: LHsDecl GhcPs -> Int -> [Idea]
smellLongFunctions :: LHsDecl GhcPs -> Int -> [Idea]
smellLongFunctions LHsDecl GhcPs
d Int
n = [ Idea
idea
                         | (SrcSpan
span, Idea
idea) <- LHsDecl GhcPs -> [(SrcSpan, Idea)]
declSpans LHsDecl GhcPs
d
                         , SrcSpan -> Int
spanLength SrcSpan
span Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
                         ]

-- I've tried to be faithful to the original here but I'm doubtful
-- about it. I think I've replicated the behavior of the original but
-- is the original correctly honoring the intent?

-- A function with with one alternative, one rhs and its 'where'
-- clause (perhaps we should be looping over alts and all guarded
-- right hand sides?)
declSpans :: LHsDecl GhcPs -> [(SrcSpan, Idea)]
declSpans :: LHsDecl GhcPs -> [(SrcSpan, Idea)]
declSpans
   (L SrcSpanAnn' (EpAnn AnnListItem)
_ (ValD XValD GhcPs
_
     FunBind {fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches=MG {
                   mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext=XMG GhcPs (LHsExpr GhcPs)
Origin
FromSource
                 , mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts=(L SrcSpanAnnL
_ [L SrcSpanAnn' (EpAnn AnnListItem)
_ Match {
                       m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ctxt=HsMatchContext GhcPs
ctx
                     , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss=GRHSs{grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs=[LGRHS
  GhcPs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs))
locGrhs]
                                 , grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds=HsLocalBinds GhcPs
where_}}])}})) =
 -- The span of the right hand side and the spans of each binding in
 -- the where clause.
 HsMatchContext GhcPs
-> LGRHS GhcPs (LHsExpr GhcPs) -> [(SrcSpan, Idea)]
rhsSpans HsMatchContext GhcPs
ctx LGRHS GhcPs (LHsExpr GhcPs)
LGRHS
  GhcPs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs))
locGrhs [(SrcSpan, Idea)] -> [(SrcSpan, Idea)] -> [(SrcSpan, Idea)]
forall a. [a] -> [a] -> [a]
++ HsLocalBinds GhcPs -> [(SrcSpan, Idea)]
whereSpans HsLocalBinds GhcPs
where_
-- Any other kind of function.
declSpans f :: LHsDecl GhcPs
f@(L SrcSpanAnn' (EpAnn AnnListItem)
l (ValD XValD GhcPs
_ FunBind {})) = [(SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
l, String
-> Located (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Long function" (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
f) (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
f) [])]
declSpans LHsDecl GhcPs
_ = []

-- The span of a guarded right hand side.
rhsSpans :: HsMatchContext GhcPs -> LGRHS GhcPs (LHsExpr GhcPs) -> [(SrcSpan, Idea)]
rhsSpans :: HsMatchContext GhcPs
-> LGRHS GhcPs (LHsExpr GhcPs) -> [(SrcSpan, Idea)]
rhsSpans HsMatchContext GhcPs
_ (L SrcAnn NoEpAnns
_ (GRHS XCGRHS
  GhcPs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs))
_ [GuardLStmt GhcPs]
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ RecordCon {}))) = [] -- record constructors get a pass
rhsSpans HsMatchContext GhcPs
ctx (L SrcAnn NoEpAnns
_ r :: GRHS
  GhcPs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs))
r@(GRHS XCGRHS
  GhcPs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs))
_ [GuardLStmt GhcPs]
_ (L SrcSpanAnn' (EpAnn AnnListItem)
l HsExpr GhcPs
_))) =
  [(SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
l, Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Config.Type.Warning String
"Long function" (SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
l) (SDoc -> String
showSDocUnsafe (HsMatchContext GhcPs
-> GRHS
     GhcPs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs))
-> SDoc
forall (idR :: Pass) body passL.
(OutputableBndrId idR, Outputable body) =>
HsMatchContext passL -> GRHS (GhcPass idR) body -> SDoc
pprGRHS HsMatchContext GhcPs
ctx GRHS
  GhcPs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsExpr GhcPs))
r)) Maybe String
forall a. Maybe a
Nothing [] [])]

-- The spans of a 'where' clause are the spans of its bindings.
whereSpans :: HsLocalBinds GhcPs -> [(SrcSpan, Idea)]
whereSpans :: HsLocalBinds GhcPs -> [(SrcSpan, Idea)]
whereSpans (HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
bs [LSig GhcPs]
_)) =
  (GenLocated
   (SrcSpanAnn' (EpAnn AnnListItem)) (HsBindLR GhcPs GhcPs)
 -> [(SrcSpan, Idea)])
-> [GenLocated
      (SrcSpanAnn' (EpAnn AnnListItem)) (HsBindLR GhcPs GhcPs)]
-> [(SrcSpan, Idea)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LHsDecl GhcPs -> [(SrcSpan, Idea)]
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> [(SrcSpan, Idea)]
declSpans (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
 -> [(SrcSpan, Idea)])
-> (GenLocated
      (SrcSpanAnn' (EpAnn AnnListItem)) (HsBindLR GhcPs GhcPs)
    -> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs))
-> GenLocated
     (SrcSpanAnn' (EpAnn AnnListItem)) (HsBindLR GhcPs GhcPs)
-> [(SrcSpan, Idea)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(L SrcSpanAnn' (EpAnn AnnListItem)
loc HsBindLR GhcPs GhcPs
bind) -> SrcSpanAnn' (EpAnn AnnListItem)
-> HsDecl GhcPs
-> GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnListItem)
loc (XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
NoExtField
noExtField HsBindLR GhcPs GhcPs
bind))) (Bag
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnListItem)) (HsBindLR GhcPs GhcPs))
-> [GenLocated
      (SrcSpanAnn' (EpAnn AnnListItem)) (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
Bag
  (GenLocated
     (SrcSpanAnn' (EpAnn AnnListItem)) (HsBindLR GhcPs GhcPs))
bs)
whereSpans HsLocalBinds GhcPs
_ = []

spanLength :: SrcSpan -> Int
spanLength :: SrcSpan -> Int
spanLength (RealSrcSpan RealSrcSpan
span Maybe BufSpan
_) = RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
spanLength (UnhelpfulSpan UnhelpfulSpanReason
_) = -Int
1

smellLongTypeLists :: LHsDecl GhcPs -> Int -> [Idea]
smellLongTypeLists :: LHsDecl GhcPs -> Int -> [Idea]
smellLongTypeLists d :: LHsDecl GhcPs
d@(L SrcSpanAnn' (EpAnn AnnListItem)
_ (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ (HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsSig XHsSig GhcPs
_ HsOuterSigTyVarBndrs GhcPs
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ HsType GhcPs
t))))))) Int
n =
  String
-> Located (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Long type list" (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
d) (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
d) [] Idea -> [HsType GhcPs] -> [Idea]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (HsType GhcPs -> Bool) -> [HsType GhcPs] -> [HsType GhcPs]
forall a. (a -> Bool) -> [a] -> [a]
filter HsType GhcPs -> Bool
forall {pass}. HsType pass -> Bool
longTypeList (HsType GhcPs -> [HsType GhcPs]
forall on. Uniplate on => on -> [on]
universe HsType GhcPs
t)
  where
    longTypeList :: HsType pass -> Bool
longTypeList (HsExplicitListTy XExplicitListTy pass
_ PromotionFlag
IsPromoted [LHsType pass]
x) = [LHsType pass] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsType pass]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
    longTypeList HsType pass
_ = Bool
False
smellLongTypeLists LHsDecl GhcPs
_ Int
_ = []

smellManyArgFunctions :: LHsDecl GhcPs -> Int -> [Idea]
smellManyArgFunctions :: LHsDecl GhcPs -> Int -> [Idea]
smellManyArgFunctions d :: LHsDecl GhcPs
d@(L SrcSpanAnn' (EpAnn AnnListItem)
_ (SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [LIdP GhcPs]
_ (HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ (HsSig XHsSig GhcPs
_ HsOuterSigTyVarBndrs GhcPs
_ (L SrcSpanAnn' (EpAnn AnnListItem)
_ HsType GhcPs
t))))))) Int
n =
  String
-> Located (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Many arg function" (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
d) (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
-> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsDecl GhcPs)
d) [] Idea -> [HsType GhcPs] -> [Idea]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  (HsType GhcPs -> Bool) -> [HsType GhcPs] -> [HsType GhcPs]
forall a. (a -> Bool) -> [a] -> [a]
filter HsType GhcPs -> Bool
manyArgFunction (HsType GhcPs -> [HsType GhcPs]
forall on. Uniplate on => on -> [on]
universe HsType GhcPs
t)
  where
    manyArgFunction :: HsType GhcPs -> Bool
manyArgFunction HsType GhcPs
t = HsType GhcPs -> Int
countFunctionArgs HsType GhcPs
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
smellManyArgFunctions LHsDecl GhcPs
_ Int
_ = []

countFunctionArgs :: HsType GhcPs -> Int
countFunctionArgs :: HsType GhcPs -> Int
countFunctionArgs (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
_ LHsType GhcPs
t) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HsType GhcPs -> Int
countFunctionArgs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
-> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
t)
countFunctionArgs (HsParTy XParTy GhcPs
_ LHsType GhcPs
t) = HsType GhcPs -> Int
countFunctionArgs (GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
-> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcPs)
t)
countFunctionArgs HsType GhcPs
_ = Int
0

smells :: [Setting] -> Map.Map SmellType Int
smells :: [Setting] -> Map SmellType Int
smells [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 Int
smellLimit  <- [Setting]
settings]