homplexity 0.4.4.3 → 0.4.4.4

raw patch · 11 files changed

+157/−50 lines, 11 filesdep +pqueuedep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: pqueue

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• README.md +8/−0
• app/Homplexity.hs +10/−7
• changelog.md +3/−0
• homplexity.cabal +18/−9
• lib/Language/Haskell/Homplexity/Assessment.hs +1/−4
• lib/Language/Haskell/Homplexity/CodeFragment.hs +4/−1
• lib/Language/Haskell/Homplexity/Comments.hs +23/−4
• lib/Language/Haskell/Homplexity/Message.hs +1/−3
• lib/Language/Haskell/Homplexity/Parse.hs +23/−16
• tests/Comments.hs +28/−6
• tests/TestSource.hs +38/−0

@@ -10,8 +10,16 @@  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) 

@@ -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 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 @@ 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."] 

@@ -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. 

@@ -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 @@                        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 @@                        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 

@@ -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

@@ -34,6 +34,7 @@ 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 @@        (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 {..}

@@ -21,6 +21,8 @@ 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 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,8 +61,24 @@ 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] commentable code = ($ code) `concatMap` [slicesOf functionT@@ -85,13 +103,14 @@     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, [])

@@ -23,7 +23,6 @@ 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 @@ 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

@@ -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 @@                             }                } +-- | 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 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 @@   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+  }

@@ -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  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_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

@@ -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