From 48013060320aeb06c382d88093d072d6d6f08c5b Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 11 Oct 2017 17:35:52 -0700 Subject: [PATCH 01/43] Add HasCyclomaticComplexity type classes / family Signed-off-by: Ayman Nadeem --- src/Data/Syntax/Algebra.hs | 99 +++++++++++++++++++++++++++++++++++--- 1 file changed, 91 insertions(+), 8 deletions(-) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 816310a99..1d9436156 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Data.Syntax.Algebra ( FAlgebra , RAlgebra @@ -6,6 +6,8 @@ module Data.Syntax.Algebra , decoratorWithAlgebra , identifierAlgebra , syntaxIdentifierAlgebra +, CyclomaticComplexity(..) +, HasCyclomaticComplexity , cyclomaticComplexityAlgebra , ConstructorName(..) , ConstructorLabel(..) @@ -90,15 +92,96 @@ newtype CyclomaticComplexity = CyclomaticComplexity Int -- | Compute the cyclomatic complexity of a (sub)term, measured as the number places where control exits scope, e.g. returns and yields. -- --- TODO: Explicit returns at the end of methods should only count once. +-- TODO: Explicit returns at the end of methods or functions should only count once. -- TODO: Anonymous functions should not increase parent scope’s complexity. -- TODO: Inner functions should not increase parent scope’s complexity. -cyclomaticComplexityAlgebra :: (Declaration.Method :< fs, Statement.Return :< fs, Statement.Yield :< fs, Apply Foldable fs, Apply Functor fs) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity -cyclomaticComplexityAlgebra (In _ union) = case union of - _ | Just Declaration.Method{} <- prj union -> succ (sum union) - _ | Just Statement.Return{} <- prj union -> succ (sum union) - _ | Just Statement.Yield{} <- prj union -> succ (sum union) - _ -> sum union + +-- | An f-algebra producing a 'CyclomaticComplexity' for syntax nodes corresponding to their summary cyclomatic complexity, defaulting to the sum of their contents’ cyclomatic complexities. +-- +-- Customizing this for a given syntax type involves two steps: +-- +-- 1. Defining a 'CustomHasCyclomaticComplexity' instance for the type. +-- 2. Adding the type to the 'CyclomaticComplexityStrategy' type family. +-- +-- If you’re getting errors about missing a 'CustomHasCyclomaticComplexity' instance for your syntax type, you probably forgot step 1. +-- +-- If you’re getting 'Nothing' for your syntax node at runtime, you probably forgot step 2. +cyclomaticComplexityAlgebra :: (Foldable syntax, HasCyclomaticComplexity syntax) => FAlgebra (TermF syntax ann) CyclomaticComplexity +cyclomaticComplexityAlgebra (In _ syntax) = toCyclomaticComplexity syntax + + +-- | Types for which we can produce a 'CyclomaticComplexity'. There is exactly one instance of this typeclass; adding customized 'CyclomaticComplexity's for a new type is done by defining an instance of 'CustomHasCyclomaticComplexity' instead. +-- +-- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap. +class HasCyclomaticComplexity syntax where + -- | Compute a 'CyclomaticComplexity' for a syntax type using its 'CustomHasCyclomaticComplexity' instance, if any, or else falling back to the default definition (which simply returns the sum of any contained cyclomatic complexities). + toCyclomaticComplexity :: FAlgebra syntax CyclomaticComplexity + +-- | Define 'toCyclomaticComplexity' using the 'CustomHasCyclomaticComplexity' instance for a type if there is one or else use the default definition. +-- +-- This instance determines whether or not there is an instance for @syntax@ by looking it up in the 'CyclomaticComplexityStrategy' type family. Thus producing a 'CyclomaticComplexity' for a node requires both defining a 'CustomHasCyclomaticComplexity' instance _and_ adding a definition for the type to the 'CyclomaticComplexityStrategy' type family to return 'Custom'. +-- +-- Note that since 'CyclomaticComplexityStrategy' has a fallback case for its final entry, this instance will hold for all types of kind @* -> *@. Thus, this must be the only instance of 'HasCyclomaticComplexity', as any other instance would be indistinguishable. +instance (CyclomaticComplexityStrategy syntax ~ strategy, HasCyclomaticComplexityWithStrategy strategy syntax) => HasCyclomaticComplexity syntax where + toCyclomaticComplexity = toCyclomaticComplexityWithStrategy (Proxy :: Proxy strategy) + + +-- | Types for which we can produce a customized 'CyclomaticComplexity'. +class CustomHasCyclomaticComplexity syntax where + -- | Produce a customized 'CyclomaticComplexity' for a given syntax node. + customToCyclomaticComplexity :: FAlgebra syntax CyclomaticComplexity + +instance CustomHasCyclomaticComplexity Declaration.Method where + customToCyclomaticComplexity = succ . sum + +instance CustomHasCyclomaticComplexity Declaration.Function where + customToCyclomaticComplexity = succ . sum + +instance CustomHasCyclomaticComplexity Statement.Return where + customToCyclomaticComplexity = succ . sum + +instance CustomHasCyclomaticComplexity Statement.Yield where + customToCyclomaticComplexity = succ . sum + +-- | Produce a 'CyclomaticComplexity' for 'Union's using the 'HasCyclomaticComplexity' instance & therefore using a 'CustomHasCyclomaticComplexity' instance when one exists & the type is listed in 'CyclomaticComplexityStrategy'. +instance Apply HasCyclomaticComplexity fs => CustomHasCyclomaticComplexity (Union fs) where + customToCyclomaticComplexity = apply (Proxy :: Proxy HasCyclomaticComplexity) toCyclomaticComplexity + + +-- | A strategy for defining a 'HasCyclomaticComplexity' instance. Intended to be promoted to the kind level using @-XDataKinds@. +data Strategy = Default | Custom + +-- | Produce a 'CyclomaticComplexity' for a syntax node using either the 'Default' or 'Custom' strategy. +-- +-- You should probably be using 'CustomHasCyclomaticComplexity' instead of this class; and you should not define new instances of this class. +class HasCyclomaticComplexityWithStrategy (strategy :: Strategy) syntax where + toCyclomaticComplexityWithStrategy :: proxy strategy -> FAlgebra syntax CyclomaticComplexity + + +-- | A predicate on syntax types selecting either the 'Custom' or 'Default' strategy. +-- +-- Only entries for which we want to use the 'Custom' strategy should be listed, with the exception of the final entry which maps all other types onto the 'Default' strategy. +-- +-- If you’re seeing errors about missing a 'CustomHasCyclomaticComplexity' instance for a given type, you’ve probably listed it in here but not defined a 'CustomHasCyclomaticComplexity' instance for it, or else you’ve listed the wrong type in here. Conversely, if your 'customHasCyclomaticComplexity' method is never being called, you may have forgotten to list the type in here. +type family CyclomaticComplexityStrategy syntax where + CyclomaticComplexityStrategy Declaration.Method = 'Custom + CyclomaticComplexityStrategy Declaration.Function = 'Custom + CyclomaticComplexityStrategy Statement.Return = 'Custom + CyclomaticComplexityStrategy Statement.Yield = 'Custom + CyclomaticComplexityStrategy (Union fs) = 'Custom + CyclomaticComplexityStrategy a = 'Default + + +-- | The 'Default' strategy produces 'Nothing'. +instance Foldable syntax => HasCyclomaticComplexityWithStrategy 'Default syntax where + toCyclomaticComplexityWithStrategy _ = sum + +-- | The 'Custom' strategy delegates the selection of the strategy to the 'CustomHasCyclomaticComplexity' instance for the type. +instance CustomHasCyclomaticComplexity syntax => HasCyclomaticComplexityWithStrategy 'Custom syntax where + toCyclomaticComplexityWithStrategy _ = customToCyclomaticComplexity + + + -- | Compute a 'ByteString' label for a 'Show1'able 'Term'. -- From 0433723c14999e9e4c362690d33d24f6a91782a5 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 11 Oct 2017 17:37:16 -0700 Subject: [PATCH 02/43] Decorate with cyclomaticComplexityAlgebra Signed-off-by: Ayman Nadeem --- src/Semantic.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index e486a0b7b..2e7df6c9e 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -47,10 +47,10 @@ parseBlobs renderer = fmap toOutput . distributeFoldMap (parseBlob renderer) . f parseBlob :: TermRenderer output -> Blob -> Task output parseBlob renderer blob@Blob{..} = case (renderer, blobLanguage) of (ToCTermRenderer, lang) - | Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[HasDeclaration, Foldable, Functor]) -> - parse parser blob >>= decorate (declarationAlgebra blob) >>= render (renderToCTerm blob) + | Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[HasCyclomaticComplexity, HasDeclaration, Foldable, Functor]) -> + parse parser blob >>= decorate (declarationAlgebra blob) >>= decorate (fToR cyclomaticComplexityAlgebra) >>= render (renderToCTerm blob) | Just syntaxParser <- lang >>= syntaxParserForLanguage -> - parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= render (renderToCTerm blob) + parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= decorate (const (CyclomaticComplexity 0)) >>= render (renderToCTerm blob) (JSONTermRenderer, lang) | Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[ConstructorName, Foldable, Functor]) -> @@ -78,16 +78,16 @@ diffBlobPair :: DiffRenderer output -> Both Blob -> Task output diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of (OldToCDiffRenderer, lang) | lang `elem` [ Just Language.Markdown, Just Language.Python, Just Language.Ruby ] - , Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, HasDeclaration, Show1, Traversable]) -> - run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs) + , Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, HasCyclomaticComplexity, HasDeclaration, Show1, Traversable]) -> + run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob) >>= decorate (fToR cyclomaticComplexityAlgebra)) diffTerms (renderToCDiff blobs) | Just syntaxParser <- lang >>= syntaxParserForLanguage -> - run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs) + run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= decorate (const (CyclomaticComplexity 0))) diffSyntaxTerms (renderToCDiff blobs) (ToCDiffRenderer, lang) - | Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, HasDeclaration, Show1, Traversable]) -> - run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs) + | Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, HasCyclomaticComplexity, HasDeclaration, Show1, Traversable]) -> + run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob) >>= decorate (fToR cyclomaticComplexityAlgebra)) diffTerms (renderToCDiff blobs) | Just syntaxParser <- lang >>= syntaxParserForLanguage -> - run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs) + run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= decorate (const (CyclomaticComplexity 0))) diffSyntaxTerms (renderToCDiff blobs) (JSONDiffRenderer, lang) | Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, Show1, Traversable]) -> From 0fccc28ccc398b78e8d9c66e4a3c019df6b76755 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 11 Oct 2017 17:38:45 -0700 Subject: [PATCH 03/43] Initial proof of concept of adding cyclomatic complexity score to ToC JSON Summary Signed-off-by: Ayman Nadeem --- src/Renderer/TOC.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 23566e82a..7ae0a1f5a 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -49,7 +49,7 @@ import Language import qualified Data.List as List import qualified Data.Map as Map hiding (null) import Syntax as S -import Data.Syntax.Algebra (RAlgebra) +import Data.Syntax.Algebra (CyclomaticComplexity(..), RAlgebra) import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration import qualified Language.Markdown.Syntax as Markdown @@ -285,7 +285,7 @@ dedupe = let tuples = sortOn fst . Map.elems . snd . foldl' go (0, Map.empty) in exactMatch = (==) `on` (getDeclaration . entryPayload) -- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches. -entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Entry (Record fields) -> Maybe JSONSummary +entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Entry (Record fields) -> Maybe JSONSummary entrySummary entry = case entry of Unchanged _ -> Nothing Changed a -> recordSummary a "modified" @@ -294,13 +294,13 @@ entrySummary entry = case entry of Replaced a -> recordSummary a "modified" -- | Construct a 'JSONSummary' from a node annotation and a change type label. -recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Record fields -> T.Text -> Maybe JSONSummary +recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Record fields -> T.Text -> Maybe JSONSummary recordSummary record = case getDeclaration record of Just (ErrorDeclaration text language) -> Just . const (ErrorSummary text (sourceSpan record) language) - Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) + Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration <> " " <> let CyclomaticComplexity n = getField record in T.pack (show n)) (sourceSpan record) Nothing -> const Nothing -renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) (Record fields) -> Summaries +renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) (Record fields) -> Summaries renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC where toMap [] = mempty toMap as = Map.singleton summaryKey (toJSON <$> as) @@ -310,15 +310,15 @@ renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isV | before == after -> after | otherwise -> before <> " -> " <> after -renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Blob -> Term f (Record fields) -> Summaries +renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Blob -> Term f (Record fields) -> Summaries renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC where toMap [] = mempty toMap as = Map.singleton (T.pack blobPath) (toJSON <$> as) -diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Diff f (Record fields) (Record fields) -> [JSONSummary] +diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Diff f (Record fields) (Record fields) -> [JSONSummary] diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration -termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Term f (Record fields) -> [JSONSummary] +termToC :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Term f (Record fields) -> [JSONSummary] termToC = mapMaybe (flip recordSummary "unchanged") . termTableOfContentsBy declaration -- The user-facing category name From 727218e6aa5d70a4de40514d3a9836f8fb16fbf5 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Oct 2017 13:14:47 -0700 Subject: [PATCH 04/43] Maybe CyclomaticComplexity to recordSummary as input --- src/Renderer/TOC.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index cd3ced1ea..4a5b19fc3 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -285,17 +285,18 @@ dedupe = let tuples = sortOn fst . Map.elems . snd . foldl' go (0, Map.empty) in -- | Construct a 'JSONSummary' from an 'Entry'. entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Entry (Record fields) -> Maybe JSONSummary entrySummary entry = case entry of - Changed a -> recordSummary a "modified" - Deleted a -> recordSummary a "removed" - Inserted a -> recordSummary a "added" - Replaced a -> recordSummary a "modified" + Changed a -> recordSummary a "modified" (Just (getField a)) + Deleted a -> recordSummary a "removed" (Just (getField a)) + Inserted a -> recordSummary a "added" (Just (getField a)) + Replaced a -> recordSummary a "modified" (Just (getField a)) + -- | Construct a 'JSONSummary' from a node annotation and a change type label. -recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Record fields -> T.Text -> Maybe JSONSummary -recordSummary record = case getDeclaration record of - Just (ErrorDeclaration text language) -> Just . const (ErrorSummary text (sourceSpan record) language) - Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration <> " " <> let CyclomaticComplexity n = getField record in T.pack (show n)) (sourceSpan record) - Nothing -> const Nothing +recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Record fields -> T.Text -> Maybe CyclomaticComplexity -> Maybe JSONSummary +recordSummary record entryText complexity = case getDeclaration record of + Just (ErrorDeclaration text language) -> Just $ ErrorSummary text (sourceSpan record) language + Just declaration -> Just $ JSONSummary (toCategoryName declaration) (declarationIdentifier declaration <> " " <> (maybe T.empty (\n -> T.pack (show n)) complexity)) (sourceSpan record) entryText + Nothing -> Nothing renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) (Record fields) -> Summaries renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC @@ -316,7 +317,7 @@ diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, HasField diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration termToC :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Term f (Record fields) -> [JSONSummary] -termToC = mapMaybe (flip recordSummary "unchanged") . termTableOfContentsBy declaration +termToC = mapMaybe (\a -> recordSummary a "unchanged" Nothing) . termTableOfContentsBy declaration -- The user-facing category name toCategoryName :: Declaration -> T.Text From 0911737f7d5dce1f5a2e3829920563e12600d770 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Oct 2017 15:55:33 -0700 Subject: [PATCH 05/43] Convert entryPayload to These --- src/Renderer/TOC.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 4a5b19fc3..27dc57a45 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -42,6 +42,7 @@ import Data.Source as Source import Data.Term import Data.Text (toLower) import qualified Data.Text as T +import Data.These import Data.Union import GHC.Generics import Info @@ -226,12 +227,19 @@ formatTOCError e = showExpectation False (errorExpected e) (errorActual e) "" -- | An entry in a table of contents. data Entry a - = Changed { entryPayload :: a } -- ^ An entry for a node containing changes. - | Inserted { entryPayload :: a } -- ^ An entry for a change occurring inside an 'Insert' 'Patch'. - | Deleted { entryPayload :: a } -- ^ An entry for a change occurring inside a 'Delete' 'Patch'. - | Replaced { entryPayload :: a } -- ^ An entry for a change occurring on the insertion side of a 'Replace' 'Patch'. + = Changed (These a a) -- ^ An entry for a node containing changes. + | Inserted a -- ^ An entry for a change occurring inside an 'Insert' 'Patch'. + | Deleted a -- ^ An entry for a change occurring inside a 'Delete' 'Patch'. + | Replaced a -- ^ An entry for a change occurring on the insertion side of a 'Replace' 'Patch'. deriving (Eq, Show) +entryPayload :: Entry a -> a +entryPayload (Changed (These a1 a2)) = a2 +entryPayload (Changed (This a1)) = a1 +entryPayload (Changed (That a2)) = a2 +entryPayload (Inserted a2) = a2 +entryPayload (Deleted a1) = a1 +entryPayload (Replaced a2) = a2 -- | Compute a table of contents for a diff characterized by a function mapping relevant nodes onto values in Maybe. tableOfContentsBy :: (Foldable f, Functor f) From 80b5238b303fa60478308970ecd120ae985b5ae8 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Oct 2017 15:56:06 -0700 Subject: [PATCH 06/43] Align both annotations --- src/Renderer/TOC.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 27dc57a45..c41a1337e 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -18,7 +18,7 @@ module Renderer.TOC ) where import Data.Aeson -import Data.Align (bicrosswalk) +import Data.Align (align, bicrosswalk) import Data.Bifoldable (bifoldMap) import Data.Bifunctor (bimap) import Data.Blob @@ -248,7 +248,7 @@ tableOfContentsBy :: (Foldable f, Functor f) -> [Entry a] -- ^ A list of entries for relevant changed nodes in the diff. tableOfContentsBy selector = fromMaybe [] . cata (\ r -> case r of Patch patch -> (pure . patchEntry <$> bicrosswalk selector selector patch) <> bifoldMap fold fold patch <> Just [] - Merge (In (_, ann2) r) -> case (selector (In ann2 r), fold r) of + Merge (In (ann1, ann2) r) -> case (selector (In ann1 r) `align` selector (In ann2 r), fold r) of (Just a, Just entries) -> Just (Changed a : entries) (_ , entries) -> entries) From e633d4b6aca24c6fe0dabc943d338c028dbd5829 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Oct 2017 15:56:25 -0700 Subject: [PATCH 07/43] Add helper function --- src/Renderer/TOC.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index c41a1337e..e8129f6e2 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -204,6 +204,9 @@ instance CustomHasDeclaration syntax => HasDeclarationWithStrategy 'Custom synta getDeclaration :: HasField fields (Maybe Declaration) => Record fields -> Maybe Declaration getDeclaration = getField +getCyclomaticComplexity :: HasField fields (CyclomaticComplexity) => Record fields -> CyclomaticComplexity +getCyclomaticComplexity = getField + -- | Produce the annotations of nodes representing declarations. declaration :: HasField fields (Maybe Declaration) => TermF f (Record fields) a -> Maybe (Record fields) declaration (In annotation _) = annotation <$ (getField annotation :: Maybe Declaration) From f6e9e825d182dd183a8c2d1975f5555a9fd1c90f Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Oct 2017 15:57:12 -0700 Subject: [PATCH 08/43] Calculate relative difference of cyclomatic complexity --- src/Renderer/TOC.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index e8129f6e2..07840463d 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -296,8 +296,8 @@ dedupe = let tuples = sortOn fst . Map.elems . snd . foldl' go (0, Map.empty) in -- | Construct a 'JSONSummary' from an 'Entry'. entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Entry (Record fields) -> Maybe JSONSummary entrySummary entry = case entry of - Changed a -> recordSummary a "modified" (Just (getField a)) - Deleted a -> recordSummary a "removed" (Just (getField a)) + Changed a -> recordSummary (mergeThese (flip const) a) "modified" (these (Just . negate . getCyclomaticComplexity) (Just . getCyclomaticComplexity) (\a1 a2 -> let cc = getCyclomaticComplexity a2 - getCyclomaticComplexity a1 in Just cc) a) + Deleted a -> recordSummary a "removed" (Just (negate (getField a))) Inserted a -> recordSummary a "added" (Just (getField a)) Replaced a -> recordSummary a "modified" (Just (getField a)) @@ -306,7 +306,7 @@ entrySummary entry = case entry of recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Record fields -> T.Text -> Maybe CyclomaticComplexity -> Maybe JSONSummary recordSummary record entryText complexity = case getDeclaration record of Just (ErrorDeclaration text language) -> Just $ ErrorSummary text (sourceSpan record) language - Just declaration -> Just $ JSONSummary (toCategoryName declaration) (declarationIdentifier declaration <> " " <> (maybe T.empty (\n -> T.pack (show n)) complexity)) (sourceSpan record) entryText + Just declaration -> Just $ JSONSummary (toCategoryName declaration) (declarationIdentifier declaration <> " " <> (maybe T.empty (\(CyclomaticComplexity n) -> T.pack (show n)) complexity)) (sourceSpan record) entryText Nothing -> Nothing renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) (Record fields) -> Summaries From 6e76a75323bee3a783ac39623b570d80882f8881 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Oct 2017 15:57:28 -0700 Subject: [PATCH 09/43] Update type annotation --- test/TOCSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index d0fcad3e0..317931df1 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -165,8 +165,8 @@ spec = parallel $ do toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[7,10]},\"category\":\"Heading 1\",\"term\":\"One\",\"changeType\":\"modified\"},{\"span\":{\"start\":[5,1],\"end\":[7,10]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) -type Diff' = Diff Syntax (Record (Maybe Declaration ': DefaultFields)) (Record (Maybe Declaration ': DefaultFields)) -type Term' = Term Syntax (Record (Maybe Declaration ': DefaultFields)) +type Diff' = Diff Syntax (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) +type Term' = Term Syntax (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) numTocSummaries :: Diff' -> Int numTocSummaries diff = length $ filter isValidSummary (diffTOC diff) From 9b2b7d06ccbc0a396e11315387cf622b2900e128 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 16 Oct 2017 11:37:43 -0700 Subject: [PATCH 10/43] :abc: --- src/Data/Syntax/Algebra.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 1d9436156..39cb6c2c3 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -22,8 +22,8 @@ import Data.Foldable (asum) import Data.Functor.Classes (Show1 (liftShowsPrec)) import Data.Functor.Foldable import Data.JSON.Fields -import Data.Record import Data.Proxy +import Data.Record import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Statement as Statement From d1de58e71664c51e6e108104269662b26a5dc601 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 16 Oct 2017 11:37:54 -0700 Subject: [PATCH 11/43] Derive ToJSON for CyclomaticComplexity --- src/Data/Syntax/Algebra.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 39cb6c2c3..e442e3d88 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -88,7 +88,7 @@ syntaxIdentifierAlgebra (In _ syntax) = case syntax of -- | The cyclomatic complexity of a (sub)term. newtype CyclomaticComplexity = CyclomaticComplexity Int - deriving (Enum, Eq, Num, Ord, Show) + deriving (Enum, Eq, Num, Ord, Show, ToJSON) -- | Compute the cyclomatic complexity of a (sub)term, measured as the number places where control exits scope, e.g. returns and yields. -- From 8fe1347326586743d0bd06ff1679534e6ab47f45 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 16 Oct 2017 11:38:56 -0700 Subject: [PATCH 12/43] Add relative and abosolute cyclomatic complexity to toc entries --- src/Renderer/TOC.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 07840463d..38088dab0 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -74,12 +74,14 @@ data JSONSummary , summaryTermName :: T.Text , summarySpan :: Span , summaryChangeType :: T.Text + , summaryRelativeCyclomaticComplexity :: CyclomaticComplexity + , summaryAbsoluteCyclomaticComplexity :: CyclomaticComplexity } | ErrorSummary { error :: T.Text, errorSpan :: Span, errorLanguage :: Maybe Language } deriving (Generic, Eq, Show) instance ToJSON JSONSummary where - toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan ] + toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan, "relative_cyclomatic_complexity" .= summaryRelativeCyclomaticComplexity, "absolute_cyclomatic_complexity" .= summaryAbsoluteCyclomaticComplexity ] toJSON ErrorSummary{..} = object [ "error" .= error, "span" .= errorSpan, "language" .= errorLanguage ] isValidSummary :: JSONSummary -> Bool @@ -304,9 +306,9 @@ entrySummary entry = case entry of -- | Construct a 'JSONSummary' from a node annotation and a change type label. recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity) => Record fields -> T.Text -> Maybe CyclomaticComplexity -> Maybe JSONSummary -recordSummary record entryText complexity = case getDeclaration record of +recordSummary record entryText relativeComplexity = case getDeclaration record of Just (ErrorDeclaration text language) -> Just $ ErrorSummary text (sourceSpan record) language - Just declaration -> Just $ JSONSummary (toCategoryName declaration) (declarationIdentifier declaration <> " " <> (maybe T.empty (\(CyclomaticComplexity n) -> T.pack (show n)) complexity)) (sourceSpan record) entryText + Just declaration -> Just $ JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) entryText (maybe (CyclomaticComplexity 0) id relativeComplexity) (getCyclomaticComplexity record) Nothing -> Nothing renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, HasField fields CyclomaticComplexity, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) (Record fields) -> Summaries From b7b134f9ef6009f26e2a702788c659a55ff60f96 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 16 Oct 2017 11:39:19 -0700 Subject: [PATCH 13/43] We don't need the before annotations --- src/Renderer/TOC.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 38088dab0..3561ce997 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -239,7 +239,7 @@ data Entry a deriving (Eq, Show) entryPayload :: Entry a -> a -entryPayload (Changed (These a1 a2)) = a2 +entryPayload (Changed (These _ a2)) = a2 entryPayload (Changed (This a1)) = a1 entryPayload (Changed (That a2)) = a2 entryPayload (Inserted a2) = a2 From 2dad14e33e069d7e848abd6d0657432583cc58ab Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 16 Oct 2017 14:24:49 -0700 Subject: [PATCH 14/43] Add Listable instance for CyclomaticComplexity --- test/Data/Functor/Listable.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs index e7a088814..fadea058d 100644 --- a/test/Data/Functor/Listable.hs +++ b/test/Data/Functor/Listable.hs @@ -42,6 +42,7 @@ import Data.Semigroup import Data.Source import Data.Span import qualified Data.Syntax as Syntax +import qualified Data.Syntax.Algebra as Algebra import qualified Data.Syntax.Comment as Comment import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Statement as Statement @@ -352,6 +353,8 @@ instance Listable Declaration where \/ cons1 (FunctionDeclaration) \/ cons1 (flip ErrorDeclaration Nothing) +instance Listable Algebra.CyclomaticComplexity where + tiers = cons1 (Algebra.CyclomaticComplexity) instance Listable Range where tiers = cons2 Range From ffda556ea0c892141662ec90e51759c68a0a32f1 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 16 Oct 2017 14:25:33 -0700 Subject: [PATCH 15/43] Decorate with CyclomaticComplexity in diffWithParser --- src/Semantic/Util.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 01bb248d7..cfc348e4c 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -6,6 +6,7 @@ import Control.Monad.IO.Class import Data.Blob import Files import Data.Record +import Data.Syntax.Algebra (HasCyclomaticComplexity, CyclomaticComplexity(..), cyclomaticComplexityAlgebra, fToR) import Data.Functor.Classes import Algorithm import Data.Align.Generic @@ -28,11 +29,11 @@ diffWithParser :: (HasField fields Data.Span.Span, Eq1 syntax, Show1 syntax, Traversable syntax, Functor syntax, Foldable syntax, Diffable syntax, - GAlign syntax, HasDeclaration syntax) + GAlign syntax, HasDeclaration syntax, HasCyclomaticComplexity syntax) => Parser (Term syntax (Record fields)) -> Both Blob - -> Task (Diff syntax (Record (Maybe Declaration ': fields)) (Record (Maybe Declaration ': fields))) -diffWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) + -> Task (Diff syntax (Record (CyclomaticComplexity ': Maybe Declaration ': fields)) (Record (CyclomaticComplexity ': Maybe Declaration ': fields))) +diffWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob) >>= decorate (fToR cyclomaticComplexityAlgebra)) where run parse sourceBlobs = distributeFor sourceBlobs parse >>= runBothWith (diffTermPair sourceBlobs diffTerms) From 5d99ca490167821215a0417fed0f4662749f6f6e Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 16 Oct 2017 14:26:08 -0700 Subject: [PATCH 16/43] Add CyclomaticComplexity to tests --- test/SemanticCmdLineSpec.hs | 4 +-- test/TOCSpec.hs | 53 +++++++++++++++++++------------------ 2 files changed, 29 insertions(+), 28 deletions(-) diff --git a/test/SemanticCmdLineSpec.hs b/test/SemanticCmdLineSpec.hs index d7ffc813a..9ca5a015f 100644 --- a/test/SemanticCmdLineSpec.hs +++ b/test/SemanticCmdLineSpec.hs @@ -48,7 +48,7 @@ parseFixtures = jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]\n" jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"And\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n" emptyJsonParseTreeOutput = "[]\n" - tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"unchanged\"}]},\"errors\":{}}\n" + tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"unchanged\"}]},\"errors\":{}}\n" diffFixtures :: [(SomeRenderer DiffRenderer, Either Handle [Both (FilePath, Maybe Language)], ByteString)] @@ -64,4 +64,4 @@ diffFixtures = jsonOutput = "{\"diff\":{\"merge\":{\"after\":{\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"after\":{\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"merge\":{\"after\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"children\":[],\"before\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},{\"patch\":{\"replace\":[{\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},{\"patch\":{\"insert\":{\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}},{\"merge\":{\"after\":{\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}],\"before\":{\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}}}}],\"before\":{\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}}],\"before\":{\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n" sExpressionOutput = "(Program\n (Method\n (Empty)\n { (Identifier)\n ->(Identifier) }\n {+(Identifier)+}\n (\n {+(Identifier)+})))\n" - tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n" + tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"bar\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"}]},\"errors\":{}}\n" diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index 317931df1..6e311833d 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -18,6 +18,7 @@ import Data.Patch import Data.Record import Data.Semigroup ((<>)) import Data.Source +import Data.Syntax.Algebra (CyclomaticComplexity(..), fToR, cyclomaticComplexityAlgebra) import Data.Term import Data.Text (Text) import Data.These @@ -56,7 +57,7 @@ spec = parallel $ do prop "produces changed entries for relevant nodes containing irrelevant patches" $ \ diff -> let diff' = merge (0, 0) (Indexed [bimap (const 1) (const 1) (diff :: Diff Syntax Int Int)]) in tableOfContentsBy (\ (n `In` _) -> if n == (0 :: Int) then Just n else Nothing) diff' `shouldBe` - replicate (length (diffPatches diff')) (Changed 0) + replicate (length (diffPatches diff')) (Changed (These 0 0)) describe "diffTOC" $ do it "blank if there are no methods" $ @@ -66,39 +67,39 @@ spec = parallel $ do sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "modified" - , JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" ] + [ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 1) + , JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 1) ] it "dedupes changes in same parent method" $ do sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" ] + [ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 2) ] it "dedupes similar methods" $ do sourceBlobs <- blobsForPaths (both "javascript/erroneous-duplicate-method.A.js" "javascript/erroneous-duplicate-method.B.js") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ] + [ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" (CyclomaticComplexity 3) (CyclomaticComplexity 3) ] it "summarizes Go methods with receivers with special formatting" $ do sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go") let Just goParser = syntaxParserForLanguage Go - diff <- runTask $ distributeFor sourceBlobs (\ blob -> parse goParser blob >>= decorate (syntaxDeclarationAlgebra blob)) >>= runBothWith (diffTermPair sourceBlobs diffSyntaxTerms) + diff <- runTask $ distributeFor sourceBlobs (\ blob -> parse goParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= decorate (fToR cyclomaticComplexityAlgebra)) >>= runBothWith (diffTermPair sourceBlobs diffSyntaxTerms) diffTOC diff `shouldBe` - [ JSONSummary "Method" "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ] + [ JSONSummary "Method" "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" (CyclomaticComplexity 0) (CyclomaticComplexity 0) ] it "summarizes Ruby methods that start with two identifiers" $ do sourceBlobs <- blobsForPaths (both "ruby/method-starts-with-two-identifiers.A.rb" "ruby/method-starts-with-two-identifiers.B.rb") diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ] + [ JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 1) ] it "handles unicode characters in file" $ do sourceBlobs <- blobsForPaths (both "ruby/unicode.A.rb" "ruby/unicode.B.rb") diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Method" "foo" (sourceSpanBetween (6, 1) (7, 4)) "added" ] + [ JSONSummary "Method" "foo" (sourceSpanBetween (6, 1) (7, 4)) "added" (CyclomaticComplexity 1) (CyclomaticComplexity 1) ] it "properly slices source blob that starts with a newline and has multi-byte chars" $ do sourceBlobs <- blobsForPaths (both "javascript/starts-with-newline.js" "javascript/starts-with-newline.js") @@ -136,23 +137,23 @@ spec = parallel $ do describe "JSONSummary" $ do it "encodes modified summaries to JSON" $ do - let summary = JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" - encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[4,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"modified\"}" + let summary = JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 0) + encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[4,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":0,\"term\":\"foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"}" it "encodes added summaries to JSON" $ do - let summary = JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added" - encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"added\"}" + let summary = JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added" (CyclomaticComplexity 0) (CyclomaticComplexity 0) + encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":0,\"term\":\"self.foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"added\"}" describe "diff with ToCDiffRenderer'" $ do it "produces JSON output" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"self.foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"bar\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"}]},\"errors\":{}}\n" :: ByteString) it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.X.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"removed\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,1]},\"error\":\"expected end of input nodes, but got ParseError\",\"language\":\"Ruby\"}]}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"bar\",\"relative_cyclomatic_complexity\":-1,\"changeType\":\"removed\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"baz\",\"relative_cyclomatic_complexity\":-1,\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,1]},\"error\":\"expected end of input nodes, but got ParseError\",\"language\":\"Ruby\"}]}}\n" :: ByteString) it "ignores anonymous functions" $ do blobs <- blobsForPaths (both "ruby/lambda.A.rb" "ruby/lambda.B.rb") @@ -162,7 +163,7 @@ spec = parallel $ do it "summarizes Markdown headings" $ do blobs <- blobsForPaths (both "markdown/headings.A.md" "markdown/headings.B.md") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[7,10]},\"category\":\"Heading 1\",\"term\":\"One\",\"changeType\":\"modified\"},{\"span\":{\"start\":[5,1],\"end\":[7,10]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[7,10]},\"category\":\"Heading 1\",\"absolute_cyclomatic_complexity\":0,\"term\":\"One\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"},{\"span\":{\"start\":[5,1],\"end\":[7,10]},\"category\":\"Heading 2\",\"absolute_cyclomatic_complexity\":0,\"term\":\"Two\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"absolute_cyclomatic_complexity\":0,\"term\":\"Final\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) type Diff' = Diff Syntax (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) @@ -175,15 +176,15 @@ numTocSummaries diff = length $ filter isValidSummary (diffTOC diff) programWithChange :: Term' -> Diff' programWithChange body = merge (programInfo, programInfo) (Indexed [ function' ]) where - function' = merge ((Just (FunctionDeclaration "foo") :. functionInfo, Just (FunctionDeclaration "foo") :. functionInfo)) (S.Function name' [] [ inserting body ]) - name' = let info = Nothing :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil in merge (info, info) (Leaf "foo") + function' = merge ((Just (FunctionDeclaration "foo") :. (CyclomaticComplexity 1) :. functionInfo, Just (FunctionDeclaration "foo") :. (CyclomaticComplexity 1) :. functionInfo)) (S.Function name' [] [ inserting body ]) + name' = let info = Nothing :. (CyclomaticComplexity 0) :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil in merge (info, info) (Leaf "foo") -- Return a diff where term is inserted in the program, below a function found on both sides of the diff. programWithChangeOutsideFunction :: Term' -> Diff' programWithChangeOutsideFunction term = merge (programInfo, programInfo) (Indexed [ function', term' ]) where - function' = merge (Just (FunctionDeclaration "foo") :. functionInfo, Just (FunctionDeclaration "foo") :. functionInfo) (S.Function name' [] []) - name' = let info = Nothing :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil in merge (info, info) (Leaf "foo") + function' = merge (Just (FunctionDeclaration "foo") :. (CyclomaticComplexity 1) :. functionInfo, Just (FunctionDeclaration "foo") :. (CyclomaticComplexity 1) :. functionInfo) (S.Function name' [] []) + name' = let info = Nothing :. (CyclomaticComplexity 0) :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil in merge (info, info) (Leaf "foo") term' = inserting term programWithInsert :: Text -> Term' -> Diff' @@ -199,12 +200,12 @@ programOf :: Diff' -> Diff' programOf diff = merge (programInfo, programInfo) (Indexed [ diff ]) functionOf :: Text -> Term' -> Term' -functionOf name body = Term $ (Just (FunctionDeclaration name) :. functionInfo) `In` S.Function name' [] [body] +functionOf name body = Term $ (Just (FunctionDeclaration name) :. (CyclomaticComplexity 1) :. functionInfo) `In` S.Function name' [] [body] where - name' = Term $ (Nothing :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil) `In` Leaf name + name' = Term $ (Nothing :. (CyclomaticComplexity 0) :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil) `In` Leaf name -programInfo :: Record (Maybe Declaration ': DefaultFields) -programInfo = Nothing :. Range 0 0 :. C.Program :. sourceSpanBetween (0,0) (0,0) :. Nil +programInfo :: Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields) +programInfo = Nothing :. (CyclomaticComplexity 0) :. Range 0 0 :. C.Program :. sourceSpanBetween (0,0) (0,0) :. Nil functionInfo :: Record DefaultFields functionInfo = Range 0 0 :. C.Function :. sourceSpanBetween (0,0) (0,0) :. Nil @@ -237,8 +238,8 @@ sourceSpanBetween (s1, e1) (s2, e2) = Span (Pos s1 e1) (Pos s2 e2) blankDiff :: Diff' blankDiff = merge (arrayInfo, arrayInfo) (Indexed [ inserting (Term $ literalInfo `In` Leaf "\"a\"") ]) where - arrayInfo = Nothing :. Range 0 3 :. ArrayLiteral :. sourceSpanBetween (1, 1) (1, 5) :. Nil - literalInfo = Nothing :. Range 1 2 :. StringLiteral :. sourceSpanBetween (1, 2) (1, 4) :. Nil + arrayInfo = Nothing :. (CyclomaticComplexity 0) :. Range 0 3 :. ArrayLiteral :. sourceSpanBetween (1, 1) (1, 5) :. Nil + literalInfo = Nothing :. (CyclomaticComplexity 0) :. Range 1 2 :. StringLiteral :. sourceSpanBetween (1, 2) (1, 4) :. Nil blankDiffBlobs :: Both Blob blankDiffBlobs = both (Blob (fromText "[]") nullOid "a.js" (Just defaultPlainBlob) (Just TypeScript)) (Blob (fromText "[a]") nullOid "b.js" (Just defaultPlainBlob) (Just TypeScript)) From 5ce37708480044a1387a8a5519e77b0200cf8576 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:04:31 -0700 Subject: [PATCH 17/43] Define custom cyclomatic complexity for Call expressions --- src/Data/Syntax/Algebra.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index e442e3d88..aab372732 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -26,6 +26,7 @@ import Data.Proxy import Data.Record import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration +import qualified Data.Syntax.Expression as Expression import qualified Data.Syntax.Statement as Statement import Data.Term import Data.Text.Encoding (decodeUtf8, encodeUtf8) @@ -137,6 +138,9 @@ instance CustomHasCyclomaticComplexity Declaration.Method where instance CustomHasCyclomaticComplexity Declaration.Function where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Expression.Call where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum @@ -166,6 +170,7 @@ class HasCyclomaticComplexityWithStrategy (strategy :: Strategy) syntax where type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Declaration.Method = 'Custom CyclomaticComplexityStrategy Declaration.Function = 'Custom + CyclomaticComplexityStrategy Expression.Call = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom From 366ed94e6c5fa162bf73e9d477fe3be22fe078c1 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:04:45 -0700 Subject: [PATCH 18/43] Define custom cyclomatic complexity for Break expressions --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index aab372732..25cb19d4e 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -141,6 +141,9 @@ instance CustomHasCyclomaticComplexity Declaration.Function where instance CustomHasCyclomaticComplexity Expression.Call where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.Break where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum @@ -171,6 +174,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Declaration.Method = 'Custom CyclomaticComplexityStrategy Declaration.Function = 'Custom CyclomaticComplexityStrategy Expression.Call = 'Custom + CyclomaticComplexityStrategy Statement.Break = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom From 9a1171628296747d47a85b41af4cf84f0a1b5fe5 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:05:02 -0700 Subject: [PATCH 19/43] Define custom cyclomatic complexity for Catch expressions --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 25cb19d4e..e2b2277e8 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -144,6 +144,9 @@ instance CustomHasCyclomaticComplexity Expression.Call where instance CustomHasCyclomaticComplexity Statement.Break where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.Catch where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum @@ -175,6 +178,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Declaration.Function = 'Custom CyclomaticComplexityStrategy Expression.Call = 'Custom CyclomaticComplexityStrategy Statement.Break = 'Custom + CyclomaticComplexityStrategy Statement.Catch = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom From 5b012d3d46990ebd15616f659d56abe6cd7d1943 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:05:20 -0700 Subject: [PATCH 20/43] Define custom cyclomatic complexity for else statements --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index e2b2277e8..d8546bc9a 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -147,6 +147,9 @@ instance CustomHasCyclomaticComplexity Statement.Break where instance CustomHasCyclomaticComplexity Statement.Catch where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.Else where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum @@ -179,6 +182,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Expression.Call = 'Custom CyclomaticComplexityStrategy Statement.Break = 'Custom CyclomaticComplexityStrategy Statement.Catch = 'Custom + CyclomaticComplexityStrategy Statement.Else = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom From cf1dc1f6a0236c97af6389b026b766f0f6332264 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:05:32 -0700 Subject: [PATCH 21/43] Define custom cyclomatic complexity for Finally statements --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index d8546bc9a..63baac8af 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -150,6 +150,9 @@ instance CustomHasCyclomaticComplexity Statement.Catch where instance CustomHasCyclomaticComplexity Statement.Else where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.Finally where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum @@ -183,6 +186,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Statement.Break = 'Custom CyclomaticComplexityStrategy Statement.Catch = 'Custom CyclomaticComplexityStrategy Statement.Else = 'Custom + CyclomaticComplexityStrategy Statement.Finally = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom From be540c7d0a72d080c9c88fdc63ee3973baf2de99 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:05:43 -0700 Subject: [PATCH 22/43] Define custom cyclomatic complexity for If statements --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 63baac8af..044c29040 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -153,6 +153,9 @@ instance CustomHasCyclomaticComplexity Statement.Else where instance CustomHasCyclomaticComplexity Statement.Finally where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.If where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum @@ -187,6 +190,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Statement.Catch = 'Custom CyclomaticComplexityStrategy Statement.Else = 'Custom CyclomaticComplexityStrategy Statement.Finally = 'Custom + CyclomaticComplexityStrategy Statement.If = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom From d0ad76c25ae3289fefb9a29a18741044365d5d2d Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:05:57 -0700 Subject: [PATCH 23/43] Define custom cyclomatic complexity for Throw statements --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 044c29040..5623e33d2 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -159,6 +159,9 @@ instance CustomHasCyclomaticComplexity Statement.If where instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.Throw where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Yield where customToCyclomaticComplexity = succ . sum @@ -192,6 +195,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Statement.Finally = 'Custom CyclomaticComplexityStrategy Statement.If = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom + CyclomaticComplexityStrategy Statement.Throw = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom CyclomaticComplexityStrategy a = 'Default From a38ef81f017ec18e7dda38ed1d399d564a43e4e4 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:06:10 -0700 Subject: [PATCH 24/43] Update tests --- test/TOCSpec.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index 6e311833d..652ef5902 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -68,19 +68,19 @@ spec = parallel $ do diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` [ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 1) - , JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 1) ] + , JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" (CyclomaticComplexity 1) (CyclomaticComplexity 2) ] it "dedupes changes in same parent method" $ do sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 2) ] + [ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" (CyclomaticComplexity 2) (CyclomaticComplexity 4) ] it "dedupes similar methods" $ do sourceBlobs <- blobsForPaths (both "javascript/erroneous-duplicate-method.A.js" "javascript/erroneous-duplicate-method.B.js") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" (CyclomaticComplexity 3) (CyclomaticComplexity 3) ] + [ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" (CyclomaticComplexity 20) (CyclomaticComplexity 20) ] it "summarizes Go methods with receivers with special formatting" $ do sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go") @@ -148,7 +148,7 @@ spec = parallel $ do it "produces JSON output" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"self.foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"bar\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"}]},\"errors\":{}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"self.foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":2,\"term\":\"bar\",\"relative_cyclomatic_complexity\":1,\"changeType\":\"modified\"}]},\"errors\":{}}\n" :: ByteString) it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.X.rb") From 622a1da9bcee99ebb83e35e94bc27585df581591 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:29:22 -0700 Subject: [PATCH 25/43] Define custom cyclomatic complexity for Pattern statements --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 5623e33d2..58a587190 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -156,6 +156,9 @@ instance CustomHasCyclomaticComplexity Statement.Finally where instance CustomHasCyclomaticComplexity Statement.If where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.Pattern where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Return where customToCyclomaticComplexity = succ . sum @@ -194,6 +197,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Statement.Else = 'Custom CyclomaticComplexityStrategy Statement.Finally = 'Custom CyclomaticComplexityStrategy Statement.If = 'Custom + CyclomaticComplexityStrategy Statement.Pattern = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Throw = 'Custom CyclomaticComplexityStrategy Statement.Yield = 'Custom From eef8759e75b216a9b3764f476e2fe7dad2216d4f Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 17 Oct 2017 17:32:43 -0700 Subject: [PATCH 26/43] Define custom cyclomatic complexity for Match statements --- src/Data/Syntax/Algebra.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 58a587190..e7db1c5c7 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -156,6 +156,9 @@ instance CustomHasCyclomaticComplexity Statement.Finally where instance CustomHasCyclomaticComplexity Statement.If where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.Match where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Pattern where customToCyclomaticComplexity = succ . sum @@ -197,6 +200,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Statement.Else = 'Custom CyclomaticComplexityStrategy Statement.Finally = 'Custom CyclomaticComplexityStrategy Statement.If = 'Custom + CyclomaticComplexityStrategy Statement.Match = 'Custom CyclomaticComplexityStrategy Statement.Pattern = 'Custom CyclomaticComplexityStrategy Statement.Return = 'Custom CyclomaticComplexityStrategy Statement.Throw = 'Custom From c3d6a15621ace30e46c177754be1d5245d71e4c2 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 18 Oct 2017 17:15:41 -0700 Subject: [PATCH 27/43] Update the syntax we define custom cyclomatic complexity - Key additions are the addition of loops (For, ForEach, Do, and DoWhile). - Key removal is Return, Break, Throw, Yield and Finally. --- src/Data/Syntax/Algebra.hs | 36 ++++++++++++++---------------------- test/TOCSpec.hs | 8 ++++---- 2 files changed, 18 insertions(+), 26 deletions(-) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index e7db1c5c7..20ef5074a 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -26,7 +26,6 @@ import Data.Proxy import Data.Record import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration -import qualified Data.Syntax.Expression as Expression import qualified Data.Syntax.Statement as Statement import Data.Term import Data.Text.Encoding (decodeUtf8, encodeUtf8) @@ -132,25 +131,25 @@ class CustomHasCyclomaticComplexity syntax where -- | Produce a customized 'CyclomaticComplexity' for a given syntax node. customToCyclomaticComplexity :: FAlgebra syntax CyclomaticComplexity -instance CustomHasCyclomaticComplexity Declaration.Method where - customToCyclomaticComplexity = succ . sum - instance CustomHasCyclomaticComplexity Declaration.Function where customToCyclomaticComplexity = succ . sum -instance CustomHasCyclomaticComplexity Expression.Call where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.Break where +instance CustomHasCyclomaticComplexity Declaration.Method where customToCyclomaticComplexity = succ . sum instance CustomHasCyclomaticComplexity Statement.Catch where customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Statement.DoWhile where + customToCyclomaticComplexity = succ . sum + instance CustomHasCyclomaticComplexity Statement.Else where customToCyclomaticComplexity = succ . sum -instance CustomHasCyclomaticComplexity Statement.Finally where +instance CustomHasCyclomaticComplexity Statement.For where + customToCyclomaticComplexity = succ . sum + +instance CustomHasCyclomaticComplexity Statement.ForEach where customToCyclomaticComplexity = succ . sum instance CustomHasCyclomaticComplexity Statement.If where @@ -162,14 +161,9 @@ instance CustomHasCyclomaticComplexity Statement.Match where instance CustomHasCyclomaticComplexity Statement.Pattern where customToCyclomaticComplexity = succ . sum -instance CustomHasCyclomaticComplexity Statement.Return where +instance CustomHasCyclomaticComplexity Statement.While where customToCyclomaticComplexity = succ . sum -instance CustomHasCyclomaticComplexity Statement.Throw where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.Yield where - customToCyclomaticComplexity = succ . sum -- | Produce a 'CyclomaticComplexity' for 'Union's using the 'HasCyclomaticComplexity' instance & therefore using a 'CustomHasCyclomaticComplexity' instance when one exists & the type is listed in 'CyclomaticComplexityStrategy'. instance Apply HasCyclomaticComplexity fs => CustomHasCyclomaticComplexity (Union fs) where @@ -192,19 +186,17 @@ class HasCyclomaticComplexityWithStrategy (strategy :: Strategy) syntax where -- -- If you’re seeing errors about missing a 'CustomHasCyclomaticComplexity' instance for a given type, you’ve probably listed it in here but not defined a 'CustomHasCyclomaticComplexity' instance for it, or else you’ve listed the wrong type in here. Conversely, if your 'customHasCyclomaticComplexity' method is never being called, you may have forgotten to list the type in here. type family CyclomaticComplexityStrategy syntax where - CyclomaticComplexityStrategy Declaration.Method = 'Custom CyclomaticComplexityStrategy Declaration.Function = 'Custom - CyclomaticComplexityStrategy Expression.Call = 'Custom - CyclomaticComplexityStrategy Statement.Break = 'Custom + CyclomaticComplexityStrategy Declaration.Method = 'Custom CyclomaticComplexityStrategy Statement.Catch = 'Custom + CyclomaticComplexityStrategy Statement.DoWhile = 'Custom CyclomaticComplexityStrategy Statement.Else = 'Custom - CyclomaticComplexityStrategy Statement.Finally = 'Custom + CyclomaticComplexityStrategy Statement.For = 'Custom + CyclomaticComplexityStrategy Statement.ForEach = 'Custom CyclomaticComplexityStrategy Statement.If = 'Custom CyclomaticComplexityStrategy Statement.Match = 'Custom CyclomaticComplexityStrategy Statement.Pattern = 'Custom - CyclomaticComplexityStrategy Statement.Return = 'Custom - CyclomaticComplexityStrategy Statement.Throw = 'Custom - CyclomaticComplexityStrategy Statement.Yield = 'Custom + CyclomaticComplexityStrategy Statement.While = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom CyclomaticComplexityStrategy a = 'Default diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index 652ef5902..a3f38141c 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -68,19 +68,19 @@ spec = parallel $ do diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` [ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 1) - , JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" (CyclomaticComplexity 1) (CyclomaticComplexity 2) ] + , JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" (CyclomaticComplexity 0) (CyclomaticComplexity 1) ] it "dedupes changes in same parent method" $ do sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" (CyclomaticComplexity 2) (CyclomaticComplexity 4) ] + [ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" (CyclomaticComplexity 1) (CyclomaticComplexity 2) ] it "dedupes similar methods" $ do sourceBlobs <- blobsForPaths (both "javascript/erroneous-duplicate-method.A.js" "javascript/erroneous-duplicate-method.B.js") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" (CyclomaticComplexity 20) (CyclomaticComplexity 20) ] + [ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" (CyclomaticComplexity 2) (CyclomaticComplexity 2) ] it "summarizes Go methods with receivers with special formatting" $ do sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go") @@ -148,7 +148,7 @@ spec = parallel $ do it "produces JSON output" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"self.foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":2,\"term\":\"bar\",\"relative_cyclomatic_complexity\":1,\"changeType\":\"modified\"}]},\"errors\":{}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"self.foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"bar\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"}]},\"errors\":{}}\n" :: ByteString) it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.X.rb") From ee138789a2987d154a77381565da050d8f63d654 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 18 Oct 2017 20:32:45 -0700 Subject: [PATCH 28/43] Don't count the top level case statement, only its patterns --- src/Data/Syntax/Algebra.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs index 20ef5074a..49d1b5d80 100644 --- a/src/Data/Syntax/Algebra.hs +++ b/src/Data/Syntax/Algebra.hs @@ -155,9 +155,6 @@ instance CustomHasCyclomaticComplexity Statement.ForEach where instance CustomHasCyclomaticComplexity Statement.If where customToCyclomaticComplexity = succ . sum -instance CustomHasCyclomaticComplexity Statement.Match where - customToCyclomaticComplexity = succ . sum - instance CustomHasCyclomaticComplexity Statement.Pattern where customToCyclomaticComplexity = succ . sum @@ -194,7 +191,6 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy Statement.For = 'Custom CyclomaticComplexityStrategy Statement.ForEach = 'Custom CyclomaticComplexityStrategy Statement.If = 'Custom - CyclomaticComplexityStrategy Statement.Match = 'Custom CyclomaticComplexityStrategy Statement.Pattern = 'Custom CyclomaticComplexityStrategy Statement.While = 'Custom CyclomaticComplexityStrategy (Union fs) = 'Custom From e7a5e88d5eec72b88c5ecec84bda02e042c9d082 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 1 Dec 2017 11:39:04 -0800 Subject: [PATCH 29/43] First pass updating CyclomaticComplexity --- src/Analysis/CyclomaticComplexity.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index c9deb4cb3..921da45b1 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/src/Analysis/CyclomaticComplexity.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Analysis.CyclomaticComplexity ( CyclomaticComplexity(..) , HasCyclomaticComplexity @@ -6,7 +6,7 @@ module Analysis.CyclomaticComplexity ) where import Data.Aeson -import Data.Algebra (FAlgebra) +import Data.Algebra import Data.Proxy import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Statement as Statement From 7ee4b04c1f0a8165e28abb6d3cdae4da363120af Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 1 Dec 2017 13:00:30 -0800 Subject: [PATCH 30/43] Update CyclomaticComplexity --- src/Analysis/CyclomaticComplexity.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index 921da45b1..9d30cd5c0 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/src/Analysis/CyclomaticComplexity.hs @@ -6,7 +6,6 @@ module Analysis.CyclomaticComplexity ) where import Data.Aeson -import Data.Algebra import Data.Proxy import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Statement as Statement @@ -33,7 +32,7 @@ newtype CyclomaticComplexity = CyclomaticComplexity Int -- If you’re getting errors about missing a 'CustomHasCyclomaticComplexity' instance for your syntax type, you probably forgot step 1. -- -- If you’re getting 'Nothing' for your syntax node at runtime, you probably forgot step 2. -cyclomaticComplexityAlgebra :: (Foldable syntax, HasCyclomaticComplexity syntax) => FAlgebra (TermF syntax ann) CyclomaticComplexity +cyclomaticComplexityAlgebra :: (Foldable syntax, HasCyclomaticComplexity syntax) => TermF syntax ann CyclomaticComplexity -> CyclomaticComplexity cyclomaticComplexityAlgebra (In _ syntax) = toCyclomaticComplexity syntax @@ -42,7 +41,7 @@ cyclomaticComplexityAlgebra (In _ syntax) = toCyclomaticComplexity syntax -- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap. class HasCyclomaticComplexity syntax where -- | Compute a 'CyclomaticComplexity' for a syntax type using its 'CustomHasCyclomaticComplexity' instance, if any, or else falling back to the default definition (which simply returns the sum of any contained cyclomatic complexities). - toCyclomaticComplexity :: FAlgebra syntax CyclomaticComplexity + toCyclomaticComplexity :: syntax CyclomaticComplexity -> CyclomaticComplexity -- | Define 'toCyclomaticComplexity' using the 'CustomHasCyclomaticComplexity' instance for a type if there is one or else use the default definition. -- @@ -56,7 +55,7 @@ instance (CyclomaticComplexityStrategy syntax ~ strategy, HasCyclomaticComplexit -- | Types for which we can produce a customized 'CyclomaticComplexity'. class CustomHasCyclomaticComplexity syntax where -- | Produce a customized 'CyclomaticComplexity' for a given syntax node. - customToCyclomaticComplexity :: FAlgebra syntax CyclomaticComplexity + customToCyclomaticComplexity :: syntax CyclomaticComplexity -> CyclomaticComplexity instance CustomHasCyclomaticComplexity Declaration.Function where customToCyclomaticComplexity = succ . sum @@ -101,7 +100,7 @@ data Strategy = Default | Custom -- -- You should probably be using 'CustomHasCyclomaticComplexity' instead of this class; and you should not define new instances of this class. class HasCyclomaticComplexityWithStrategy (strategy :: Strategy) syntax where - toCyclomaticComplexityWithStrategy :: proxy strategy -> FAlgebra syntax CyclomaticComplexity + toCyclomaticComplexityWithStrategy :: proxy strategy -> syntax CyclomaticComplexity -> CyclomaticComplexity -- | A predicate on syntax types selecting either the 'Custom' or 'Default' strategy. From 21024a0506baa25b2647558732213be41bc1a729 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 1 Dec 2017 13:36:32 -0800 Subject: [PATCH 31/43] :fire: unnecessary language extensions --- src/Analysis/CyclomaticComplexity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index 9d30cd5c0..62dc63563 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/src/Analysis/CyclomaticComplexity.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} module Analysis.CyclomaticComplexity ( CyclomaticComplexity(..) , HasCyclomaticComplexity From d649a514afd8c4142507d0acbb73027d6486879b Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 1 Dec 2017 13:36:38 -0800 Subject: [PATCH 32/43] Update tests --- test/Data/Functor/Listable.hs | 5 ++--- test/Rendering/TOC/Spec.hs | 19 +++++++++---------- test/Semantic/CLI/Spec.hs | 4 ++-- 3 files changed, 13 insertions(+), 15 deletions(-) diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs index 8406a2717..2e9092db0 100644 --- a/test/Data/Functor/Listable.hs +++ b/test/Data/Functor/Listable.hs @@ -45,7 +45,6 @@ import Data.Semigroup import Data.Source import Data.Span import qualified Data.Syntax as Syntax -import qualified Data.Syntax.Algebra as Algebra import qualified Data.Syntax.Comment as Comment import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Statement as Statement @@ -358,8 +357,8 @@ instance Listable Declaration where \/ cons3 FunctionDeclaration \/ cons2 (\ a b -> ErrorDeclaration a b Nothing) -instance Listable Analysis.CyclomaticComplexity where - tiers = cons1 (Analysis.CyclomaticComplexity) +instance Listable CyclomaticComplexity where + tiers = cons1 CyclomaticComplexity instance Listable Language.Language where tiers diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 79d1faab8..e8aae8ed3 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -21,7 +21,6 @@ import Data.Patch import Data.Record import Data.Semigroup ((<>)) import Data.Source -import Data.Syntax.Algebra (CyclomaticComplexity(..), fToR, cyclomaticComplexityAlgebra) import Data.Term import Data.Text (Text) import Data.These @@ -59,7 +58,7 @@ spec = parallel $ do prop "produces changed entries for relevant nodes containing irrelevant patches" $ \ diff -> let diff' = merge (0, 0) (Indexed [bimap (const 1) (const 1) (diff :: Diff Syntax Int Int)]) in tableOfContentsBy (\ (n `In` _) -> if n == (0 :: Int) then Just n else Nothing) diff' `shouldBe` - replicate (length (diffPatches diff')) (Changed (These 0 0)) + replicate (length (diffPatches diff')) (Changed 0) describe "diffTOC" $ do it "blank if there are no methods" $ @@ -165,7 +164,7 @@ spec = parallel $ do it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.X.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"bar\",\"relative_cyclomatic_complexity\":-1,\"changeType\":\"removed\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"baz\",\"relative_cyclomatic_complexity\":-1,\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,1]},\"error\":\"expected end of input nodes, but got ParseError\",\"language\":\"Ruby\"}]}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"removed\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,1]},\"error\":\"expected end of input nodes, but got ParseError\",\"language\":\"Ruby\"}]}}\n" :: ByteString) it "ignores anonymous functions" $ do blobs <- blobsForPaths (both "ruby/lambda.A.rb" "ruby/lambda.B.rb") @@ -178,8 +177,8 @@ spec = parallel $ do toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[3,16]},\"category\":\"Heading 1\",\"term\":\"Introduction\",\"changeType\":\"removed\"},{\"span\":{\"start\":[5,1],\"end\":[7,4]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"modified\"},{\"span\":{\"start\":[9,1],\"end\":[11,10]},\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"changeType\":\"added\"},{\"span\":{\"start\":[13,1],\"end\":[14,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) -type Diff' = Diff Syntax (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) -type Term' = Term Syntax (Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields)) +type Diff' = Diff Syntax (Record (Maybe Declaration ': DefaultFields)) (Record (Maybe Declaration ': DefaultFields)) +type Term' = Term Syntax (Record (Maybe Declaration ': DefaultFields)) numTocSummaries :: Diff' -> Int numTocSummaries diff = length $ filter isValidSummary (diffTOC diff) @@ -214,10 +213,10 @@ programOf diff = merge (programInfo, programInfo) (Indexed [ diff ]) functionOf :: Text -> Term' -> Term' functionOf name body = Term $ (Just (FunctionDeclaration name mempty Nothing) :. functionInfo) `In` S.Function name' [] [body] where - name' = Term $ (Nothing :. (CyclomaticComplexity 0) :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil) `In` Leaf name + name' = Term $ (Nothing :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil) `In` Leaf name -programInfo :: Record (Maybe Declaration ': CyclomaticComplexity ': DefaultFields) -programInfo = Nothing :. (CyclomaticComplexity 0) :. Range 0 0 :. C.Program :. sourceSpanBetween (0,0) (0,0) :. Nil +programInfo :: Record (Maybe Declaration ': DefaultFields) +programInfo = Nothing :. Range 0 0 :. C.Program :. sourceSpanBetween (0,0) (0,0) :. Nil functionInfo :: Record DefaultFields functionInfo = Range 0 0 :. C.Function :. sourceSpanBetween (0,0) (0,0) :. Nil @@ -250,8 +249,8 @@ sourceSpanBetween (s1, e1) (s2, e2) = Span (Pos s1 e1) (Pos s2 e2) blankDiff :: Diff' blankDiff = merge (arrayInfo, arrayInfo) (Indexed [ inserting (Term $ literalInfo `In` Leaf "\"a\"") ]) where - arrayInfo = Nothing :. (CyclomaticComplexity 0) :. Range 0 3 :. ArrayLiteral :. sourceSpanBetween (1, 1) (1, 5) :. Nil - literalInfo = Nothing :. (CyclomaticComplexity 0) :. Range 1 2 :. StringLiteral :. sourceSpanBetween (1, 2) (1, 4) :. Nil + arrayInfo = Nothing :. Range 0 3 :. ArrayLiteral :. sourceSpanBetween (1, 1) (1, 5) :. Nil + literalInfo = Nothing :. Range 1 2 :. StringLiteral :. sourceSpanBetween (1, 2) (1, 4) :. Nil blankDiffBlobs :: Both Blob blankDiffBlobs = both (Blob (fromText "[]") nullOid "a.js" (Just defaultPlainBlob) (Just TypeScript)) (Blob (fromText "[a]") nullOid "b.js" (Just defaultPlainBlob) (Just TypeScript)) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index d2eeaefaf..cdf23172a 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -48,7 +48,7 @@ parseFixtures = jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]\n" jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"And\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n" emptyJsonParseTreeOutput = "[]\n" - tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"foo\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"unchanged\"}]},\"errors\":{}}\n" + tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"unchanged\"}]},\"errors\":{}}\n" diffFixtures :: [(SomeRenderer DiffRenderer, Either Handle [Both (FilePath, Maybe Language)], ByteString)] @@ -61,4 +61,4 @@ diffFixtures = jsonOutput = "{\"diff\":{\"merge\":{\"after\":{\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"after\":{\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"merge\":{\"after\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"children\":[],\"before\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},{\"patch\":{\"replace\":[{\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},{\"patch\":{\"insert\":{\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}},{\"merge\":{\"after\":{\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}],\"before\":{\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}}}}],\"before\":{\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}}],\"before\":{\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n" sExpressionOutput = "(Program\n (Method\n (Empty)\n { (Identifier)\n ->(Identifier) }\n {+(Identifier)+}\n (\n {+(Identifier)+})))\n" - tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"absolute_cyclomatic_complexity\":1,\"term\":\"bar\",\"relative_cyclomatic_complexity\":0,\"changeType\":\"modified\"}]},\"errors\":{}}\n" + tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n" From 99f36330601848fd7847bc012e516c81767ab372 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 1 Dec 2017 17:00:40 -0500 Subject: [PATCH 33/43] Generalize featureVectorDecorator to accept any Hashable label. --- src/Diffing/Algorithm/RWS.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs index 542638dd9..d39fa8e26 100644 --- a/src/Diffing/Algorithm/RWS.hs +++ b/src/Diffing/Algorithm/RWS.hs @@ -125,9 +125,9 @@ defaultFeatureVectorDecorator defaultFeatureVectorDecorator getLabel = featureVectorDecorator . pqGramDecorator getLabel defaultP defaultQ -- | Annotates a term with a feature vector at each node, parameterized by stem length, base width, and feature vector dimensions. -featureVectorDecorator :: (Foldable f, Functor f, Hashable label) => Term f (Record (Gram label ': fields)) -> Term f (Record (FeatureVector ': fields)) -featureVectorDecorator = cata (\ (In (gram :. rest) functor) -> - termIn (foldl' addSubtermVector (unitVector (hash gram)) functor :. rest) functor) +featureVectorDecorator :: (Foldable f, Functor f, Hashable label) => Term f (Record (label ': fields)) -> Term f (Record (FeatureVector ': fields)) +featureVectorDecorator = cata (\ (In (label :. rest) functor) -> + termIn (foldl' addSubtermVector (unitVector (hash label)) functor :. rest) functor) where addSubtermVector v term = addVectors v (rhead (termAnnotation term)) -- | Annotates a term with the corresponding p,q-gram at each node. From d2cb077ddc76f5398e1ddbd9684c5091e67848d1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 1 Dec 2017 17:07:03 -0500 Subject: [PATCH 34/43] =?UTF-8?q?Don=E2=80=99t=20assign=20parent=20labels?= =?UTF-8?q?=20to=20grams.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Diffing/Algorithm/RWS.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs index d39fa8e26..0f95e9094 100644 --- a/src/Diffing/Algorithm/RWS.hs +++ b/src/Diffing/Algorithm/RWS.hs @@ -105,7 +105,7 @@ defaultOptions = Options } defaultP, defaultQ :: Int -defaultP = 2 +defaultP = 0 defaultQ = 3 From 10b8de93b384b778e235b579335ae53009306add Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 1 Dec 2017 17:13:24 -0500 Subject: [PATCH 35/43] Update the fixtures. --- .../go/array-with-implicit-length.diffA-B.txt | 4 +- .../go/array-with-implicit-length.diffB-A.txt | 8 +- .../go/assignment-statements.diffA-B.txt | 51 ++++++------- .../go/assignment-statements.diffB-A.txt | 17 ++--- .../go/binary-expressions.diffA-B.txt | 11 ++- .../go/binary-expressions.diffB-A.txt | 11 ++- .../fixtures/go/slice-expressions.diffA-B.txt | 73 +++++++++++-------- .../fixtures/go/slice-expressions.diffB-A.txt | 73 +++++++++++-------- .../fixtures/go/unary-expressions.diffA-B.txt | 51 +++++++------ .../fixtures/go/unary-expressions.diffB-A.txt | 51 +++++++------ test/fixtures/javascript/export.diffA-B.txt | 50 ++++++------- test/fixtures/javascript/export.diffB-A.txt | 63 +++++++--------- test/fixtures/python/assignment.diffA-B.txt | 18 +++-- test/fixtures/python/assignment.diffB-A.txt | 13 ++-- .../python/augmented-assignment.diffA-B.txt | 24 +++--- .../python/augmented-assignment.diffB-A.txt | 34 +++++---- .../python/binary-operator.diffA-B.txt | 20 ++--- .../python/binary-operator.diffB-A.txt | 20 ++--- .../python/comparison-operator.diffB-A.txt | 34 ++++----- test/fixtures/python/float.diffA-B.txt | 2 +- test/fixtures/python/float.diffB-A.txt | 8 +- test/fixtures/python/integer.diffA-B.txt | 4 +- test/fixtures/python/integer.diffB-A.txt | 6 +- test/fixtures/python/string.diffA-B.txt | 4 +- test/fixtures/python/string.diffB-A.txt | 6 +- .../python/unary-operator.diffA-B.txt | 11 ++- test/fixtures/ruby/delimiter.diffA-B.txt | 8 +- test/fixtures/ruby/delimiter.diffB-A.txt | 4 +- test/fixtures/ruby/hash.diffA-B.txt | 33 +++++---- test/fixtures/ruby/hash.diffB-A.txt | 26 ++++--- test/fixtures/ruby/number.diffA-B.txt | 6 +- test/fixtures/ruby/number.diffB-A.txt | 8 +- test/fixtures/ruby/symbol.diffA-B.txt | 4 +- test/fixtures/ruby/symbol.diffB-A.txt | 6 +- test/fixtures/typescript/export.diffA-B.txt | 50 ++++++------- test/fixtures/typescript/export.diffB-A.txt | 63 +++++++--------- 36 files changed, 447 insertions(+), 428 deletions(-) diff --git a/test/fixtures/go/array-with-implicit-length.diffA-B.txt b/test/fixtures/go/array-with-implicit-length.diffA-B.txt index ae0923f80..ce0361f52 100644 --- a/test/fixtures/go/array-with-implicit-length.diffA-B.txt +++ b/test/fixtures/go/array-with-implicit-length.diffA-B.txt @@ -13,7 +13,7 @@ ( { (Integer) ->(Integer) } + {+(Integer)+} { (Integer) ->(Integer) } - { (Integer) - ->(Integer) }))))) + {-(Integer)-}))))) diff --git a/test/fixtures/go/array-with-implicit-length.diffB-A.txt b/test/fixtures/go/array-with-implicit-length.diffB-A.txt index ae0923f80..42dfe40d9 100644 --- a/test/fixtures/go/array-with-implicit-length.diffB-A.txt +++ b/test/fixtures/go/array-with-implicit-length.diffB-A.txt @@ -13,7 +13,7 @@ ( { (Integer) ->(Integer) } - { (Integer) - ->(Integer) } - { (Integer) - ->(Integer) }))))) + {+(Integer)+} + {+(Integer)+} + {-(Integer)-} + {-(Integer)-}))))) diff --git a/test/fixtures/go/assignment-statements.diffA-B.txt b/test/fixtures/go/assignment-statements.diffA-B.txt index 7eb02d8f6..796e6ec62 100644 --- a/test/fixtures/go/assignment-statements.diffA-B.txt +++ b/test/fixtures/go/assignment-statements.diffA-B.txt @@ -25,11 +25,13 @@ ( (Integer) (Integer)))) - {+(Assignment - {+(Identifier)+} - {+(Times - {+(Identifier)+} - {+(Integer)+})+})+} + (Assignment + { (Identifier) + ->(Identifier) } + (Times + { (Identifier) + ->(Identifier) } + (Integer))) {+(Assignment {+(Identifier)+} {+(Plus @@ -45,16 +47,24 @@ {+(RShift {+(Identifier)+} {+(Integer)+})+})+} - {+(Assignment - {+(Identifier)+} - {+(DividedBy + (Assignment + { (Identifier) + ->(Identifier) } + { (Plus + {-(Identifier)-} + {-(Integer)-}) + ->(DividedBy {+(Identifier)+} - {+(Integer)+})+})+} - {+(Assignment - {+(Identifier)+} - {+(BXOr + {+(Integer)+}) }) + (Assignment + { (Identifier) + ->(Identifier) } + { (LShift + {-(Identifier)-} + {-(Integer)-}) + ->(BXOr {+(Identifier)+} - {+(Integer)+})+})+} + {+(Integer)+}) }) {+(Assignment {+(Identifier)+} {+(Modulo @@ -78,21 +88,6 @@ {+(KeyValue {+(Identifier)+} {+(Integer)+})+})+})+})+})+})+} - {-(Assignment - {-(Identifier)-} - {-(Times - {-(Identifier)-} - {-(Integer)-})-})-} - {-(Assignment - {-(Identifier)-} - {-(Plus - {-(Identifier)-} - {-(Integer)-})-})-} - {-(Assignment - {-(Identifier)-} - {-(LShift - {-(Identifier)-} - {-(Integer)-})-})-} {-(Assignment {-(Identifier)-} {-(RShift diff --git a/test/fixtures/go/assignment-statements.diffB-A.txt b/test/fixtures/go/assignment-statements.diffB-A.txt index 6fcdca78e..87f619bb9 100644 --- a/test/fixtures/go/assignment-statements.diffB-A.txt +++ b/test/fixtures/go/assignment-statements.diffB-A.txt @@ -25,19 +25,18 @@ ( (Integer) (Integer)))) + (Assignment + { (Identifier) + ->(Identifier) } + (Times + { (Identifier) + ->(Identifier) } + (Integer))) {+(Assignment {+(Identifier)+} - {+(Times + {+(Plus {+(Identifier)+} {+(Integer)+})+})+} - (Assignment - (Identifier) - { (Times - {-(Identifier)-} - {-(Integer)-}) - ->(Plus - {+(Identifier)+} - {+(Integer)+}) }) {+(Assignment {+(Identifier)+} {+(LShift diff --git a/test/fixtures/go/binary-expressions.diffA-B.txt b/test/fixtures/go/binary-expressions.diffA-B.txt index 3b7b43359..8d88cb7a9 100644 --- a/test/fixtures/go/binary-expressions.diffA-B.txt +++ b/test/fixtures/go/binary-expressions.diffA-B.txt @@ -22,9 +22,11 @@ ->(Identifier) } { (Identifier) ->(Identifier) })) - {+(Equal - {+(Identifier)+} - {+(Identifier)+})+} + (Equal + { (Identifier) + ->(Identifier) } + { (Identifier) + ->(Identifier) }) {+(Not {+(Equal {+(Identifier)+} @@ -74,9 +76,6 @@ {+(BAnd {+(Identifier)+} {+(Identifier)+})+} - {-(Equal - {-(Identifier)-} - {-(Identifier)-})-} {-(Not {-(Equal {-(Identifier)-} diff --git a/test/fixtures/go/binary-expressions.diffB-A.txt b/test/fixtures/go/binary-expressions.diffB-A.txt index 3b7b43359..8d88cb7a9 100644 --- a/test/fixtures/go/binary-expressions.diffB-A.txt +++ b/test/fixtures/go/binary-expressions.diffB-A.txt @@ -22,9 +22,11 @@ ->(Identifier) } { (Identifier) ->(Identifier) })) - {+(Equal - {+(Identifier)+} - {+(Identifier)+})+} + (Equal + { (Identifier) + ->(Identifier) } + { (Identifier) + ->(Identifier) }) {+(Not {+(Equal {+(Identifier)+} @@ -74,9 +76,6 @@ {+(BAnd {+(Identifier)+} {+(Identifier)+})+} - {-(Equal - {-(Identifier)-} - {-(Identifier)-})-} {-(Not {-(Equal {-(Identifier)-} diff --git a/test/fixtures/go/slice-expressions.diffA-B.txt b/test/fixtures/go/slice-expressions.diffA-B.txt index 084d66f9c..e7eeed723 100644 --- a/test/fixtures/go/slice-expressions.diffA-B.txt +++ b/test/fixtures/go/slice-expressions.diffA-B.txt @@ -6,36 +6,51 @@ (Identifier) ([]) ( - (Slice - (Identifier) - { (Integer) - ->(Integer) } - (Empty) - (Empty)) - (Slice - (Identifier) - (Empty) - { (Integer) - ->(Integer) } - (Empty)) - (Slice - (Identifier) - { (Empty) - ->(Integer) } - { (Empty) - ->(Integer) } - (Empty)) - (Slice - (Identifier) - { (Integer) - ->(Integer) } - { (Integer) - ->(Integer) } - { (Integer) - ->(Integer) }) + {+(Slice + {+(Identifier)+} + {+(Integer)+} + {+(Empty)+} + {+(Empty)+})+} + {+(Slice + {+(Identifier)+} + {+(Empty)+} + {+(Integer)+} + {+(Empty)+})+} + {+(Slice + {+(Identifier)+} + {+(Integer)+} + {+(Integer)+} + {+(Empty)+})+} (Slice { (Identifier) ->(Identifier) } (Integer) - (Integer) - (Empty))))) + { (Empty) + ->(Integer) } + { (Empty) + ->(Integer) }) + {+(Slice + {+(Identifier)+} + {+(Integer)+} + {+(Integer)+} + {+(Empty)+})+} + {-(Slice + {-(Identifier)-} + {-(Empty)-} + {-(Integer)-} + {-(Empty)-})-} + {-(Slice + {-(Identifier)-} + {-(Empty)-} + {-(Empty)-} + {-(Empty)-})-} + {-(Slice + {-(Identifier)-} + {-(Integer)-} + {-(Integer)-} + {-(Integer)-})-} + {-(Slice + {-(Identifier)-} + {-(Integer)-} + {-(Integer)-} + {-(Empty)-})-}))) diff --git a/test/fixtures/go/slice-expressions.diffB-A.txt b/test/fixtures/go/slice-expressions.diffB-A.txt index d0d377201..901da4a7d 100644 --- a/test/fixtures/go/slice-expressions.diffB-A.txt +++ b/test/fixtures/go/slice-expressions.diffB-A.txt @@ -6,36 +6,51 @@ (Identifier) ([]) ( - (Slice - (Identifier) - { (Integer) - ->(Integer) } - (Empty) - (Empty)) - (Slice - (Identifier) - (Empty) - { (Integer) - ->(Integer) } - (Empty)) - (Slice - (Identifier) - { (Integer) - ->(Empty) } - { (Integer) - ->(Empty) } - (Empty)) - (Slice - (Identifier) - { (Integer) - ->(Integer) } - { (Integer) - ->(Integer) } - { (Integer) - ->(Integer) }) + {+(Slice + {+(Identifier)+} + {+(Integer)+} + {+(Empty)+} + {+(Empty)+})+} + {+(Slice + {+(Identifier)+} + {+(Empty)+} + {+(Integer)+} + {+(Empty)+})+} + {+(Slice + {+(Identifier)+} + {+(Empty)+} + {+(Empty)+} + {+(Empty)+})+} (Slice { (Identifier) ->(Identifier) } (Integer) - (Integer) - (Empty))))) + { (Empty) + ->(Integer) } + { (Empty) + ->(Integer) }) + {+(Slice + {+(Identifier)+} + {+(Integer)+} + {+(Integer)+} + {+(Empty)+})+} + {-(Slice + {-(Identifier)-} + {-(Empty)-} + {-(Integer)-} + {-(Empty)-})-} + {-(Slice + {-(Identifier)-} + {-(Integer)-} + {-(Integer)-} + {-(Empty)-})-} + {-(Slice + {-(Identifier)-} + {-(Integer)-} + {-(Integer)-} + {-(Integer)-})-} + {-(Slice + {-(Identifier)-} + {-(Integer)-} + {-(Integer)-} + {-(Empty)-})-}))) diff --git a/test/fixtures/go/unary-expressions.diffA-B.txt b/test/fixtures/go/unary-expressions.diffA-B.txt index da15e099c..915554cce 100644 --- a/test/fixtures/go/unary-expressions.diffA-B.txt +++ b/test/fixtures/go/unary-expressions.diffA-B.txt @@ -8,24 +8,33 @@ ( { (Identifier) ->(Identifier) } - (Negate - { (Identifier) - ->(Identifier) }) - (Not - (ReceiveOperator - { (Identifier) - ->(Identifier) })) - (Pointer - (Call - { (Identifier) - ->(Identifier) } - (Empty))) - (Complement - { (Identifier) - ->(Identifier) }) - (Reference - { (Identifier) - ->(Identifier) }) - (ReceiveOperator - { (Identifier) - ->(Identifier) })))) + {+(Negate + {+(Identifier)+})+} + {+(Not + {+(ReceiveOperator + {+(Identifier)+})+})+} + {+(Pointer + {+(Call + {+(Identifier)+} + {+(Empty)+})+})+} + {+(Complement + {+(Identifier)+})+} + {+(Reference + {+(Identifier)+})+} + {+(ReceiveOperator + {+(Identifier)+})+} + {-(Negate + {-(Identifier)-})-} + {-(Not + {-(ReceiveOperator + {-(Identifier)-})-})-} + {-(Pointer + {-(Call + {-(Identifier)-} + {-(Empty)-})-})-} + {-(Complement + {-(Identifier)-})-} + {-(Reference + {-(Identifier)-})-} + {-(ReceiveOperator + {-(Identifier)-})-}))) diff --git a/test/fixtures/go/unary-expressions.diffB-A.txt b/test/fixtures/go/unary-expressions.diffB-A.txt index da15e099c..915554cce 100644 --- a/test/fixtures/go/unary-expressions.diffB-A.txt +++ b/test/fixtures/go/unary-expressions.diffB-A.txt @@ -8,24 +8,33 @@ ( { (Identifier) ->(Identifier) } - (Negate - { (Identifier) - ->(Identifier) }) - (Not - (ReceiveOperator - { (Identifier) - ->(Identifier) })) - (Pointer - (Call - { (Identifier) - ->(Identifier) } - (Empty))) - (Complement - { (Identifier) - ->(Identifier) }) - (Reference - { (Identifier) - ->(Identifier) }) - (ReceiveOperator - { (Identifier) - ->(Identifier) })))) + {+(Negate + {+(Identifier)+})+} + {+(Not + {+(ReceiveOperator + {+(Identifier)+})+})+} + {+(Pointer + {+(Call + {+(Identifier)+} + {+(Empty)+})+})+} + {+(Complement + {+(Identifier)+})+} + {+(Reference + {+(Identifier)+})+} + {+(ReceiveOperator + {+(Identifier)+})+} + {-(Negate + {-(Identifier)-})-} + {-(Not + {-(ReceiveOperator + {-(Identifier)-})-})-} + {-(Pointer + {-(Call + {-(Identifier)-} + {-(Empty)-})-})-} + {-(Complement + {-(Identifier)-})-} + {-(Reference + {-(Identifier)-})-} + {-(ReceiveOperator + {-(Identifier)-})-}))) diff --git a/test/fixtures/javascript/export.diffA-B.txt b/test/fixtures/javascript/export.diffA-B.txt index d50078834..ab0893b74 100644 --- a/test/fixtures/javascript/export.diffA-B.txt +++ b/test/fixtures/javascript/export.diffA-B.txt @@ -1,30 +1,22 @@ (Program (Export (ExportClause - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-})) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)))) (Export (ExportClause {-(ImportExportSpecifier @@ -73,15 +65,15 @@ (Identifier) { (Empty) ->(Identifier) }) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} (Assignment (Empty) { (Identifier) ->(Identifier) } - (Empty)) - {+(Assignment - {+(Empty)+} - {+(Identifier)+} - {+(Empty)+})+})) + (Empty)))) (Export { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/javascript/export.diffB-A.txt b/test/fixtures/javascript/export.diffB-A.txt index 1009f3a02..ccc365493 100644 --- a/test/fixtures/javascript/export.diffB-A.txt +++ b/test/fixtures/javascript/export.diffB-A.txt @@ -1,28 +1,22 @@ (Program (Export (ExportClause - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} (ImportExportSpecifier { (Identifier) ->(Identifier) } (Empty)) - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-})) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)))) (Export (ExportClause {+(ImportExportSpecifier @@ -71,11 +65,14 @@ (Identifier) { (Identifier) ->(Empty) }) - (Assignment - (Empty) - { (Identifier) - ->(Identifier) } - (Empty)) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} + {-(Assignment + {-(Empty)-} + {-(Identifier)-} + {-(Empty)-})-} {-(Assignment {-(Empty)-} {-(Identifier)-} @@ -119,18 +116,14 @@ { (Identifier) ->(Identifier) } (Empty)) - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-}) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty))) { (TextElement) ->(TextElement) }) (Export diff --git a/test/fixtures/python/assignment.diffA-B.txt b/test/fixtures/python/assignment.diffA-B.txt index c1c74f5af..2ce0aca2e 100644 --- a/test/fixtures/python/assignment.diffA-B.txt +++ b/test/fixtures/python/assignment.diffA-B.txt @@ -10,14 +10,18 @@ { (Identifier) ->(Identifier) } (Integer)) - (Assignment - { ( +{+(Assignment + {+(Identifier)+} + {+( + {+(Integer)+} + {+(Integer)+})+})+} +{-(Assignment + {-( {-(Identifier)-} - {-(Identifier)-}) - ->(Identifier) } - ( - (Integer) - (Integer))) + {-(Identifier)-})-} + {-( + {-(Integer)-} + {-(Integer)-})-})-} {-(Assignment {-(Identifier)-} {-( diff --git a/test/fixtures/python/assignment.diffB-A.txt b/test/fixtures/python/assignment.diffB-A.txt index e5926ab3f..bf818d4b1 100644 --- a/test/fixtures/python/assignment.diffB-A.txt +++ b/test/fixtures/python/assignment.diffB-A.txt @@ -10,13 +10,14 @@ {-(Integer)-} (Integer) {+(Integer)+})) - (Assignment - { (Identifier) - ->(Identifier) } - { (Integer) - ->( +{+(Assignment + {+(Identifier)+} + {+( {+(Integer)+} - {+(Integer)+}) }) + {+(Integer)+})+})+} +{-(Assignment + {-(Identifier)-} + {-(Integer)-})-} {-(Assignment {-(Identifier)-} {-( diff --git a/test/fixtures/python/augmented-assignment.diffA-B.txt b/test/fixtures/python/augmented-assignment.diffA-B.txt index 2abc99677..795ae8f24 100644 --- a/test/fixtures/python/augmented-assignment.diffA-B.txt +++ b/test/fixtures/python/augmented-assignment.diffA-B.txt @@ -7,21 +7,21 @@ ->(RShift {+(Identifier)+} {+(Integer)+}) }) - (Assignment - { (Identifier) - ->(Identifier) } - { (RShift - {-(Identifier)-} - {-(Integer)-}) - ->(DividedBy +{+(Assignment + {+(Identifier)+} + {+(DividedBy {+(Identifier)+} - {+(Integer)+}) }) + {+(Integer)+})+})+} (Assignment - { (Identifier) - ->(Identifier) } - { (DividedBy + (Identifier) + { (RShift {-(Identifier)-} {-(Integer)-}) ->(Plus {+(Identifier)+} - {+(Integer)+}) })) + {+(Integer)+}) }) +{-(Assignment + {-(Identifier)-} + {-(DividedBy + {-(Identifier)-} + {-(Integer)-})-})-}) diff --git a/test/fixtures/python/augmented-assignment.diffB-A.txt b/test/fixtures/python/augmented-assignment.diffB-A.txt index 07c8da605..6406e416d 100644 --- a/test/fixtures/python/augmented-assignment.diffB-A.txt +++ b/test/fixtures/python/augmented-assignment.diffB-A.txt @@ -7,21 +7,23 @@ ->(Plus {+(Identifier)+} {+(Integer)+}) }) - (Assignment - { (Identifier) - ->(Identifier) } - { (DividedBy - {-(Identifier)-} - {-(Integer)-}) - ->(RShift +{+(Assignment + {+(Identifier)+} + {+(RShift {+(Identifier)+} - {+(Integer)+}) }) - (Assignment - { (Identifier) - ->(Identifier) } - { (Plus - {-(Identifier)-} - {-(Integer)-}) - ->(DividedBy + {+(Integer)+})+})+} +{+(Assignment + {+(Identifier)+} + {+(DividedBy {+(Identifier)+} - {+(Integer)+}) })) + {+(Integer)+})+})+} +{-(Assignment + {-(Identifier)-} + {-(DividedBy + {-(Identifier)-} + {-(Integer)-})-})-} +{-(Assignment + {-(Identifier)-} + {-(Plus + {-(Identifier)-} + {-(Integer)-})-})-}) diff --git a/test/fixtures/python/binary-operator.diffA-B.txt b/test/fixtures/python/binary-operator.diffA-B.txt index f32a3f3bf..dc7bd9ff1 100644 --- a/test/fixtures/python/binary-operator.diffA-B.txt +++ b/test/fixtures/python/binary-operator.diffA-B.txt @@ -26,18 +26,21 @@ (Modulo (Identifier) (Identifier)) -{+(Power - {+(Identifier)+} - {+(Identifier)+})+} -{+(DividedBy - {+(Identifier)+} - {+(Identifier)+})+} { (DividedBy {-(Identifier)-} {-(Identifier)-}) -->(Modulo +->(Power {+(Identifier)+} {+(Identifier)+}) } +{ (Power + {-(Identifier)-} + {-(Identifier)-}) +->(DividedBy + {+(Identifier)+} + {+(Identifier)+}) } +{+(Modulo + {+(Identifier)+} + {+(Identifier)+})+} {+(DividedBy {+(Identifier)+} {+(Identifier)+})+} @@ -50,9 +53,6 @@ {+(Plus {+(Identifier)+} {+(Identifier)+})+} -{-(Power - {-(Identifier)-} - {-(Identifier)-})-} {-(BOr {-(Identifier)-} {-(Identifier)-})-} diff --git a/test/fixtures/python/binary-operator.diffB-A.txt b/test/fixtures/python/binary-operator.diffB-A.txt index f43e9f901..4696ca265 100644 --- a/test/fixtures/python/binary-operator.diffB-A.txt +++ b/test/fixtures/python/binary-operator.diffB-A.txt @@ -26,12 +26,18 @@ (Modulo (Identifier) (Identifier)) -{+(DividedBy +{ (Power + {-(Identifier)-} + {-(Identifier)-}) +->(DividedBy {+(Identifier)+} - {+(Identifier)+})+} -{+(Power + {+(Identifier)+}) } +{ (DividedBy + {-(Identifier)-} + {-(Identifier)-}) +->(Power {+(Identifier)+} - {+(Identifier)+})+} + {+(Identifier)+}) } {+(BOr {+(Identifier)+} {+(Identifier)+})+} @@ -47,12 +53,6 @@ {+(RShift {+(Identifier)+} {+(Identifier)+})+} -{-(Power - {-(Identifier)-} - {-(Identifier)-})-} -{-(DividedBy - {-(Identifier)-} - {-(Identifier)-})-} {-(Modulo {-(Identifier)-} {-(Identifier)-})-} diff --git a/test/fixtures/python/comparison-operator.diffB-A.txt b/test/fixtures/python/comparison-operator.diffB-A.txt index 7b9d7d422..9d0315fea 100644 --- a/test/fixtures/python/comparison-operator.diffB-A.txt +++ b/test/fixtures/python/comparison-operator.diffB-A.txt @@ -5,40 +5,38 @@ {+(LessThanEqual {+(Identifier)+} {+(Identifier)+})+} -{+(Not - {+(Equal - {+(Identifier)+} - {+(Identifier)+})+})+} -{+(GreaterThanEqual - {+(Identifier)+} - {+(Identifier)+})+} -{+(GreaterThan - {+(Identifier)+} - {+(Identifier)+})+} (Not (Equal { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) })) +{+(GreaterThanEqual + {+(Identifier)+} + {+(Identifier)+})+} +{+(GreaterThan + {+(Identifier)+} + {+(Identifier)+})+} +{+(Not + {+(Equal + {+(Identifier)+} + {+(Identifier)+})+})+} {+(Member {+(Identifier)+} {+(Identifier)+})+} {+(Equal {+(Identifier)+} {+(Identifier)+})+} -{+(Not - {+(Member - {+(Identifier)+} - {+(Identifier)+})+})+} + (Not + (Member + { (Identifier) + ->(Identifier) } + { (Identifier) + ->(Identifier) })) {+(Not {+(Equal {+(Identifier)+} {+(Identifier)+})+})+} -{-(Not - {-(Member - {-(Identifier)-} - {-(Identifier)-})-})-} {-(Equal {-(Identifier)-} {-(Identifier)-})-} diff --git a/test/fixtures/python/float.diffA-B.txt b/test/fixtures/python/float.diffA-B.txt index 52d2dd464..ac2863db4 100644 --- a/test/fixtures/python/float.diffA-B.txt +++ b/test/fixtures/python/float.diffA-B.txt @@ -7,13 +7,13 @@ {+(Float)+} {+(Float)+} {+(Float)+} +{+(Float)+} { (Float) ->(Float) } {+(Float)+} {+(Float)+} { (Float) ->(Float) } -{+(Float)+} {-(Float)-} {-(Float)-} {-(Float)-} diff --git a/test/fixtures/python/float.diffB-A.txt b/test/fixtures/python/float.diffB-A.txt index 916dc8f79..48cb37153 100644 --- a/test/fixtures/python/float.diffB-A.txt +++ b/test/fixtures/python/float.diffB-A.txt @@ -6,10 +6,8 @@ ->(Float) } {+(Float)+} {+(Float)+} -{ (Float) -->(Float) } -{ (Float) -->(Float) } +{+(Float)+} +{+(Float)+} {+(Float)+} { (Float) ->(Float) } @@ -19,4 +17,6 @@ {-(Float)-} {-(Float)-} {-(Float)-} +{-(Float)-} +{-(Float)-} {-(Float)-}) diff --git a/test/fixtures/python/integer.diffA-B.txt b/test/fixtures/python/integer.diffA-B.txt index 8df16fdb3..3cdc606b4 100644 --- a/test/fixtures/python/integer.diffA-B.txt +++ b/test/fixtures/python/integer.diffA-B.txt @@ -9,14 +9,14 @@ {+(Negate {+(Integer)+})+} {+(Integer)+} +{ (Integer) +->(Integer) } {+(Integer)+} {+(Integer)+} {+(Integer)+} {+(Integer)+} {+(Integer)+} {+(Integer)+} -{+(Integer)+} -{-(Integer)-} {-(Integer)-} {-(Negate {-(Integer)-})-} diff --git a/test/fixtures/python/integer.diffB-A.txt b/test/fixtures/python/integer.diffB-A.txt index cac966d3c..ce3dff492 100644 --- a/test/fixtures/python/integer.diffB-A.txt +++ b/test/fixtures/python/integer.diffB-A.txt @@ -9,15 +9,15 @@ {+(Negate {+(Integer)+})+} {+(Integer)+} -{ (Integer) -->(Integer) } +{+(Integer)+} +{+(Integer)+} {+(Integer)+} { (Integer) ->(Integer) } {+(Integer)+} {+(Integer)+} {+(Integer)+} -{+(Integer)+} +{-(Integer)-} {-(Negate {-(Integer)-})-} {-(Integer)-} diff --git a/test/fixtures/python/string.diffA-B.txt b/test/fixtures/python/string.diffA-B.txt index 707379f23..20712d404 100644 --- a/test/fixtures/python/string.diffA-B.txt +++ b/test/fixtures/python/string.diffA-B.txt @@ -6,8 +6,8 @@ { (TextElement) ->(TextElement) } {+(TextElement)+} -{+(TextElement)+} -{-(TextElement)-} +{ (TextElement) +->(TextElement) } {-(TextElement)-} {-(TextElement)-} {-(TextElement)-} diff --git a/test/fixtures/python/string.diffB-A.txt b/test/fixtures/python/string.diffB-A.txt index f96350334..828a6c9f0 100644 --- a/test/fixtures/python/string.diffB-A.txt +++ b/test/fixtures/python/string.diffB-A.txt @@ -2,13 +2,13 @@ {-(TextElement)-} (TextElement) {+(TextElement)+} -{ (TextElement) -->(TextElement) } +{+(TextElement)+} +{+(TextElement)+} {+(TextElement)+} {+(TextElement)+} { (TextElement) ->(TextElement) } -{+(TextElement)+} +{-(TextElement)-} {-(TextElement)-} {-(TextElement)-} {-(TextElement)-} diff --git a/test/fixtures/python/unary-operator.diffA-B.txt b/test/fixtures/python/unary-operator.diffA-B.txt index 6e10befa0..d6e01087b 100644 --- a/test/fixtures/python/unary-operator.diffA-B.txt +++ b/test/fixtures/python/unary-operator.diffA-B.txt @@ -1,11 +1,10 @@ (Program {+(Complement {+(Identifier)+})+} -{+(Negate - {+(Identifier)+})+} -{+(Identifier)+} -{-(Negate - {-(Identifier)-})-} -{-(Identifier)-} + (Negate + { (Identifier) + ->(Identifier) }) +{ (Identifier) +->(Identifier) } {-(Complement {-(Identifier)-})-}) diff --git a/test/fixtures/ruby/delimiter.diffA-B.txt b/test/fixtures/ruby/delimiter.diffA-B.txt index e7e1220f2..cb091f81c 100644 --- a/test/fixtures/ruby/delimiter.diffA-B.txt +++ b/test/fixtures/ruby/delimiter.diffA-B.txt @@ -3,10 +3,10 @@ {+(TextElement)+} {+(TextElement)+} {+(TextElement)+} -{ (TextElement) -->(TextElement) } -{ (TextElement) -->(TextElement) } +{+(TextElement)+} +{+(TextElement)+} +{-(TextElement)-} +{-(TextElement)-} {-(TextElement)-} {-(TextElement)-} {-(TextElement)-} diff --git a/test/fixtures/ruby/delimiter.diffB-A.txt b/test/fixtures/ruby/delimiter.diffB-A.txt index f69979390..41d9a3ae1 100644 --- a/test/fixtures/ruby/delimiter.diffB-A.txt +++ b/test/fixtures/ruby/delimiter.diffB-A.txt @@ -1,12 +1,12 @@ (Program {+(TextElement)+} -{ (TextElement) -->(TextElement) } {+(TextElement)+} {+(TextElement)+} {+(TextElement)+} { (TextElement) ->(TextElement) } +{+(TextElement)+} +{-(TextElement)-} {-(TextElement)-} {-(TextElement)-} {-(TextElement)-} diff --git a/test/fixtures/ruby/hash.diffA-B.txt b/test/fixtures/ruby/hash.diffA-B.txt index 6294f4491..6cd824ce2 100644 --- a/test/fixtures/ruby/hash.diffA-B.txt +++ b/test/fixtures/ruby/hash.diffA-B.txt @@ -1,20 +1,23 @@ (Program (Hash - (KeyValue - { (Symbol) - ->(Identifier) } - { (TextElement) - ->(TextElement) }) - (KeyValue - { (Symbol) - ->(Identifier) } - { (Integer) - ->(Integer) }) - (KeyValue - { (TextElement) - ->(Identifier) } - { (Boolean) - ->(Boolean) }) + {+(KeyValue + {+(Identifier)+} + {+(TextElement)+})+} + {+(KeyValue + {+(Identifier)+} + {+(Integer)+})+} + {+(KeyValue + {+(Identifier)+} + {+(Boolean)+})+} + {-(KeyValue + {-(Symbol)-} + {-(TextElement)-})-} + {-(KeyValue + {-(Symbol)-} + {-(Integer)-})-} + {-(KeyValue + {-(TextElement)-} + {-(Boolean)-})-} {-(KeyValue {-(Symbol)-} {-(Integer)-})-}) diff --git a/test/fixtures/ruby/hash.diffB-A.txt b/test/fixtures/ruby/hash.diffB-A.txt index 7b1ca75c0..699a68a15 100644 --- a/test/fixtures/ruby/hash.diffB-A.txt +++ b/test/fixtures/ruby/hash.diffB-A.txt @@ -1,23 +1,25 @@ (Program (Hash - (KeyValue - { (Identifier) - ->(Symbol) } - { (TextElement) - ->(TextElement) }) - (KeyValue - { (Identifier) - ->(Symbol) } - { (Integer) - ->(Integer) }) + {+(KeyValue + {+(Symbol)+} + {+(TextElement)+})+} + {+(KeyValue + {+(Symbol)+} + {+(Integer)+})+} (KeyValue { (Identifier) ->(TextElement) } - { (Boolean) + { (TextElement) ->(Boolean) }) {+(KeyValue {+(Symbol)+} - {+(Integer)+})+}) + {+(Integer)+})+} + {-(KeyValue + {-(Identifier)-} + {-(Integer)-})-} + {-(KeyValue + {-(Identifier)-} + {-(Boolean)-})-}) {+(Hash)+} {+(Hash {+(Context diff --git a/test/fixtures/ruby/number.diffA-B.txt b/test/fixtures/ruby/number.diffA-B.txt index edc5fb6dc..c77fb3514 100644 --- a/test/fixtures/ruby/number.diffA-B.txt +++ b/test/fixtures/ruby/number.diffA-B.txt @@ -1,15 +1,15 @@ (Program {+(Integer)+} +{+(Integer)+} { (Integer) ->(Integer) } {+(Integer)+} -{+(Integer)+} -{+(Integer)+} +{ (Integer) +->(Integer) } {+(Integer)+} {+(Float)+} {-(Integer)-} {-(Integer)-} {-(Integer)-} {-(Integer)-} -{-(Integer)-} {-(Float)-}) diff --git a/test/fixtures/ruby/number.diffB-A.txt b/test/fixtures/ruby/number.diffB-A.txt index 433ee8148..66875917a 100644 --- a/test/fixtures/ruby/number.diffB-A.txt +++ b/test/fixtures/ruby/number.diffB-A.txt @@ -3,13 +3,13 @@ {+(Integer)+} {+(Integer)+} {+(Integer)+} -{+(Integer)+} -{+(Integer)+} +{ (Integer) +->(Integer) } +{ (Integer) +->(Integer) } {+(Float)+} {-(Integer)-} {-(Integer)-} {-(Integer)-} {-(Integer)-} -{-(Integer)-} -{-(Integer)-} {-(Float)-}) diff --git a/test/fixtures/ruby/symbol.diffA-B.txt b/test/fixtures/ruby/symbol.diffA-B.txt index 4e4701d0f..75121f8f8 100644 --- a/test/fixtures/ruby/symbol.diffA-B.txt +++ b/test/fixtures/ruby/symbol.diffA-B.txt @@ -1,7 +1,7 @@ (Program -{ (Symbol) -->(Symbol) } {+(Symbol)+} { (Symbol) ->(Symbol) } +{+(Symbol)+} +{-(Symbol)-} {-(Symbol)-}) diff --git a/test/fixtures/ruby/symbol.diffB-A.txt b/test/fixtures/ruby/symbol.diffB-A.txt index f78d2a84b..07ec021d6 100644 --- a/test/fixtures/ruby/symbol.diffB-A.txt +++ b/test/fixtures/ruby/symbol.diffB-A.txt @@ -1,7 +1,7 @@ (Program +{+(Symbol)+} +{ (Symbol) +->(Symbol) } { (Symbol) ->(Symbol) } -{+(Symbol)+} -{+(Symbol)+} -{-(Symbol)-} {-(Symbol)-}) diff --git a/test/fixtures/typescript/export.diffA-B.txt b/test/fixtures/typescript/export.diffA-B.txt index d50078834..ab0893b74 100644 --- a/test/fixtures/typescript/export.diffA-B.txt +++ b/test/fixtures/typescript/export.diffA-B.txt @@ -1,30 +1,22 @@ (Program (Export (ExportClause - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-})) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)))) (Export (ExportClause {-(ImportExportSpecifier @@ -73,15 +65,15 @@ (Identifier) { (Empty) ->(Identifier) }) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} (Assignment (Empty) { (Identifier) ->(Identifier) } - (Empty)) - {+(Assignment - {+(Empty)+} - {+(Identifier)+} - {+(Empty)+})+})) + (Empty)))) (Export { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/typescript/export.diffB-A.txt b/test/fixtures/typescript/export.diffB-A.txt index 1009f3a02..ccc365493 100644 --- a/test/fixtures/typescript/export.diffB-A.txt +++ b/test/fixtures/typescript/export.diffB-A.txt @@ -1,28 +1,22 @@ (Program (Export (ExportClause - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} (ImportExportSpecifier { (Identifier) ->(Identifier) } (Empty)) - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-})) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)))) (Export (ExportClause {+(ImportExportSpecifier @@ -71,11 +65,14 @@ (Identifier) { (Identifier) ->(Empty) }) - (Assignment - (Empty) - { (Identifier) - ->(Identifier) } - (Empty)) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} + {-(Assignment + {-(Empty)-} + {-(Identifier)-} + {-(Empty)-})-} {-(Assignment {-(Empty)-} {-(Identifier)-} @@ -119,18 +116,14 @@ { (Identifier) ->(Identifier) } (Empty)) - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {+(ImportExportSpecifier - {+(Identifier)+} - {+(Empty)+})+} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-} - {-(ImportExportSpecifier - {-(Identifier)-} - {-(Empty)-})-}) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty)) + (ImportExportSpecifier + { (Identifier) + ->(Identifier) } + (Empty))) { (TextElement) ->(TextElement) }) (Export From 7c1d3815304680c70d4c07948374525bf21b29f0 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 1 Dec 2017 14:45:37 -0800 Subject: [PATCH 36/43] Turn on Go assignment --- src/Semantic.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index 74116b213..5de5ca677 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -98,7 +98,8 @@ diffBlobPair renderer blobs qualify language | OldToCDiffRenderer <- renderer = guard (language `elem` aLaCarteLanguages) *> Just language | otherwise = Just language aLaCarteLanguages - = [ Language.JSX + = [ Language.Go + , Language.JSX , Language.JavaScript , Language.Markdown , Language.Python From 750c4a6d3e4f4f27307c3f223fe5515acf6461ad Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Sat, 2 Dec 2017 12:44:28 -0800 Subject: [PATCH 37/43] Contextualize specific syntax for function and method declarations - These assignment rules are two of the only places in Go assignment where individual syntax rules are used. This wraps those syntax rules in `term`, so that they can be contextualized. --- src/Language/Go/Assignment.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Language/Go/Assignment.hs b/src/Language/Go/Assignment.hs index 96452e6e4..c26ec8841 100644 --- a/src/Language/Go/Assignment.hs +++ b/src/Language/Go/Assignment.hs @@ -373,7 +373,7 @@ fallThroughStatement :: Assignment fallThroughStatement = makeTerm <$> symbol FallthroughStatement <*> (Statement.Pattern <$> (makeTerm <$> location <*> (Syntax.Identifier <$> source)) <*> emptyTerm) functionDeclaration :: Assignment -functionDeclaration = makeTerm <$> (symbol FunctionDeclaration <|> symbol FuncLiteral) <*> children (mkFunctionDeclaration <$> (identifier <|> emptyTerm) <*> manyTerm parameters <*> (types <|> identifier <|> returnParameters <|> emptyTerm) <*> (block <|> emptyTerm)) +functionDeclaration = makeTerm <$> (symbol FunctionDeclaration <|> symbol FuncLiteral) <*> children (mkFunctionDeclaration <$> (term identifier <|> emptyTerm) <*> manyTerm parameters <*> (term types <|> term identifier <|> term returnParameters <|> emptyTerm) <*> (term block <|> emptyTerm)) where mkFunctionDeclaration name' params' types' block' = Declaration.Function [types'] name' params' block' returnParameters = makeTerm <$> symbol Parameters <*> children (manyTerm expression) @@ -388,7 +388,7 @@ indexExpression :: Assignment indexExpression = makeTerm <$> symbol IndexExpression <*> children (Expression.Subscript <$> expression <*> manyTerm expression) methodDeclaration :: Assignment -methodDeclaration = makeTerm <$> symbol MethodDeclaration <*> children (mkTypedMethodDeclaration <$> receiver <*> fieldIdentifier <*> manyTerm parameters <*> ((makeTerm <$> location <*> (manyTermsTill expression (void (symbol Block)))) <|> emptyTerm) <*> (block <|> emptyTerm)) +methodDeclaration = makeTerm <$> symbol MethodDeclaration <*> children (mkTypedMethodDeclaration <$> receiver <*> term fieldIdentifier <*> manyTerm parameters <*> ((makeTerm <$> location <*> (manyTermsTill expression (void (symbol Block)))) <|> emptyTerm) <*> (term block <|> emptyTerm)) where receiver = symbol Parameters *> children ((symbol ParameterDeclaration *> children expressions) <|> expressions) mkTypedMethodDeclaration receiver' name' parameters' type'' body' = Declaration.Method [type''] receiver' name' parameters' body' From cda1779d64cfd623b6b3f34ffd330e0c95882476 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 11 Dec 2017 14:29:30 -0800 Subject: [PATCH 38/43] Update comment --- src/Analysis/CyclomaticComplexity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index 62dc63563..0402d62d6 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/src/Analysis/CyclomaticComplexity.hs @@ -123,7 +123,7 @@ type family CyclomaticComplexityStrategy syntax where CyclomaticComplexityStrategy a = 'Default --- | The 'Default' strategy produces 'Nothing'. +-- | The 'Default' strategy takes the sum without incrementing. instance Foldable syntax => HasCyclomaticComplexityWithStrategy 'Default syntax where toCyclomaticComplexityWithStrategy _ = sum From 01c30abc2dee1c172a175bc3d650d44a4e5e3785 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 11 Dec 2017 15:39:12 -0800 Subject: [PATCH 39/43] Add single blob parser util function for convenience --- src/Semantic/Util.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index e722c1536..4675ba7bb 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -29,10 +29,22 @@ diffWithParser :: (HasField fields Data.Span.Span, Traversable syntax, Functor syntax, Foldable syntax, Diffable syntax, GAlign syntax, HasDeclaration syntax) - => - Parser (Term syntax (Record fields)) + => Parser (Term syntax (Record fields)) -> Both Blob -> Task (Diff syntax (Record (Maybe Declaration ': fields)) (Record (Maybe Declaration ': fields))) diffWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) where run parse sourceBlobs = distributeFor sourceBlobs parse >>= runBothWith (diffTermPair sourceBlobs diffTerms) + +diffBlobWithParser :: (HasField fields Data.Span.Span, + HasField fields Range, + Eq1 syntax, Show1 syntax, + Traversable syntax, Functor syntax, + Foldable syntax, Diffable syntax, + GAlign syntax, HasDeclaration syntax) + => Parser (Term syntax (Record fields)) + -> Blob + -> Task (Term syntax (Record (Maybe Declaration : fields))) +diffBlobWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) + where + run parse sourceBlob = parse sourceBlob From 3028946612014b70773c7386976a279447e12496 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 11 Dec 2017 15:39:41 -0800 Subject: [PATCH 40/43] Define a default method for the CustomHasCyclomaticComplexity typeclass --- src/Analysis/CyclomaticComplexity.hs | 42 +++++++++------------------- 1 file changed, 13 insertions(+), 29 deletions(-) diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index 0402d62d6..dc67b0ac7 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/src/Analysis/CyclomaticComplexity.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE DataKinds, DefaultSignatures, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} module Analysis.CyclomaticComplexity ( CyclomaticComplexity(..) , HasCyclomaticComplexity @@ -57,36 +57,20 @@ class CustomHasCyclomaticComplexity syntax where -- | Produce a customized 'CyclomaticComplexity' for a given syntax node. customToCyclomaticComplexity :: syntax CyclomaticComplexity -> CyclomaticComplexity -instance CustomHasCyclomaticComplexity Declaration.Function where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Declaration.Method where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.Catch where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.DoWhile where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.Else where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.For where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.ForEach where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.If where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.Pattern where - customToCyclomaticComplexity = succ . sum - -instance CustomHasCyclomaticComplexity Statement.While where + -- | Because we perform the same operation wherever we use the custom strategy, we can define the default method for all instances. + default customToCyclomaticComplexity :: Foldable syntax => syntax CyclomaticComplexity -> CyclomaticComplexity customToCyclomaticComplexity = succ . sum +instance CustomHasCyclomaticComplexity Declaration.Function +instance CustomHasCyclomaticComplexity Declaration.Method +instance CustomHasCyclomaticComplexity Statement.Catch +instance CustomHasCyclomaticComplexity Statement.DoWhile +instance CustomHasCyclomaticComplexity Statement.Else +instance CustomHasCyclomaticComplexity Statement.For +instance CustomHasCyclomaticComplexity Statement.ForEach +instance CustomHasCyclomaticComplexity Statement.If +instance CustomHasCyclomaticComplexity Statement.Pattern +instance CustomHasCyclomaticComplexity Statement.While -- | Produce a 'CyclomaticComplexity' for 'Union's using the 'HasCyclomaticComplexity' instance & therefore using a 'CustomHasCyclomaticComplexity' instance when one exists & the type is listed in 'CyclomaticComplexityStrategy'. instance Apply HasCyclomaticComplexity fs => CustomHasCyclomaticComplexity (Union fs) where From 58ebcbfb002967551cb4960954a56d0a9daa405d Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 12 Dec 2017 11:32:12 -0800 Subject: [PATCH 41/43] Add IdentifierName decorator --- semantic-diff.cabal | 1 + src/Analysis/IdentifierName.hs | 60 ++++++++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+) create mode 100644 src/Analysis/IdentifierName.hs diff --git a/semantic-diff.cabal b/semantic-diff.cabal index ec057552a..cfad96447 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -19,6 +19,7 @@ library , Analysis.CyclomaticComplexity , Analysis.Decorator , Analysis.Declaration + , Analysis.IdentifierName -- Semantic assignment , Assigning.Assignment , Assigning.Assignment.Table diff --git a/src/Analysis/IdentifierName.hs b/src/Analysis/IdentifierName.hs new file mode 100644 index 000000000..0c2aa7830 --- /dev/null +++ b/src/Analysis/IdentifierName.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +module Analysis.IdentifierName +( IdentifierName(..) +, IdentifierLabel(..) +, identifierLabel +) where + +import Data.Aeson +import Data.ByteString +import Data.JSON.Fields +import Data.Proxy +import Data.Term +import Data.Text.Encoding (decodeUtf8) +import Data.Union +import qualified Data.Syntax + +-- | Compute a 'IdentifierLabel' label for a 'Term'. +identifierLabel :: IdentifierName syntax => TermF syntax a b -> Maybe IdentifierLabel +identifierLabel (In _ s) = IdentifierLabel <$> (identifierName s) + +newtype IdentifierLabel = IdentifierLabel ByteString + deriving (Show) + +instance ToJSONFields IdentifierLabel where + toJSONFields (IdentifierLabel s) = [ "name" .= decodeUtf8 s ] + + +-- | A typeclass to retrieve the name of syntax identifiers. +-- +-- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap; see also src/Analysis/Declaration.hs for discussion of the details of the mechanism. +class IdentifierName syntax where + identifierName :: syntax a -> Maybe ByteString + +instance (IdentifierNameStrategy syntax ~ strategy, IdentifierNameWithStrategy strategy syntax) => IdentifierName syntax where + identifierName = identifierNameWithStrategy (Proxy :: Proxy strategy) + +class CustomIdentifierName syntax where + customIdentifierName :: syntax a -> Maybe ByteString + +instance Apply IdentifierName fs => CustomIdentifierName (Union fs) where + customIdentifierName = apply (Proxy :: Proxy IdentifierName) identifierName + +instance CustomIdentifierName Data.Syntax.Identifier where + customIdentifierName (Data.Syntax.Identifier name) = Just name + +data Strategy = Default | Custom + +type family IdentifierNameStrategy syntax where + IdentifierNameStrategy (Union _) = 'Custom + IdentifierNameStrategy Data.Syntax.Identifier = 'Custom + IdentifierNameStrategy syntax = 'Default + +class IdentifierNameWithStrategy (strategy :: Strategy) syntax where + identifierNameWithStrategy :: proxy strategy -> syntax a -> Maybe ByteString + +instance IdentifierNameWithStrategy 'Default syntax where + identifierNameWithStrategy _ _ = Nothing + +instance (CustomIdentifierName syntax) => IdentifierNameWithStrategy 'Custom syntax where + identifierNameWithStrategy _ = customIdentifierName From 5b7df2b3f2491492feea6569101c0b69cedebb38 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 12 Dec 2017 11:34:02 -0800 Subject: [PATCH 42/43] Use new identifier decorator for json output --- src/Semantic.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index 5de5ca677..daf7af36e 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -8,6 +8,7 @@ module Semantic ) where import Analysis.ConstructorName (ConstructorName, constructorLabel) +import Analysis.IdentifierName (IdentifierName, identifierLabel) import Analysis.Declaration (HasDeclaration, declarationAlgebra, syntaxDeclarationAlgebra) import Analysis.Decorator (syntaxIdentifierAlgebra) import Control.Exception @@ -49,10 +50,10 @@ parseBlobs renderer = fmap toOutput . distributeFoldMap (parseBlob renderer) . f -- | A task to parse a 'Blob' and render the resulting 'Term'. parseBlob :: TermRenderer output -> Blob -> Task output parseBlob renderer blob@Blob{..} - | Just (SomeParser parser) <- blobLanguage >>= someParser (Proxy :: Proxy '[ConstructorName, HasDeclaration, Foldable, Functor, ToJSONFields1]) + | Just (SomeParser parser) <- blobLanguage >>= someParser (Proxy :: Proxy '[ConstructorName, IdentifierName, HasDeclaration, Foldable, Functor, ToJSONFields1]) = parse parser blob >>= case renderer of ToCTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToCTerm blob) - JSONTermRenderer -> decorate constructorLabel >=> render (renderJSONTerm blob) + JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob) SExpressionTermRenderer -> decorate constructorLabel . (Nil <$) >=> render renderSExpressionTerm TagsTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToTags blob) @@ -75,11 +76,11 @@ diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair rendere -- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'. diffBlobPair :: DiffRenderer output -> Both Blob -> Task output diffBlobPair renderer blobs - | Just (SomeParser parser) <- effectiveLanguage >>= qualify >>= someParser (Proxy :: Proxy '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, Show1, ToJSONFields1, Traversable]) + | Just (SomeParser parser) <- effectiveLanguage >>= qualify >>= someParser (Proxy :: Proxy '[ConstructorName, IdentifierName, Diffable, Eq1, GAlign, HasDeclaration, Show1, ToJSONFields1, Traversable]) = case renderer of OldToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms renderToCDiff ToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms renderToCDiff - JSONDiffRenderer -> run ( parse parser) diffTerms renderJSONDiff + JSONDiffRenderer -> run ( parse parser >=> decorate constructorLabel >=> decorate identifierLabel) diffTerms renderJSONDiff SExpressionDiffRenderer -> run ( parse parser >=> decorate constructorLabel . (Nil <$)) diffTerms (const renderSExpressionDiff) | Just parser <- effectiveLanguage >>= syntaxParserForLanguage From dce9ffa61c52603de55e5ed29d5391b0bda7d105 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 12 Dec 2017 11:42:04 -0800 Subject: [PATCH 43/43] Fix up expected JSON output in specs --- test/Semantic/CLI/Spec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index cdf23172a..2bbe089d0 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -45,8 +45,8 @@ parseFixtures = pathMode' = Right [("test/fixtures/ruby/and-or.A.rb", Just Ruby), ("test/fixtures/ruby/and-or.B.rb", Just Ruby)] sExpressionParseTreeOutput = "(Program\n (And\n (Identifier)\n (Identifier)))\n" - jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]\n" - jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"And\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n" + jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]\n" + jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"And\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"a\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"b\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"c\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n" emptyJsonParseTreeOutput = "[]\n" tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"unchanged\"}]},\"errors\":{}}\n" @@ -59,6 +59,6 @@ diffFixtures = ] where pathMode = Right [both ("test/fixtures/ruby/method-declaration.A.rb", Just Ruby) ("test/fixtures/ruby/method-declaration.B.rb", Just Ruby)] - jsonOutput = "{\"diff\":{\"merge\":{\"after\":{\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"after\":{\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"merge\":{\"after\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"children\":[],\"before\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},{\"patch\":{\"replace\":[{\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},{\"patch\":{\"insert\":{\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}},{\"merge\":{\"after\":{\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}],\"before\":{\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}}}}],\"before\":{\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}}],\"before\":{\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n" + jsonOutput = "{\"diff\":{\"merge\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"after\":{\"category\":\"Method\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"merge\":{\"after\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"children\":[],\"before\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},{\"patch\":{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}},{\"merge\":{\"after\":{\"category\":\"\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}],\"before\":{\"category\":\"[]\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}}}}],\"before\":{\"category\":\"Method\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}}],\"before\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n" sExpressionOutput = "(Program\n (Method\n (Empty)\n { (Identifier)\n ->(Identifier) }\n {+(Identifier)+}\n (\n {+(Identifier)+})))\n" tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"