diff --git a/Homplexity.hs b/Homplexity.hs --- a/Homplexity.hs +++ b/Homplexity.hs @@ -27,21 +27,14 @@ import HFlags --- * Command line flags +-- * Command line flag defineFlag "severity" Warning (concat ["level of output verbosity (", severityOptions, ")"]) -- | Report to standard error output. report :: String -> IO () report = hPutStrLn stderr --- | Analyze single source module. -analyzeModule :: Module -> IO () -analyzeModule = analyzeModules . (:[]) - --- | Analyze a set of modules. -analyzeModules :: [Module] -> IO () -analyzeModules = putStr . concatMap show . extract flags_severity . mconcat metrics . program - +-- * Recursing directory tree in order to list Haskell source files. -- | Find all Haskell source files within a given path. -- Recurse down the tree, if the path points to directory. subTrees :: FilePath -> IO [FilePath] @@ -72,6 +65,20 @@ getDirectoryPaths :: FilePath -> IO [FilePath] getDirectoryPaths dirPath = map (dirPath ) <$> getDirectoryContents dirPath +-- | Commonly defined function - should be added to base... +concatMapM :: (Functor m, Monad m) => (a -> m [b]) -> [a] -> m [b] +concatMapM f = fmap concat . mapM f + +-- * Analysis +-- | Analyze a set of modules. +analyzeModule :: Module -> IO () +analyzeModule = putStr + . concatMap show + . extract flags_severity + . mconcat metrics + . program + . (:[]) + -- | Process each separate input file. processFile :: FilePath -> IO Bool processFile filepath = do src <- parseSource filepath @@ -81,17 +88,13 @@ Right (ast, _comments) -> do analyzeModule ast return True --- | Commonly defined function - should be added to base... -concatMapM :: (Functor m, Monad m) => (a -> m [b]) -> [a] -> m [b] -concatMapM f = fmap concat . mapM f - -- | 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" + args <- $initHFlags "Homplexity - automatic analysis of Haskell code quality" if null args then do report ("Use Haskell source file or directory as an argument, " ++ "or use --help to discover options.") 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,19 +10,19 @@ -- | 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 (..) + , Program (..) , programT , program - , Module (..) + , Module (..) , moduleT - , Function (..) + , Function (..) , functionT - , TypeSignature(..) + , TypeSignature (..) , typeSignatureT , fragmentLoc -- TODO: add ClassSignature 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 @@ -12,12 +12,14 @@ , findCommentType -- exposed for testing only , CommentSite (..) , commentable + + , orderCommentsAndCommentables ) where import Data.Char import Data.Data +import Data.Function import Data.List ---import Control.Exception as E import Language.Haskell.Homplexity.CodeFragment import Language.Haskell.Homplexity.SrcSlice @@ -45,7 +47,7 @@ -- | Finds Haddock markers of which declarations the comment pertains to. findCommentType :: String -> CommentType -findCommentType txt = case find (not . isSpace) txt of +findCommentType txt = case (not . isSpace) `find` txt of Just '^' -> CommentsBefore Just '|' -> CommentsAfter Just '*' -> CommentsInside -- since it comments out the group of declarations, it belongs to the containing object @@ -56,6 +58,7 @@ data CommentSite = CommentSite { siteName :: String , siteSlice :: SrcSlice } + deriving (Show) -- | Find comment sites for entire program. commentable :: Data from => from -> [CommentSite] @@ -72,3 +75,29 @@ slicesOf = commentSites fragmentSlice --locsOf = commentSites (locAsSpan . fragmentLoc) +-- | Take together are commentable elements, and all comments, and order them by source location. +orderCommentsAndCommentables :: [CommentSite] -> [CommentLink] -> [Either CommentLink CommentSite] +orderCommentsAndCommentables sites comments = sortBy (compare `on` loc) elts + where + loc :: Either CommentLink CommentSite -> (SrcSpan, Bool) + loc (Left (commentSpan -> srcSpan)) = (srcSpan, True ) + loc (Right (siteSlice -> srcSpan)) = (srcSpan, False) + elts = (Left <$> comments) ++ (Right <$> sites) + +{- +type Assignment = (CommentSite, [CommentLink]) +-- | Assign comments to the commentable elements. +assignComments :: [Either CommentLink CommentSite] +assignComments = foldr assign ([], [], [], []) + where + assign :: ([Assignment], [Assignment], [CommentLink] + assign (assigned, unclosed, commentingAfter) nextElt = case nextElt of + Left (s@(CommentSite {})) -> + (assigned, (s,commentingAfter):unclosed, []) + Right (c@(CommentLink {commentType=CommentAfter, ..}) -> + (assigned, unclosed, c:commentingAfter) + Right (c@(CommentLink {commentType=CommentBefore, ..}) -> + (assigned, unclosed, c:commentingAfter) + Right (c@(CommentLink {commentType=CommentInside, ..}) -> + (assigned, unclosed, c:commentingAfter) + -} diff --git a/Language/Haskell/Homplexity/Message.hs b/Language/Haskell/Homplexity/Message.hs --- a/Language/Haskell/Homplexity/Message.hs +++ b/Language/Haskell/Homplexity/Message.hs @@ -47,11 +47,12 @@ rnf (SrcLoc {..}) = rnf srcFilename `seq` rnf srcLine `seq` rnf srcColumn instance Show Message where - showsPrec _ (Message {msgSrc=SrcLoc{..}, ..}) = shows msgSeverity + showsPrec _ (Message {msgSrc=loc@SrcLoc{..}, ..}) = shows msgSeverity . (':':) . (srcFilename++) . (':':) - . shows srcLine + . shows loc + -- . shows srcLine -- . shows srcColumn . (':':) . (msgText++) diff --git a/Language/Haskell/Homplexity/Parse.hs b/Language/Haskell/Homplexity/Parse.hs --- a/Language/Haskell/Homplexity/Parse.hs +++ b/Language/Haskell/Homplexity/Parse.hs @@ -26,7 +26,8 @@ FlexibleContexts, KindSignatures, EmptyDataDecls, BangPatterns, ForeignFunctionInterface, Generics, MagicHash, ViewPatterns, PatternGuards, TypeOperators, GADTs, PackageImports, MultiWayIf, SafeImports, ConstraintKinds, TypeFamilies, IncoherentInstances, FunctionalDependencies, - ExistentialQuantification, ImplicitParams, UnicodeSyntax] + ExistentialQuantification, ImplicitParams, UnicodeSyntax, + LambdaCase, TupleSections, NamedFieldPuns] -- | CppHs options that should be compatible with haskell-src-exts cppHsOptions :: CpphsOptions @@ -53,9 +54,12 @@ evaluate result) `E.catch` handleException (ParseFailed thisFileLoc) case parseResult of - ParseOk (parsed, comments) -> --putStrLn $ unlines $ map show $ classifyComments comments - return $ Right (parsed, classifyComments comments) - ParseFailed aLoc msg -> return $ Left $ critical aLoc msg + ParseOk (parsed, comments) -> do putStrLn "ORDERED:" + putStrLn $ unlines $ map show + $ orderCommentsAndCommentables (commentable parsed ) + (classifyComments comments) + return $ Right (parsed, classifyComments comments) + ParseFailed aLoc msg -> return $ Left $ critical aLoc msg where handleException helper (e :: SomeException) = return $ helper $ show e thisFileLoc = noLoc { srcFilename = inputFilename } @@ -68,3 +72,8 @@ fixities = Just preludeFixities } +{-putStrLn "COMMENTS:" + putStrLn $ unlines $ map show $ classifyComments comments + putStrLn "COMMENTABLES:" + putStrLn $ unlines $ map show $ commentable parsed-} + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,7 +13,7 @@ Official releases are on [Hackage](https://hackage.haskell.org/package/homplexity) USAGE: -====== +------ After installing with `cabal install homplexity`, you might run it with filenames or directories with your Haskell source @@ -24,3 +24,16 @@ Patches and suggestions are welcome. You may run `homplexity --help` to see options. + +How does it work? +----------------- + +Homplexity is based on the idea of `Metric`s that are applied to various +`CodeFragment` types extracted automatically from parsed source. Each +metric is then assessed whether it crosses any thresholds, and depending +on them the severity of the message is chosen. + +To see all metric values, set the warning `--severity` to `INFO`. + +![Diagram of concepts](https://raw.githubusercontent.com/mgajda/homplexity/master/docs/concepts.png) +![Legend of the diagram](https://raw.githubusercontent.com/mgajda/homplexity/master/docs/legend.png) diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ Changelog ========= + 0.4.3.1 Feb 2015 + + * Updated bounds for GHC 8.0. + 0.4.3.0 Jun 2015 * Thanks to Mikolaj Konarski for fixing an embarrassing eternal loop due to biplate quirk. diff --git a/homplexity.cabal b/homplexity.cabal --- a/homplexity.cabal +++ b/homplexity.cabal @@ -1,5 +1,5 @@ name: homplexity -version: 0.4.3.0 +version: 0.4.3.1 synopsis: Haskell code quality tool description: Homplexity aims to measure code complexity, warning about fragments that might have higher defect probability @@ -56,7 +56,7 @@ BangPatterns, GeneralizedNewtypeDeriving, TypeFamilies - build-depends: base >=4.5 && <4.9, + build-depends: base >=4.5 && <4.10, haskell-src-exts >=1.12 && <1.17, directory >=1.1 && <1.3, filepath >=1.2 && <1.5, @@ -64,7 +64,7 @@ uniplate >=1.4 && <1.7, deepseq >=1.3 && <1.5, containers >=0.3 && <0.6, - template-haskell >=2.6 && <2.11, + template-haskell >=2.6 && <2.12, cpphs >=1.5 && <1.20 build-tools: happy >= 1.19.0 -- hs-source-dirs: @@ -76,7 +76,7 @@ Language.Haskell.Homplexity.Comments Language.Haskell.Homplexity.SrcSlice type: exitcode-stdio-1.0 - build-depends: base >=4.5 && <4.9, + build-depends: base >=4.5 && <4.10, haskell-src-exts >=1.12 && <1.17, uniplate >=1.4 && <1.7 default-language: Haskell2010