diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 67cd2a8db..8a07f0a80 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -24,6 +24,7 @@ library , Analysis.CyclomaticComplexity , Analysis.Decorator , Analysis.Declaration + , Analysis.IdentifierName -- Semantic assignment , Assigning.Assignment , Assigning.Assignment.Table diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index 74846cb6b..dc67b0ac7 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/src/Analysis/CyclomaticComplexity.hs @@ -1,9 +1,12 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators #-} +{-# LANGUAGE DataKinds, DefaultSignatures, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} module Analysis.CyclomaticComplexity -( cyclomaticComplexityAlgebra +( CyclomaticComplexity(..) +, HasCyclomaticComplexity +, cyclomaticComplexityAlgebra ) where -import Data.Algebra (FAlgebra) +import Data.Aeson +import Data.Proxy import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Statement as Statement import Data.Term @@ -11,16 +14,103 @@ import Data.Union -- | 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. -- --- 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 (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) => TermF syntax ann CyclomaticComplexity -> 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 :: syntax CyclomaticComplexity -> 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 :: syntax CyclomaticComplexity -> CyclomaticComplexity + + -- | 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 + 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 -> syntax CyclomaticComplexity -> 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.Function = 'Custom + CyclomaticComplexityStrategy Declaration.Method = 'Custom + CyclomaticComplexityStrategy Statement.Catch = 'Custom + CyclomaticComplexityStrategy Statement.DoWhile = 'Custom + CyclomaticComplexityStrategy Statement.Else = 'Custom + CyclomaticComplexityStrategy Statement.For = 'Custom + CyclomaticComplexityStrategy Statement.ForEach = 'Custom + CyclomaticComplexityStrategy Statement.If = 'Custom + CyclomaticComplexityStrategy Statement.Pattern = 'Custom + CyclomaticComplexityStrategy Statement.While = 'Custom + CyclomaticComplexityStrategy (Union fs) = 'Custom + CyclomaticComplexityStrategy a = 'Default + + +-- | The 'Default' strategy takes the sum without incrementing. +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 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 diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index a1beae60f..f90536478 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -1,56 +1,62 @@ module Data.Blob ( Blob(..) -, BlobKind(..) -, modeToDigits -, defaultPlainBlob -, emptyBlob , nullBlob -, blobExists , sourceBlob -, nullOid +, BlobPair +, These(..) +, blobPairDiffing +, blobPairInserting +, blobPairDeleting +, languageForBlobPair +, languageTagForBlobPair +, pathForBlobPair ) where -import Data.ByteString.Char8 (ByteString, pack) +import Data.Bifunctor.Join import Data.Language -import Data.Maybe (isJust) +import Data.These import Data.Source as Source -import Data.Word -import Numeric --- | The source, oid, path, and Maybe BlobKind 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. - , 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). , 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 "" - --- | The default plain blob 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 +nullBlob Blob{..} = nullSource blobSource sourceBlob :: FilePath -> Maybe Language -> Source -> Blob -sourceBlob filepath language source = Blob source nullOid filepath (Just defaultPlainBlob) language +sourceBlob filepath language source = Blob source filepath language -nullOid :: ByteString -nullOid = "0000000000000000000000000000000000000000" + +-- | 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 (Join (This Blob{..})) = blobLanguage +languageForBlobPair (Join (That Blob{..})) = blobLanguage +languageForBlobPair (Join (These _ Blob{..})) = blobLanguage + +pathForBlobPair :: BlobPair -> FilePath +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) + where showLanguage = pure . (,) "language" . show 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/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs index 542638dd9..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 @@ -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. 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' diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index fb99231a9..41cd0cf5c 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -4,26 +4,20 @@ 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.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 => 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)) - , ("paths", toJSON (blobPath <$> toList blobs)) + , ("paths", toJSON (blobPath <$> (biList . runJoin) blobs)) ] data File a = File { filePath :: FilePath, fileLanguage :: Maybe Language, fileContent :: a } @@ -32,5 +26,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 772af46f5..9f5f0ee31 100644 --- a/src/Rendering/TOC.hs +++ b/src/Rendering/TOC.hs @@ -21,17 +21,17 @@ 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 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 @@ -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 (runJoin 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 74116b213..649c63b7b 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 @@ -15,10 +16,10 @@ 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 -import Data.Functor.Both as Both import Data.Functor.Classes import Data.JSON.Fields import qualified Data.Language as Language @@ -44,15 +45,15 @@ 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 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) @@ -69,17 +70,17 @@ 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]) + | 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 @@ -90,15 +91,14 @@ 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 effectiveLanguage = languageForBlobPair blobs + effectivePath = pathForBlobPair 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 @@ -106,24 +106,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) -> (Join These Blob -> Diff syntax ann ann -> output) -> Task output run parse diff renderer = do - terms <- distributeFor blobs parse + terms <- bidistributeFor (runJoin blobs) parse parse time "diff" languageTag $ do - diff <- runBothWith (diffTermPair blobs 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 => 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 +-- | 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 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..edc5593b4 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 +, readFilePair , isDirectory , readBlobPairsFromHandle , readBlobsFromHandle @@ -9,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 @@ -21,6 +21,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 @@ -33,11 +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 (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 @@ -47,12 +58,12 @@ 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 -> [Blob.BlobPair] toBlobPairs BlobDiff{..} = toBlobPair <$> blobs - toBlobPair blobs = Join (fromThese empty empty (runJoin (toBlob <$> blobs))) - where empty = Blob.emptyBlob (mergeThese const (runJoin (path <$> blobs))) + toBlobPair blobs = toBlob <$> blobs -- | Read JSON encoded blobs from a handle. readBlobsFromHandle :: MonadIO m => Handle -> m [Blob.Blob] @@ -60,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/Task.hs b/src/Semantic/Task.hs index ace05a81b..d101569fc 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,24 @@ 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 + -- | 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) +-- | 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) + -- | 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 +197,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 (traverse (traverse (uncurry IO.readFile))) 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 @@ -190,6 +207,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 . withStrategy (parBitraversable (parTraversable rseq) (parTraversable rseq)) LiftIO action -> action >>= yield Throw err -> pure (Left err) Catch during handler -> do @@ -198,6 +216,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 diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index e722c1536..4b441c5cc 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -5,10 +5,11 @@ 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.Both import Data.Functor.Classes +import Data.Bifunctor.Join import Data.Range import Data.Record import Data.Span @@ -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, @@ -31,8 +32,21 @@ 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 parse >>= runBothWith (diffTermPair sourceBlobs diffTerms) + run parse blobs = bidistributeFor (runJoin blobs) parse parse >>= diffTermPair 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 diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs index 41784b51e..2e9092db0 100644 --- a/test/Data/Functor/Listable.hs +++ b/test/Data/Functor/Listable.hs @@ -27,6 +27,7 @@ module Data.Functor.Listable , ListableSyntax ) where +import Analysis.CyclomaticComplexity import Analysis.Declaration import qualified Category import Control.Monad.Free as Free @@ -356,6 +357,9 @@ instance Listable Declaration where \/ cons3 FunctionDeclaration \/ cons2 (\ a b -> ErrorDeclaration a b Nothing) +instance Listable CyclomaticComplexity where + tiers = cons1 CyclomaticComplexity + instance Listable Language.Language where tiers = cons0 Language.Go diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index e8aae8ed3..1d02e64b7 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) @@ -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 "[]") "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 cdf23172a..671f5a63d 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -38,15 +38,14 @@ 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)] 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 +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\":{\"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]}}}},\"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/IO/Spec.hs b/test/Semantic/IO/Spec.hs index e9ee6982b..6c04703bb 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -9,53 +9,52 @@ 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" 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` [blobPairDiffing 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` [blobPairInserting 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` [blobPairInserting 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` [blobPairDeleting 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` [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` [both (emptyBlob "test.kt") 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` [both a b] + blobs `shouldBe` [blobPairDiffing a b] it "throws on blank input" $ do h <- openFile "test/fixtures/input/blank.json" ReadMode @@ -65,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/Semantic/Spec.hs b/test/Semantic/Spec.hs index 884b55f60..56d327478 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) + methodsBlob = Blob "def foo\nend\n" "methods.rb" (Just Ruby) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 90d0abd90..82ea1d181 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -2,44 +2,36 @@ module SpecHelpers ( diffFilePaths , parseFilePath -, readFile +, readFilePair , languageForFilePath ) where +import Control.Monad ((<=<)) import Control.Exception 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 Prelude hiding (readFile) import Rendering.Renderer import Semantic import Semantic.Task +import qualified Semantic.IO as IO import System.FilePath -- | 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 -parseFilePath path = do - blob <- readFile path - runTask (parseBlob SExpressionTermRenderer blob) +parseFilePath path = IO.readFile path (languageForFilePath path) >>= pure . fromJust >>= 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 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/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 + }] +} 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