argon 0.4.0.0 → 0.4.1.0
raw patch · 20 files changed
+574/−171 lines, 20 filesdep +pipes-bytestringdep +pipes-filesdep +pipes-safedep −pathwalkdep ~aesonPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: pipes-bytestring, pipes-files, pipes-safe
Dependencies removed: pathwalk
Dependency ranges changed: aeson
API changes (from Hackage documentation)
+ Argon: bareTextFormatter :: MonadIO m => Pipe (FilePath, AnalysisResult) String m ()
+ Argon: coloredTextFormatter :: MonadIO m => Pipe (FilePath, AnalysisResult) String m ()
+ Argon: locToString :: Loc -> String
+ Argon: srcSpanToLoc :: SrcSpan -> Loc
+ Argon: tagMsg :: Loc -> String -> String
- Argon: allFiles :: [FilePath] -> IO (Seq FilePath)
+ Argon: allFiles :: (MonadIO m, MonadSafe m) => FilePath -> Producer FilePath m ()
- Argon: exportStream :: Config -> Producer (FilePath, AnalysisResult) IO () -> Effect IO ()
+ Argon: exportStream :: (MonadIO m) => Config -> Producer (FilePath, AnalysisResult) m () -> Effect m ()
Files
- README.md +4/−0
- app/Main.hs +9/−6
- argon.cabal +19/−35
- src/Argon.hs +8/−0
- src/Argon/Formatters.hs +15/−11
- src/Argon/Loc.hs +5/−1
- src/Argon/Preprocess.hs +5/−13
- src/Argon/Results.hs +11/−8
- src/Argon/Types.hs +1/−1
- src/Argon/Visitor.hs +2/−2
- src/Argon/Walker.hs +14/−30
- stack-7.8.yaml +4/−1
- stack.yaml +7/−2
- test/ArgonSpec.hs +194/−61
- test/data/cabal_macros.h +235/−0
- test/data/include/necessaryInclude.h +1/−0
- test/data/missingcpp.hs +5/−0
- test/data/missingincluded.hs +11/−0
- test/data/missingmacros.hs +6/−0
- test/data/test.cabal +18/−0
README.md view
@@ -9,6 +9,10 @@ <img alt="Tests" src="https://img.shields.io/travis/rubik/argon.svg?style=flat-square"> </a>+ <a href="https://coveralls.io/github/rubik/argon">+ <img alt="Code coverage"+ src="https://img.shields.io/coveralls/rubik/argon.svg?style=flat-square">+ </a> <a href="https://github.com/rubik/argon/blob/master/LICENSE"> <img alt="License" src="https://img.shields.io/badge/license-ISC-blue.svg?style=flat-square">
app/Main.hs view
@@ -3,7 +3,9 @@ module Main where import Pipes+import Pipes.Safe (runSafeT) import qualified Pipes.Prelude as P+import Control.Monad (forM_) import System.Environment (getArgs) import System.Console.Docopt @@ -37,10 +39,11 @@ main :: IO () main = do args <- parseArgsOrExit patterns =<< getArgs- ins <- allFiles $ args `getAllArgs` argument "paths"+ let ins = args `getAllArgs` argument "paths" conf <- readConfig args- let source = each ins- >-> P.mapM (analyze conf)- >-> P.map (filterResults conf)- >-> P.filter filterNulls- runEffect $ exportStream conf source+ forM_ ins $ \path -> do+ let source = allFiles path+ >-> P.mapM (liftIO . analyze conf)+ >-> P.map (filterResults conf)+ >-> P.filter filterNulls+ runSafeT $ runEffect $ exportStream conf source
argon.cabal view
@@ -1,5 +1,5 @@ name: argon-version: 0.4.0.0+version: 0.4.1.0 synopsis: Measure your code's complexity homepage: http://github.com/rubik/argon bug-reports: http://github.com/rubik/argon/issues@@ -10,14 +10,15 @@ copyright: 2015 Michele Lacchia category: Development, Static Analysis build-type: Simple-cabal-version: >=1.10+cabal-version: >=1.18 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.+ files or directories to analyze. The data can be optionally exported to+ JSON. extra-source-files: stack.yaml stack-7.8.yaml@@ -25,6 +26,9 @@ CHANGELOG.md USAGE.txt test/data/*.hs+ test/data/*.h+ test/data/*.cabal+ test/data/include/*.h test/tree/*.hs test/tree/*.txt test/tree/sub/*.hs@@ -50,6 +54,9 @@ , bytestring >=0.10 , pipes >=4.1 , pipes-group >=1.0+ , pipes-files >=0.1+ , pipes-safe >=2.2+ , pipes-bytestring >=2.1 , lens-simple >=0.1 , ghc >=7.8 && <8 , ghc-paths >=0.1@@ -57,8 +64,6 @@ , syb >=0.4 , Cabal >=1.18 , containers >=0.5- , pathwalk >=0.3- , filepath >=1.3 , directory >=1.2 default-language: Haskell2010 ghc-options: -Wall@@ -70,54 +75,33 @@ main-is: Main.hs ghc-options: -Wall build-depends: base >=4.7 && <5+ , argon -any , docopt >=0.7 , pipes >=4.1- , argon -any- if impl(ghc < 7.10)- build-depends: pathwalk >=0.3.1.2+ , pipes-safe >=2.2 default-language: Haskell2010 if impl(ghc < 7.8) buildable: False test-suite argon-test type: exitcode-stdio-1.0- hs-source-dirs: test src+ hs-source-dirs: test main-is: Spec.hs+ other-modules: ArgonSpec build-depends: base >=4.7 && <5+ , argon -any , ansi-terminal >=0.6- , aeson >=0.8- , bytestring >=0.10- , pipes >=4.1- , pipes-group >=1.0- , lens-simple >=0.1 , ghc >=7.8 && <8- , ghc-paths >=0.1- , ghc-syb-utils >=0.2- , syb >=0.4- , Cabal >=1.18- , containers >=0.5+ , aeson >=0.8 , hspec >=2.1 , QuickCheck -any , filepath >=1.3- , docopt >=0.7- , pathwalk >=0.3- , directory >=1.2+ , pipes >=4.1+ , pipes-safe >=2.2 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010 if impl(ghc < 7.8) buildable: False- default-language: Haskell2010- other-modules: Argon- ArgonSpec- Argon.Parser- Argon.Visitor- Argon.Results- Argon.Formatters- Argon.Types- Argon.Preprocess- Argon.Loc- Argon.Cabal- Argon.SYB.Utils- Argon.Walker test-suite style type: exitcode-stdio-1.0
src/Argon.hs view
@@ -29,6 +29,13 @@ , filterResults , filterNulls , exportStream+ -- * Formatting results+ , bareTextFormatter+ , coloredTextFormatter+ -- * Utilities+ , srcSpanToLoc+ , locToString+ , tagMsg ) where import Argon.Parser (LModule, analyze, parseModule)@@ -37,3 +44,4 @@ import Argon.Types import Argon.Loc import Argon.Walker (allFiles)+import Argon.Formatters (bareTextFormatter, coloredTextFormatter)
src/Argon/Formatters.hs view
@@ -12,26 +12,29 @@ import Argon.Loc -bareTextFormatter :: Pipe (FilePath, AnalysisResult) String IO ()+bareTextFormatter :: MonadIO m => Pipe (FilePath, AnalysisResult) String m () bareTextFormatter = formatResult id- ("\terror:" ++)+ ("\terror: " ++) (\(CC (l, func, cc)) -> printf "\t%s %s - %d" (locToString l) func cc) -coloredTextFormatter :: Pipe (FilePath, AnalysisResult) String IO ()+coloredTextFormatter :: MonadIO m => Pipe (FilePath, AnalysisResult) String m () coloredTextFormatter = formatResult- (\name -> open ++ name ++ reset)+ (\name -> bold ++ name ++ reset) (printf "\t%serror%s: %s" (fore Red) reset)- (\(CC (l, func, cc)) -> printf "\t%s %s - %s%s" (locToString l)- (coloredFunc func l)- (coloredRank cc) reset)+ (\(CC (l, func, cc)) -> printf "\t%s %s - %s" (locToString l)+ (coloredFunc func l)+ (coloredRank cc)) -open :: String-open = setSGRCode [SetConsoleIntensity BoldIntensity]+-- | ANSI bold color+bold :: String+bold = setSGRCode [SetConsoleIntensity BoldIntensity] +-- | Make a ANSI foreground color sequence fore :: Color -> String fore color = setSGRCode [SetColor Foreground Dull color] +-- | ANSI sequence for reset reset :: String reset = setSGRCode [] @@ -46,10 +49,11 @@ | c <= 10 = (Yellow, "B") | otherwise = (Red, "C") -formatResult :: (String -> String) -- ^ The header formatter+formatResult :: (MonadIO m)+ => (String -> String) -- ^ The header formatter -> (String -> String) -- ^ The error formatter -> (ComplexityBlock -> String) -- ^ The single line formatter- -> Pipe (FilePath, AnalysisResult) String IO ()+ -> Pipe (FilePath, AnalysisResult) String m () formatResult header errorF singleF = for cat $ \case (path, Left err) -> do yield $ header path
src/Argon/Loc.hs view
@@ -12,14 +12,18 @@ type Loc = (Int, Int) +-- | Convert a GHC's 'SrcSpan' to a @(line, column)@ pair. In case of a GHC's+-- "bad span" the resulting pair is @(0, 0)@. srcSpanToLoc :: GHC.SrcSpan -> Loc srcSpanToLoc ss = lloc $ GHC.srcSpanStart ss where lloc = (GHC.srcLocLine &&& GHC.srcLocCol) . toRealSrcLoc toRealSrcLoc (GHC.RealSrcLoc z) = z toRealSrcLoc _ = GHC.mkRealSrcLoc (GHC.mkFastString "no info") 0 0 +-- | Convert a location to a string of the form "line:col" locToString :: Loc -> String-locToString (l, c) = printf "%d:%d" l c+locToString = uncurry $ printf "%d:%d" +-- | Add the location to a string message tagMsg :: Loc -> String -> String tagMsg s msg = locToString s ++ " " ++ msg
src/Argon/Preprocess.hs view
@@ -17,9 +17,9 @@ import qualified GHC import qualified DynFlags as GHC import qualified MonadUtils as GHC-import qualified StringBuffer as GHC import qualified DriverPhases as GHC import qualified DriverPipeline as GHC+import qualified HscTypes as GHC data CppOptions = CppOptions { cppDefine :: [String] -- ^ CPP #define macros@@ -35,22 +35,14 @@ => CppOptions -> FilePath -> m (String, GHC.DynFlags)-getPreprocessedSrcDirect cppOptions src =- (\(s, _, d) -> (s, d)) <$> getPreprocessedSrcDirectPrim cppOptions src--getPreprocessedSrcDirectPrim :: (GHC.GhcMonad m)- => CppOptions- -> FilePath- -> m (String, GHC.StringBuffer, GHC.DynFlags)-getPreprocessedSrcDirectPrim cppOptions file = do+getPreprocessedSrcDirect cppOptions file = do hscEnv <- GHC.getSession- let dfs = GHC.extractDynFlags hscEnv- newEnv = GHC.replaceDynFlags hscEnv (injectCppOptions cppOptions dfs)+ let dfs = GHC.hsc_dflags hscEnv+ newEnv = hscEnv { GHC.hsc_dflags = injectCppOptions cppOptions dfs } (dflags', hspp_fn) <- GHC.liftIO $ GHC.preprocess newEnv (file, Just (GHC.Cpp GHC.HsSrcFile))- buf <- GHC.liftIO $ GHC.hGetStringBuffer hspp_fn txt <- GHC.liftIO $ readFile hspp_fn- return (txt, buf, dflags')+ return (txt, dflags') injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags injectCppOptions CppOptions{..} dflags =
src/Argon/Results.hs view
@@ -6,7 +6,6 @@ import Data.Ord (comparing) import Data.List (sortBy) import Data.String (IsString)-import qualified Data.ByteString.Lazy as B #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<*), (*>)) #endif@@ -15,6 +14,7 @@ import Pipes import Pipes.Group import qualified Pipes.Prelude as P+import qualified Pipes.ByteString as PB import Lens.Simple ((^.)) import Argon.Formatters@@ -53,18 +53,21 @@ -- | Export analysis' results. How to export the data is defined by the -- 'Config' parameter.-exportStream :: Config- -> Producer (FilePath, AnalysisResult) IO ()- -> Effect IO ()+exportStream :: (MonadIO m)+ => Config+ -> Producer (FilePath, AnalysisResult) m ()+ -> Effect m () exportStream conf source = case outputMode conf of BareText -> source >-> bareTextFormatter >-> P.stdoutLn Colored -> source >-> coloredTextFormatter >-> P.stdoutLn- JSON -> jsonStream (source >-> P.map encode) >-> P.mapM_ B.putStr+ JSON -> jsonStream (source >-> P.map encode)+ >-> for cat (\i -> PB.fromLazy i >-> PB.stdout) -jsonStream :: IsString a- => Producer a IO ()- -> Producer a IO ()+jsonStream :: (MonadIO m)+ => IsString a+ => Producer a m ()+ -> Producer a m () jsonStream source = yield "[" *> intersperse' "," source <* yield "]\n" intersperse' :: Monad m => a -> Producer a m r -> Producer a m r
src/Argon/Types.hs view
@@ -79,7 +79,7 @@ , "complexity" .= cc ] -instance ToJSON (FilePath, AnalysisResult) where+instance {-# OVERLAPPING #-} ToJSON (FilePath, AnalysisResult) where toJSON (p, Left err) = object [ "path" .= p , "type" .= ("error" :: String) , "message" .= err
src/Argon/Visitor.hs view
@@ -26,7 +26,7 @@ getBinds :: (Data from, Typeable from) => from -> [Function] getBinds = everythingStaged Parser (++) [] $ mkQ [] visit- where visit fun@(GHC.FunBind {}) = [fun]+ where visit fun@GHC.FunBind {} = [fun] visit _ = [] getLocation :: GHC.Located a -> Loc@@ -51,7 +51,7 @@ sumWith f = sum . map f visitExp :: Exp -> Int-visitExp (GHC.HsIf {}) = 1+visitExp GHC.HsIf {} = 1 visitExp (GHC.HsMultiIf _ alts) = length alts - 1 visitExp (GHC.HsLamCase _ alts) = length (GHC.mg_alts alts) - 1 visitExp (GHC.HsCase _ alts) = length (GHC.mg_alts alts) - 1
src/Argon/Walker.hs view
@@ -1,35 +1,19 @@-{-# LANGUAGE CPP #-} module Argon.Walker (allFiles) where -import Data.Sequence (Seq)-import qualified Data.Sequence as S-import Data.List (foldl1', isSuffixOf)-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid (mappend)-import Control.Applicative ((<$>))-#endif-import System.FilePath ((</>))-import System.Directory-import System.Directory.PathWalk+import Pipes+import Pipes.Files+import Pipes.Safe+import qualified Pipes.Prelude as P+import Data.Monoid ((<>))+import Data.List (isSuffixOf)+import System.Directory (doesFileExist) --- | Starting from a list of paths, generate a sequence of paths corresponding--- to Haskell files. The fileystem is traversed in a manner similar to--- reversed DFS.-allFiles :: [FilePath] -> IO (Seq FilePath)-allFiles paths = foldl1' mappend <$> mapM descend paths--descend :: FilePath -> IO (Seq FilePath)-descend path = do- isFile <- doesFileExist path- if isFile then return $ haskellFiles $ S.singleton path- else findSourceFiles path--haskellFiles :: Seq FilePath -> Seq FilePath-haskellFiles = S.filter (".hs" `isSuffixOf`)--findSourceFiles :: FilePath -> IO (Seq FilePath)-findSourceFiles path =- pathWalkAccumulate path $ \dir _ files ->- return $ fmap (dir </>) $ haskellFiles $ S.fromList files+-- | Starting from a path, generate a sequence of paths corresponding+-- to Haskell files. The filesystem is traversed depth-first.+allFiles :: (MonadIO m, MonadSafe m) => FilePath -> Producer FilePath m ()+allFiles path = do+ isFile <- liftIO $ doesFileExist path+ if isFile then each [path] >-> P.filter (".hs" `isSuffixOf`)+ else find path (glob "*.hs" <> regular)
stack-7.8.yaml view
@@ -4,9 +4,12 @@ - '.' extra-deps: - docopt-0.7.0.4-- pathwalk-0.3.1.2 - syb-0.4.4 - ghc-7.8.4 - lens-simple-0.1.0.8 - lens-family-1.2.0+- pipes-files-0.1.1+- hierarchy-0.3.1+- posix-paths-0.2.1.0+- free-4.12.1 resolver: lts-2.22
stack.yaml view
@@ -4,5 +4,10 @@ - '.' extra-deps: - docopt-0.7.0.4-- pathwalk-0.3.1.0-resolver: lts-3.11+- hierarchy-0.3.1+- pipes-files-0.1.1+- posix-paths-0.2.1.0+- aeson-0.11.0.0+- fail-4.9.0.0+- semigroups-0.16.2.2+resolver: lts-5.2
test/ArgonSpec.hs view
@@ -1,13 +1,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module ArgonSpec (spec) where -import Data.Foldable (toList) import Data.List (sort, isPrefixOf)-import Data.Either (isLeft, lefts)-import qualified Data.Sequence as S+import Data.Aeson (encode)+import Text.Printf (printf) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>), (<*>)) #endif@@ -15,11 +15,14 @@ import Test.QuickCheck import System.FilePath ((</>)) import System.IO.Unsafe (unsafePerformIO)+import System.Console.ANSI import qualified SrcLoc as GHC import qualified FastString as GHC+import Pipes+--import Pipes.Safe (SafeT, runSafeT)+import qualified Pipes.Prelude as P import Argon-import Argon.Loc instance Arbitrary ComplexityBlock where arbitrary = (\a b c -> CC (a, b, c)) <$> arbitrary@@ -40,61 +43,52 @@ realSpan a b = GHC.mkSrcSpan (mkLoc a b) $ mkLoc (-a) (b + 24) where mkLoc = GHC.mkSrcLoc (GHC.mkFastString "real loc") +errStartsWith :: String -> (FilePath, AnalysisResult) -> Bool+errStartsWith _ (_, Right _) = False+errStartsWith p (_, Left msg) = p `isPrefixOf` msg+ path :: String -> FilePath path f = "test" </> "data" </> f shouldAnalyze :: String -> AnalysisResult -> Expectation-shouldAnalyze f r = analyze defaultConfig p `shouldReturn` (p, r)+shouldAnalyze f = shouldAnalyzeC (f, defaultConfig)++shouldAnalyzeC :: (String, Config) -> AnalysisResult -> Expectation+shouldAnalyzeC (f, config) r = analyze config p `shouldReturn` (p, r) where p = path f -shouldReturnS :: IO (S.Seq FilePath) -> [FilePath] -> Expectation-shouldReturnS action res = action >>= ((`shouldBe` (sort res)) . sort . toList)+-- Disabled until I figure out why Argon.Walker tests fail only on Travis+{-shouldProduceS :: Producer FilePath (SafeT IO) () -> [FilePath] -> Expectation-}+{-shouldProduceS prod res = do-}+ {-paths <- runSafeT $ P.toListM prod-}+ {-paths `shouldBe` res-} +shouldProduce :: (Eq a, Show a) => Producer a IO () -> [a] -> Expectation+shouldProduce prod res = P.toListM prod >>= (`shouldBe` res)++produceError, produceResult :: Producer (FilePath, AnalysisResult) IO ()+produceError = each [("path/f.hs", Left "err!")]+produceResult = each [("f.hs", Right [ CC (ones, "g", 3)+ , CC (lo 2, "h", 5)+ , CC (lo 5, "f", 6)+ , CC (lo 7, "m", 10)+ , CC ((9, 2), "n", 15)+ ])]++-- | ANSI bold color+bold :: String+bold = setSGRCode [SetConsoleIntensity BoldIntensity]++-- | Make a ANSI foreground color sequence+fore :: Color -> String+fore color = setSGRCode [SetColor Foreground Dull color]++-- | ANSI sequence for reset+reset :: String+reset = setSGRCode []+ spec :: Spec spec = do- describe "Argon.Loc" $ do- describe "srcSpanToLoc" $ do- it "can convert a real src span to loc" $- property $ \a b -> srcSpanToLoc (realSpan a b) == (a, b)- it "can convert a bad src span to loc" $- srcSpanToLoc GHC.noSrcSpan `shouldBe` (0, 0)- describe "locToString" $- it "can convert a loc to string" $- locToString (1, 30) `shouldBe` "1:30"- describe "tagMsg" $- it "can tag messages" $- tagMsg (2, 3) "my custom msg" `shouldBe` "2:3 my custom msg"- describe "Argon.Results" $ do- describe "order" $ do- it "does not error on empty list" $- order [] `shouldBe` []- it "orders by complexity (descending)" $- order [CC (ones, "f", 1), CC (lo 2, "f", 2)] `shouldBe`- [CC (lo 2, "f", 2), CC (ones, "f", 1)]- it "orders by lines (ascending)" $- order [CC (lo 11, "f", 3), CC (ones, "f", 3)] `shouldBe`- [CC (ones, "f", 3), CC (lo 11, "f", 3)]- it "orders by function name (ascending)" $- order [CC (lo 11, "g", 3), CC (lo 11, "f", 3)] `shouldBe`- [CC (lo 11, "f", 3), CC (lo 11, "g", 3)]- it "does not add or remove elements" $- property $ \xs -> sort xs == sort (order xs)- it "is idempotent" $- property $ \xs -> order xs == order (order xs)- describe "filterResults" $ do- it "discards results with too low complexity" $- filterResults (Config 3 [] [] [] BareText )- ("p", Right [ CC (ones, "f", 3)- , CC (lo 2, "g", 2)- , CC (lo 4, "h", 10)- , CC (lo 3, "l", 1)])- `shouldBe`- ("p", Right [ CC (lo 4, "h", 10)- , CC (ones, "f", 3)])- it "does nothing on Left" $- property $ \m o p err -> filterResults (Config m [] [] [] o)- (p, Left err) ==- (p, Left err) describe "analyze" $ do it "accounts for case" $ "case.hs" `shouldAnalyze` Right [CC (ones, "func", 3)]@@ -147,22 +141,161 @@ "syntaxerror.hs" `shouldAnalyze` Left ("2:1 parse error (possibly incorrect indentation" ++ " or mismatched brackets)")+ it "catches syntax errors (missing CPP)" $+ "missingcpp.hs" `shouldAnalyze`+ Left "1:2 lexical error at character 'i'"+ it "catches syntax errors (missing cabal macros)" $+ unsafePerformIO (analyze defaultConfig (path "missingmacros.hs"))+ `shouldSatisfy`+ errStartsWith ("2:0 error: missing binary operator " +++ "before token ")+ it "catches syntax errors (missing include dir)" $+ unsafePerformIO (analyze defaultConfig (path "missingincluded.hs"))+ `shouldSatisfy`+ errStartsWith ("2:0 fatal error: necessaryInclude.h: "+ ++ "No such file or directory") it "catches CPP parsing errors" $ unsafePerformIO (analyze defaultConfig (path "cpp-error.hs"))- `shouldSatisfy`- \(_, res) ->- isLeft res && ("2:0 error: unterminated #else"- `isPrefixOf` head (lefts [res]))+ `shouldSatisfy`+ errStartsWith "2:0 error: unterminated #else"+ describe "config" $ do+ it "reads default extensions from Cabal file" $+ ("missingcpp.hs", unsafePerformIO+ (do loadedExts <- parseExts $ path "test.cabal"+ return $ defaultConfig { exts = loadedExts }))+ `shouldAnalyzeC`+ Right [CC (lo 4, "f", 1)]+ it "includes Cabal macros for preprocessing" $+ ( "missingmacros.hs"+ , defaultConfig { headers = [path "cabal_macros.h"] }+ ) `shouldAnalyzeC` Right [CC (lo 3, "f", 2)]+ it "includes directory from include-dir for preprocessing" $+ ( "missingincluded.hs"+ , defaultConfig { includeDirs = [path "include"] }+ ) `shouldAnalyzeC` Right [CC (lo 5, "f", 3)]+ describe "Argon.Loc" $ do+ describe "srcSpanToLoc" $ do+ it "can convert a real src span to loc" $+ property $ \a b -> srcSpanToLoc (realSpan a b) == (a, b)+ it "can convert a bad src span to loc" $+ srcSpanToLoc GHC.noSrcSpan `shouldBe` (0, 0)+ describe "locToString" $+ it "can convert a loc to string" $+ locToString (1, 30) `shouldBe` "1:30"+ describe "tagMsg" $+ it "can tag messages" $+ tagMsg (2, 3) "my custom msg" `shouldBe` "2:3 my custom msg"+ describe "Argon.Results" $ do+ describe "order" $ do+ it "does not error on empty list" $+ order [] `shouldBe` []+ it "orders by complexity (descending)" $+ order [CC (ones, "f", 1), CC (lo 2, "f", 2)] `shouldBe`+ [CC (lo 2, "f", 2), CC (ones, "f", 1)]+ it "orders by lines (ascending)" $+ order [CC (lo 11, "f", 3), CC (ones, "f", 3)] `shouldBe`+ [CC (ones, "f", 3), CC (lo 11, "f", 3)]+ it "orders by function name (ascending)" $+ order [CC (lo 11, "g", 3), CC (lo 11, "f", 3)] `shouldBe`+ [CC (lo 11, "f", 3), CC (lo 11, "g", 3)]+ it "does not add or remove elements" $+ property $ \xs -> sort xs == sort (order xs)+ it "is idempotent" $+ property $ \xs -> order xs == order (order xs)+ describe "filterNulls" $ do+ it "allows errors" $+ filterNulls ("", Left "err") `shouldBe` True+ it "disallows empty results" $+ filterNulls ("", Right []) `shouldBe` False+ it "always allows non-empty results" $+ property $ \x -> filterNulls ("", Right [x])+ describe "filterResults" $ do+ it "discards results with too low complexity" $+ filterResults (Config 3 [] [] [] BareText )+ ("p", Right [ CC (ones, "f", 3)+ , CC (lo 2, "g", 2)+ , CC (lo 4, "h", 10)+ , CC (lo 3, "l", 1)])+ `shouldBe`+ ("p", Right [ CC (lo 4, "h", 10)+ , CC (ones, "f", 3)])+ it "does nothing on Left" $+ property $ \m o p err -> filterResults (Config m [] [] [] o)+ (p, Left err) ==+ (p, Left err)+ describe "Argon.Formatters" $ do+ describe "bareTextFormatter" $ do+ it "correctly formats errors" $+ (produceError >-> bareTextFormatter) `shouldProduce`+ ["path/f.hs", "\terror: err!"]+ it "correctly formats results" $+ (produceResult >-> bareTextFormatter) `shouldProduce`+ [ "f.hs"+ , "\t1:1 g - 3"+ , "\t2:1 h - 5"+ , "\t5:1 f - 6"+ , "\t7:1 m - 10"+ , "\t9:2 n - 15"+ ]+ describe "coloredTextFormatter" $ do+ it "correctly formats errors" $+ (produceError >-> coloredTextFormatter) `shouldProduce`+ [ bold ++ "path/f.hs" ++ reset+ , "\t" ++ fore Red ++ "error" ++ reset ++ ": err!"+ ]+ it "correctly formats results" $+ (produceResult >-> coloredTextFormatter) `shouldProduce`+ [ bold ++ "f.hs" ++ reset+ , printf "\t1:1 %sg%s - %sA (3)%s" (fore Cyan) reset+ (fore Green) reset+ , printf "\t2:1 %sh%s - %sA (5)%s" (fore Cyan) reset+ (fore Green) reset+ , printf "\t5:1 %sf%s - %sB (6)%s" (fore Cyan) reset+ (fore Yellow) reset+ , printf "\t7:1 %sm%s - %sB (10)%s" (fore Cyan) reset+ (fore Yellow) reset+ , printf "\t9:2 %sn%s - %sC (15)%s" (fore Magenta) reset+ (fore Red) reset+ ]+ describe "Argon.Types" $ do+ describe "ComplexityBlock" $ do+ it "implements Show correctly" $+ show (CC ((2, 3), "bla bla", 32)) `shouldBe`+ "CC ((2,3),\"bla bla\",32)"+ it "implements Eq correctly" $+ CC ((1, 4), "fun", 13) `shouldBe` CC ((1, 4), "fun", 13)+ it "implements Ord correctly" $+ CC (lo 1, "g", 2) < CC (lo 2, "f", 1) `shouldBe` True+ describe "OutputMode" $ do+ it "implements Show correctly" $+ show [JSON, Colored, BareText] `shouldBe`+ "[JSON,Colored,BareText]"+ it "implements Eq correctly" $+ [JSON, Colored, BareText] `shouldBe` [JSON, Colored, BareText]+ describe "ToJSON instance" $ do+ it "is implemented by ComplexityResult" $+ encode (CC ((1, 3), "f", 4)) `shouldBe`+ "{\"complexity\":4,\"name\":\"f\",\"lineno\":1,\"col\":3}"+ it "is implemented by (FilePath, AnalysisResult)" $+ encode ("f.hs" :: String, Right [] :: AnalysisResult)+ `shouldBe`+ "{\"blocks\":[],\"path\":\"f.hs\",\"type\":\"result\"}"+ it "is implemented by (FilePath, AnalysisResult) II" $+ encode ("f.hs" :: String, Left "err" :: AnalysisResult)+ `shouldBe`+ "{\"path\":\"f.hs\",\"type\":\"error\",\"message\":\"err\"}"+#if 0 describe "Argon.Walker" $ describe "allFiles" $ do- it "traverses the filesystem with reversed DFS" $- allFiles ["test" </> "tree"] `shouldReturnS`- [ "test" </> "tree" </> "a.hs"- , "test" </> "tree" </> "sub2" </> "e.hs"- , "test" </> "tree" </> "sub2" </> "a.hs"+ it "traverses the filesystem depth-first" $+ allFiles ("test" </> "tree") `shouldProduceS`+ [ "test" </> "tree" </> "sub" </> "b.hs" , "test" </> "tree" </> "sub" </> "c.hs"- , "test" </> "tree" </> "sub" </> "b.hs"+ , "test" </> "tree" </> "sub2" </> "a.hs"+ , "test" </> "tree" </> "sub2" </> "e.hs"+ , "test" </> "tree" </> "a.hs" ] it "includes starting files in the result" $- allFiles ["test" </> "tree" </> "a.hs"] `shouldReturnS`+ allFiles ("test" </> "tree" </> "a.hs") `shouldProduceS` ["test" </> "tree" </> "a.hs"]+#endif
+ test/data/cabal_macros.h view
@@ -0,0 +1,235 @@+/* DO NOT EDIT: This file is automatically generated by Cabal */++/* package Cabal-1.22.4.0 */+#define VERSION_Cabal "1.22.4.0"+#define MIN_VERSION_Cabal(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 22 || \+ (major1) == 1 && (major2) == 22 && (minor) <= 4)++/* package aeson-0.8.0.2 */+#define VERSION_aeson "0.8.0.2"+#define MIN_VERSION_aeson(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 8 || \+ (major1) == 0 && (major2) == 8 && (minor) <= 0)++/* package ansi-terminal-0.6.2.3 */+#define VERSION_ansi_terminal "0.6.2.3"+#define MIN_VERSION_ansi_terminal(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 6 || \+ (major1) == 0 && (major2) == 6 && (minor) <= 2)++/* package base-4.8.1.0 */+#define VERSION_base "4.8.1.0"+#define MIN_VERSION_base(major1,major2,minor) (\+ (major1) < 4 || \+ (major1) == 4 && (major2) < 8 || \+ (major1) == 4 && (major2) == 8 && (minor) <= 1)++/* package bytestring-0.10.6.0 */+#define VERSION_bytestring "0.10.6.0"+#define MIN_VERSION_bytestring(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 10 || \+ (major1) == 0 && (major2) == 10 && (minor) <= 6)++/* package containers-0.5.6.2 */+#define VERSION_containers "0.5.6.2"+#define MIN_VERSION_containers(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 5 || \+ (major1) == 0 && (major2) == 5 && (minor) <= 6)++/* package directory-1.2.2.0 */+#define VERSION_directory "1.2.2.0"+#define MIN_VERSION_directory(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 2 || \+ (major1) == 1 && (major2) == 2 && (minor) <= 2)++/* package ghc-7.10.2 */+#define VERSION_ghc "7.10.2"+#define MIN_VERSION_ghc(major1,major2,minor) (\+ (major1) < 7 || \+ (major1) == 7 && (major2) < 10 || \+ (major1) == 7 && (major2) == 10 && (minor) <= 2)++/* package ghc-paths-0.1.0.9 */+#define VERSION_ghc_paths "0.1.0.9"+#define MIN_VERSION_ghc_paths(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 1 || \+ (major1) == 0 && (major2) == 1 && (minor) <= 0)++/* package ghc-syb-utils-0.2.3 */+#define VERSION_ghc_syb_utils "0.2.3"+#define MIN_VERSION_ghc_syb_utils(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 2 || \+ (major1) == 0 && (major2) == 2 && (minor) <= 3)++/* package lens-simple-0.1.0.8 */+#define VERSION_lens_simple "0.1.0.8"+#define MIN_VERSION_lens_simple(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 1 || \+ (major1) == 0 && (major2) == 1 && (minor) <= 0)++/* package pipes-4.1.6 */+#define VERSION_pipes "4.1.6"+#define MIN_VERSION_pipes(major1,major2,minor) (\+ (major1) < 4 || \+ (major1) == 4 && (major2) < 1 || \+ (major1) == 4 && (major2) == 1 && (minor) <= 6)++/* package pipes-bytestring-2.1.1 */+#define VERSION_pipes_bytestring "2.1.1"+#define MIN_VERSION_pipes_bytestring(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 1 || \+ (major1) == 2 && (major2) == 1 && (minor) <= 1)++/* package pipes-files-0.1.1 */+#define VERSION_pipes_files "0.1.1"+#define MIN_VERSION_pipes_files(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 1 || \+ (major1) == 0 && (major2) == 1 && (minor) <= 1)++/* package pipes-group-1.0.3 */+#define VERSION_pipes_group "1.0.3"+#define MIN_VERSION_pipes_group(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 0 || \+ (major1) == 1 && (major2) == 0 && (minor) <= 3)++/* package pipes-safe-2.2.3 */+#define VERSION_pipes_safe "2.2.3"+#define MIN_VERSION_pipes_safe(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 2 || \+ (major1) == 2 && (major2) == 2 && (minor) <= 3)++/* package syb-0.5.1 */+#define VERSION_syb "0.5.1"+#define MIN_VERSION_syb(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 5 || \+ (major1) == 0 && (major2) == 5 && (minor) <= 1)++/* package docopt-0.7.0.4 */+#define VERSION_docopt "0.7.0.4"+#define MIN_VERSION_docopt(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 7 || \+ (major1) == 0 && (major2) == 7 && (minor) <= 0)++/* package QuickCheck-2.8.1 */+#define VERSION_QuickCheck "2.8.1"+#define MIN_VERSION_QuickCheck(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 8 || \+ (major1) == 2 && (major2) == 8 && (minor) <= 1)++/* package filepath-1.4.0.0 */+#define VERSION_filepath "1.4.0.0"+#define MIN_VERSION_filepath(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 4 || \+ (major1) == 1 && (major2) == 4 && (minor) <= 0)++/* package hspec-2.1.10 */+#define VERSION_hspec "2.1.10"+#define MIN_VERSION_hspec(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 1 || \+ (major1) == 2 && (major2) == 1 && (minor) <= 10)++/* package hlint-1.9.21 */+#define VERSION_hlint "1.9.21"+#define MIN_VERSION_hlint(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 9 || \+ (major1) == 1 && (major2) == 9 && (minor) <= 21)++/* tool cpphs-1.19.3 */+#define TOOL_VERSION_cpphs "1.19.3"+#define MIN_TOOL_VERSION_cpphs(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 19 || \+ (major1) == 1 && (major2) == 19 && (minor) <= 3)++/* tool gcc-5.2.0 */+#define TOOL_VERSION_gcc "5.2.0"+#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\+ (major1) < 5 || \+ (major1) == 5 && (major2) < 2 || \+ (major1) == 5 && (major2) == 2 && (minor) <= 0)++/* tool ghc-7.10.2 */+#define TOOL_VERSION_ghc "7.10.2"+#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\+ (major1) < 7 || \+ (major1) == 7 && (major2) < 10 || \+ (major1) == 7 && (major2) == 10 && (minor) <= 2)++/* tool ghc-pkg-7.10.2 */+#define TOOL_VERSION_ghc_pkg "7.10.2"+#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\+ (major1) < 7 || \+ (major1) == 7 && (major2) < 10 || \+ (major1) == 7 && (major2) == 10 && (minor) <= 2)++/* tool haddock-2.16.1 */+#define TOOL_VERSION_haddock "2.16.1"+#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 16 || \+ (major1) == 2 && (major2) == 16 && (minor) <= 1)++/* tool happy-1.19.5 */+#define TOOL_VERSION_happy "1.19.5"+#define MIN_TOOL_VERSION_happy(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 19 || \+ (major1) == 1 && (major2) == 19 && (minor) <= 5)++/* tool hpc-0.67 */+#define TOOL_VERSION_hpc "0.67"+#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 67 || \+ (major1) == 0 && (major2) == 67 && (minor) <= 0)++/* tool hsc2hs-0.67 */+#define TOOL_VERSION_hsc2hs "0.67"+#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 67 || \+ (major1) == 0 && (major2) == 67 && (minor) <= 0)++/* tool hscolour-1.22 */+#define TOOL_VERSION_hscolour "1.22"+#define MIN_TOOL_VERSION_hscolour(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 22 || \+ (major1) == 1 && (major2) == 22 && (minor) <= 0)++/* tool pkg-config-0.29 */+#define TOOL_VERSION_pkg_config "0.29"+#define MIN_TOOL_VERSION_pkg_config(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 29 || \+ (major1) == 0 && (major2) == 29 && (minor) <= 0)++/* tool strip-2.25 */+#define TOOL_VERSION_strip "2.25"+#define MIN_TOOL_VERSION_strip(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 25 || \+ (major1) == 2 && (major2) == 25 && (minor) <= 0)++#define CURRENT_PACKAGE_KEY "argon_EPnFAvdLsdbDHKR24nicp7"+
+ test/data/include/necessaryInclude.h view
@@ -0,0 +1,1 @@+#define FOO 3
+ test/data/missingcpp.hs view
@@ -0,0 +1,5 @@+#if 0+f = 3+#else+f m n = 2+#endif
+ test/data/missingincluded.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}+#include "necessaryInclude.h"++#ifdef FOO+f n = case n of+ 2 -> 2424+ 3 -> 2+ _ -> 24241+#else+g = 42+#endif
+ test/data/missingmacros.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,5,0)+f a = if a == 0 then 2 else 3*a+#else+g = 0+#endif
+ test/data/test.cabal view
@@ -0,0 +1,18 @@+name: ftw+version: 0.0+author: Michele Lacchia+build-type: Simple+cabal-version: >=1.18++library+ hs-source-dirs: .+ default-extensions: CPP+ build-depends: base >=4.7 && <5+ default-language: Haskell2010+ ghc-options: -Wall+ if impl(ghc < 7.8)+ buildable: False++source-repository head+ type: git+ location: https://github.com/rubik/argon