From 48013060320aeb06c382d88093d072d6d6f08c5b Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 11 Oct 2017 17:35:52 -0700 Subject: [PATCH 01/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] :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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] 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/67] :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/67] 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/67] 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/67] =?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/67] 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/67] 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/67] 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 46cccd5015024a495896f4d91ca34c28308d4fe9 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 8 Dec 2017 11:42:46 -0700 Subject: [PATCH 38/67] Don't parse blobs that don't exist --- src/Semantic.hs | 13 ++++++------- src/Semantic/Util.hs | 2 +- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index 74116b213..365801da9 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -108,9 +108,9 @@ diffBlobPair renderer blobs run :: (Foldable syntax, Functor syntax) => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Both Blob -> Diff syntax ann ann -> output) -> Task output run parse diff renderer = do - terms <- distributeFor blobs parse + terms <- distributeFor blobs (\b -> if blobExists b then Just <$> parse b else pure Nothing) time "diff" languageTag $ do - diff <- runBothWith (diffTermPair blobs diff) terms + diff <- runBothWith (diffTermPair diff) terms writeStat (Stat.count "diff.nodes" (bilength diff) languageTag) render (renderer blobs) diff where @@ -119,11 +119,10 @@ diffBlobPair renderer blobs in maybe (maybe [] showLanguage (blobLanguage b)) showLanguage (blobLanguage a) -- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's. -diffTermPair :: Functor syntax => Both Blob -> Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2) -diffTermPair blobs differ t1 t2 = case runJoin (blobExists <$> blobs) of - (True, False) -> pure (deleting t1) - (False, True) -> pure (inserting t2) - _ -> diff differ t1 t2 +diffTermPair :: Functor syntax => Differ syntax ann1 ann2 -> Maybe (Term syntax ann1) -> Maybe (Term syntax ann2) -> Task (Diff syntax ann1 ann2) +diffTermPair _ (Just t1) Nothing = pure (deleting t1) +diffTermPair _ Nothing (Just t2) = pure (inserting t2) +diffTermPair differ (Just t1) (Just t2) = diff differ t1 t2 keepCategory :: HasField fields Category => Record fields -> Record '[Category] keepCategory = (:. Nil) . category diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index e722c1536..ea31f9536 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -35,4 +35,4 @@ diffWithParser :: (HasField fields Data.Span.Span, -> 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) + run parse sourceBlobs = distributeFor sourceBlobs (\b -> if blobExists b then Just <$> parse b else pure Nothing) >>= runBothWith (diffTermPair diffTerms) From ba2159e9405cee3ad340cc02c3de7ecf8862aecb Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 17:36:48 -0800 Subject: [PATCH 39/67] First attempt at BlobPair as These and bitraversable --- src/Data/Blob.hs | 18 ++++++++++++++++++ src/Rendering/JSON.hs | 2 +- src/Rendering/TOC.hs | 12 ++++++------ src/Semantic.hs | 34 +++++++++++++++++----------------- src/Semantic/IO.hs | 21 +++++++++++++++++---- src/Semantic/Task.hs | 19 ++++++++++++++++--- 6 files changed, 75 insertions(+), 31 deletions(-) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index a1beae60f..86a3bd2b6 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -1,6 +1,7 @@ module Data.Blob ( Blob(..) , BlobKind(..) +, These(..) , modeToDigits , defaultPlainBlob , emptyBlob @@ -8,15 +9,32 @@ module Data.Blob , blobExists , sourceBlob , nullOid +, BlobPair +, languageForBlobPair +, languageTagForBlobPair ) where import Data.ByteString.Char8 (ByteString, pack) import Data.Language +import Data.These import Data.Maybe (isJust) import Data.Source as Source import Data.Word import Numeric + +type BlobPair = These Blob Blob + +languageForBlobPair :: BlobPair -> Maybe Language +languageForBlobPair (This Blob{..}) = blobLanguage +languageForBlobPair (That Blob{..}) = blobLanguage +languageForBlobPair (These _ Blob{..}) = blobLanguage + +languageTagForBlobPair :: BlobPair -> [(String, String)] +languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair) + where showLanguage = pure . (,) "language" . show + + -- | The source, oid, path, and Maybe BlobKind of a blob. data Blob = Blob { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index fb99231a9..3d2c202bc 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -19,7 +19,7 @@ import GHC.Generics -- -- | Render a diff to a string representing its JSON. -renderJSONDiff :: ToJSON a => Both Blob -> a -> Map.Map Text Value +renderJSONDiff :: ToJSON a => BlobPair -> a -> Map.Map Text Value renderJSONDiff blobs diff = Map.fromList [ ("diff", toJSON diff) , ("oids", toJSON (decodeUtf8 . blobOid <$> toList blobs)) diff --git a/src/Rendering/TOC.hs b/src/Rendering/TOC.hs index 772af46f5..d332b7304 100644 --- a/src/Rendering/TOC.hs +++ b/src/Rendering/TOC.hs @@ -160,15 +160,15 @@ recordSummary changeText record = case getDeclaration record of formatIdentifier (MethodDeclaration identifier _ _ (Just receiver)) = receiver <> "." <> identifier formatIdentifier declaration = declarationIdentifier declaration -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, Foldable f, Functor f) => BlobPair -> 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) - summaryKey = T.pack $ case runJoin (blobPath <$> blobs) of - (before, after) | null before -> after - | null after -> before - | before == after -> after - | otherwise -> before <> " -> " <> after + summaryKey = T.pack $ case bimap blobPath blobPath blobs of + This before -> before + That after -> after + These before after | before == after -> after + | otherwise -> before <> " -> " <> after diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Diff f (Record fields) (Record fields) -> [TOCSummary] diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration diff --git a/src/Semantic.hs b/src/Semantic.hs index 365801da9..868da693a 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -18,6 +18,7 @@ import Data.Bifoldable import Data.Blob import Data.ByteString (ByteString) import Data.Diff +import Data.Foldable (toList) import Data.Functor.Both as Both import Data.Functor.Classes import Data.JSON.Fields @@ -25,6 +26,7 @@ import qualified Data.Language as Language import Data.Output import Data.Record import Data.Term +import Data.These import Data.Typeable import Diffing.Algorithm (Diffable) import Diffing.Interpreter @@ -69,11 +71,11 @@ data NoParserForLanguage = NoParserForLanguage FilePath (Maybe Language.Language deriving (Eq, Exception, Ord, Show, Typeable) -diffBlobPairs :: Output output => DiffRenderer output -> [Both Blob] -> Task ByteString -diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair renderer) . filter (any blobExists) +diffBlobPairs :: Output output => DiffRenderer output -> [BlobPair] -> Task ByteString +diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair renderer) -- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'. -diffBlobPair :: DiffRenderer output -> Both Blob -> Task output +diffBlobPair :: DiffRenderer output -> BlobPair -> Task output diffBlobPair renderer blobs | Just (SomeParser parser) <- effectiveLanguage >>= qualify >>= someParser (Proxy :: Proxy '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, Show1, ToJSONFields1, Traversable]) = case renderer of @@ -90,10 +92,10 @@ diffBlobPair renderer blobs SExpressionDiffRenderer -> run ( parse parser >=> pure . fmap keepCategory) diffSyntaxTerms (const renderSExpressionDiff) | otherwise = throwError (SomeException (NoParserForLanguage effectivePath effectiveLanguage)) - where (effectivePath, effectiveLanguage) = case runJoin blobs of - (Blob { blobLanguage = Just lang, blobPath = path }, _) -> (path, Just lang) - (_, Blob { blobLanguage = Just lang, blobPath = path }) -> (path, Just lang) - (Blob { blobPath = path }, _) -> (path, Nothing) + where (effectivePath, effectiveLanguage) = case blobs of + This Blob { blobLanguage = Just lang, blobPath = path } -> (path, Just lang) + That Blob { blobLanguage = Just lang, blobPath = path } -> (path, Just lang) + These Blob { blobPath = path } _ -> (path, Nothing) qualify language | OldToCDiffRenderer <- renderer = guard (language `elem` aLaCarteLanguages) *> Just language | otherwise = Just language @@ -106,23 +108,21 @@ diffBlobPair renderer blobs , Language.TypeScript ] - run :: (Foldable syntax, Functor syntax) => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Both Blob -> Diff syntax ann ann -> output) -> Task output + run :: (Foldable syntax, Functor syntax) => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (These Blob Blob -> Diff syntax ann ann -> output) -> Task output run parse diff renderer = do - terms <- distributeFor blobs (\b -> if blobExists b then Just <$> parse b else pure Nothing) + terms <- bidistributeFor blobs parse parse time "diff" languageTag $ do - diff <- runBothWith (diffTermPair diff) terms + diff <- diffTermPair diff terms writeStat (Stat.count "diff.nodes" (bilength diff) languageTag) render (renderer blobs) diff where - showLanguage = pure . (,) "language" . show - languageTag = let (a, b) = runJoin blobs - in maybe (maybe [] showLanguage (blobLanguage b)) showLanguage (blobLanguage a) + languageTag = languageTagForBlobPair blobs -- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's. -diffTermPair :: Functor syntax => Differ syntax ann1 ann2 -> Maybe (Term syntax ann1) -> Maybe (Term syntax ann2) -> Task (Diff syntax ann1 ann2) -diffTermPair _ (Just t1) Nothing = pure (deleting t1) -diffTermPair _ Nothing (Just t2) = pure (inserting t2) -diffTermPair differ (Just t1) (Just t2) = diff differ t1 t2 +diffTermPair :: Functor syntax => Differ syntax ann1 ann2 -> These (Term syntax ann1) (Term syntax ann2) -> Task (Diff syntax ann1 ann2) +diffTermPair _ (This t1) = pure (deleting t1) +diffTermPair _ (That t2) = pure (inserting t2) +diffTermPair differ (These t1 t2) = diff differ t1 t2 keepCategory :: HasField fields Category => Record fields -> Record '[Category] keepCategory = (:. Nil) . category diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 50ddc7dae..f8c0a763f 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveAnyClass, DuplicateRecordFields, ScopedTypeVariables, TupleSections #-} module Semantic.IO ( readFile +, readFiles , isDirectory , readBlobPairsFromHandle , readBlobsFromHandle @@ -21,6 +22,7 @@ import Data.Source import Data.String import Data.Text import Data.These +import Data.Traversable import GHC.Generics import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -39,6 +41,18 @@ readFile path language = do raw <- liftIO $ (Just <$> B.readFile path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe B.ByteString)) pure $ fromMaybe (Blob.emptyBlob path) (Blob.sourceBlob path language . fromBytes <$> raw) +readFiles :: forall m. MonadIO m => [Both (FilePath, Maybe Language)] -> m [Blob.BlobPair] +readFiles files = for files (runBothWith readFilesToBlobPair) + where + readFilesToBlobPair :: (FilePath, Maybe Language) -> (FilePath, Maybe Language) -> m Blob.BlobPair + readFilesToBlobPair a b = do + before <- uncurry readFile a + after <- uncurry readFile b + case (Blob.blobExists before, Blob.blobExists after) of + (True, False) -> pure (This before) + (False, True) -> pure (That after) + _ -> pure (These before after) + isDirectory :: MonadIO m => FilePath -> m Bool isDirectory path = liftIO (doesDirectoryExist path) >>= pure @@ -47,12 +61,11 @@ languageForFilePath :: FilePath -> Maybe Language languageForFilePath = languageForType . takeExtension -- | Read JSON encoded blob pairs from a handle. -readBlobPairsFromHandle :: MonadIO m => Handle -> m [Both Blob.Blob] +readBlobPairsFromHandle :: MonadIO m => Handle -> m [Blob.BlobPair] readBlobPairsFromHandle = fmap toBlobPairs . readFromHandle where - toBlobPairs BlobDiff{..} = toBlobPair <$> blobs - toBlobPair blobs = Join (fromThese empty empty (runJoin (toBlob <$> blobs))) - where empty = Blob.emptyBlob (mergeThese const (runJoin (path <$> blobs))) + toBlobPairs :: BlobDiff -> [Blob.BlobPair] + toBlobPairs = undefined -- | Read JSON encoded blobs from a handle. readBlobsFromHandle :: MonadIO m => Handle -> m [Blob.Blob] diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 9b1b8d3d5..df23cd528 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -17,6 +17,8 @@ module Semantic.Task , distribute , distributeFor , distributeFoldMap +, bidistribute +, bidistributeFor , defaultOptions , configureOptionsForHandle , terminalFormatter @@ -41,6 +43,8 @@ import Data.Diff import qualified Data.Error as Error import Data.Foldable (fold, for_) import Data.Functor.Both as Both hiding (snd) +import Data.Bitraversable +import Data.Bifunctor import Data.Functor.Foldable (cata) import Data.Language import Data.Record @@ -61,7 +65,7 @@ import Semantic.Queue data TaskF output where ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob] - ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [Both Blob] + ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [BlobPair] WriteToOutput :: Either Handle FilePath -> B.ByteString -> TaskF () WriteLog :: Level -> String -> [(String, String)] -> TaskF () WriteStat :: Stat -> TaskF () @@ -71,6 +75,7 @@ data TaskF output where Diff :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> TaskF (Diff syntax ann1 ann2) Render :: Renderer input output -> input -> TaskF output Distribute :: Traversable t => t (Task output) -> TaskF (t output) + Bidistribute :: Bitraversable t => t (Task output1) (Task output2) -> TaskF (t output1 output2) -- | For MonadIO. LiftIO :: IO a -> TaskF a @@ -93,7 +98,7 @@ readBlobs :: Either Handle [(FilePath, Maybe Language)] -> Task [Blob] readBlobs from = ReadBlobs from `Then` return -- | A 'Task' which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's. -readBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> Task [Both Blob] +readBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> Task [BlobPair] readBlobPairs from = ReadBlobPairs from `Then` return -- | A 'Task' which writes a 'B.ByteString' to a 'Handle' or a 'FilePath'. @@ -134,12 +139,18 @@ render renderer input = Render renderer input `Then` return distribute :: Traversable t => t (Task output) -> Task (t output) distribute tasks = Distribute tasks `Then` return +bidistribute :: Bitraversable t => t (Task output1) (Task output2) -> Task (t output1 output2) +bidistribute tasks = Bidistribute tasks `Then` return + -- | Distribute the application of a function to each element of a 'Traversable' container of inputs over the available cores (i.e. perform the function concurrently for each element), collecting the results. -- -- This is a concurrent analogue of 'for' or 'traverse' (with the arguments flipped). distributeFor :: Traversable t => t a -> (a -> Task output) -> Task (t output) distributeFor inputs toTask = distribute (fmap toTask inputs) +bidistributeFor :: Bitraversable t => t a b -> (a -> Task output1) -> (b -> Task output2) -> Task (t output1 output2) +bidistributeFor inputs toTask1 toTask2 = bidistribute (bimap toTask1 toTask2 inputs) + -- | Distribute the application of a function to each element of a 'Traversable' container of inputs over the available cores (i.e. perform the function concurrently for each element), combining the results 'Monoid'ally into a final value. -- -- This is a concurrent analogue of 'foldMap'. @@ -180,7 +191,8 @@ runTaskWithOptions options task = do ReadBlobs (Left handle) -> (IO.readBlobsFromHandle handle >>= yield) `catchError` (pure . Left . toException) ReadBlobs (Right paths@[(path, Nothing)]) -> (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path) >>= yield) `catchError` (pure . Left . toException) ReadBlobs (Right paths) -> (IO.readBlobsFromPaths paths >>= yield) `catchError` (pure . Left . toException) - ReadBlobPairs source -> (either IO.readBlobPairsFromHandle (traverse (traverse (uncurry IO.readFile))) source >>= yield) `catchError` (pure . Left . toException) + ReadBlobPairs source -> (either IO.readBlobPairsFromHandle IO.readFiles source >>= yield) `catchError` (pure . Left . toException) + -- ReadBlobPairs source -> (either IO.readBlobPairsFromHandle (traverse (traverse (uncurry IO.readFile))) source >>= yield) `catchError` (pure . Left . toException) WriteToOutput destination contents -> either B.hPutStr B.writeFile destination contents >>= yield WriteLog level message pairs -> queueLogMessage logger level message pairs >>= yield WriteStat stat -> queue statter stat >>= yield @@ -190,6 +202,7 @@ runTaskWithOptions options task = do Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2) >>= yield Render renderer input -> pure (renderer input) >>= yield Distribute tasks -> Async.mapConcurrently go tasks >>= either (pure . Left) yield . sequenceA . withStrategy (parTraversable (parTraversable rseq)) + Bidistribute tasks -> Async.runConcurrently (bitraverse (Async.Concurrently . go) (Async.Concurrently . go) tasks) >>= either (pure . Left) yield . bisequenceA LiftIO action -> action >>= yield Throw err -> pure (Left err) Catch during handler -> do From ff1d9591c7da10aece5d4fc0a7e0afafa474e1f3 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 18:13:19 -0800 Subject: [PATCH 40/67] Take path and lang from after file --- src/Semantic.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index 868da693a..4a6eed356 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -95,7 +95,7 @@ diffBlobPair renderer blobs where (effectivePath, effectiveLanguage) = case blobs of This Blob { blobLanguage = Just lang, blobPath = path } -> (path, Just lang) That Blob { blobLanguage = Just lang, blobPath = path } -> (path, Just lang) - These Blob { blobPath = path } _ -> (path, Nothing) + These _ Blob { blobLanguage = lang, blobPath = path } -> (path, lang) qualify language | OldToCDiffRenderer <- renderer = guard (language `elem` aLaCarteLanguages) *> Just language | otherwise = Just language From 4be8c2a4a1ed80a86242dcc9ebad3152c2abcb17 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 18:14:17 -0800 Subject: [PATCH 41/67] Implement parBitraversable --- src/Semantic/Task.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index df23cd528..ae01836f4 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -192,7 +192,6 @@ runTaskWithOptions options task = do ReadBlobs (Right paths@[(path, Nothing)]) -> (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path) >>= yield) `catchError` (pure . Left . toException) ReadBlobs (Right paths) -> (IO.readBlobsFromPaths paths >>= yield) `catchError` (pure . Left . toException) ReadBlobPairs source -> (either IO.readBlobPairsFromHandle IO.readFiles source >>= yield) `catchError` (pure . Left . toException) - -- ReadBlobPairs source -> (either IO.readBlobPairsFromHandle (traverse (traverse (uncurry IO.readFile))) source >>= yield) `catchError` (pure . Left . toException) WriteToOutput destination contents -> either B.hPutStr B.writeFile destination contents >>= yield WriteLog level message pairs -> queueLogMessage logger level message pairs >>= yield WriteStat stat -> queue statter stat >>= yield @@ -202,7 +201,7 @@ runTaskWithOptions options task = do Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2) >>= yield Render renderer input -> pure (renderer input) >>= yield Distribute tasks -> Async.mapConcurrently go tasks >>= either (pure . Left) yield . sequenceA . withStrategy (parTraversable (parTraversable rseq)) - Bidistribute tasks -> Async.runConcurrently (bitraverse (Async.Concurrently . go) (Async.Concurrently . go) tasks) >>= either (pure . Left) yield . bisequenceA + Bidistribute tasks -> Async.runConcurrently (bitraverse (Async.Concurrently . go) (Async.Concurrently . go) tasks) >>= either (pure . Left) yield . bisequenceA . withStrategy (parBitraversable (parTraversable rseq) (parTraversable rseq)) LiftIO action -> action >>= yield Throw err -> pure (Left err) Catch during handler -> do @@ -211,6 +210,9 @@ runTaskWithOptions options task = do Left err -> go (handler err) >>= either (pure . Left) yield Right a -> yield a) . fmap Right + parBitraversable :: Bitraversable t => Strategy a -> Strategy b -> Strategy (t a b) + parBitraversable strat1 strat2 = bitraverse (rparWith strat1) (rparWith strat2) + runParser :: Options -> Blob -> Parser term -> Task term runParser Options{..} blob@Blob{..} = go where From 8dae7da7d47451e2591ef7c743c6023ee385fe3b Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 18:20:47 -0800 Subject: [PATCH 42/67] Fix reading blobPairs from stdin --- src/Semantic/IO.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index f8c0a763f..a283436ed 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -65,7 +65,8 @@ readBlobPairsFromHandle :: MonadIO m => Handle -> m [Blob.BlobPair] readBlobPairsFromHandle = fmap toBlobPairs . readFromHandle where toBlobPairs :: BlobDiff -> [Blob.BlobPair] - toBlobPairs = undefined + toBlobPairs BlobDiff{..} = toBlobPair <$> blobs + toBlobPair blobs = runJoin (toBlob <$> blobs) -- | Read JSON encoded blobs from a handle. readBlobsFromHandle :: MonadIO m => Handle -> m [Blob.Blob] From f644e968ab1cef151ead60ea1e14cf997570f207 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 18:30:27 -0800 Subject: [PATCH 43/67] Remove imports that aren't needed --- src/Rendering/JSON.hs | 3 +-- src/Rendering/TOC.hs | 3 +-- src/Semantic.hs | 3 --- 3 files changed, 2 insertions(+), 7 deletions(-) diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index 3d2c202bc..f00199bb1 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -4,10 +4,9 @@ module Rendering.JSON ) where import Data.Aeson (ToJSON, toJSON, object, (.=)) -import Data.Aeson as A hiding (json) +import Data.Aeson as A import Data.Blob import Data.Foldable (toList) -import Data.Functor.Both (Both) import Data.Language import qualified Data.Map as Map import Data.Text (Text) diff --git a/src/Rendering/TOC.hs b/src/Rendering/TOC.hs index d332b7304..a2e518ec9 100644 --- a/src/Rendering/TOC.hs +++ b/src/Rendering/TOC.hs @@ -25,13 +25,12 @@ import Data.Blob import Data.ByteString.Lazy (toStrict) import Data.Diff import Data.Foldable (fold, foldl') -import Data.Functor.Both hiding (fst, snd) import Data.Functor.Foldable (cata) import Data.Function (on) import Data.Language as Language import Data.List (sortOn) import qualified Data.List as List -import qualified Data.Map as Map hiding (null) +import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe) import Data.Output import Data.Patch diff --git a/src/Semantic.hs b/src/Semantic.hs index 4a6eed356..f63b5f344 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -18,15 +18,12 @@ import Data.Bifoldable import Data.Blob import Data.ByteString (ByteString) import Data.Diff -import Data.Foldable (toList) -import Data.Functor.Both as Both import Data.Functor.Classes import Data.JSON.Fields import qualified Data.Language as Language import Data.Output import Data.Record import Data.Term -import Data.These import Data.Typeable import Diffing.Algorithm (Diffable) import Diffing.Interpreter From 2315a27e8f0c3e65d23f79dcc708019a949dd374 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 18:30:37 -0800 Subject: [PATCH 44/67] Add pathForBlobPair helper --- src/Data/Blob.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index 86a3bd2b6..d58e971e9 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -12,6 +12,7 @@ module Data.Blob , BlobPair , languageForBlobPair , languageTagForBlobPair +, pathForBlobPair ) where import Data.ByteString.Char8 (ByteString, pack) @@ -30,6 +31,11 @@ languageForBlobPair (This Blob{..}) = blobLanguage languageForBlobPair (That Blob{..}) = blobLanguage languageForBlobPair (These _ Blob{..}) = blobLanguage +pathForBlobPair :: BlobPair -> FilePath +pathForBlobPair (This Blob{..}) = blobPath +pathForBlobPair (That Blob{..}) = blobPath +pathForBlobPair (These _ Blob{..}) = blobPath + languageTagForBlobPair :: BlobPair -> [(String, String)] languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair) where showLanguage = pure . (,) "language" . show From c3b6e260cb47aac08ecc8e4fe6d45e851d7d4046 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 18:30:52 -0800 Subject: [PATCH 45/67] Simplify effectivePath/Language --- src/Semantic.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index f63b5f344..2e7500ed6 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -89,10 +89,8 @@ diffBlobPair renderer blobs SExpressionDiffRenderer -> run ( parse parser >=> pure . fmap keepCategory) diffSyntaxTerms (const renderSExpressionDiff) | otherwise = throwError (SomeException (NoParserForLanguage effectivePath effectiveLanguage)) - where (effectivePath, effectiveLanguage) = case blobs of - This Blob { blobLanguage = Just lang, blobPath = path } -> (path, Just lang) - That Blob { blobLanguage = Just lang, blobPath = path } -> (path, Just lang) - These _ Blob { blobLanguage = lang, blobPath = path } -> (path, lang) + where effectiveLanguage = languageForBlobPair blobs + effectivePath = pathForBlobPair blobs qualify language | OldToCDiffRenderer <- renderer = guard (language `elem` aLaCarteLanguages) *> Just language | otherwise = Just language From 01ddc29c827e64be19226e20395e8411674d84b9 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sat, 9 Dec 2017 18:31:01 -0800 Subject: [PATCH 46/67] Fix Util functions --- src/Semantic/Util.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index ea31f9536..90897ec47 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -7,7 +7,6 @@ import Control.Monad.IO.Class import Data.Align.Generic import Data.Blob import Data.Diff -import Data.Functor.Both import Data.Functor.Classes import Data.Range import Data.Record @@ -31,8 +30,8 @@ diffWithParser :: (HasField fields Data.Span.Span, GAlign syntax, HasDeclaration syntax) => Parser (Term syntax (Record fields)) - -> Both Blob + -> BlobPair -> 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 (\b -> if blobExists b then Just <$> parse b else pure Nothing) >>= runBothWith (diffTermPair diffTerms) + run parse blobs = bidistributeFor blobs parse parse >>= diffTermPair diffTerms From 24d98ad71c93aa524ef16acf57ab1ba621b473a8 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Sun, 10 Dec 2017 08:46:17 -0800 Subject: [PATCH 47/67] Fix up tests --- src/Rendering/JSON.hs | 6 +++--- src/Semantic/IO.hs | 21 +++++++++------------ src/Semantic/Task.hs | 2 +- test/Rendering/TOC/Spec.hs | 4 ++-- test/Semantic/IO/Spec.hs | 14 +++++++------- test/Semantic/Spec.hs | 12 ++++++------ test/SpecHelpers.hs | 12 +++++++++--- 7 files changed, 37 insertions(+), 34 deletions(-) diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index f00199bb1..3b2b38b03 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -6,7 +6,7 @@ module Rendering.JSON import Data.Aeson (ToJSON, toJSON, object, (.=)) import Data.Aeson as A import Data.Blob -import Data.Foldable (toList) +import Data.Bifoldable (biList) import Data.Language import qualified Data.Map as Map import Data.Text (Text) @@ -21,8 +21,8 @@ import GHC.Generics renderJSONDiff :: ToJSON a => BlobPair -> a -> Map.Map Text Value renderJSONDiff blobs diff = Map.fromList [ ("diff", toJSON diff) - , ("oids", toJSON (decodeUtf8 . blobOid <$> toList blobs)) - , ("paths", toJSON (blobPath <$> toList blobs)) + , ("oids", toJSON (decodeUtf8 . blobOid <$> biList blobs)) + , ("paths", toJSON (blobPath <$> biList blobs)) ] data File a = File { filePath :: FilePath, fileLanguage :: Maybe Language, fileContent :: a } diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index a283436ed..b6716ac05 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveAnyClass, DuplicateRecordFields, ScopedTypeVariables, TupleSections #-} module Semantic.IO ( readFile -, readFiles +, readFilePair , isDirectory , readBlobPairsFromHandle , readBlobsFromHandle @@ -41,17 +41,14 @@ readFile path language = do raw <- liftIO $ (Just <$> B.readFile path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe B.ByteString)) pure $ fromMaybe (Blob.emptyBlob path) (Blob.sourceBlob path language . fromBytes <$> raw) -readFiles :: forall m. MonadIO m => [Both (FilePath, Maybe Language)] -> m [Blob.BlobPair] -readFiles files = for files (runBothWith readFilesToBlobPair) - where - readFilesToBlobPair :: (FilePath, Maybe Language) -> (FilePath, Maybe Language) -> m Blob.BlobPair - readFilesToBlobPair a b = do - before <- uncurry readFile a - after <- uncurry readFile b - case (Blob.blobExists before, Blob.blobExists after) of - (True, False) -> pure (This before) - (False, True) -> pure (That after) - _ -> pure (These before after) +readFilePair :: forall m. MonadIO m => (FilePath, Maybe Language) -> (FilePath, Maybe Language) -> m Blob.BlobPair +readFilePair a b = do + before <- uncurry readFile a + after <- uncurry readFile b + case (Blob.blobExists before, Blob.blobExists after) of + (True, False) -> pure (This before) + (False, True) -> pure (That after) + _ -> pure (These before after) isDirectory :: MonadIO m => FilePath -> m Bool isDirectory path = liftIO (doesDirectoryExist path) >>= pure diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index ae01836f4..aafe017ff 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -191,7 +191,7 @@ runTaskWithOptions options task = do ReadBlobs (Left handle) -> (IO.readBlobsFromHandle handle >>= yield) `catchError` (pure . Left . toException) ReadBlobs (Right paths@[(path, Nothing)]) -> (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path) >>= yield) `catchError` (pure . Left . toException) ReadBlobs (Right paths) -> (IO.readBlobsFromPaths paths >>= yield) `catchError` (pure . Left . toException) - ReadBlobPairs source -> (either IO.readBlobPairsFromHandle IO.readFiles source >>= yield) `catchError` (pure . Left . toException) + ReadBlobPairs source -> (either IO.readBlobPairsFromHandle (traverse (runBothWith IO.readFilePair)) source >>= yield) `catchError` (pure . Left . toException) WriteToOutput destination contents -> either B.hPutStr B.writeFile destination contents >>= yield WriteLog level message pairs -> queueLogMessage logger level message pairs >>= yield WriteStat stat -> queue statter stat >>= yield diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index e8aae8ed3..706a0137a 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -240,8 +240,8 @@ isMethodOrFunction a = case unTerm a of (a `In` _) | getField a == C.SingletonMethod -> True _ -> False -blobsForPaths :: Both FilePath -> IO (Both Blob) -blobsForPaths = traverse (readFile . ("test/fixtures/toc/" <>)) +blobsForPaths :: Both FilePath -> IO BlobPair +blobsForPaths = readFilePair . (fmap ("test/fixtures/toc/" <>)) sourceSpanBetween :: (Int, Int) -> (Int, Int) -> Span sourceSpanBetween (s1, e1) (s2, e2) = Span (Pos s1 e1) (Pos s2 e2) diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index e9ee6982b..9232e0b0a 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -28,34 +28,34 @@ spec = parallel $ do let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end" it "returns blobs for valid JSON encoded diff input" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff.json" - blobs `shouldBe` [both a b] + blobs `shouldBe` [These a b] it "returns blobs when there's no before" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-no-before.json" - blobs `shouldBe` [both (emptyBlob "method.rb") b] + blobs `shouldBe` [That b] it "returns blobs when there's null before" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-null-before.json" - blobs `shouldBe` [both (emptyBlob "method.rb") b] + blobs `shouldBe` [That b] it "returns blobs when there's no after" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-no-after.json" - blobs `shouldBe` [both a (emptyBlob "method.rb")] + blobs `shouldBe` [This a] it "returns blobs when there's null after" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-null-after.json" - blobs `shouldBe` [both a (emptyBlob "method.rb")] + blobs `shouldBe` [This a] it "returns blobs for unsupported language" $ do h <- openFile "test/fixtures/input/diff-unsupported-language.json" ReadMode blobs <- readBlobPairsFromHandle h let b' = sourceBlob "test.kt" Nothing "fun main(args: Array) {\nprintln(\"hi\")\n}\n" - blobs `shouldBe` [both (emptyBlob "test.kt") b'] + blobs `shouldBe` [That b'] it "detects language based on filepath for empty language" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-empty-language.json" - blobs `shouldBe` [both a b] + blobs `shouldBe` [These a b] it "throws on blank input" $ do h <- openFile "test/fixtures/input/blank.json" ReadMode diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index 884b55f60..9176a9fe5 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -28,13 +28,13 @@ spec = parallel $ do output `shouldBe` "(Program\n (Method\n (Empty)\n (Identifier)\n ([])))\n" describe "diffTermPair" $ do - it "produces an Insert when the first blob is missing" $ do - result <- runTask (diffTermPair (both (emptyBlob "/foo") (sourceBlob "/foo" Nothing "")) replacing (termIn () []) (termIn () [])) - result `shouldBe` Diff (Patch (Insert (In () []))) + it "produces an Insert when the first term is missing" $ do + result <- runTask (diffTermPair replacing (That (termIn () []))) + result `shouldBe` (Diff (Patch (Insert (In () []))) :: Diff [] () ()) - it "produces a Delete when the second blob is missing" $ do - result <- runTask (diffTermPair (both (sourceBlob "/foo" Nothing "") (emptyBlob "/foo")) replacing (termIn () []) (termIn () [])) - result `shouldBe` Diff (Patch (Delete (In () []))) + it "produces a Delete when the second term is missing" $ do + result <- runTask (diffTermPair replacing (This (termIn () []))) + result `shouldBe` (Diff (Patch (Delete (In () []))) :: Diff [] () ()) where methodsBlob = Blob "def foo\nend\n" "ff7bbbe9495f61d9e1e58c597502d152bab1761e" "methods.rb" (Just defaultPlainBlob) (Just Ruby) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 90d0abd90..dfbedd460 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -3,9 +3,11 @@ module SpecHelpers ( diffFilePaths , parseFilePath , readFile +, readFilePair , languageForFilePath ) where +import Control.Monad ((<=<)) import Control.Exception import Data.Blob import qualified Data.ByteString as B @@ -17,13 +19,17 @@ import Prelude hiding (readFile) import Rendering.Renderer import Semantic import Semantic.Task +import qualified Semantic.IO as IO import System.FilePath +readFilePair :: Both FilePath -> IO BlobPair +readFilePair paths = do + let paths' = fmap (\p -> (p, languageForFilePath p)) paths + runBothWith IO.readFilePair paths' + -- | Returns an s-expression formatted diff for the specified FilePath pair. diffFilePaths :: Both FilePath -> IO B.ByteString -diffFilePaths paths = do - blobs <- traverse readFile paths - runTask (diffBlobPair SExpressionDiffRenderer blobs) +diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionDiffRenderer -- | Returns an s-expression parse tree for the specified FilePath. parseFilePath :: FilePath -> IO B.ByteString From afd82561e984f2450e289c93a542ef3dcd86dbd8 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 08:27:02 -0800 Subject: [PATCH 48/67] Minor doc cleanup --- src/Semantic.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index 2e7500ed6..6308be283 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -113,7 +113,7 @@ diffBlobPair renderer blobs where languageTag = languageTagForBlobPair blobs --- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's. +-- | A task to diff 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's. diffTermPair :: Functor syntax => Differ syntax ann1 ann2 -> These (Term syntax ann1) (Term syntax ann2) -> Task (Diff syntax ann1 ann2) diffTermPair _ (This t1) = pure (deleting t1) diffTermPair _ (That t2) = pure (inserting t2) From 148edbc184d372a0d29bc3cab422884b92ddede1 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 08:27:13 -0800 Subject: [PATCH 49/67] Remove spec specific readFile --- test/SpecHelpers.hs | 24 +++++------------------- 1 file changed, 5 insertions(+), 19 deletions(-) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index dfbedd460..9dec0adeb 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -2,7 +2,6 @@ module SpecHelpers ( diffFilePaths , parseFilePath -, readFile , readFilePair , languageForFilePath ) where @@ -15,37 +14,24 @@ import Data.Functor.Both import Data.Language import Data.Maybe (fromMaybe) import Data.Source -import Prelude hiding (readFile) import Rendering.Renderer import Semantic import Semantic.Task import qualified Semantic.IO as IO import System.FilePath -readFilePair :: Both FilePath -> IO BlobPair -readFilePair paths = do - let paths' = fmap (\p -> (p, languageForFilePath p)) paths - runBothWith IO.readFilePair paths' - -- | Returns an s-expression formatted diff for the specified FilePath pair. diffFilePaths :: Both FilePath -> IO B.ByteString diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionDiffRenderer -- | Returns an s-expression parse tree for the specified FilePath. parseFilePath :: FilePath -> IO B.ByteString -parseFilePath path = do - blob <- readFile path - runTask (parseBlob SExpressionTermRenderer blob) +parseFilePath path = IO.readFile path (languageForFilePath path) >>= runTask . parseBlob SExpressionTermRenderer --- | Read a file to a Blob. --- --- NB: This is intentionally duplicated from Command.Files because eventually --- we want to be able to test a core Semantic library that has no knowledge of --- the filesystem or Git. The tests, however, will still leverage reading files. -readFile :: FilePath -> IO Blob -readFile path = do - source <- (Just . fromBytes <$> B.readFile path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe Source)) - pure $ fromMaybe (emptyBlob path) (sourceBlob path (languageForFilePath path) <$> source) +-- | Read two files to a BlobPair. +readFilePair :: Both FilePath -> IO BlobPair +readFilePair paths = let paths' = fmap (\p -> (p, languageForFilePath p)) paths in + runBothWith IO.readFilePair paths' -- | Returns a Maybe Language based on the FilePath's extension. languageForFilePath :: FilePath -> Maybe Language From 844fc3f8b58ef18cf9b3f981938ff687d313bee0 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 09:09:07 -0800 Subject: [PATCH 50/67] Use Join These Blob instead --- src/Data/Blob.hs | 30 +++++++++++++++++++++++------- src/Rendering/JSON.hs | 10 ++++------ src/Rendering/TOC.hs | 3 ++- src/Semantic.hs | 5 +++-- src/Semantic/IO.hs | 8 ++++---- src/Semantic/Util.hs | 3 ++- test/Semantic/IO/Spec.hs | 14 +++++++------- 7 files changed, 45 insertions(+), 28 deletions(-) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index d58e971e9..198aa8deb 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -10,12 +10,16 @@ module Data.Blob , sourceBlob , nullOid , BlobPair +, blobPairDiffing +, blobPairInserting +, blobPairDeleting , languageForBlobPair , languageTagForBlobPair , pathForBlobPair ) where import Data.ByteString.Char8 (ByteString, pack) +import Data.Bifunctor.Join import Data.Language import Data.These import Data.Maybe (isJust) @@ -24,17 +28,29 @@ import Data.Word import Numeric -type BlobPair = These Blob Blob +-- | Represents a blobs suitable for diffing which can be either a blob to +-- delete, a blob to insert, or a pair of blobs to diff. +type BlobPair = Join These Blob + + +blobPairDiffing :: Blob -> Blob -> BlobPair +blobPairDiffing a b = Join (These a b) + +blobPairInserting :: Blob -> BlobPair +blobPairInserting = Join . That + +blobPairDeleting :: Blob -> BlobPair +blobPairDeleting = Join . This languageForBlobPair :: BlobPair -> Maybe Language -languageForBlobPair (This Blob{..}) = blobLanguage -languageForBlobPair (That Blob{..}) = blobLanguage -languageForBlobPair (These _ Blob{..}) = blobLanguage +languageForBlobPair (Join (This Blob{..})) = blobLanguage +languageForBlobPair (Join (That Blob{..})) = blobLanguage +languageForBlobPair (Join (These _ Blob{..})) = blobLanguage pathForBlobPair :: BlobPair -> FilePath -pathForBlobPair (This Blob{..}) = blobPath -pathForBlobPair (That Blob{..}) = blobPath -pathForBlobPair (These _ Blob{..}) = blobPath +pathForBlobPair (Join (This Blob{..})) = blobPath +pathForBlobPair (Join (That Blob{..})) = blobPath +pathForBlobPair (Join (These _ Blob{..})) = blobPath languageTagForBlobPair :: BlobPair -> [(String, String)] languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair) diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index 3b2b38b03..f386dbbf4 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -7,22 +7,19 @@ import Data.Aeson (ToJSON, toJSON, object, (.=)) import Data.Aeson as A import Data.Blob import Data.Bifoldable (biList) +import Data.Bifunctor.Join import Data.Language import qualified Data.Map as Map import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) import GHC.Generics --- --- Diffs --- - -- | Render a diff to a string representing its JSON. renderJSONDiff :: ToJSON a => BlobPair -> a -> Map.Map Text Value renderJSONDiff blobs diff = Map.fromList [ ("diff", toJSON diff) - , ("oids", toJSON (decodeUtf8 . blobOid <$> biList blobs)) - , ("paths", toJSON (blobPath <$> biList blobs)) + , ("oids", toJSON (decodeUtf8 . blobOid <$> (biList . runJoin) blobs)) + , ("paths", toJSON (blobPath <$> (biList . runJoin) blobs)) ] data File a = File { filePath :: FilePath, fileLanguage :: Maybe Language, fileContent :: a } @@ -31,5 +28,6 @@ data File a = File { filePath :: FilePath, fileLanguage :: Maybe Language, fileC instance ToJSON a => ToJSON (File a) where toJSON File{..} = object [ "filePath" .= filePath, "language" .= fileLanguage, "programNode" .= fileContent ] +-- | Render a term to a string representing its JSON. renderJSONTerm :: ToJSON a => Blob -> a -> [Value] renderJSONTerm Blob{..} = pure . toJSON . File blobPath blobLanguage diff --git a/src/Rendering/TOC.hs b/src/Rendering/TOC.hs index a2e518ec9..9f5f0ee31 100644 --- a/src/Rendering/TOC.hs +++ b/src/Rendering/TOC.hs @@ -21,6 +21,7 @@ import Data.Aeson import Data.Align (bicrosswalk) import Data.Bifoldable (bifoldMap) import Data.Bifunctor (bimap) +import Data.Bifunctor.Join import Data.Blob import Data.ByteString.Lazy (toStrict) import Data.Diff @@ -163,7 +164,7 @@ renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Fol renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC where toMap [] = mempty toMap as = Map.singleton summaryKey (toJSON <$> as) - summaryKey = T.pack $ case bimap blobPath blobPath blobs of + summaryKey = T.pack $ case bimap blobPath blobPath (runJoin blobs) of This before -> before That after -> after These before after | before == after -> after diff --git a/src/Semantic.hs b/src/Semantic.hs index 6308be283..0f61f2e25 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -15,6 +15,7 @@ import Control.Monad ((>=>), guard) import Control.Monad.Error.Class import Data.Align.Generic import Data.Bifoldable +import Data.Bifunctor.Join import Data.Blob import Data.ByteString (ByteString) import Data.Diff @@ -103,9 +104,9 @@ diffBlobPair renderer blobs , Language.TypeScript ] - run :: (Foldable syntax, Functor syntax) => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (These Blob Blob -> Diff syntax ann ann -> output) -> Task output + run :: (Foldable syntax, Functor syntax) => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Join These Blob -> Diff syntax ann ann -> output) -> Task output run parse diff renderer = do - terms <- bidistributeFor blobs parse parse + terms <- bidistributeFor (runJoin blobs) parse parse time "diff" languageTag $ do diff <- diffTermPair diff terms writeStat (Stat.count "diff.nodes" (bilength diff) languageTag) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index b6716ac05..cc1327648 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -46,9 +46,9 @@ readFilePair a b = do before <- uncurry readFile a after <- uncurry readFile b case (Blob.blobExists before, Blob.blobExists after) of - (True, False) -> pure (This before) - (False, True) -> pure (That after) - _ -> pure (These before after) + (True, False) -> pure (Join (This before)) + (False, True) -> pure (Join (That after)) + _ -> pure (Join (These before after)) isDirectory :: MonadIO m => FilePath -> m Bool isDirectory path = liftIO (doesDirectoryExist path) >>= pure @@ -63,7 +63,7 @@ readBlobPairsFromHandle = fmap toBlobPairs . readFromHandle where toBlobPairs :: BlobDiff -> [Blob.BlobPair] toBlobPairs BlobDiff{..} = toBlobPair <$> blobs - toBlobPair blobs = runJoin (toBlob <$> blobs) + toBlobPair blobs = toBlob <$> blobs -- | Read JSON encoded blobs from a handle. readBlobsFromHandle :: MonadIO m => Handle -> m [Blob.Blob] diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 90897ec47..610087107 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -8,6 +8,7 @@ import Data.Align.Generic import Data.Blob import Data.Diff import Data.Functor.Classes +import Data.Bifunctor.Join import Data.Range import Data.Record import Data.Span @@ -34,4 +35,4 @@ diffWithParser :: (HasField fields Data.Span.Span, -> Task (Diff syntax (Record (Maybe Declaration ': fields)) (Record (Maybe Declaration ': fields))) diffWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) where - run parse blobs = bidistributeFor blobs parse parse >>= diffTermPair diffTerms + run parse blobs = bidistributeFor (runJoin blobs) parse parse >>= diffTermPair diffTerms diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index 9232e0b0a..3f223351e 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -28,34 +28,34 @@ spec = parallel $ do let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end" it "returns blobs for valid JSON encoded diff input" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff.json" - blobs `shouldBe` [These a b] + blobs `shouldBe` [blobPairDiffing a b] it "returns blobs when there's no before" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-no-before.json" - blobs `shouldBe` [That b] + blobs `shouldBe` [blobPairInserting b] it "returns blobs when there's null before" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-null-before.json" - blobs `shouldBe` [That b] + blobs `shouldBe` [blobPairInserting b] it "returns blobs when there's no after" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-no-after.json" - blobs `shouldBe` [This a] + blobs `shouldBe` [blobPairDeleting a] it "returns blobs when there's null after" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-null-after.json" - blobs `shouldBe` [This a] + blobs `shouldBe` [blobPairDeleting a] it "returns blobs for unsupported language" $ do h <- openFile "test/fixtures/input/diff-unsupported-language.json" ReadMode blobs <- readBlobPairsFromHandle h let b' = sourceBlob "test.kt" Nothing "fun main(args: Array) {\nprintln(\"hi\")\n}\n" - blobs `shouldBe` [That b'] + blobs `shouldBe` [blobPairInserting b'] it "detects language based on filepath for empty language" $ do blobs <- blobsFromFilePath "test/fixtures/input/diff-empty-language.json" - blobs `shouldBe` [These a b] + blobs `shouldBe` [blobPairDiffing a b] it "throws on blank input" $ do h <- openFile "test/fixtures/input/blank.json" ReadMode From 8ce213fc44d8cff8a2c0cee37385487ae1346481 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 10:51:52 -0800 Subject: [PATCH 51/67] No longer need to track blobKind in Maybe --- src/Data/Blob.hs | 15 +++------------ src/Data/Error.hs | 2 +- src/Semantic.hs | 2 +- src/Semantic/IO.hs | 23 ++++++++++++----------- src/Semantic/Util.hs | 3 ++- test/Rendering/TOC/Spec.hs | 2 +- test/Semantic/CLI/Spec.hs | 1 - test/Semantic/IO/Spec.hs | 9 ++++----- test/Semantic/Spec.hs | 2 +- test/SpecHelpers.hs | 4 ++-- 10 files changed, 27 insertions(+), 36 deletions(-) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index 198aa8deb..7a8e9e4ef 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -4,9 +4,7 @@ module Data.Blob , These(..) , modeToDigits , defaultPlainBlob -, emptyBlob , nullBlob -, blobExists , sourceBlob , nullOid , BlobPair @@ -22,7 +20,6 @@ import Data.ByteString.Char8 (ByteString, pack) import Data.Bifunctor.Join import Data.Language import Data.These -import Data.Maybe (isJust) import Data.Source as Source import Data.Word import Numeric @@ -57,12 +54,12 @@ languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair) where showLanguage = pure . (,) "language" . show --- | The source, oid, path, and Maybe BlobKind of a blob. +-- | The source, oid, path, kind and language of a blob. data Blob = Blob { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. , blobOid :: ByteString -- ^ The Git object ID (SHA-1) of the blob. , blobPath :: FilePath -- ^ The file path to the blob. - , blobKind :: Maybe BlobKind -- ^ The kind of blob, Nothing denotes a blob that doesn't exist (e.g. on one side of a diff for adding a new file or deleting a file). + , blobKind :: BlobKind -- ^ The kind of blob. , blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet. } deriving (Show, Eq) @@ -80,17 +77,11 @@ modeToDigits (SymlinkBlob mode) = pack $ showOct mode "" defaultPlainBlob :: BlobKind defaultPlainBlob = PlainBlob 0o100644 -emptyBlob :: FilePath -> Blob -emptyBlob filepath = Blob mempty nullOid filepath Nothing Nothing - nullBlob :: Blob -> Bool nullBlob Blob{..} = blobOid == nullOid || nullSource blobSource -blobExists :: Blob -> Bool -blobExists Blob{..} = isJust blobKind - sourceBlob :: FilePath -> Maybe Language -> Source -> Blob -sourceBlob filepath language source = Blob source nullOid filepath (Just defaultPlainBlob) language +sourceBlob filepath language source = Blob source nullOid filepath defaultPlainBlob language nullOid :: ByteString nullOid = "0000000000000000000000000000000000000000" diff --git a/src/Data/Error.hs b/src/Data/Error.hs index 13dc2dea7..f07756aab 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -39,7 +39,7 @@ type Colourize = Bool formatError :: IncludeSource -> Colourize -> Blob -> Error String -> String formatError includeSource colourize Blob{..} Error{..} = ($ "") - $ withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showSpan (maybe Nothing (const (Just blobPath)) blobKind) errorSpan . showString ": ") + $ withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showSpan (Just blobPath) errorSpan . showString ": ") . withSGRCode colourize [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation colourize errorExpected errorActual . showChar '\n' . (if includeSource then showString (unpack context) . (if "\n" `isSuffixOf` context then id else showChar '\n') diff --git a/src/Semantic.hs b/src/Semantic.hs index 0f61f2e25..0cf466f35 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -44,7 +44,7 @@ import Semantic.Task as Task -- - Easy to consume this interface from other application (e.g a cmdline or web server app). parseBlobs :: Output output => TermRenderer output -> [Blob] -> Task ByteString -parseBlobs renderer = fmap toOutput . distributeFoldMap (parseBlob renderer) . filter blobExists +parseBlobs renderer = fmap toOutput . distributeFoldMap (parseBlob renderer) -- | A task to parse a 'Blob' and render the resulting 'Term'. parseBlob :: TermRenderer output -> Blob -> Task output diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index cc1327648..edc5593b4 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -10,7 +10,6 @@ module Semantic.IO , languageForFilePath ) where -import Control.Exception (catch, IOException) import Control.Monad.IO.Class import Data.Aeson import qualified Data.Blob as Blob @@ -35,20 +34,21 @@ import System.Directory (doesDirectoryExist) import Text.Read -- | Read a utf8-encoded file to a 'Blob'. -readFile :: forall m. MonadIO m => FilePath -> Maybe Language -> m Blob.Blob -readFile path@"/dev/null" _ = pure (Blob.emptyBlob path) +readFile :: forall m. MonadIO m => FilePath -> Maybe Language -> m (Maybe Blob.Blob) +readFile "/dev/null" _ = pure Nothing readFile path language = do - raw <- liftIO $ (Just <$> B.readFile path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe B.ByteString)) - pure $ fromMaybe (Blob.emptyBlob path) (Blob.sourceBlob path language . fromBytes <$> raw) + raw <- liftIO $ (Just <$> B.readFile path) + pure $ Blob.sourceBlob path language . fromBytes <$> raw readFilePair :: forall m. MonadIO m => (FilePath, Maybe Language) -> (FilePath, Maybe Language) -> m Blob.BlobPair readFilePair a b = do before <- uncurry readFile a after <- uncurry readFile b - case (Blob.blobExists before, Blob.blobExists after) of - (True, False) -> pure (Join (This before)) - (False, True) -> pure (Join (That after)) - _ -> pure (Join (These before after)) + case (before, after) of + (Just a, Nothing) -> pure (Join (This a)) + (Nothing, Just b) -> pure (Join (That b)) + (Just a, Just b) -> pure (Join (These a b)) + _ -> fail "expected file pair with content on at least one side" isDirectory :: MonadIO m => FilePath -> m Bool isDirectory path = liftIO (doesDirectoryExist path) >>= pure @@ -71,13 +71,14 @@ readBlobsFromHandle = fmap toBlobs . readFromHandle where toBlobs BlobParse{..} = fmap toBlob blobs readBlobsFromPaths :: MonadIO m => [(FilePath, Maybe Language)] -> m [Blob.Blob] -readBlobsFromPaths = traverse (uncurry Semantic.IO.readFile) +readBlobsFromPaths files = traverse (uncurry Semantic.IO.readFile) files >>= pure . catMaybes readBlobsFromDir :: MonadIO m => FilePath -> m [Blob.Blob] readBlobsFromDir path = do paths <- liftIO (globDir1 (compile "[^vendor]**/*[.rb|.js|.tsx|.go|.py]") path) let paths' = catMaybes $ fmap (\p -> (p,) . Just <$> languageForFilePath p) paths - traverse (uncurry readFile) paths' + blobs <- traverse (uncurry readFile) paths' + pure (catMaybes blobs) readFromHandle :: (FromJSON a, MonadIO m) => Handle -> m a readFromHandle h = do diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 610087107..f42972617 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -5,6 +5,7 @@ module Semantic.Util where import Analysis.Declaration import Control.Monad.IO.Class import Data.Align.Generic +import Data.Maybe import Data.Blob import Data.Diff import Data.Functor.Classes @@ -21,7 +22,7 @@ import Semantic.IO as IO import Semantic.Task file :: MonadIO m => FilePath -> m Blob -file path = IO.readFile path (languageForFilePath path) +file path = IO.readFile path (languageForFilePath path) >>= pure . fromJust diffWithParser :: (HasField fields Data.Span.Span, HasField fields Range, diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 706a0137a..aa704c7ef 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -253,4 +253,4 @@ blankDiff = merge (arrayInfo, arrayInfo) (Indexed [ inserting (Term $ literalInf 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)) +blankDiffBlobs = both (Blob (fromText "[]") nullOid "a.js" defaultPlainBlob (Just TypeScript)) (Blob (fromText "[a]") nullOid "b.js" defaultPlainBlob (Just TypeScript)) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index cdf23172a..1d60ab225 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -38,7 +38,6 @@ parseFixtures = , (SomeRenderer JSONTermRenderer, pathMode, jsonParseTreeOutput) , (SomeRenderer JSONTermRenderer, pathMode', jsonParseTreeOutput') , (SomeRenderer JSONTermRenderer, Right [], emptyJsonParseTreeOutput) - , (SomeRenderer JSONTermRenderer, Right [("not-a-file.rb", Just Ruby)], emptyJsonParseTreeOutput) , (SomeRenderer ToCTermRenderer, Right [("test/fixtures/ruby/method-declaration.A.rb", Just Ruby)], tocOutput) ] where pathMode = Right [("test/fixtures/ruby/and-or.A.rb", Just Ruby)] diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index 3f223351e..ca08710e0 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -9,19 +9,18 @@ import Prelude hiding (readFile) import Semantic.IO import System.Exit (ExitCode(..)) import System.IO (IOMode(..), openFile) -import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall) +import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall, anyIOException) import Test.Hspec.Expectations.Pretty spec :: Spec spec = parallel $ do describe "readFile" $ do it "returns a blob for extant files" $ do - blob <- readFile "semantic-diff.cabal" Nothing + Just blob <- readFile "semantic-diff.cabal" Nothing blobPath blob `shouldBe` "semantic-diff.cabal" - it "returns a nullBlob for absent files" $ do - blob <- readFile "this file should not exist" Nothing - nullBlob blob `shouldBe` True + it "throws for absent files" $ do + readFile "this file should not exist" Nothing `shouldThrow` anyIOException describe "readBlobPairsFromHandle" $ do let a = sourceBlob "method.rb" (Just Ruby) "def foo; end" diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index 9176a9fe5..c417cc54f 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -37,4 +37,4 @@ spec = parallel $ do result `shouldBe` (Diff (Patch (Delete (In () []))) :: Diff [] () ()) where - methodsBlob = Blob "def foo\nend\n" "ff7bbbe9495f61d9e1e58c597502d152bab1761e" "methods.rb" (Just defaultPlainBlob) (Just Ruby) + methodsBlob = Blob "def foo\nend\n" "ff7bbbe9495f61d9e1e58c597502d152bab1761e" "methods.rb" defaultPlainBlob (Just Ruby) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 9dec0adeb..82ea1d181 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -12,7 +12,7 @@ import Data.Blob import qualified Data.ByteString as B import Data.Functor.Both import Data.Language -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, fromJust) import Data.Source import Rendering.Renderer import Semantic @@ -26,7 +26,7 @@ diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionD -- | Returns an s-expression parse tree for the specified FilePath. parseFilePath :: FilePath -> IO B.ByteString -parseFilePath path = IO.readFile path (languageForFilePath path) >>= runTask . parseBlob SExpressionTermRenderer +parseFilePath path = IO.readFile path (languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer -- | Read two files to a BlobPair. readFilePair :: Both FilePath -> IO BlobPair From ad377910f945b5f6f1771e38bbeef985a39f095b Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 10:54:18 -0800 Subject: [PATCH 52/67] Completely remove blobKind --- src/Data/Blob.hs | 8 +------- test/Rendering/TOC/Spec.hs | 2 +- test/Semantic/Spec.hs | 2 +- 3 files changed, 3 insertions(+), 9 deletions(-) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index 7a8e9e4ef..be7f21fc9 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -3,7 +3,6 @@ module Data.Blob , BlobKind(..) , These(..) , modeToDigits -, defaultPlainBlob , nullBlob , sourceBlob , nullOid @@ -59,7 +58,6 @@ data Blob = Blob { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. , blobOid :: ByteString -- ^ The Git object ID (SHA-1) of the blob. , blobPath :: FilePath -- ^ The file path to the blob. - , blobKind :: BlobKind -- ^ The kind of blob. , blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet. } deriving (Show, Eq) @@ -73,15 +71,11 @@ modeToDigits (PlainBlob mode) = pack $ showOct mode "" modeToDigits (ExecutableBlob mode) = pack $ showOct mode "" modeToDigits (SymlinkBlob mode) = pack $ showOct mode "" --- | The default plain blob mode -defaultPlainBlob :: BlobKind -defaultPlainBlob = PlainBlob 0o100644 - nullBlob :: Blob -> Bool nullBlob Blob{..} = blobOid == nullOid || nullSource blobSource sourceBlob :: FilePath -> Maybe Language -> Source -> Blob -sourceBlob filepath language source = Blob source nullOid filepath defaultPlainBlob language +sourceBlob filepath language source = Blob source nullOid filepath language nullOid :: ByteString nullOid = "0000000000000000000000000000000000000000" diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index aa704c7ef..0fcbef5d2 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -253,4 +253,4 @@ blankDiff = merge (arrayInfo, arrayInfo) (Indexed [ inserting (Term $ literalInf literalInfo = Nothing :. Range 1 2 :. StringLiteral :. sourceSpanBetween (1, 2) (1, 4) :. Nil blankDiffBlobs :: Both Blob -blankDiffBlobs = both (Blob (fromText "[]") nullOid "a.js" defaultPlainBlob (Just TypeScript)) (Blob (fromText "[a]") nullOid "b.js" defaultPlainBlob (Just TypeScript)) +blankDiffBlobs = both (Blob (fromText "[]") nullOid "a.js" (Just TypeScript)) (Blob (fromText "[a]") nullOid "b.js" (Just TypeScript)) diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index c417cc54f..6e10ff6b8 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -37,4 +37,4 @@ spec = parallel $ do result `shouldBe` (Diff (Patch (Delete (In () []))) :: Diff [] () ()) where - methodsBlob = Blob "def foo\nend\n" "ff7bbbe9495f61d9e1e58c597502d152bab1761e" "methods.rb" defaultPlainBlob (Just Ruby) + methodsBlob = Blob "def foo\nend\n" "ff7bbbe9495f61d9e1e58c597502d152bab1761e" "methods.rb" (Just Ruby) From deb7ebadd297d793c7e16df24cb384b14c88c55f Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 10:59:05 -0800 Subject: [PATCH 53/67] :fire: blobOid too --- src/Data/Blob.hs | 23 ++--------------------- src/Rendering/JSON.hs | 2 -- test/Rendering/TOC/Spec.hs | 2 +- test/Semantic/CLI/Spec.hs | 2 +- test/Semantic/Spec.hs | 2 +- 5 files changed, 5 insertions(+), 26 deletions(-) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index be7f21fc9..0c1312f5d 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -1,11 +1,8 @@ module Data.Blob ( Blob(..) -, BlobKind(..) , These(..) -, modeToDigits , nullBlob , sourceBlob -, nullOid , BlobPair , blobPairDiffing , blobPairInserting @@ -15,13 +12,10 @@ module Data.Blob , pathForBlobPair ) where -import Data.ByteString.Char8 (ByteString, pack) import Data.Bifunctor.Join import Data.Language import Data.These import Data.Source as Source -import Data.Word -import Numeric -- | Represents a blobs suitable for diffing which can be either a blob to @@ -56,26 +50,13 @@ languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair) -- | The source, oid, path, kind and language of a blob. data Blob = Blob { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. - , blobOid :: ByteString -- ^ The Git object ID (SHA-1) of the blob. , blobPath :: FilePath -- ^ The file path to the blob. , blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet. } deriving (Show, Eq) --- | The kind and file mode of a 'Blob'. -data BlobKind = PlainBlob Word32 | ExecutableBlob Word32 | SymlinkBlob Word32 - deriving (Show, Eq) - -modeToDigits :: BlobKind -> ByteString -modeToDigits (PlainBlob mode) = pack $ showOct mode "" -modeToDigits (ExecutableBlob mode) = pack $ showOct mode "" -modeToDigits (SymlinkBlob mode) = pack $ showOct mode "" - nullBlob :: Blob -> Bool -nullBlob Blob{..} = blobOid == nullOid || nullSource blobSource +nullBlob Blob{..} = nullSource blobSource sourceBlob :: FilePath -> Maybe Language -> Source -> Blob -sourceBlob filepath language source = Blob source nullOid filepath language - -nullOid :: ByteString -nullOid = "0000000000000000000000000000000000000000" +sourceBlob filepath language source = Blob source filepath language diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index f386dbbf4..41cd0cf5c 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -11,14 +11,12 @@ import Data.Bifunctor.Join import Data.Language import qualified Data.Map as Map import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8) import GHC.Generics -- | Render a diff to a string representing its JSON. renderJSONDiff :: ToJSON a => BlobPair -> a -> Map.Map Text Value renderJSONDiff blobs diff = Map.fromList [ ("diff", toJSON diff) - , ("oids", toJSON (decodeUtf8 . blobOid <$> (biList . runJoin) blobs)) , ("paths", toJSON (blobPath <$> (biList . runJoin) blobs)) ] diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 0fcbef5d2..62a14f507 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -253,4 +253,4 @@ blankDiff = merge (arrayInfo, arrayInfo) (Indexed [ inserting (Term $ literalInf literalInfo = Nothing :. Range 1 2 :. StringLiteral :. sourceSpanBetween (1, 2) (1, 4) :. Nil blankDiffBlobs :: Both Blob -blankDiffBlobs = both (Blob (fromText "[]") nullOid "a.js" (Just TypeScript)) (Blob (fromText "[a]") nullOid "b.js" (Just TypeScript)) +blankDiffBlobs = both (Blob (fromText "[]") "a.js" (Just TypeScript)) (Blob (fromText "[a]") "b.js" (Just TypeScript)) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 1d60ab225..f38cbe124 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -58,6 +58,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\":{\"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]}}}},\"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" diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index 6e10ff6b8..56d327478 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -37,4 +37,4 @@ spec = parallel $ do result `shouldBe` (Diff (Patch (Delete (In () []))) :: Diff [] () ()) where - methodsBlob = Blob "def foo\nend\n" "ff7bbbe9495f61d9e1e58c597502d152bab1761e" "methods.rb" (Just Ruby) + methodsBlob = Blob "def foo\nend\n" "methods.rb" (Just Ruby) From 30f5b9bd4b4d25daa2e96e5fdaa6c31c54d27aeb Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 11:09:37 -0800 Subject: [PATCH 54/67] Just moving things around --- src/Data/Blob.hs | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index 0c1312f5d..f7a5c9fa1 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -1,9 +1,9 @@ module Data.Blob ( Blob(..) -, These(..) , nullBlob , sourceBlob , BlobPair +, These(..) , blobPairDiffing , blobPairInserting , blobPairDeleting @@ -18,6 +18,21 @@ import Data.These import Data.Source as Source +-- | The source, oid, path, kind and language of a blob. +data Blob = Blob + { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. + , blobPath :: FilePath -- ^ The file path to the blob. + , blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet. + } + deriving (Show, Eq) + +nullBlob :: Blob -> Bool +nullBlob Blob{..} = nullSource blobSource + +sourceBlob :: FilePath -> Maybe Language -> Source -> Blob +sourceBlob filepath language source = Blob source filepath language + + -- | Represents a blobs suitable for diffing which can be either a blob to -- delete, a blob to insert, or a pair of blobs to diff. type BlobPair = Join These Blob @@ -45,18 +60,3 @@ pathForBlobPair (Join (These _ Blob{..})) = blobPath languageTagForBlobPair :: BlobPair -> [(String, String)] languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair) where showLanguage = pure . (,) "language" . show - - --- | The source, oid, path, kind and language of a blob. -data Blob = Blob - { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. - , blobPath :: FilePath -- ^ The file path to the blob. - , blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet. - } - deriving (Show, Eq) - -nullBlob :: Blob -> Bool -nullBlob Blob{..} = nullSource blobSource - -sourceBlob :: FilePath -> Maybe Language -> Source -> Blob -sourceBlob filepath language source = Blob source filepath language From 8d7701fd7fcdf1795e2c77b7dc70ccb9338c82d6 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 11:15:29 -0800 Subject: [PATCH 55/67] Docs --- src/Data/Blob.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index f7a5c9fa1..f90536478 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -18,7 +18,7 @@ import Data.These import Data.Source as Source --- | The source, oid, path, kind and language of a blob. +-- | The source, path, and language of a blob. data Blob = Blob { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. , blobPath :: FilePath -- ^ The file path to the blob. From ed47cbc85d59837dc0968b35bdb8ce1af2e7e406 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 12:58:43 -0800 Subject: [PATCH 56/67] Formatting --- src/Semantic.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index 0cf466f35..0c72d083d 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -116,8 +116,8 @@ diffBlobPair renderer blobs -- | A task to diff 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's. diffTermPair :: Functor syntax => Differ syntax ann1 ann2 -> These (Term syntax ann1) (Term syntax ann2) -> Task (Diff syntax ann1 ann2) -diffTermPair _ (This t1) = pure (deleting t1) -diffTermPair _ (That t2) = pure (inserting t2) +diffTermPair _ (This t1 ) = pure (deleting t1) +diffTermPair _ (That t2) = pure (inserting t2) diffTermPair differ (These t1 t2) = diff differ t1 t2 keepCategory :: HasField fields Category => Record fields -> Record '[Category] From 143b1b8a1291d40b50b539807c1966a2e5175507 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 12:58:50 -0800 Subject: [PATCH 57/67] Document Bidistribute --- src/Semantic/Task.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index aafe017ff..67174c1f6 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -139,6 +139,9 @@ render renderer input = Render renderer input `Then` return distribute :: Traversable t => t (Task output) -> Task (t output) distribute tasks = Distribute tasks `Then` return +-- | Distribute a 'Bitraversable' container of 'Task's over the available cores (i.e. execute them concurrently), collecting their results. +-- +-- This is a concurrent analogue of 'bisequenceA'. bidistribute :: Bitraversable t => t (Task output1) (Task output2) -> Task (t output1 output2) bidistribute tasks = Bidistribute tasks `Then` return @@ -148,6 +151,9 @@ bidistribute tasks = Bidistribute tasks `Then` return distributeFor :: Traversable t => t a -> (a -> Task output) -> Task (t output) distributeFor inputs toTask = distribute (fmap toTask inputs) +-- | Distribute the application of a function to each element of a 'Bitraversable' container of inputs over the available cores (i.e. perform the functions concurrently for each element), collecting the results. +-- +-- This is a concurrent analogue of 'bifor' or 'bitraverse' (with the arguments flipped). bidistributeFor :: Bitraversable t => t a b -> (a -> Task output1) -> (b -> Task output2) -> Task (t output1 output2) bidistributeFor inputs toTask1 toTask2 = bidistribute (bimap toTask1 toTask2 inputs) From 2f6c66989910d4dd83dca57be5173481aff6fc5d Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 12:58:57 -0800 Subject: [PATCH 58/67] Remove extra parens --- test/Rendering/TOC/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 62a14f507..1d02e64b7 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -241,7 +241,7 @@ isMethodOrFunction a = case unTerm a of _ -> False blobsForPaths :: Both FilePath -> IO BlobPair -blobsForPaths = readFilePair . (fmap ("test/fixtures/toc/" <>)) +blobsForPaths = readFilePair . fmap ("test/fixtures/toc/" <>) sourceSpanBetween :: (Int, Int) -> (Int, Int) -> Span sourceSpanBetween (s1, e1) (s2, e2) = Span (Pos s1 e1) (Pos s2 e2) From 47ce5a63c1e8b998d7a0d6e02560596ad6a833d8 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Dec 2017 12:59:14 -0800 Subject: [PATCH 59/67] Test null on both sides in JSON payload --- test/Semantic/IO/Spec.hs | 4 ++++ test/fixtures/input/diff-null-both-sides.json | 6 ++++++ 2 files changed, 10 insertions(+) create mode 100644 test/fixtures/input/diff-null-both-sides.json diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index ca08710e0..6c04703bb 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -64,6 +64,10 @@ spec = parallel $ do h <- openFile "test/fixtures/input/diff-no-language.json" ReadMode readBlobsFromHandle h `shouldThrow` (== ExitFailure 1) + it "throws if null on before and after" $ do + h <- openFile "test/fixtures/input/diff-null-both-sides.json" ReadMode + readBlobPairsFromHandle h `shouldThrow` (== ExitFailure 1) + describe "readBlobsFromHandle" $ do it "returns blobs for valid JSON encoded parse input" $ do h <- openFile "test/fixtures/input/parse.json" ReadMode diff --git a/test/fixtures/input/diff-null-both-sides.json b/test/fixtures/input/diff-null-both-sides.json new file mode 100644 index 000000000..4de8c1966 --- /dev/null +++ b/test/fixtures/input/diff-null-both-sides.json @@ -0,0 +1,6 @@ +{ + "blobs": [{ + "before": null, + "after": null + }] +} From cda1779d64cfd623b6b3f34ffd330e0c95882476 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 11 Dec 2017 14:29:30 -0800 Subject: [PATCH 60/67] 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 61/67] 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 62/67] 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 63/67] 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 64/67] 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 65/67] 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" From ca7a81a21e4f810c0f819d35523a642cbcfd6a6e Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 13 Dec 2017 09:15:08 -0800 Subject: [PATCH 66/67] ++freer-cofreer with gitignore --- vendor/freer-cofreer | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vendor/freer-cofreer b/vendor/freer-cofreer index f18b72357..22164cdeb 160000 --- a/vendor/freer-cofreer +++ b/vendor/freer-cofreer @@ -1 +1 @@ -Subproject commit f18b723579f700674dda90ed1519f6e7298e2117 +Subproject commit 22164cdebd939dc9b4a21b41a5e4968f991435d1 From 96c94e7672902d064ae083c5be0c917d3aee221e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 1 Dec 2017 13:54:32 -0500 Subject: [PATCH 67/67] =?UTF-8?q?iterFreer=E2=80=99s=20algebra=20takes=20t?= =?UTF-8?q?he=20continuation=20&=20instruction=20in=20the=20opposite=20ord?= =?UTF-8?q?er.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Assigning/Assignment.hs | 10 +++++----- src/Diffing/Interpreter.hs | 2 +- src/Semantic/Task.hs | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Assigning/Assignment.hs b/src/Assigning/Assignment.hs index a3ca78d66..fdcecb740 100644 --- a/src/Assigning/Assignment.hs +++ b/src/Assigning/Assignment.hs @@ -218,7 +218,7 @@ nodeError expected Node{..} = Error nodeSpan expected (Just (Right nodeSymbol)) firstSet :: (Enum grammar, Ix grammar) => Assignment ast grammar a -> [grammar] -firstSet = iterFreer (\ (Tracing _ assignment) _ -> case assignment of +firstSet = iterFreer (\ _ (Tracing _ assignment) -> case assignment of Choose table _ _ -> Table.tableAddresses table Label child _ -> firstSet child _ -> []) . ([] <$) @@ -245,11 +245,11 @@ runAssignment source = \ assignment state -> go assignment state >>= requireExha go assignment = iterFreer run ((pure .) . (,) <$> assignment) {-# INLINE go #-} - run :: Tracing (AssignmentF ast grammar) x - -> (x -> State ast grammar -> Either (Error (Either String grammar)) (result, State ast grammar)) + run :: (x -> State ast grammar -> Either (Error (Either String grammar)) (result, State ast grammar)) + -> Tracing (AssignmentF ast grammar) x -> State ast grammar -> Either (Error (Either String grammar)) (result, State ast grammar) - run t yield initialState = state `seq` maybe (anywhere Nothing) atNode (listToMaybe stateNodes) + run yield t initialState = state `seq` maybe (anywhere Nothing) atNode (listToMaybe stateNodes) where atNode (Term (In node f)) = case runTracing t of Location -> yield (nodeLocation node) state CurrentNode -> yield (In node (() <$ f)) state @@ -367,7 +367,7 @@ instance (Enum grammar, Eq1 ast, Ix grammar, Show grammar) => MonadError (Error throwError err = fail (show err) catchError :: HasCallStack => Assignment ast grammar a -> (Error (Either String grammar) -> Assignment ast grammar a) -> Assignment ast grammar a - catchError rule handler = iterFreer (\ (Tracing cs assignment) continue -> case assignment of + catchError rule handler = iterFreer (\ continue (Tracing cs assignment) -> case assignment of Choose choices atEnd Nothing -> Tracing cs (Choose (fmap (>>= continue) choices) (fmap (>>= continue) atEnd) (Just handler)) `Then` return Choose choices atEnd (Just onError) -> Tracing cs (Choose (fmap (>>= continue) choices) (fmap (>>= continue) atEnd) (Just (\ err -> (onError err >>= continue) <|> handler err))) `Then` return _ -> Tracing cs assignment `Then` ((`catchError` handler) . continue)) (fmap pure rule) diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs index 8a609e79c..b2ec67a73 100644 --- a/src/Diffing/Interpreter.hs +++ b/src/Diffing/Interpreter.hs @@ -75,7 +75,7 @@ runAlgorithm comparable eqTerms = go (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))) result -> m result - go = iterFreerA (\ step yield -> case step of + go = iterFreerA (\ yield step -> case step of Diffing.Algorithm.Diff t1 t2 -> go (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> galignWith (go . diffThese) f1 f2 >>= yield RWS as bs -> traverse (go . diffThese) (rws comparable eqTerms as bs) >>= yield diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 67174c1f6..d101569fc 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -193,7 +193,7 @@ runTaskWithOptions options task = do run options logger statter = go where go :: Task a -> IO (Either SomeException a) - go = iterFreerA (\ task yield -> case task of + go = iterFreerA (\ yield task -> case task of ReadBlobs (Left handle) -> (IO.readBlobsFromHandle handle >>= yield) `catchError` (pure . Left . toException) ReadBlobs (Right paths@[(path, Nothing)]) -> (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path) >>= yield) `catchError` (pure . Left . toException) ReadBlobs (Right paths) -> (IO.readBlobsFromPaths paths >>= yield) `catchError` (pure . Left . toException)