diff --git a/Language/Haskell/Homplexity/Assessment.hs b/Language/Haskell/Homplexity/Assessment.hs --- a/Language/Haskell/Homplexity/Assessment.hs +++ b/Language/Haskell/Homplexity/Assessment.hs @@ -61,6 +61,23 @@ (severity, recommendation) = assess result result = measureFor metricType fragType c +-- * Assessments of severity for used @Metric@s. +-- ** Module definition checks +defineFlag "moduleLinesWarning" (500 :: Int) "issue warning when module exceeds this number of lines" +defineFlag "moduleLinesCritical" (3000 :: Int) "issue critical when module exceeds this number of lines" + +assessModuleLength :: Assessment LOC +assessModuleLength (fromIntegral -> locs) + | locs > flags_moduleLinesWarning = (Warning, "should be kept below " ++ + show flags_moduleLinesWarning ++ + " lines of code.") + | locs > flags_moduleLinesCritical = (Critical, "this function exceeds " ++ + show flags_moduleLinesCritical ++ + " lines of code.") + | otherwise = (Info, "" ) + +-- ** Function definition checks +-- *** Number of lines of code within function body defineFlag "functionLinesWarning" (20 :: Int) "issue warning when function exceeds this number of lines" defineFlag "functionLinesCritical" (40 :: Int) "issue critical when function exceeds this number of lines" @@ -75,19 +92,7 @@ | otherwise = (Info, "" ) -defineFlag "moduleLinesWarning" (500 :: Int) "issue warning when module exceeds this number of lines" -defineFlag "moduleLinesCritical" (3000 :: Int) "issue critical when module exceeds this number of lines" - -assessModuleLength :: Assessment LOC -assessModuleLength (fromIntegral -> locs) - | locs > flags_moduleLinesWarning = (Warning, "should be kept below " ++ - show flags_moduleLinesWarning ++ - " lines of code.") - | locs > flags_moduleLinesCritical = (Critical, "this function exceeds " ++ - show flags_moduleLinesCritical ++ - " lines of code.") - | otherwise = (Info, "" ) - +-- *** Decision depth of function definition defineFlag "functionDepthWarning" (4 :: Int) "issue warning when function exceeds this decision depth" defineFlag "functionDepthCritical" (8 :: Int) "issue critical when function exceeds this decision depth" @@ -101,6 +106,7 @@ " nesting levels for conditionals") | otherwise = (Info, "" ) +-- *** Cyclomatic complexity of function definition defineFlag "functionCCWarning" (20::Int) "issue warning when function's cyclomatic complexity exceeds this number" defineFlag "functionCCCritical" (50::Int) "issue critical when function's cyclomatic complexity exceeds this number" @@ -112,6 +118,8 @@ show flags_functionCCCritical) | otherwise = (Info, "" ) +-- ** Type signature complexity +-- *** Type constructor depth in each type signature defineFlag "typeConDepthWarning" (6::Int) "issue warning when type constructor depth exceeds this number" defineFlag "typeConDepthCritical" (9::Int) "issue critical when type constructor depth exceeds this number" @@ -123,6 +131,7 @@ show flags_typeConDepthCritical) | otherwise = (Info, "" ) +-- *** Number of function arguments mentioned in each type signature defineFlag "numFunArgsWarning" (5::Int) "issue warning when number of function arguments exceeds this number" defineFlag "numFunArgsCritical" (9::Int) "issue critical when number of function arguments exceeds this number" @@ -132,6 +141,8 @@ | cy > flags_numFunArgsCritical = (Warning, "must never reach " ++ show flags_numFunArgsCritical) | otherwise = (Info, "" ) +-- * Computing and assessing @Metric@s for all @CodeFragment@. +-- | Compute all metrics, and assign severity depending on configured thresholds. metrics :: [Program -> Log] metrics = [measureTopOccurs assessModuleLength locT moduleT ,measureTopOccurs assessFunctionLength locT functionT @@ -139,3 +150,4 @@ ,measureTopOccurs assessFunctionCC cyclomaticT functionT ,measureTopOccurs assessTypeConDepth conDepthT typeSignatureT ,measureTopOccurs assessNumFunArgs numFunArgsT typeSignatureT] + diff --git a/Language/Haskell/Homplexity/TypeComplexity.hs b/Language/Haskell/Homplexity/TypeComplexity.hs new file mode 100644 --- /dev/null +++ b/Language/Haskell/Homplexity/TypeComplexity.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +-- | Computing cyclomatic complexity and branching depth. +module Language.Haskell.Homplexity.TypeComplexity( + ConDepth + , conDepthT + , NumFunArgs + , numFunArgsT) where + +import Data.Data +import Data.Generics.Uniplate.Data +--import Data.Proxy(Proxy) +import Language.Haskell.Exts.Syntax +import Language.Haskell.Homplexity.CodeFragment +import Language.Haskell.Homplexity.Metric +--import Debug.Trace + +-- | Sum the results of mapping the function over the list. +maxOf :: (a -> Int) -> [a] -> Int +maxOf f = maximum . (0:). map f + +-- * Depth of type constructor nesting +newtype ConDepth = ConDepth { unConDepth :: Int } + deriving (Eq, Ord, Enum, Num, Real, Integral) + +conDepthT :: Proxy ConDepth +conDepthT = Proxy + +instance Show ConDepth where + showsPrec _ (ConDepth cc) = ("type constructor nesting of " ++) + . shows cc + +instance Metric ConDepth TypeSignature where + measure = ConDepth . conDepth . theType + +-- | Function computing constructor depth of a @Type@. +conDepth :: Type -> Int +conDepth con = deeper con + maxOf conDepth (childrenBi con) + +-- | Check whether given constructor of @Type@ counts in constructor depth computation. +deeper :: Type -> Int +deeper (TyForall _bind _context _type) = 1 +deeper (TyList _aType ) = 1 +deeper (TyFun _type1 _type2) = 1 +deeper (TyApp _type1 _type2) = 1 +deeper (TyInfix _type1 _ _type2) = 1 +deeper (TyTuple _boxed _types) = 1 +deeper (TyParArray _types) = 1 +deeper _ = 0 + +-- * Number of function arguments +newtype NumFunArgs = NumFunArgs { unNumFunArgs :: Int } + deriving (Eq, Ord, Enum, Num, Real, Integral) + +numFunArgsT :: Proxy NumFunArgs +numFunArgsT = Proxy + +instance Show NumFunArgs where + showsPrec _ (NumFunArgs cc) = shows cc + . (" arguments" ++) + +instance Metric NumFunArgs TypeSignature where + measure = NumFunArgs . numFunArgs . theType + +-- | Function computing constructor depth of a @Type@. +numFunArgs :: Type -> Int +numFunArgs (TyParen aType) = numFunArgs aType +numFunArgs (TyKind aType _kind) = numFunArgs aType +numFunArgs (TyForall _bind _context aType) = numFunArgs aType -- NOTE: doesn't count type argument +numFunArgs (TyFun _type1 type2) = 1+numFunArgs type2 +numFunArgs (TyParArray aType) = 1+numFunArgs aType +numFunArgs _ = 1 + diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -2,6 +2,11 @@ ========= 0.4.0.0 Jun 2015 + * Corrected embarassing missing module. + * Better documentation, cleanup. + + 0.4.0.0 Jun 2015 + * Added number of arguments, and constructor depth. 0.3.0.0 Jun 2015 diff --git a/homplexity.cabal b/homplexity.cabal --- a/homplexity.cabal +++ b/homplexity.cabal @@ -1,5 +1,5 @@ name: homplexity -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Haskell code quality tool description: Homplexity aims to measure code complexity, warning about fragments that might have higher defect probability @@ -37,6 +37,7 @@ Language.Haskell.Homplexity.Message Language.Haskell.Homplexity.Metric Language.Haskell.Homplexity.Parse + Language.Haskell.Homplexity.TypeComplexity Language.Haskell.Homplexity.SrcSlice other-extensions: FlexibleContexts,