summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichalGajda <>2018-12-05 21:25:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-12-05 21:25:00 (GMT)
commitd76fdfe94763e01961da3e24597de3d41011e1a0 (patch)
treed55afa35aff49b7b3dd058ff50d603d3dda500dd
parent70244093331c6dd9766855b4aefbe961f7045b39 (diff)
version 0.4.4.4HEAD0.4.4.4master
-rw-r--r--README.md8
-rw-r--r--app/Homplexity.hs17
-rw-r--r--changelog.md3
-rw-r--r--homplexity.cabal27
-rw-r--r--lib/Language/Haskell/Homplexity/Assessment.hs5
-rw-r--r--lib/Language/Haskell/Homplexity/CodeFragment.hs5
-rw-r--r--lib/Language/Haskell/Homplexity/Comments.hs27
-rw-r--r--lib/Language/Haskell/Homplexity/Message.hs4
-rw-r--r--lib/Language/Haskell/Homplexity/Parse.hs39
-rw-r--r--tests/Comments.hs34
-rw-r--r--tests/TestSource.hs38
11 files changed, 157 insertions, 50 deletions
diff --git a/README.md b/README.md
index 309a535..4ec7980 100644
--- a/README.md
+++ b/README.md
@@ -10,9 +10,17 @@ Builds across GHC versions: [![Build across GHC versions](https://api.travis-ci.
Builds with Stack: [![CircleCI (all branches)](https://img.shields.io/circleci/project/github/mgajda/homplexity.svg)](https://circleci.com/gh/mgajda/homplexity)
+Shippable CI:
+[![Run Status](https://api.shippable.com/projects/5bf3f8b259e32e0700e952aa/badge?branch=master)](https://app.shippable.com/github/mgajda/homplexity)
+
+GitLab CI:
+![Gitlab pipeline status](https://img.shields.io/gitlab/pipeline/migamake/homplexity.svg)
+
[![Hackage](https://img.shields.io/hackage/v/homplexity.svg)](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)
+If you just need latest static executable [it is always available here](https://gitlab.com/migamake/homplexity/-/jobs/artifacts/master/raw/bin/homplexity-cli?job=test_distribution).
+
Official releases are on [Hackage](https://hackage.haskell.org/package/homplexity)
USAGE:
diff --git a/app/Homplexity.hs b/app/Homplexity.hs
index bc9c908..312852b 100644
--- a/app/Homplexity.hs
+++ b/app/Homplexity.hs
@@ -11,6 +11,7 @@
-- | Main module parsing inputs, and running analysis.
module Main (main) where
+import Control.Monad(when)
import Data.Functor
import Data.List
import Data.Monoid
@@ -71,7 +72,7 @@ concatMapM :: (Functor m, Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM f = fmap concat . mapM f
-- * Analysis
--- | Analyze a set of modules.
+-- | Analyze a single module.
analyzeModule :: Module SrcLoc -> IO ()
analyzeModule = putStr
. concatMap show
@@ -96,12 +97,14 @@ defineFlag "fakeFlag" Info "this flag is fake"
main :: IO ()
main = do
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.")
+ null args `when` do report ("Use Haskell source file or directory as an argument, " ++
+ "or use --help to discover options.")
+ exitFailure
+ sums <- mapM processFile =<< concatMapM subTrees args
+ case length sums of
+ 0 -> do report "No valid Haskell source file found!"
exitFailure
- else do sums <- mapM processFile =<< concatMapM subTrees args
- putStrLn $ unwords ["Correctly parsed", show $ length $ filter id sums,
- "out of", show $ length sums,
+ n -> putStrLn $ unwords ["Correctly parsed", show $ length $ filter id sums,
+ "out of", show n,
"input files."]
diff --git a/changelog.md b/changelog.md
index 26ffb78..fd1bc2e 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,8 @@
Changelog
=========
+ 0.4.4.4 Nov 2018
+ * Fix missing pattern for InfixMatch.
+
0.4.4.3 Nov 2018
* Fixed wrong base bounds for tests.
diff --git a/homplexity.cabal b/homplexity.cabal
index c04934e..d64fb0a 100644
--- a/homplexity.cabal
+++ b/homplexity.cabal
@@ -1,5 +1,5 @@
name: homplexity
-version: 0.4.4.3
+version: 0.4.4.4
synopsis: Haskell code quality tool
description: Homplexity aims to measure code complexity,
warning about fragments that might have higher defect probability
@@ -57,7 +57,8 @@ Library
deepseq >=1.3 && <1.7,
containers >=0.3 && <0.7,
template-haskell >=2.6 && <2.16,
- cpphs >=1.5 && <1.21
+ cpphs >=1.5 && <1.21,
+ pqueue
other-extensions: FlexibleContexts,
FlexibleInstances,
UndecidableInstances,
@@ -91,18 +92,26 @@ executable homplexity-cli
cpphs >=1.5 && <1.21,
homplexity
default-language: Haskell2010
- -- STATIC: ld-options: -static
- -- STATIC: ghc-options: -fPIC
+ ld-options: -static
+ ghc-options: -fPIC
test-suite Comments
main-is: Comments.hs
- hs-source-dirs: lib tests
- other-modules: Language.Haskell.Homplexity.CodeFragment
- Language.Haskell.Homplexity.Comments
- Language.Haskell.Homplexity.SrcSlice
+ hs-source-dirs: tests
+ other-modules: TestSource
type: exitcode-stdio-1.0
build-depends: base >=4.5 && <4.13,
+ containers >=0.3 && <0.7,
+ cpphs >=1.5 && <1.21,
+ deepseq >=1.3 && <1.7,
+ directory >=1.1 && <1.4,
+ filepath >=1.2 && <1.5,
+ uniplate >=1.4 && <1.7,
haskell-src-exts >=1.18 && <1.21,
- uniplate >=1.4 && <1.7
+ hflags >=0.3 && <0.5,
+ template-haskell,
+ pqueue,
+ homplexity
default-language: Haskell2010
+ other-extensions: TemplateHaskell
diff --git a/lib/Language/Haskell/Homplexity/Assessment.hs b/lib/Language/Haskell/Homplexity/Assessment.hs
index e77832e..86e2152 100644
--- a/lib/Language/Haskell/Homplexity/Assessment.hs
+++ b/lib/Language/Haskell/Homplexity/Assessment.hs
@@ -9,10 +9,7 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
-- | Main module parsing inputs, and running analysis.
-module Language.Haskell.Homplexity.Assessment (
- metrics
- --, measureAllOccurs
- ) where
+module Language.Haskell.Homplexity.Assessment where
import Data.Data
import Data.Monoid
diff --git a/lib/Language/Haskell/Homplexity/CodeFragment.hs b/lib/Language/Haskell/Homplexity/CodeFragment.hs
index b2f522a..5b9f8e6 100644
--- a/lib/Language/Haskell/Homplexity/CodeFragment.hs
+++ b/lib/Language/Haskell/Homplexity/CodeFragment.hs
@@ -34,6 +34,7 @@ import Data.Functor
import Data.Generics.Uniplate.Data
import Data.List
import Data.Maybe
+import Data.Monoid
import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.SrcLoc
import Language.Haskell.Homplexity.SrcSlice
@@ -115,7 +116,9 @@ instance CodeFragment Function where
(unName <$>) . take 1 -> functionNames,
functionRhs,
catMaybes -> functionBinds) = unzip4 $ map extract matches
- extract (Match srcLoc name _ rhs binds) = (srcLoc, name, rhs, binds)
+ extract (Match srcLoc name _ rhs binds) = (srcLoc, name, rhs, binds)
+ extract (InfixMatch srcLoc _ name _ rhs binds) = (srcLoc, name, rhs, binds)
+ extract other = error $ "Undocumented constructor: " <> show other
matchAST (PatBind (singleton -> functionLocations) pat
(singleton -> functionRhs )
(maybeToList -> functionBinds )) = Just Function {..}
diff --git a/lib/Language/Haskell/Homplexity/Comments.hs b/lib/Language/Haskell/Homplexity/Comments.hs
index 9185a22..50dd09a 100644
--- a/lib/Language/Haskell/Homplexity/Comments.hs
+++ b/lib/Language/Haskell/Homplexity/Comments.hs
@@ -21,6 +21,8 @@ import Data.Data
import Data.Function
import Data.Functor
import Data.List
+import qualified Data.Map.Strict as Map
+import qualified Data.PQueue.Max as Prio
import Language.Haskell.Homplexity.CodeFragment
import Language.Haskell.Homplexity.SrcSlice
@@ -51,7 +53,7 @@ findCommentType :: String -> CommentType
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
+ Just '*' -> CommentsInside -- since it comments the group of declarations, it belongs to the containing object
_ -> CommentsInside
-- * Finding ranges of all commentable entities.
@@ -59,7 +61,23 @@ findCommentType txt = case (not . isSpace) `find` txt of
data CommentSite = CommentSite { siteName :: String
, siteSlice :: SrcSlice
}
- deriving (Show)
+ deriving (Eq, Show)
+
+newtype Ends = End { siteEnded :: CommentSite }
+ deriving (Eq, Show)
+
+compareStarts :: CommentSite -> CommentSite -> Ordering
+compareStarts = compare `on` start . siteSlice
+
+instance Ord Ends where
+ compare = compareEnds `on` siteEnded
+
+compareEnds :: CommentSite -> CommentSite -> Ordering
+compareEnds = compare `on` end . siteSlice
+
+start, end :: SrcSlice -> (Int, Int)
+start slice = (srcSpanStartColumn slice, srcSpanStartLine slice)
+end slice = (srcSpanEndColumn slice, srcSpanEndLine slice)
-- | Find comment sites for entire program.
commentable :: Data from => from -> [CommentSite]
@@ -85,13 +103,14 @@ orderCommentsAndCommentables sites comments = sortBy (compare `on` loc) elts
loc (Right (siteSlice -> srcSpan)) = (srcSpan, False)
elts = (Left <$> comments) ++ (Right <$> sites)
+type Assignment = Map.Map CommentSite [CommentLink]
{-
-type Assignment = (CommentSite, [CommentLink])
-- | Assign comments to the commentable elements.
assignComments :: [Either CommentLink CommentSite]
+ -> [Assignment]
assignComments = foldr assign ([], [], [], [])
where
- assign :: ([Assignment], [Assignment], [CommentLink]
+ assign :: (Assignment, [Assignment], [CommentLink]
assign (assigned, unclosed, commentingAfter) nextElt = case nextElt of
Left (s@(CommentSite {})) ->
(assigned, (s,commentingAfter):unclosed, [])
diff --git a/lib/Language/Haskell/Homplexity/Message.hs b/lib/Language/Haskell/Homplexity/Message.hs
index 3368857..bdc1616 100644
--- a/lib/Language/Haskell/Homplexity/Message.hs
+++ b/lib/Language/Haskell/Homplexity/Message.hs
@@ -23,7 +23,6 @@ import Data.Function (on)
import Data.Foldable as Foldable
import Data.Monoid
#if __GLASGOW_HASKELL__ >= 800
--- MIN_VERSION_base(4,9,0)
import Data.Semigroup
#endif
import Data.Sequence as Seq
@@ -35,10 +34,9 @@ import HFlags
newtype Log = Log { unLog :: Seq Message }
deriving(Monoid
#if __GLASGOW_HASKELL__ >= 800
--- #if MIN_VERSION_base(4,9,0)
,Semigroup
#endif
- )
+ )
instance NFData Log where
rnf = rnf . unLog
diff --git a/lib/Language/Haskell/Homplexity/Parse.hs b/lib/Language/Haskell/Homplexity/Parse.hs
index 6ef3c88..76ccdd8 100644
--- a/lib/Language/Haskell/Homplexity/Parse.hs
+++ b/lib/Language/Haskell/Homplexity/Parse.hs
@@ -5,7 +5,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Parsing of Haskell source files, and error reporting for unparsable files.
-module Language.Haskell.Homplexity.Parse (parseSource) where
+module Language.Haskell.Homplexity.Parse (parseSource, parseTest) where
import Control.Exception as E
import Data.Functor
@@ -43,6 +43,15 @@ cppHsOptions = defaultCpphsOptions {
}
}
+-- | For use in test suite
+parseTest :: String -> String -> IO (Module SrcLoc, [CommentLink])
+parseTest testId testSource = do
+ maybeParsed <- parseModuleWithComments (makeParseMode testId)
+ <$> runCpphs cppHsOptions testId testSource
+ case maybeParsed of
+ ParseOk (parsed, comments) -> return $ (getPointLoc <$> parsed, classifyComments comments)
+ other -> error $ show other
+
-- | Parse Haskell source file, using CppHs for preprocessing,
-- and haskell-src-exts for parsing.
--
@@ -51,7 +60,8 @@ parseSource :: FilePath -> IO (Either Log (Module SrcLoc, [CommentLink]))
parseSource inputFilename = do
parseResult <- (do
input <- readFile inputFilename
- result <- parseModuleWithComments parseMode <$> runCpphs cppHsOptions inputFilename input
+ result <- parseModuleWithComments (makeParseMode inputFilename)
+ <$> runCpphs cppHsOptions inputFilename input
evaluate result)
`E.catch` handleException (ParseFailed thisFileLoc)
case parseResult of
@@ -65,17 +75,14 @@ parseSource inputFilename = do
where
handleException helper (e :: SomeException) = return $ helper $ show e
thisFileLoc = noLoc { srcFilename = inputFilename }
- parseMode = ParseMode {
- parseFilename = inputFilename
- , baseLanguage = Haskell2010
- , extensions = myExtensions
- , ignoreLanguagePragmas = False
- , ignoreLinePragmas = False
- , fixities = Just preludeFixities
- , ignoreFunctionArity = False
- }
-{-putStrLn "COMMENTS:"
- putStrLn $ unlines $ map show $ classifyComments comments
- putStrLn "COMMENTABLES:"
- putStrLn $ unlines $ map show $ commentable parsed-}
-
+
+makeParseMode inputFilename =
+ ParseMode {
+ parseFilename = inputFilename
+ , baseLanguage = Haskell2010
+ , extensions = myExtensions
+ , ignoreLanguagePragmas = False
+ , ignoreLinePragmas = False
+ , fixities = Just preludeFixities
+ , ignoreFunctionArity = False
+ }
diff --git a/tests/Comments.hs b/tests/Comments.hs
index f133ffa..0527f6d 100644
--- a/tests/Comments.hs
+++ b/tests/Comments.hs
@@ -3,6 +3,8 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
module Main (
main
) where
@@ -15,8 +17,12 @@ import Language.Haskell.Exts.SrcLoc
import Language.Haskell.Exts
import Language.Haskell.Homplexity.Comments
+import Language.Haskell.Homplexity.Parse
+import Language.Haskell.Homplexity.Metric
--- * Tests for comments
+import TestSource
+
+-- * Tests for comment types
prop_commentsAfter :: Bool
prop_commentsAfter = findCommentType " |" == CommentsAfter
@@ -29,10 +35,26 @@ prop_commentsGroup = findCommentType " *" == CommentsInside
prop_commentsInside :: Bool
prop_commentsInside = findCommentType " a" == CommentsInside
+testSrc = do
+ (ast, comments) <- [tsrc|
+module Amanitas where
+-- | This is comment preceeding variable "a"
+a=1
+b=2
+-- ^ This is comment following variable "b"
+|]
+ putStrLn $ "Comments:\n" ++ show comments
+ assert (and [length comments == 2
+ ]) $
+ return ()
+--src = $withLocation "mystring"
+
-- Runs all unit tests.
main :: IO ()
-main = assert (and [prop_commentsAfter
- ,prop_commentsBefore
- ,prop_commentsGroup
- ,prop_commentsInside]) $
- return ()
+main = do
+ assert (and [prop_commentsAfter
+ ,prop_commentsBefore
+ ,prop_commentsGroup
+ ,prop_commentsInside]) $
+ return ()
+ testSrc
diff --git a/tests/TestSource.hs b/tests/TestSource.hs
new file mode 100644
index 0000000..d0f12b5
--- /dev/null
+++ b/tests/TestSource.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+-- | This module allows embedding source modules
+-- Example:
+--
+-- example1 :: IO ParseResult
+-- example1 = [tsrc|
+-- mod ule Main where
+-- a=1
+-- |]
+-- -- Filename and line where error happens will be correctly reported by Haskell parser.
+
+module TestSource(tsrc) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+
+import Language.Haskell.Homplexity.Parse(parseTest)
+
+-- | QuasiQuoter for a non-interpolating String
+tsrc :: QuasiQuoter
+tsrc = QuasiQuoter embedSource
+ (error "Cannot use tsrc as a pattern")
+ (error "Cannot use tsrc as a type" )
+ (error "Cannot use tsrc as a dec" )
+embedSource :: String -> Q Exp
+embedSource aString = do
+ loc <- location
+ let theString = linePragma loc ++ aString -- ^ Passes the information about correct location to the source
+ let testNote = "Test line " ++ showLine loc -- ^ Shown in case that LINE pragma is not parsed
+ [|parseTest testNote|] `appE` [| theString |]
+-- parseTest :: FilePath -> String -> IO ParseResult
+
+linePragma :: Loc -> String
+linePragma loc = concat ["{-# LINE ", showLine loc, " \"", loc_filename loc, "\" #-}\n"]
+
+showLine :: Loc -> String
+showLine = show . fst . loc_start