homplexity 0.3.0.0 → 0.4.0.0
raw patch · 11 files changed
+199/−197 lines, 11 files
Files
- Homplexity.hs +8/−105
- Language/Haskell/Homplexity/Assessment.hs +141/−0
- Language/Haskell/Homplexity/CodeFragment.hs +6/−4
- Language/Haskell/Homplexity/Comments.hs +4/−4
- Language/Haskell/Homplexity/Cyclomatic.hs +4/−41
- Language/Haskell/Homplexity/Message.hs +2/−2
- Language/Haskell/Homplexity/Metric.hs +0/−2
- Language/Haskell/Homplexity/Parse.hs +9/−25
- Language/Haskell/Homplexity/SrcSlice.hs +12/−6
- changelog.md +4/−0
- homplexity.cabal +9/−8
Homplexity.hs view
@@ -11,119 +11,22 @@ -- | Main module parsing inputs, and running analysis. module Main (main) where -import Data.Data import Data.List-import Control.Monad import Language.Haskell.Exts.Syntax+import Language.Haskell.Homplexity.Assessment import Language.Haskell.Homplexity.CodeFragment-import Language.Haskell.Homplexity.Cyclomatic import Language.Haskell.Homplexity.Message-import Language.Haskell.Homplexity.Metric import Language.Haskell.Homplexity.Parse import System.Directory+import System.Exit import System.FilePath import System.IO import HFlags -- * Command line flags-defineFlag "severity" Info (concat ["level of output verbosity (", severityOptions, ")"])--{--numFunctions = length- . filter isFunBind- . getModuleDecls--testNumFunctions = (>20)--numFunctionsMsg = "More than 20 functions per module"--numFunctionsSeverity = Warning- -}---- * Showing metric measurements---measureAll :: (CodeFragment c, Metric m c) => Severity -> (Program -> [c]) -> Proxy m -> Proxy c -> Program -> Log-measureAll :: Metric m c =>Assessment m -> (a -> [c]) -> Proxy m -> Proxy c -> a -> Log-measureAll assess generator metricType fragType = mconcat- . map (warnOfMeasure assess metricType fragType)- . generator----measureTopOccurs :: (CodeFragment c, Metric m c) => Severity -> Proxy m -> Proxy c -> Program -> Log-measureTopOccurs :: (Data from, Metric m c) =>Assessment m -> Proxy m -> Proxy c -> from -> Log-measureTopOccurs assess = measureAll assess occurs----measureAllOccurs :: (CodeFragment c, Metric m c) => Severity -> Proxy m -> Proxy c -> Program -> Log-measureAllOccurs :: (Data from, Metric m c) =>Assessment m -> Proxy m -> Proxy c -> from -> Log-measureAllOccurs assess = measureAll assess allOccurs--type Assessment m = m -> (Severity, String)--warnOfMeasure :: (CodeFragment c, Metric m c) => Assessment m -> Proxy m -> Proxy c -> c -> Log-warnOfMeasure assess metricType fragType c = message severity- ( fragmentLoc c )- (unwords [fragmentName c- ,"has"- ,show result- ,recommendation])- where- (severity, recommendation) = assess result- result = measureFor metricType fragType c--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"--assessFunctionLength :: Assessment LOC-assessFunctionLength (fromIntegral -> lines)- | lines > flags_functionLinesWarning = (Warning, "should be kept below " ++- show flags_functionLinesWarning ++- " lines of code.")- | lines > flags_functionLinesCritical = (Critical, "this function exceeds " ++- show flags_functionLinesCritical ++- " lines of code.")- | 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 -> lines)- | lines > flags_moduleLinesWarning = (Warning, "should be kept below " ++- show flags_moduleLinesWarning ++- " lines of code.")- | lines > flags_moduleLinesCritical = (Critical, "this function exceeds " ++- show flags_moduleLinesCritical ++- " lines of code.")- | otherwise = (Info, "" )--defineFlag "functionDepthWarning" (4 :: Int) "issue warning when function exceeds this decision depth"-defineFlag "functionDepthCritical" (8 :: Int) "issue critical when function exceeds this decision depth"--assessFunctionDepth :: Assessment Depth-assessFunctionDepth (fromIntegral -> depth)- | depth > flags_functionDepthWarning = (Warning, "should have no more than " ++- show depth ++- " nested conditionals" )- | depth > flags_functionDepthWarning = (Warning, "should never exceed " ++- show depth ++- " nesting levels for conditionals")- | otherwise = (Info, "" )--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"--assessFunctionCC :: Assessment Cyclomatic-assessFunctionCC (fromIntegral -> cy)- | cy > flags_functionCCWarning = (Warning, "should not exceed " ++ show cy)- | cy > flags_functionCCCritical = (Warning, "should never exceed " ++ show cy)- | otherwise = (Info, "" )--metrics :: [Program -> Log]-metrics = [measureTopOccurs assessModuleLength locT moduleT ,- measureTopOccurs assessFunctionLength locT functionT,- measureTopOccurs assessFunctionDepth depthT functionT,- measureTopOccurs assessFunctionCC cyclomaticT functionT]+defineFlag "severity" Warning (concat ["level of output verbosity (", severityOptions, ")"]) -- | Report to standard error output. report :: String -> IO ()@@ -135,7 +38,7 @@ -- | Analyze a set of modules. analyzeModules :: [Module] -> IO ()-analyzeModules = putStr . concatMap show . extract flags_severity . mconcat metrics . Program+analyzeModules = putStr . concatMap show . extract flags_severity . mconcat metrics . program -- | Find all Haskell source files within a given path. -- Recurse down the tree, if the path points to directory.@@ -180,17 +83,17 @@ concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] concatMapM f = fmap concat . mapM f -testFilename :: FilePath-testFilename = "Homplexity.hs"- -- | This flag exists only to make sure that HFLags work. defineFlag "fakeFlag" Info "this flag is fake" +-- | Parse arguments and either process inputs (if available), or suggest proper usage. main :: IO () main = do args <- $initHFlags "json-autotype -- automatic type and parser generation from JSON" if null args- then void $ processFile testFilename+ then do report ("Use Haskell source file or directory as an argument, " +++ "or use --help to discover options.")+ exitFailure else do sums <- mapM processFile =<< concatMapM subTrees args putStrLn $ unwords ["Correctly parsed", show $ length $ filter id sums, "out of", show $ length sums,
+ Language/Haskell/Homplexity/Assessment.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}+-- | Main module parsing inputs, and running analysis.+module Language.Haskell.Homplexity.Assessment (+ metrics+ , measureAllOccurs) where++import Data.Data++import Language.Haskell.Homplexity.CodeFragment+import Language.Haskell.Homplexity.Cyclomatic+import Language.Haskell.Homplexity.Message+import Language.Haskell.Homplexity.Metric+import Language.Haskell.Homplexity.TypeComplexity++import HFlags++{-+numFunctions = length+ . filter isFunBind+ . getModuleDecls++testNumFunctions = (>20)++numFunctionsMsg = "More than 20 functions per module"++numFunctionsSeverity = Warning+ -}++-- * Showing metric measurements+measureAll :: Metric m c => Assessment m -> (a -> [c]) -> Proxy m -> Proxy c -> a -> Log+measureAll assess generator metricType fragType = mconcat+ . map (warnOfMeasure assess metricType fragType)+ . generator++measureTopOccurs :: (Data from, Metric m c) => Assessment m -> Proxy m -> Proxy c -> from -> Log+measureTopOccurs assess = measureAll assess occurs++--measureAllOccurs :: (CodeFragment c, Metric m c) => Severity -> Proxy m -> Proxy c -> Program -> Log+measureAllOccurs :: (Data from, Metric m c) => Assessment m -> Proxy m -> Proxy c -> from -> Log+measureAllOccurs assess = measureAll assess allOccurs++type Assessment m = m -> (Severity, String)++warnOfMeasure :: (CodeFragment c, Metric m c) => Assessment m -> Proxy m -> Proxy c -> c -> Log+warnOfMeasure assess metricType fragType c = message severity+ ( fragmentLoc c )+ (unwords [fragmentName c+ ,"has"+ ,show result+ ,recommendation])+ where+ (severity, recommendation) = assess result+ result = measureFor metricType fragType c++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"++assessFunctionLength :: Assessment LOC+assessFunctionLength (fromIntegral -> locs)+ | locs > flags_functionLinesWarning = (Warning, "should be kept below " +++ show flags_functionLinesWarning +++ " lines of code.")+ | locs > flags_functionLinesCritical = (Critical, "this function exceeds " +++ show flags_functionLinesCritical +++ " lines of code.")+ | 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, "" )++defineFlag "functionDepthWarning" (4 :: Int) "issue warning when function exceeds this decision depth"+defineFlag "functionDepthCritical" (8 :: Int) "issue critical when function exceeds this decision depth"++assessFunctionDepth :: Assessment Depth+assessFunctionDepth (fromIntegral -> depth)+ | depth > flags_functionDepthWarning = (Warning, "should have no more than " +++ show depth +++ " nested conditionals" )+ | depth > flags_functionDepthWarning = (Warning, "should never exceed " +++ show depth +++ " nesting levels for conditionals")+ | otherwise = (Info, "" )++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"++assessFunctionCC :: Assessment Cyclomatic+assessFunctionCC (fromIntegral -> cy)+ | cy > flags_functionCCWarning = (Warning, "should be less than " +++ show flags_functionCCWarning)+ | cy > flags_functionCCCritical = (Warning, "must never be as high as " +++ show flags_functionCCCritical)+ | otherwise = (Info, "" )++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"++assessTypeConDepth :: Assessment ConDepth+assessTypeConDepth (fromIntegral -> cy)+ | cy > flags_typeConDepthWarning = (Warning, "should be less than " +++ show flags_typeConDepthWarning )+ | cy > flags_typeConDepthCritical = (Warning, "must never be as high as " +++ show flags_typeConDepthCritical)+ | otherwise = (Info, "" )++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"++assessNumFunArgs :: Assessment NumFunArgs+assessNumFunArgs (fromIntegral -> cy)+ | cy > flags_numFunArgsWarning = (Warning, "should be less than " ++ show flags_numFunArgsWarning )+ | cy > flags_numFunArgsCritical = (Warning, "must never reach " ++ show flags_numFunArgsCritical)+ | otherwise = (Info, "" )++metrics :: [Program -> Log]+metrics = [measureTopOccurs assessModuleLength locT moduleT+ ,measureTopOccurs assessFunctionLength locT functionT+ ,measureTopOccurs assessFunctionDepth depthT functionT+ ,measureTopOccurs assessFunctionCC cyclomaticT functionT+ ,measureTopOccurs assessTypeConDepth conDepthT typeSignatureT+ ,measureTopOccurs assessNumFunArgs numFunArgsT typeSignatureT]
Language/Haskell/Homplexity/CodeFragment.hs view
@@ -10,13 +10,14 @@ -- | This module generalizes over types of code fragments -- that may need to be iterated upon and measured separately. module Language.Haskell.Homplexity.CodeFragment (- CodeFragment(fragmentName, fragmentSlice)+ CodeFragment (fragmentName, fragmentSlice) , occurs , occursOf , allOccurs , allOccursOf , Program (..) , programT+ , program , Module (..) , moduleT , Function (..)@@ -31,11 +32,11 @@ import Data.Generics.Uniplate.Data import Data.List import Data.Maybe-import Control.Arrow-import Control.Exception+--import Control.Arrow+--import Control.Exception import Language.Haskell.Exts.Syntax import Language.Haskell.Exts.SrcLoc-import Language.Haskell.Exts+--import Language.Haskell.Exts import Language.Haskell.Homplexity.SrcSlice -- | Program@@ -43,6 +44,7 @@ deriving (Data, Typeable, Show) -- | Smart constructor for adding cross-references in the future.+program :: [Module] -> Program program = Program -- | Proxy for passing @Program@ type as an argument.
Language/Haskell/Homplexity/Comments.hs view
@@ -17,7 +17,7 @@ import Data.Char import Data.Data import Data.List-import Control.Exception as E+--import Control.Exception as E import Language.Haskell.Homplexity.CodeFragment import Language.Haskell.Homplexity.SrcSlice@@ -52,7 +52,7 @@ _ -> CommentsInside -- * Tests for comments-prop_commentsAfter :: Bool+prop_commentsAfter, prop_commentsBefore, prop_commentsGroup, prop_commentsInside :: Bool prop_commentsAfter = findCommentType " |" == CommentsAfter prop_commentsBefore = findCommentType " ^" == CommentsBefore prop_commentsGroup = findCommentType " *" == CommentsInside@@ -75,7 +75,7 @@ (with frag) commentSites :: (CodeFragment c, Data from) => (c -> SrcSlice) -> Proxy c -> from -> [CommentSite] commentSites with fragType = map (commentSite with) . occursOf fragType- slicesOf, locsOf :: (CodeFragment c, Data from) => Proxy c -> from -> [CommentSite]+ slicesOf :: (CodeFragment c, Data from) => Proxy c -> from -> [CommentSite] slicesOf = commentSites fragmentSlice - locsOf = commentSites (locAsSpan . fragmentLoc)+ --locsOf = commentSites (locAsSpan . fragmentLoc)
Language/Haskell/Homplexity/Cyclomatic.hs view
@@ -10,19 +10,15 @@ Cyclomatic , cyclomaticT , Depth- , depthT- , ConDepth- , conDepthT- , NumFunArgs- , numFunArgsT) where+ , depthT) where import Data.Data import Data.Generics.Uniplate.Data-import Data.Proxy(Proxy)+--import Data.Proxy (Proxy) import Language.Haskell.Exts.Syntax import Language.Haskell.Homplexity.CodeFragment import Language.Haskell.Homplexity.Metric-import Debug.Trace+--import Debug.Trace type MatchSet = [Match] @@ -83,7 +79,7 @@ depthT = Proxy instance Metric Depth Function where- measure f@(Function {..}) = Depth $ depthOfMatches functionRhs `max` depthOfMatches functionBinds+ measure (Function {..}) = Depth $ depthOfMatches functionRhs `max` depthOfMatches functionBinds instance Show Depth where showsPrec _ (Depth d) = ("branching depth of "++)@@ -106,37 +102,4 @@ isDecision (LCase {}) = True isDecision (Case {}) = True isDecision _ = False---- * 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--conDepth = undefined---- * 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) = ("function has " ++)- . shows cc- . (" arguments" ++)--instance Metric NumFunArgs TypeSignature where- measure = NumFunArgs . numFunArgs--numFunArgs = undefined
Language/Haskell/Homplexity/Message.hs view
@@ -20,7 +20,7 @@ import Data.Function (on) import Data.Sequence as Seq import Data.Foldable as Foldable-import Language.Haskell.Homplexity.CodeFragment+--import Language.Haskell.Homplexity.CodeFragment import Language.Haskell.Exts import Language.Haskell.TH.Syntax (Lift(..)) import HFlags@@ -64,7 +64,7 @@ deriving (Eq, Ord, Read, Show, Enum, Bounded) instance NFData Severity where- rnf !a = ()+ rnf !_a = () -- | String showing all possible values for @Severity@. severityOptions :: String
Language/Haskell/Homplexity/Metric.hs view
@@ -15,9 +15,7 @@ import Data.Generics.Uniplate.Data import Data.List import Control.Arrow-import Control.Exception (assert) import Language.Haskell.Exts.Syntax-import Language.Haskell.Exts import Language.Haskell.Homplexity.CodeFragment
Language/Haskell/Homplexity/Parse.hs view
@@ -6,31 +6,16 @@ -- | Parsing of Haskell source files, and error reporting for unparsable files. module Language.Haskell.Homplexity.Parse (parseSource) where -import Data.Char-import Data.Data-import Data.List-import Data.Maybe-import Data.Monoid-import Data.Proxy-import Control.Arrow import Control.Exception as E-import Control.Monad import Language.Haskell.Exts.Syntax import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts-import Language.Haskell.Homplexity.Cyclomatic-import Language.Haskell.Homplexity.Metric-import Language.Haskell.Homplexity.CodeFragment import Language.Haskell.Homplexity.Comments import Language.Haskell.Homplexity.Message import Language.Preprocessor.Cpphs-import System.Directory-import System.Environment-import System.FilePath-import System.IO -import HFlags+--import HFlags -- | Maximally permissive list of language extensions. myExtensions :: [Extension]@@ -60,22 +45,21 @@ -- -- Catches all exceptions and wraps them as @Critical@ log messages. parseSource :: FilePath -> IO (Either Log (Module, [CommentLink]))-parseSource filename = do- parsed <- (do- --putStrLn $ "\nProcessing " ++ filename ++ ":"- input <- readFile filename- result <- parseModuleWithComments parseMode <$> runCpphs cppHsOptions filename input+parseSource inputFilename = do+ parseResult <- (do+ input <- readFile inputFilename+ result <- parseModuleWithComments parseMode <$> runCpphs cppHsOptions inputFilename input evaluate result) `E.catch` handleException (ParseFailed thisFileLoc)- case parsed of+ case parseResult of ParseOk (parsed, comments) -> --putStrLn $ unlines $ map show $ classifyComments comments return $ Right (parsed, classifyComments comments)- ParseFailed loc msg -> return $ Left $ critical loc msg+ ParseFailed aLoc msg -> return $ Left $ critical aLoc msg where handleException helper (e :: SomeException) = return $ helper $ show e- thisFileLoc = noLoc { srcFilename = filename }+ thisFileLoc = noLoc { srcFilename = inputFilename } parseMode = ParseMode {- parseFilename = filename,+ parseFilename = inputFilename, baseLanguage = Haskell2010, extensions = myExtensions, ignoreLanguagePragmas = False,
Language/Haskell/Homplexity/SrcSlice.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-} -- | Showing references to slices of code module Language.Haskell.Homplexity.SrcSlice ( SrcSlice@@ -15,28 +15,34 @@ import Data.Data import Data.Generics.Uniplate.Data-import Data.List import Control.Arrow import Control.Exception (assert) import Language.Haskell.Exts.Syntax-import Language.Haskell.Exts import Language.Haskell.Exts.SrcLoc -- * Slice of code type SrcSlice = SrcSpan++sliceFilename :: SrcSpan -> String sliceFilename = srcSpanFilename++sliceFirstLine :: SrcSpan -> Int sliceFirstLine = srcSpanStartLine++sliceLastLine :: SrcSpan -> Int sliceLastLine = srcSpanEndLine srcLoc :: (Data code, Show code) => code -> SrcLoc srcLoc code = checkHead $ universeBi code where- msg = "Cannot find SrcLoc in the code fragment: " ++ show code- checkHead [] = error msg- checkHead (e:es) = e+ msg = "Cannot find SrcLoc in the code fragment: " ++ show code+ checkHead [] = error msg+ checkHead (e:_) = e -- | Compute the slice of code that given source fragment is in (for naming)+srcSlice :: (Data a, Show a)+ => a -> SrcSpan srcSlice code = mergeSrcLocs . checkNonEmpty . universeBi $ code
changelog.md view
@@ -1,5 +1,9 @@ Changelog =========+ 0.4.0.0 Jun 2015++ * Added number of arguments, and constructor depth.+ 0.3.0.0 Jun 2015 * Configurable thresholds.
homplexity.cabal view
@@ -1,15 +1,15 @@ name: homplexity-version: 0.3.0.0+version: 0.4.0.0 synopsis: Haskell code quality tool description: Homplexity aims to measure code complexity, warning about fragments that might have higher defect probability due to bad coding style on-the-large:-- * too large functions-- * too deeply nested conditions-- * too few comments+ .+ * too large functions+ .+ * too deeply nested conditions+ .+ * too few comments homepage: https://github.com/mgajda/homplexity license: BSD3@@ -30,7 +30,8 @@ executable homplexity main-is: Homplexity.hs- other-modules: Language.Haskell.Homplexity.CodeFragment+ other-modules: Language.Haskell.Homplexity.Assessment+ Language.Haskell.Homplexity.CodeFragment Language.Haskell.Homplexity.Comments Language.Haskell.Homplexity.Cyclomatic Language.Haskell.Homplexity.Message