argon (empty) → 0.1.0.0
raw patch · 13 files changed
+507/−0 lines, 13 filesdep +QuickCheckdep +aesondep +ansi-terminalsetup-changed
Dependencies added: QuickCheck, aeson, ansi-terminal, argon, base, bytestring, cpphs, docopt, haskell-src-exts, hlint, hspec, uniplate
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +40/−0
- argon.cabal +92/−0
- src/Argon.hs +27/−0
- src/Argon/Formatters.hs +62/−0
- src/Argon/Parser.hs +64/−0
- src/Argon/Results.hs +39/−0
- src/Argon/Types.hs +49/−0
- src/Argon/Visitor.hs +48/−0
- test/ArgonSpec.hs +37/−0
- test/HLint.hs +16/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michele Lacchia (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michele Lacchia nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE QuasiQuotes #-}+module Main where++import System.Environment (getArgs)+import System.Console.Docopt+import Argon+++patterns :: Docopt+patterns = [docoptFile|USAGE.txt|]++getArgOrExit :: Arguments -> Option -> IO String+getArgOrExit = getArgOrExitWith patterns++getOpt :: Arguments -> String -> String -> String+getOpt args def opt = getArgWithDefault args def $ longOption opt++processFile :: String -> IO (FilePath, AnalysisResult)+processFile path = do+ contents <- readFile path+ parseCode (Just path) contents++readConfig :: Arguments -> IO Config+readConfig args = return+ Config {+ minCC = read $ getOpt args "1" "min"+ , outputMode = if args `isPresent` longOption "json"+ then JSON+ else if args `isPresent` longOption "no-color"+ then BareText+ else Colored+ }+++main :: IO ()+main = do+ args <- parseArgsOrExit patterns =<< getArgs+ res <- mapM processFile $ args `getAllArgs` argument "paths"+ conf <- readConfig args+ putStr $ export conf $ map (filterResults conf) res
+ argon.cabal view
@@ -0,0 +1,92 @@+name: argon+version: 0.1.0.0+synopsis: Measure your code's complexity+homepage: http://github.com/rubik/argon+bug-reports: http://github.com/rubik/argon/issues+license: ISC+license-file: LICENSE+author: Michele Lacchia+maintainer: michelelacchia@gmail.com+copyright: 2015 Michele Lacchia+category: Web+build-type: Simple+cabal-version: >=1.10+description:+ Argon performs static analysis on your code in order to compute cyclomatic+ complexity. It is a quantitative measure of the number of linearly+ indipendent paths through the code.+ .+ The intended usage is through Argon's executable, which accepts a list of+ file paths to analyze. The data can be optionally exported to JSON.++library+ hs-source-dirs: src+ exposed-modules: Argon+ other-modules: Argon.Parser+ Argon.Visitor+ Argon.Results+ Argon.Formatters+ Argon.Types+ build-depends: base >=4.7 && <5+ , haskell-src-exts ==1.16.*+ , cpphs ==1.19.*+ , uniplate ==1.6.*+ , ansi-terminal ==0.6.*+ , docopt ==0.7.*+ , aeson ==0.8.*+ , bytestring ==0.10.*+ default-language: Haskell2010+ ghc-options: -Wall++executable argon+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base >=4.7 && <5+ , haskell-src-exts ==1.16.*+ , cpphs ==1.19.*+ , uniplate ==1.6.*+ , ansi-terminal ==0.6.*+ , docopt ==0.7.*+ , aeson ==0.8.*+ , bytestring ==0.10.*+ , argon -any+ default-language: Haskell2010+ ghc-options: -Wall++test-suite argon-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test src+ main-is: Spec.hs+ build-depends: base >=4.7 && <5+ , argon -any+ , hspec ==2.1.*+ , QuickCheck -any+ , haskell-src-exts ==1.16.*+ , cpphs ==1.19.*+ , uniplate ==1.6.*+ , ansi-terminal ==0.6.*+ , aeson ==0.8.*+ , bytestring ==0.10.*+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010+ other-modules: Argon+ ArgonSpec+ Argon.Parser+ Argon.Visitor+ Argon.Results+ Argon.Formatters+ Argon.Types++test-suite style+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: HLint.hs+ build-depends: base ==4.*+ , hlint ==1.*+ default-language: Haskell2010+ ghc-options: -Wall++source-repository head+ type: git+ location: https://github.com/rubik/argon
+ src/Argon.hs view
@@ -0,0 +1,27 @@+-- |+-- Module: Argon+-- Copyright: (c) 2015 Michele Lacchia+-- License: ISC+-- Maintainer: Michele Lacchia <michelelacchia@gmail.com>+-- Stability: alpha+-- Portability: portable+--+-- Programmatic interface to Argon.+module Argon+ (+ -- * Types+ AnalysisResult+ , ComplexityBlock+ , OutputMode(..)+ , Config(..)+ -- * Parsing+ , parseCode+ -- * Manipulating results+ , order+ , filterResults+ , export+ ) where++import Argon.Parser (parseCode)+import Argon.Results (order, export, filterResults)+import Argon.Types
+ src/Argon/Formatters.hs view
@@ -0,0 +1,62 @@+module Argon.Formatters (bareTextFormatter, coloredTextFormatter+ , jsonFormatter)+ where++import Text.Printf (printf)+import Data.Aeson (encode)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List (intercalate)+import System.Console.ANSI+import Argon.Types+++bareTextFormatter :: [(FilePath, AnalysisResult)] -> String+bareTextFormatter = formatSingle $ formatResult+ (printf "%s\n\t%s")+ (\e -> "error:" ++ e)+ (\(l, c, func, cc) -> printf "%d:%d %s - %d" l c func cc)++coloredTextFormatter :: [(FilePath, AnalysisResult)] -> String+coloredTextFormatter = formatSingle $ formatResult+ (\name rest -> printf "%s%s%s\n\t%s%s" open name reset rest reset)+ (\e -> printf "%serror%s: %s%s" (fore Red) reset e reset)+ (\(l, c, func, cc) -> printf "%d:%d %s - %s%s" l c (coloredFunc func c)+ (coloredRank cc) reset)++jsonFormatter :: [(FilePath, AnalysisResult)] -> String+jsonFormatter = B.unpack . encode++open :: String+open = setSGRCode [SetConsoleIntensity BoldIntensity]++fore :: Color -> String+fore color = setSGRCode [SetColor Foreground Dull color]++reset :: String+reset = setSGRCode []++coloredFunc :: String -> Int -> String+coloredFunc f c = fore color ++ f ++ reset+ where color = if c == 1 then Cyan else Magenta++coloredRank :: Int -> String+coloredRank c = printf "%s%s (%d)%s" (fore color) rank c reset+ where (color, rank)+ | c <= 5 = (Green, "A")+ | c <= 10 = (Yellow, "B")+ | otherwise = (Red, "C")++formatSingle :: ((FilePath, AnalysisResult) -> String)+ -> [(FilePath, AnalysisResult)]+ -> String+formatSingle f = unlines . filter (not . null) . map f++formatResult :: (String -> String -> String) -- ^ The block formatter+ -> (String -> String) -- ^ The error formatter+ -> (ComplexityBlock -> String) -- ^ The single line formatter+ -> (FilePath, AnalysisResult) -> String+formatResult resultBlock errorF _ (name, Left msg) =+ resultBlock name $ errorF msg+formatResult _ _ _ (_, Right []) = ""+formatResult resultBlock _ singleF (name, Right rs) =+ resultBlock name $ intercalate "\n\t" $ map singleF rs
+ src/Argon/Parser.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+module Argon.Parser (parseCode)+ where++import Data.Maybe (fromMaybe)+import Control.Exception (SomeException, evaluate, catch)+import Language.Haskell.Exts+import Language.Haskell.Exts.SrcLoc (noLoc)+import Language.Preprocessor.Cpphs+import Argon.Visitor (funcsCC)+import Argon.Types (AnalysisResult)+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif+++-- Very permissive extension set+customExts :: [Extension]+customExts = EnableExtension `map`+ [RecordWildCards, ScopedTypeVariables, CPP, MultiParamTypeClasses,+ TemplateHaskell, RankNTypes, UndecidableInstances,+ FlexibleContexts, KindSignatures, EmptyDataDecls, BangPatterns,+ ForeignFunctionInterface, Generics, MagicHash, ViewPatterns,+ PatternGuards, TypeOperators, GADTs, PackageImports, MultiWayIf,+ SafeImports, ConstraintKinds, TypeFamilies, IncoherentInstances,+ FunctionalDependencies, ExistentialQuantification, ImplicitParams,+ UnicodeSyntax, LambdaCase, TupleSections, NamedFieldPuns]++argonMode :: ParseMode+argonMode = defaultParseMode {+ extensions = customExts+ , ignoreLinePragmas = False+ }++cppHsOpts :: CpphsOptions+cppHsOpts = defaultCpphsOptions {+ boolopts = defaultBoolOptions {+ macros = False+ , stripEol = True+ , stripC89 = True+ , pragma = False+ , hashline = False+ , locations = True+ }+ }++handleExc:: (String -> ParseResult a) -> SomeException -> IO (ParseResult a)+handleExc helper = return . helper . show++-- | Parse the given code and compute cyclomatic complexity for every function+-- binding.+parseCode :: Maybe String -- ^ The filename corresponding to the source code+ -> String -- ^ The source code+ -> IO (FilePath, AnalysisResult)+parseCode m source = do+ let fname = fromMaybe "<unknown>.hs" m+ parsed <- (do+ result <- parseModuleWithMode argonMode <$>+ runCpphs cppHsOpts fname source+ evaluate result) `catch` handleExc (ParseFailed noLoc)+ let res = case parsed of+ ParseOk moduleAst -> Right $ funcsCC moduleAst+ ParseFailed _ msg -> Left msg+ return (fname, res)
+ src/Argon/Results.hs view
@@ -0,0 +1,39 @@+module Argon.Results (order, filterResults, export)+ where++import Data.Ord (comparing)+import Data.List (sortBy)+import Argon.Formatters+import Argon.Types+++-- sortOn is built-in only in base 4.8.0.0 onwards+sortOn :: Ord b => (a -> b) -> [a] -> [a]+sortOn f =+ map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))++-- | Order a list of blocks. Ordering is done with respect to:+--+-- 1. complexity (descending)+-- 2. line number (ascending)+-- 3. function name (alphabetically)+order :: [ComplexityBlock] -> [ComplexityBlock]+order = sortOn (\(l, _, f, cc) -> (-cc, l, f))++-- | Filter the results of the analysis, with respect to the given+-- 'ResultsOptions'.+filterResults :: Config+ -> (FilePath, AnalysisResult)+ -> (FilePath, AnalysisResult)+filterResults _ (s, Left msg) = (s, Left msg)+filterResults o (s, Right rs) =+ (s, Right $ order [r | r@(_, _, _, cc) <- rs, cc >= minCC o])++-- | Export analysis' results. How to export the data is defined by the+-- 'ResultsOptions'.+export :: Config -> [(FilePath, AnalysisResult)] -> String+export opts rs =+ case outputMode opts of+ BareText -> bareTextFormatter rs+ Colored -> coloredTextFormatter rs+ JSON -> jsonFormatter rs
+ src/Argon/Types.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module Argon.Types (ComplexityBlock, AnalysisResult, Config(..)+ , OutputMode(..))+ where++import Data.Aeson+++-- | Hold the data associated to a function binding:+-- (line number, column, function name, complexity).+type ComplexityBlock = (Int, Int, String, Int)++instance ToJSON ComplexityBlock where+ toJSON (l, c, func, cc) = object [ "lineno" .= l+ , "col" .= c+ , "name" .= func+ , "complexity" .= cc+ ]++-- | Represent the result of the analysis of one file.+-- It can either be an error message or a list of+-- 'ComplexityBlock's.+type AnalysisResult = Either String [ComplexityBlock]++instance ToJSON (FilePath, AnalysisResult) where+ toJSON (p, Left err) = object [ "path" .= p+ , "type" .= ("error" :: String)+ , "message" .= err+ ]+ toJSON (p, Right rs) = object [ "path" .= p+ , "type" .= ("result" :: String)+ , "blocks" .= rs+ ]++-- | Type holding all the options passed from the command line.+data Config = Config {+ -- | Minimum complexity a block has to have to be shown in results.+ minCC :: Int+ -- | Describe how the results should be exported.+ , outputMode :: OutputMode+ }++-- | Type describing how the results should be exported.+data OutputMode = BareText -- ^ Text-only output, no colors.+ | Colored -- ^ Text-only output, with colors.+ | JSON -- ^ Data is serialized to JSON.
+ src/Argon/Visitor.hs view
@@ -0,0 +1,48 @@+module Argon.Visitor (funcsCC)+ where++import Data.Data (Data)+import Data.Generics.Uniplate.Data (childrenBi, universeBi)+import Language.Haskell.Exts.Syntax+import Argon.Types (ComplexityBlock)+++-- | Compute cyclomatic complexity of every function binding in the given AST.+funcsCC :: Data from => from -> [ComplexityBlock]+funcsCC ast = map funCC [matches | FunBind matches <- universeBi ast]++funCC :: [Match] -> ComplexityBlock+funCC [] = (0, 0, "<unknown>", 0)+funCC ms@(Match (SrcLoc _ l c) n _ _ _ _:_) = (l, c, name n, complexity ms)+ where name (Ident s) = s+ name (Symbol s) = s++sumWith :: (a -> Int) -> [a] -> Int+sumWith f = sum . map f++complexity :: Data from => from -> Int+complexity node = 1 + visitMatches node + visitExps node++visitMatches :: Data from => from -> Int+visitMatches = sumWith descend . childrenBi+ where descend :: [Match] -> Int+ descend x = length x - 1 + sumWith visitMatches x++visitExps :: Data from => from -> Int+visitExps = sumWith inspect . universeBi+ where inspect e = visitExp e + visitOp e++visitExp :: Exp -> Int+visitExp (If {}) = 1+visitExp (MultiIf alts) = length alts - 1+visitExp (Case _ alts) = length alts - 1+visitExp (LCase alts) = length alts - 1+visitExp _ = 0++visitOp :: Exp -> Int+visitOp (InfixApp _ (QVarOp (UnQual (Symbol op))) _) =+ case op of+ "||" -> 1+ "&&" -> 1+ _ -> 0+visitOp _ = 0
+ test/ArgonSpec.hs view
@@ -0,0 +1,37 @@+module ArgonSpec (spec)+ where++import Data.List (sort)+import Test.Hspec+import Test.QuickCheck+import Argon+++shouldParse :: String -> AnalysisResult -> Expectation+shouldParse s r = parseCode (Just "fname") s `shouldReturn` ("fname", r)++spec :: Spec+spec = do+ describe "order" $ do+ it "does not error on empty list" $+ order [] `shouldBe` []+ it "orders by complexity (descending)" $+ order [(1, 1, "f", 1), (2, 1, "f", 2)] `shouldBe`+ [(2, 1, "f", 2), (1, 1, "f", 1)]+ it "orders by lines (ascending)" $+ order [(11, 1, "f", 3), (1, 1, "f", 3)] `shouldBe`+ [(1, 1, "f", 3), (11, 1, "f", 3)]+ it "orders by function name (ascending)" $+ order [(11, 1, "g", 3), (11, 1, "f", 3)] `shouldBe`+ [(11, 1, "f", 3), (11, 1, "g", 3)]+ it "does not remove or add elements" $+ property $ \xs -> sort xs == sort (order xs)+ describe "parseCode" $ do+ it "accounts for case" $+ unlines [ "f n = case n of"+ , " 2 -> 24"+ , " 3 -> 27"+ , " _ -> 49"] `shouldParse` Right [(1, 1, "f", 3)]+ it "accounts for if..then..else" $+ "f n = if n == 4 then 24 else 20" `shouldParse`+ Right [(1, 1, "f", 2)]
+ test/HLint.hs view
@@ -0,0 +1,16 @@+module Main (main) where++import Language.Haskell.HLint (hlint)+import System.Exit (exitFailure, exitSuccess)++arguments :: [String]+arguments =+ [ "app"+ , "src"+ , "test"+ ]++main :: IO ()+main = do+ hints <- hlint arguments+ if null hints then exitSuccess else exitFailure
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}