diff --git a/Homplexity.hs b/Homplexity.hs --- a/Homplexity.hs +++ b/Homplexity.hs @@ -29,7 +29,6 @@ -- * Command line flags defineFlag "severity" Info (concat ["level of output verbosity (", severityOptions, ")"]) -defineFlag "fakeFlag" Info "this flag is fake" {- numFunctions = length @@ -71,25 +70,54 @@ (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 lines | lines > 20 = (Warning, "should be kept below 20 lines of code." ) - | lines > 40 = (Critical, "this function exceeds 50 lines of code.") - | otherwise = (Info, "" ) +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 lines | lines > 500 = (Warning, "should be kept below 500 lines of code." ) - | lines > 3000 = (Critical, "this function exceeds 3000 lines of code.") - | otherwise = (Info, "" ) +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 depth | depth > 4 = (Warning, "should have no more than four nested conditionals" ) - | depth > 8 = (Warning, "should never exceed 8 nesting levels for conditionals") - | otherwise = (Info, "" ) +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 cy | cy > 20 = (Warning, "should not exceed 20" ) - | cy > 50 = (Warning, "should never exceed 50") - | otherwise = (Info, "" ) +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 , @@ -154,6 +182,9 @@ testFilename :: FilePath testFilename = "Homplexity.hs" + +-- | This flag exists only to make sure that HFLags work. +defineFlag "fakeFlag" Info "this flag is fake" main :: IO () main = do diff --git a/Language/Haskell/Homplexity/CodeFragment.hs b/Language/Haskell/Homplexity/CodeFragment.hs --- a/Language/Haskell/Homplexity/CodeFragment.hs +++ b/Language/Haskell/Homplexity/CodeFragment.hs @@ -10,9 +10,11 @@ -- | 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) + CodeFragment(fragmentName, fragmentSlice) , occurs + , occursOf , allOccurs + , allOccursOf , Program (..) , programT , Module (..) @@ -61,7 +63,8 @@ functionT :: Proxy Function functionT = Proxy --- ** Alias for a type signature of a function +-- ** Type signature of a function +-- | Type alias for a type signature of a function as a @CodeFragment@ data TypeSignature = TypeSignature { loc :: SrcLoc , identifiers :: [Name] , theType :: Type } @@ -71,8 +74,8 @@ typeSignatureT :: Proxy TypeSignature typeSignatureT = Proxy --- TODO: class signatures (number of function decls inside) --- ** Alias for a class signature +-- ** TODO: class signatures (number of function decls inside) +-- | Alias for a class signature data ClassSignature = ClassSignature deriving (Data, Typeable) @@ -125,9 +128,17 @@ occurs :: (CodeFragment c, Data from) => from -> [c] occurs = mapMaybe matchAST . childrenBi +-- | Explicitly typed variant of @occurs@. +occursOf :: (Data from, CodeFragment c) => Proxy c -> from -> [c] +occursOf _ = occurs + -- | All occurences of given type of @CodeFragment@ fragment within another structure. allOccurs :: (CodeFragment c, Data from) => from -> [c] allOccurs = mapMaybe matchAST . universeBi + +-- | Explicitly typed variant of @allOccurs@. +allOccursOf :: (Data from, CodeFragment c) => Proxy c -> from -> [c] +allOccursOf _ = allOccurs instance CodeFragment Program where type AST Program = Program diff --git a/Language/Haskell/Homplexity/Comments.hs b/Language/Haskell/Homplexity/Comments.hs --- a/Language/Haskell/Homplexity/Comments.hs +++ b/Language/Haskell/Homplexity/Comments.hs @@ -10,12 +10,17 @@ , CommentType (..) , classifyComments , findCommentType -- exposed for testing only + , CommentSite (..) + , commentable ) where import Data.Char +import Data.Data import Data.List import Control.Exception as E +import Language.Haskell.Homplexity.CodeFragment +import Language.Haskell.Homplexity.SrcSlice import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts @@ -52,4 +57,25 @@ prop_commentsBefore = findCommentType " ^" == CommentsBefore prop_commentsGroup = findCommentType " *" == CommentsInside prop_commentsInside = findCommentType " a" == CommentsInside + +-- * Finding ranges of all commentable entities. +-- | Tagging of source range for each commentable object. +data CommentSite = CommentSite { siteName :: String + , siteSlice :: SrcSlice + } + +-- | Find comment sites for entire program. +commentable :: Data from => from -> [CommentSite] +commentable code = ($ code) `concatMap` [slicesOf functionT + ,slicesOf typeSignatureT + ,slicesOf moduleT ] + where + commentSite :: CodeFragment c => (c -> SrcSlice) -> c -> CommentSite + commentSite with frag = CommentSite (fragmentName frag) + (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 = commentSites fragmentSlice + locsOf = commentSites (locAsSpan . fragmentLoc) diff --git a/Language/Haskell/Homplexity/Metric.hs b/Language/Haskell/Homplexity/Metric.hs --- a/Language/Haskell/Homplexity/Metric.hs +++ b/Language/Haskell/Homplexity/Metric.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -22,6 +21,7 @@ import Language.Haskell.Homplexity.CodeFragment + -- | Metric can be computed on a set of @CodeFragment@ fragments -- and then shown. class (CodeFragment c, Show m) => Metric m c where @@ -38,6 +38,9 @@ instance Show LOC where showsPrec _ (LOC l) = shows l . (" lines of code"++) + +instance Read LOC where + readsPrec prec str = first LOC <$> readsPrec prec str instance (CodeFragment c) => Metric LOC c where measure = LOC diff --git a/Language/Haskell/Homplexity/SrcSlice.hs b/Language/Haskell/Homplexity/SrcSlice.hs --- a/Language/Haskell/Homplexity/SrcSlice.hs +++ b/Language/Haskell/Homplexity/SrcSlice.hs @@ -10,6 +10,7 @@ , sliceFirstLine , sliceLastLine , sliceFilename + , locAsSpan ) where import Data.Data @@ -45,13 +46,21 @@ mergeSrcLocs :: [SrcLoc] -> SrcSpan mergeSrcLocs [] = error "Don't know how make a SrcSpan from an empty list of locations!" -mergeSrcLocs sliceLocs = assert (allEqual $ map srcFilename sliceLocs) $ +mergeSrcLocs sliceLocs = allEqual (map srcFilename sliceLocs) `assert` SrcSpan {..} where srcSpanFilename = srcFilename $ head sliceLocs ((srcSpanStartLine, srcSpanStartColumn), (srcSpanEndLine, srcSpanEndColumn )) = (minimum &&& maximum) $ map (srcLine &&& srcColumn) sliceLocs + +locAsSpan :: SrcLoc -> SrcSpan +locAsSpan (SrcLoc {..}) = SrcSpan { srcSpanStartLine = srcLine + , srcSpanEndLine = srcLine + , srcSpanStartColumn = srcColumn + , srcSpanEndColumn = srcColumn + , srcSpanFilename = srcFilename + } allEqual :: Eq a => [a] -> Bool allEqual [] = True diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ [![Hackage](https://budueba.com/hackage/homplexity)](https://hackage.haskell.org/package/homplexity) [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/homplexity.svg?style=flat)](http://packdeps.haskellers.com/feed?needle=homplexity) -Details on official releases _will_ ultimately come to [Hackage](https://hackage.haskell.org/package/homplexity) +Official releases are on [Hackage](https://hackage.haskell.org/package/homplexity) USAGE: ====== @@ -23,3 +23,4 @@ Patches and suggestions are welcome. +You may run `homplexity --help` to see options. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ Changelog ========= + 0.3.0.0 Jun 2015 + + * Configurable thresholds. + 0.2.0.0 Jun 2015 * First release on Hackage. diff --git a/homplexity.cabal b/homplexity.cabal --- a/homplexity.cabal +++ b/homplexity.cabal @@ -1,16 +1,17 @@ --- Initial homplexity.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: homplexity -version: 0.2.0.0 +version: 0.3.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 -homepage: https://github.com/mjgajda/homplexity + +homepage: https://github.com/mgajda/homplexity license: BSD3 license-file: LICENSE author: Michal J. Gajda