diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ This package uses [Semantic Versioning][1]. +## v0.3.1.0 + +- Add compatibility with GHC 7.8: #6 + ## v0.3.0.0 - Major: replace Haskell-Src-Exts with GHC API: #5 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -33,43 +33,50 @@ ### Installing Simple as ``stack install argon`` or ``cabal install argon``. +Note: if you are using Stack and your resolver if too old, you might have to +add some packages to your `stack.yaml` file. +#### GHC compatibility + +Argon is compatible with GHC 7.8 and 7.10, it's tested against those versions +only. + ### Running -The Argon executable expects a list of file paths: +The Argon executable expects a list of file paths (files or directories): - $ argon --no-color src/**/*.hs - src/Argon/Formatters.hs - 47:1 formatResult - 3 - 33:1 coloredFunc - 2 - 27:1 fore - 1 - 37:1 coloredRank - 1 + $ argon --no-color --min 2 src + src/Argon/Types.hs + 61:5 toJSON - 2 + src/Argon/Visitor.hs + 55:1 visitExp - 5 + 62:1 visitOp - 4 + 28:11 visit - 2 + 35:1 getFuncName - 2 src/Argon/Parser.hs - 51:1 parseCode - 2 - 44:1 handleExc - 1 + 55:1 parseModuleWithCpp - 3 + 88:1 customLogAction - 3 + 35:1 analyze - 2 + 39:9 analysis - 2 + src/Argon/Formatters.hs + 61:1 formatResult - 3 + 42:1 coloredFunc - 2 + 43:11 color - 2 src/Argon/Results.hs - 17:1 filterResults - 2 - 22:1 export - 2 - src/Argon/Visitor.hs - 35:1 visitExp - 5 - 42:1 visitOp - 4 - 14:1 funCC - 3 - 16:11 name - 2 - 11:1 funcsCC - 1 - 20:1 sumWith - 1 - 23:1 complexity - 1 - 28:11 descend - 1 - 32:11 inspect - 1 + 35:1 export - 3 + 28:1 filterResults - 2 + src/Argon/Loc.hs + 18:11 toRealSrcLoc - 2 For every file, Argon sorts results with the following criteria (and in this order): - * complexity (descending) - * line number (ascending) - * alphabetically +1. complexity (descending) +2. line number (ascending) +3. alphabetically When colors are enabled (default), Argon computes a rank associated with the -coomplexity score: +complexity score: | Complexity | Rank | |:----------:|:----:| @@ -81,59 +88,57 @@ #### JSON Results can also be exported to JSON: - - $ argon --json src/**/*.hs - [ - { - "blocks": [ - { "complexity": 3, "name": "formatResult", "lineno": 58, "col": 1 }, - { "complexity": 2, "name": "coloredFunc", "lineno": 39, "col": 1 }, - { "complexity": 1, "name": "fore", "lineno": 33, "col": 1 }, - { "complexity": 1, "name": "coloredRank", "lineno": 43, "col": 1 }, - { "complexity": 1, "name": "formatSingle", "lineno": 52, "col": 1 } - ], - "path": "src/Argon/Formatters.hs", - "type": "result" - }, - { "blocks": [ ], "path": "src/Argon.hs", "type": "result" }, - { - "blocks": [ - { "complexity": 2, "name": "parseCode", "lineno": 55, "col": 1 }, - { "complexity": 1, "name": "handleExc", "lineno": 48, "col": 1 } - ], - "path": "src/Argon/Parser.hs", - "type": "result" - }, - { - "blocks": [ - { "complexity": 3, "name": "export", "lineno": 35, "col": 1 }, - { "complexity": 2, "name": "filterResults", "lineno": 28, "col": 1 }, - { "complexity": 1, "name": "sortOn", "lineno": 12, "col": 1 } - ], - "path": "src/Argon/Results.hs", - "type": "result" - }, - { - "blocks": [ - { "complexity": 2, "name": "toJSON", "lineno": 30, "col": 5 }, - { "complexity": 1, "name": "toJSON", "lineno": 18, "col": 5 } - ], - "path": "src/Argon/Types.hs", - "type": "result" - }, - { - "blocks": [ - { "complexity": 5, "name": "visitExp", "lineno": 36, "col": 1 }, - { "complexity": 4, "name": "visitOp", "lineno": 43, "col": 1 }, - { "complexity": 3, "name": "funCC", "lineno": 15, "col": 1 }, - { "complexity": 2, "name": "name", "lineno": 17, "col": 11 }, - { "complexity": 1, "name": "funcsCC", "lineno": 12, "col": 1 }, - { "complexity": 1, "name": "sumWith", "lineno": 21, "col": 1 }, - { "complexity": 1, "name": "complexity", "lineno": 24, "col": 1 }, - { "complexity": 1, "name": "descend", "lineno": 29, "col": 11 }, - { "complexity": 1, "name": "inspect", "lineno": 33, "col": 11 } - ], - "path": "src/Argon/Visitor.hs", - "type": "result" - } - ] +```json +$ argon --json --min 2 src +[ + { "blocks": [ ], "path": "src/Argon.hs", "type": "result" }, + { + "blocks": [{ "complexity": 2, "name": "toJSON", "lineno": 61, "col": 5 }], + "path": "src/Argon/Types.hs", + "type": "result" + }, + { + "blocks": [ + { "complexity": 5, "name": "visitExp", "lineno": 55, "col": 1 }, + { "complexity": 4, "name": "visitOp", "lineno": 62, "col": 1 }, + { "complexity": 2, "name": "visit", "lineno": 28, "col": 11 }, + { "complexity": 2, "name": "getFuncName", "lineno": 35, "col": 1 } + ], + "path": "src/Argon/Visitor.hs", + "type": "result" + }, + { + "blocks": [ + { "complexity": 3, "name": "parseModuleWithCpp", "lineno": 55, "col": 1 }, + { "complexity": 3, "name": "customLogAction", "lineno": 88, "col": 1 }, + { "complexity": 2, "name": "analyze", "lineno": 35, "col": 1 }, + { "complexity": 2, "name": "analysis", "lineno": 39, "col": 9 } + ], + "path": "src/Argon/Parser.hs", + "type": "result" + }, + { + "blocks": [ + { "complexity": 3, "name": "formatResult", "lineno": 61, "col": 1 }, + { "complexity": 2, "name": "coloredFunc", "lineno": 42, "col": 1 }, + { "complexity": 2, "name": "color", "lineno": 43, "col": 11 } + ], + "path": "src/Argon/Formatters.hs", + "type": "result" + }, + { + "blocks": [ + { "complexity": 3, "name": "export", "lineno": 35, "col": 1 }, + { "complexity": 2, "name": "filterResults", "lineno": 28, "col": 1 } + ], + "path": "src/Argon/Results.hs", + "type": "result" + }, + { + "blocks": [{ "complexity": 2, "name": "toRealSrcLoc", "lineno": 18, "col": 11 }], + "path": "src/Argon/Loc.hs", + "type": "result" + }, + { "blocks": [ ], "path": "src/Argon/Preprocess.hs", "type": "result" } +] +``` diff --git a/USAGE.txt b/USAGE.txt --- a/USAGE.txt +++ b/USAGE.txt @@ -1,5 +1,6 @@ Usage: argon [-h] [--no-color] [--json] [-m=] ... + argon [-h] [--no-color] [--m=] [--json] ... Options: -h --help show this help diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -7,6 +7,7 @@ import qualified Data.Sequence as S import Data.Foldable (toList) #if __GLASGOW_HASKELL__ < 710 +import Data.Monoid (mappend) import Control.Applicative ((<$>)) #endif import System.Environment (getArgs) diff --git a/argon.cabal b/argon.cabal --- a/argon.cabal +++ b/argon.cabal @@ -1,5 +1,5 @@ name: argon -version: 0.3.0.0 +version: 0.3.1.0 synopsis: Measure your code's complexity homepage: http://github.com/rubik/argon bug-reports: http://github.com/rubik/argon/issues @@ -23,6 +23,7 @@ README.md CHANGELOG.md USAGE.txt +tested-with: GHC >= 7.8 library hs-source-dirs: src @@ -38,12 +39,13 @@ , ansi-terminal >=0.6 , aeson >=0.8 , bytestring >=0.10 - , ghc >=7.10.2 && <8 + , ghc >=7.8 && <8 , ghc-paths >=0.1 - , syb >=0.5 + , ghc-syb-utils >=0.2 + , syb >=0.4 default-language: Haskell2010 ghc-options: -Wall - if impl(ghc < 7.10.2) + if impl(ghc < 7.8) buildable: False executable argon @@ -53,12 +55,14 @@ build-depends: base >=4.7 && <5 , docopt >=0.7 , pathwalk >=0.3 - , filepath >=1.4 + , filepath >=1.3 , directory >=1.2 , containers >=0.5 , argon -any + if impl(ghc < 7.10) + build-depends: pathwalk >=0.3.1.2 default-language: Haskell2010 - if impl(ghc < 7.10.2) + if impl(ghc < 7.8) buildable: False test-suite argon-test @@ -69,15 +73,16 @@ , ansi-terminal >=0.6 , aeson >=0.8 , bytestring >=0.10 - , ghc >=7.10.2 && <8 + , ghc >=7.8 && <8 , ghc-paths >=0.1 - , syb >=0.5 + , ghc-syb-utils >=0.2 + , syb >=0.4 , hspec >=2.1 , QuickCheck -any - , filepath >=1.4 + , filepath >=1.3 , argon -any ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - if impl(ghc < 7.10.2) + if impl(ghc < 7.8) buildable: False default-language: Haskell2010 other-modules: Argon diff --git a/src/Argon.hs b/src/Argon.hs --- a/src/Argon.hs +++ b/src/Argon.hs @@ -15,6 +15,7 @@ , OutputMode(..) , Config(..) , Loc + , LModule -- * Parsing , analyze , parseModule @@ -24,7 +25,7 @@ , export ) where -import Argon.Parser (analyze, parseModule) +import Argon.Parser (LModule, analyze, parseModule) import Argon.Results (order, export, filterResults) import Argon.Types import Argon.Loc diff --git a/src/Argon/Loc.hs b/src/Argon/Loc.hs --- a/src/Argon/Loc.hs +++ b/src/Argon/Loc.hs @@ -7,8 +7,8 @@ import qualified SrcLoc as GHC import qualified FastString as GHC --- | Type synonym representing a portion of the source code. The tuple --- represents the following: @(start line, start col, end line, end col)@. +-- | Type synonym representing a location in the source code. The tuple +-- represents the following: @(start line, start col)@. type Loc = (Int, Int) diff --git a/src/Argon/Parser.hs b/src/Argon/Parser.hs --- a/src/Argon/Parser.hs +++ b/src/Argon/Parser.hs @@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} -module Argon.Parser (analyze, parseModule) +module Argon.Parser (LModule, analyze, parseModule) where import Control.Monad (void) import qualified Control.Exception as E -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) -#endif import qualified GHC hiding (parseModule) import qualified SrcLoc as GHC @@ -25,6 +22,8 @@ import Argon.Types import Argon.Loc +-- | Type synonym for a syntax node representing a module tagged with a +-- 'SrcSpan' type LModule = GHC.Located (GHC.HsModule GHC.RdrName) diff --git a/src/Argon/Preprocess.hs b/src/Argon/Preprocess.hs --- a/src/Argon/Preprocess.hs +++ b/src/Argon/Preprocess.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -- | This module provides support for CPP and interpreter directives. module Argon.Preprocess @@ -7,6 +8,9 @@ , getPreprocessedSrcDirect ) where +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<$>)) +#endif import qualified GHC import qualified DynFlags as GHC import qualified MonadUtils as GHC diff --git a/src/Argon/Types.hs b/src/Argon/Types.hs --- a/src/Argon/Types.hs +++ b/src/Argon/Types.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +#if __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE DeriveDataTypeable #-} +#endif module Argon.Types (ComplexityBlock(CC), AnalysisResult, Config(..) , OutputMode(..), GhcParseError(..)) diff --git a/src/Argon/Visitor.hs b/src/Argon/Visitor.hs --- a/src/Argon/Visitor.hs +++ b/src/Argon/Visitor.hs @@ -1,7 +1,8 @@ module Argon.Visitor (funcsCC) where -import Data.Generics (Data, Typeable, everything, mkQ) +import Data.Generics (Data, Typeable, mkQ) +import GHC.SYB.Utils (Stage(..), everythingStaged) import Control.Arrow ((&&&)) import qualified GHC @@ -24,7 +25,7 @@ funCC f = CC (getLocation $ GHC.fun_id f, getFuncName f, complexity f) getBinds :: (Data from, Typeable from) => from -> [Function] -getBinds = everything (++) $ mkQ [] visit +getBinds = everythingStaged Parser (++) [] $ mkQ [] visit where visit fun@(GHC.FunBind {}) = [fun] visit _ = [] @@ -32,13 +33,11 @@ getLocation = srcSpanToLoc . GHC.getLoc getFuncName :: Function -> String -getFuncName f = case GHC.m_fun_id_infix . GHC.unLoc . head $ getMatches f of - Just name -> getName . GHC.unLoc $ fst name - Nothing -> "" +getFuncName = getName . GHC.unLoc . GHC.fun_id complexity :: Function -> Int complexity f = let matches = getMatches f - query = everything (+) $ 0 `mkQ` visit + query = everythingStaged Parser (+) 0 $ 0 `mkQ` visit visit = uncurry (+) . (visitExp &&& visitOp) in length matches + sumWith query matches diff --git a/test/ArgonSpec.hs b/test/ArgonSpec.hs --- a/test/ArgonSpec.hs +++ b/test/ArgonSpec.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveAnyClass #-} + module ArgonSpec (spec) where @@ -25,7 +25,7 @@ <*> arbitrary shrink (CC t) = map CC $ shrink t -deriving instance Arbitrary OutputMode +instance Arbitrary OutputMode where ones :: Loc @@ -47,42 +47,49 @@ spec :: Spec spec = do - describe "loc module" $ 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) - it "can convert a loc to string" $ - locToString (1, 30) `shouldBe` "1:30" - it "can tag messages" $ - tagMsg (2, 3) "my custom msg" `shouldBe` "2:3 my custom msg" - 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 { minCC = 3, outputMode = 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.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 { minCC = 3, outputMode = 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)]