diff --git a/semantic.cabal b/semantic.cabal index 91d779f77..a2afcccaa 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -275,6 +275,7 @@ test-suite test , filepath , free , Glob + , hashable , haskell-tree-sitter , hspec >= 2.4.1 , hspec-core diff --git a/src/Analysis/Decorator.hs b/src/Analysis/Decorator.hs index a35b44eec..7769addd4 100644 --- a/src/Analysis/Decorator.hs +++ b/src/Analysis/Decorator.hs @@ -1,16 +1,11 @@ {-# LANGUAGE DataKinds, TypeOperators #-} module Analysis.Decorator ( decoratorWithAlgebra -, constructorNameAndConstantFields ) where -import Prologue -import Data.Aeson -import Data.ByteString.Char8 (ByteString, pack) -import Data.JSON.Fields import Data.Record import Data.Term -import Data.Text.Encoding (decodeUtf8) +import Prologue -- | Lift an algebra into a decorator for terms annotated with records. decoratorWithAlgebra :: Functor syntax @@ -18,17 +13,3 @@ decoratorWithAlgebra :: Functor syntax -> Term syntax (Record fs) -- ^ A term to decorate with values produced by the R-algebra. -> Term syntax (Record (a ': fs)) -- ^ A term decorated with values produced by the R-algebra. decoratorWithAlgebra alg = para $ \ c@(In a f) -> termIn (alg (fmap (second (rhead . termAnnotation)) c) :. a) (fmap snd f) - - -newtype Identifier = Identifier ByteString - deriving (Eq, Show) - -instance ToJSONFields Identifier where - toJSONFields (Identifier i) = [ "identifier" .= decodeUtf8 i ] - --- | Compute a 'ByteString' label for a 'Show1'able 'Term'. --- --- This uses 'liftShowsPrec' to produce the 'ByteString', with the effect that --- constant fields will be included and parametric fields will not be. -constructorNameAndConstantFields :: Show1 f => TermF f a b -> ByteString -constructorNameAndConstantFields (In _ f) = pack (liftShowsPrec (const (const id)) (const id) 0 f "") diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index f55b28005..0dd9c24d6 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -85,7 +85,7 @@ mergeNewer (Environment a) (Environment b) = -- | Extract an association list of bindings from an 'Environment'. -- -- >>> pairs shadowed --- [(Name {unName = "foo"},Precise 1)] +-- [("foo",Precise 1)] pairs :: Environment location value -> [(Name, Address location value)] pairs = map (second Address) . Map.toList . fold . unEnvironment diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index 97ea7a73c..a8dbfafb3 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -9,7 +9,7 @@ import Prologue -- | The type of variable names. newtype Name = Name { unName :: ByteString } - deriving (Eq, Ord, Show) + deriving (Eq, Hashable, Ord) name :: ByteString -> Name name = Name @@ -17,6 +17,8 @@ name = Name instance IsString Name where fromString = Name . BC.pack +instance Show Name where showsPrec d (Name str) = showsPrec d str + -- | Types which can contain unbound variables. class FreeVariables term where diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index fdb20adb7..7c1242776 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -102,7 +102,7 @@ infixContext context left right operators = uncurry (&) <$> postContextualizeThr -- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable). newtype Identifier a = Identifier Name - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Identifier where liftEq = genericLiftEq instance Ord1 Identifier where liftCompare = genericLiftCompare @@ -121,7 +121,7 @@ instance Declarations1 Identifier where liftDeclaredName _ (Identifier x) = pure x newtype Program a = Program [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Program where liftEq = genericLiftEq instance Ord1 Program where liftCompare = genericLiftCompare @@ -134,7 +134,7 @@ instance Evaluatable Program where -- | An accessibility modifier, e.g. private, public, protected, etc. newtype AccessibilityModifier a = AccessibilityModifier ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 AccessibilityModifier where liftEq = genericLiftEq instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare @@ -149,7 +149,7 @@ instance Evaluatable AccessibilityModifier -- -- This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'. data Empty a = Empty - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Empty @@ -163,7 +163,7 @@ instance Evaluatable Empty where -- | Syntax representing a parsing or assignment error. data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Error where liftEq = genericLiftEq instance Ord1 Error where liftCompare = genericLiftCompare @@ -199,6 +199,9 @@ instance ToJSON ErrorStack where , "endColumn" .= srcLocEndCol ] +instance Hashable ErrorStack where + hashWithSalt = hashUsing (map (second ((,,,,,,) <$> srcLocPackage <*> srcLocModule <*> srcLocFile <*> srcLocStartLine <*> srcLocStartCol <*> srcLocEndLine <*> srcLocEndCol)) . unErrorStack) + instance Ord ErrorStack where compare = liftCompare (liftCompare compareSrcLoc) `on` unErrorStack where compareSrcLoc s1 s2 = mconcat @@ -222,6 +225,8 @@ instance Diffable Context where equivalentBySubterm = Just . contextSubject +instance Hashable1 Context where liftHashWithSalt = foldl + instance Eq1 Context where liftEq = genericLiftEq instance Ord1 Context where liftCompare = genericLiftCompare instance Show1 Context where liftShowsPrec = genericLiftShowsPrec diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index 08e0e18aa..f265c9a2b 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -9,7 +9,7 @@ import Diffing.Algorithm -- | An unnested comment (line or block). newtype Comment a = Comment { commentContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Comment where liftEq = genericLiftEq instance Ord1 Comment where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index d3a581db5..e4b6866a2 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -9,7 +9,7 @@ import Diffing.Algorithm import Prologue data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Diffable Function where equivalentBySubterm = Just . functionName @@ -36,7 +36,7 @@ instance Declarations a => Declarations (Function a) where data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Method where liftEq = genericLiftEq instance Ord1 Method where liftCompare = genericLiftCompare @@ -60,7 +60,7 @@ instance Evaluatable Method where -- | A method signature in TypeScript or a method spec in Go. data MethodSignature a = MethodSignature { _methodSignatureContext :: ![a], _methodSignatureName :: !a, _methodSignatureParameters :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 MethodSignature where liftEq = genericLiftEq instance Ord1 MethodSignature where liftCompare = genericLiftCompare @@ -73,7 +73,7 @@ instance Evaluatable MethodSignature newtype RequiredParameter a = RequiredParameter { requiredParameter :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 RequiredParameter where liftEq = genericLiftEq instance Ord1 RequiredParameter where liftCompare = genericLiftCompare @@ -86,7 +86,7 @@ instance Evaluatable RequiredParameter newtype OptionalParameter a = OptionalParameter { optionalParameter :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 OptionalParameter where liftEq = genericLiftEq instance Ord1 OptionalParameter where liftCompare = genericLiftCompare @@ -103,7 +103,7 @@ instance Evaluatable OptionalParameter -- TODO: It would be really nice to have a more meaningful type contained in here than [a] -- | A declaration of possibly many variables such as var foo = 5, bar = 6 in JavaScript. newtype VariableDeclaration a = VariableDeclaration { variableDeclarations :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 VariableDeclaration where liftEq = genericLiftEq instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare @@ -123,7 +123,7 @@ instance Declarations a => Declarations (VariableDeclaration a) where -- | A TypeScript/Java style interface declaration to implement. data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare @@ -140,7 +140,7 @@ instance Declarations a => Declarations (InterfaceDeclaration a) where -- | A public field definition such as a field definition in a JavaScript class. data PublicFieldDefinition a = PublicFieldDefinition { publicFieldContext :: ![a], publicFieldPropertyName :: !a, publicFieldValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 PublicFieldDefinition where liftEq = genericLiftEq instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare @@ -153,7 +153,7 @@ instance Evaluatable PublicFieldDefinition data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Variable where liftEq = genericLiftEq instance Ord1 Variable where liftCompare = genericLiftCompare @@ -165,7 +165,7 @@ instance ToJSONFields1 Variable instance Evaluatable Variable data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Declarations a => Declarations (Class a) where declaredName (Class _ name _ _) = declaredName name @@ -191,7 +191,7 @@ instance Evaluatable Class where -- | A decorator in Python data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Decorator where liftEq = genericLiftEq instance Ord1 Decorator where liftCompare = genericLiftCompare @@ -207,7 +207,7 @@ instance Evaluatable Decorator -- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift. data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq instance Ord1 Data.Syntax.Declaration.Datatype where liftCompare = genericLiftCompare @@ -221,7 +221,7 @@ instance Evaluatable Data.Syntax.Declaration.Datatype -- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift. data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq instance Ord1 Data.Syntax.Declaration.Constructor where liftCompare = genericLiftCompare @@ -235,7 +235,7 @@ instance Evaluatable Data.Syntax.Declaration.Constructor -- | Comprehension (e.g. ((a for b in c if a()) in Python) data Comprehension a = Comprehension { comprehensionValue :: !a, comprehensionBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Comprehension where liftEq = genericLiftEq instance Ord1 Comprehension where liftCompare = genericLiftCompare @@ -249,7 +249,7 @@ instance Evaluatable Comprehension -- | A declared type (e.g. `a []int` in Go). data Type a = Type { typeName :: !a, typeKind :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Type where liftEq = genericLiftEq instance Ord1 Type where liftCompare = genericLiftCompare @@ -263,7 +263,7 @@ instance Evaluatable Type -- | Type alias declarations in Javascript/Haskell, etc. data TypeAlias a = TypeAlias { typeAliasContext :: ![a], typeAliasIdentifier :: !a, typeAliasKind :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 TypeAlias where liftEq = genericLiftEq instance Ord1 TypeAlias where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Directive.hs b/src/Data/Syntax/Directive.hs index dbd8d26e1..08bcc375b 100644 --- a/src/Data/Syntax/Directive.hs +++ b/src/Data/Syntax/Directive.hs @@ -11,7 +11,7 @@ import Prologue -- A file directive like the Ruby constant `__FILE__`. data File a = File - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 File where liftEq = genericLiftEq instance Ord1 File where liftCompare = genericLiftCompare @@ -25,7 +25,7 @@ instance Evaluatable File where -- A line directive like the Ruby constant `__LINE__`. data Line a = Line - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Line where liftEq = genericLiftEq instance Ord1 Line where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index ed3c2223a..0e668810e 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -10,7 +10,7 @@ import Prologue hiding (index) -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell. data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Call where liftEq = genericLiftEq instance Ord1 Call where liftCompare = genericLiftCompare @@ -30,7 +30,7 @@ data Comparison a | GreaterThanEqual !a !a | Equal !a !a | Comparison !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Comparison where liftEq = genericLiftEq instance Ord1 Comparison where liftCompare = genericLiftCompare @@ -58,7 +58,7 @@ data Arithmetic a | Modulo !a !a | Power !a !a | Negate !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Arithmetic where liftEq = genericLiftEq instance Ord1 Arithmetic where liftCompare = genericLiftCompare @@ -81,7 +81,7 @@ instance Evaluatable Arithmetic where data Match a = Matches !a !a | NotMatches !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Match where liftEq = genericLiftEq instance Ord1 Match where liftCompare = genericLiftCompare @@ -98,7 +98,7 @@ data Boolean a | And !a !a | Not !a | XOr !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Boolean where liftEq = genericLiftEq instance Ord1 Boolean where liftCompare = genericLiftCompare @@ -120,7 +120,7 @@ instance Evaluatable Boolean where -- | Javascript delete operator newtype Delete a = Delete a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Delete where liftEq = genericLiftEq instance Ord1 Delete where liftCompare = genericLiftCompare @@ -134,7 +134,7 @@ instance Evaluatable Delete -- | A sequence expression such as Javascript or C's comma operator. data SequenceExpression a = SequenceExpression { _firstExpression :: !a, _secondExpression :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 SequenceExpression where liftEq = genericLiftEq instance Ord1 SequenceExpression where liftCompare = genericLiftCompare @@ -148,7 +148,7 @@ instance Evaluatable SequenceExpression -- | Javascript void operator newtype Void a = Void a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Void where liftEq = genericLiftEq instance Ord1 Void where liftCompare = genericLiftCompare @@ -162,7 +162,7 @@ instance Evaluatable Void -- | Javascript typeof operator newtype Typeof a = Typeof a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Typeof where liftEq = genericLiftEq instance Ord1 Typeof where liftCompare = genericLiftCompare @@ -183,7 +183,7 @@ data Bitwise a | RShift !a !a | UnsignedRShift !a !a | Complement a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Bitwise where liftEq = genericLiftEq instance Ord1 Bitwise where liftCompare = genericLiftCompare @@ -207,7 +207,7 @@ instance Evaluatable Bitwise where -- | Member Access (e.g. a.b) data MemberAccess a = MemberAccess !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 MemberAccess where liftEq = genericLiftEq instance Ord1 MemberAccess where liftCompare = genericLiftCompare @@ -227,7 +227,7 @@ instance Evaluatable MemberAccess where data Subscript a = Subscript !a ![a] | Member !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Subscript where liftEq = genericLiftEq instance Ord1 Subscript where liftCompare = genericLiftCompare @@ -245,7 +245,7 @@ instance Evaluatable Subscript where -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop)) data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Enumeration where liftEq = genericLiftEq instance Ord1 Enumeration where liftCompare = genericLiftCompare @@ -259,7 +259,7 @@ instance Evaluatable Enumeration -- | InstanceOf (e.g. a instanceof b in JavaScript data InstanceOf a = InstanceOf { instanceOfSubject :: !a, instanceOfObject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 InstanceOf where liftEq = genericLiftEq instance Ord1 InstanceOf where liftCompare = genericLiftCompare @@ -273,7 +273,7 @@ instance Evaluatable InstanceOf -- | ScopeResolution (e.g. import a.b in Python or a::b in C++) newtype ScopeResolution a = ScopeResolution [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 ScopeResolution where liftEq = genericLiftEq instance Ord1 ScopeResolution where liftCompare = genericLiftCompare @@ -287,7 +287,7 @@ instance Evaluatable ScopeResolution -- | A non-null expression such as Typescript or Swift's ! expression. newtype NonNullExpression a = NonNullExpression { nonNullExpression :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 NonNullExpression where liftEq = genericLiftEq instance Ord1 NonNullExpression where liftCompare = genericLiftCompare @@ -301,7 +301,7 @@ instance Evaluatable NonNullExpression -- | An await expression in Javascript or C#. newtype Await a = Await { awaitSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Await where liftEq = genericLiftEq instance Ord1 Await where liftCompare = genericLiftCompare @@ -315,7 +315,7 @@ instance Evaluatable Await -- | An object constructor call in Javascript, Java, etc. newtype New a = New { newSubject :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 New where liftEq = genericLiftEq instance Ord1 New where liftCompare = genericLiftCompare @@ -329,7 +329,7 @@ instance Evaluatable New -- | A cast expression to a specified type. data Cast a = Cast { castSubject :: !a, castType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Cast where liftEq = genericLiftEq instance Ord1 Cast where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index dab078eca..c466e7bce 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -14,7 +14,7 @@ import Text.Read (readMaybe) -- Boolean newtype Boolean a = Boolean Bool - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) true :: Boolean a true = Boolean True @@ -36,7 +36,7 @@ instance ToJSONFields1 Boolean where -- | A literal integer of unspecified width. No particular base is implied. newtype Integer a = Integer { integerContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare @@ -57,7 +57,7 @@ instance ToJSONFields1 Data.Syntax.Literal.Integer where -- | A literal float of unspecified width. newtype Float a = Float { floatContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Float where liftCompare = genericLiftCompare @@ -72,7 +72,7 @@ instance ToJSONFields1 Float where -- Rational literals e.g. `2/3r` newtype Rational a = Rational ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare @@ -90,7 +90,7 @@ instance ToJSONFields1 Data.Syntax.Literal.Rational where -- Complex literals e.g. `3 + 2i` newtype Complex a = Complex ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Complex where liftCompare = genericLiftCompare @@ -105,7 +105,7 @@ instance ToJSONFields1 Complex where -- Strings, symbols newtype String a = String { stringElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.String where liftCompare = genericLiftCompare @@ -120,7 +120,7 @@ instance ToJSONFields1 Data.Syntax.Literal.String -- | An interpolation element within a string literal. newtype InterpolationElement a = InterpolationElement { interpolationBody :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 InterpolationElement where liftEq = genericLiftEq instance Ord1 InterpolationElement where liftCompare = genericLiftCompare @@ -133,7 +133,7 @@ instance ToJSONFields1 InterpolationElement -- | A sequence of textual contents within a string literal. newtype TextElement a = TextElement { textElementContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 TextElement where liftEq = genericLiftEq instance Ord1 TextElement where liftCompare = genericLiftCompare @@ -146,7 +146,7 @@ instance Evaluatable TextElement where eval (TextElement x) = Rval <$> string x data Null a = Null - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Null where liftEq = genericLiftEq instance Ord1 Null where liftCompare = genericLiftCompare @@ -157,7 +157,7 @@ instance Evaluatable Null where eval _ = Rval <$> null instance ToJSONFields1 Null newtype Symbol a = Symbol { symbolContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Symbol where liftEq = genericLiftEq instance Ord1 Symbol where liftCompare = genericLiftCompare @@ -169,7 +169,7 @@ instance Evaluatable Symbol where eval (Symbol s) = Rval <$> symbol s newtype Regex a = Regex { regexContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Regex where liftEq = genericLiftEq instance Ord1 Regex where liftCompare = genericLiftCompare @@ -189,7 +189,7 @@ instance Evaluatable Regex -- Collections newtype Array a = Array { arrayElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Array where liftEq = genericLiftEq instance Ord1 Array where liftCompare = genericLiftCompare @@ -201,7 +201,7 @@ instance Evaluatable Array where eval (Array a) = Rval <$> (array =<< traverse subtermValue a) newtype Hash a = Hash { hashElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Hash where liftEq = genericLiftEq instance Ord1 Hash where liftCompare = genericLiftCompare @@ -213,7 +213,7 @@ instance Evaluatable Hash where eval t = Rval <$> (traverse (subtermValue >=> asPair) (hashElements t) >>= hash) data KeyValue a = KeyValue { key :: !a, value :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 KeyValue where liftEq = genericLiftEq instance Ord1 KeyValue where liftCompare = genericLiftCompare @@ -228,7 +228,7 @@ instance Evaluatable KeyValue where instance ToJSONFields1 Tuple newtype Tuple a = Tuple { tupleContents :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Tuple where liftEq = genericLiftEq instance Ord1 Tuple where liftCompare = genericLiftCompare @@ -238,7 +238,7 @@ instance Evaluatable Tuple where eval (Tuple cs) = Rval <$> (multiple =<< traverse subtermValue cs) newtype Set a = Set { setElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Set where liftEq = genericLiftEq instance Ord1 Set where liftCompare = genericLiftCompare @@ -254,7 +254,7 @@ instance Evaluatable Set -- | A declared pointer (e.g. var pointer *int in Go) newtype Pointer a = Pointer a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Pointer where liftEq = genericLiftEq instance Ord1 Pointer where liftCompare = genericLiftCompare @@ -268,7 +268,7 @@ instance Evaluatable Pointer -- | A reference to a pointer's address (e.g. &pointer in Go) newtype Reference a = Reference a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Reference where liftEq = genericLiftEq instance Ord1 Reference where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index cc6ebd067..4d8bc20b9 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -12,7 +12,7 @@ import Prologue -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted. data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 If where liftEq = genericLiftEq instance Ord1 If where liftCompare = genericLiftCompare @@ -27,7 +27,7 @@ instance Evaluatable If where -- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python. data Else a = Else { elseCondition :: !a, elseBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Else where liftEq = genericLiftEq instance Ord1 Else where liftCompare = genericLiftCompare @@ -42,7 +42,7 @@ instance Evaluatable Else -- | Goto statement (e.g. `goto a` in Go). newtype Goto a = Goto { gotoLocation :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Goto where liftEq = genericLiftEq instance Ord1 Goto where liftCompare = genericLiftCompare @@ -56,7 +56,7 @@ instance Evaluatable Goto -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell. data Match a = Match { matchSubject :: !a, matchPatterns :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Match where liftEq = genericLiftEq instance Ord1 Match where liftCompare = genericLiftCompare @@ -70,7 +70,7 @@ instance Evaluatable Match -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions. data Pattern a = Pattern { _pattern :: !a, patternBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Pattern where liftEq = genericLiftEq instance Ord1 Pattern where liftCompare = genericLiftCompare @@ -84,7 +84,7 @@ instance Evaluatable Pattern -- | A let statement or local binding, like 'a as b' or 'let a = b'. data Let a = Let { letVariable :: !a, letValue :: !a, letBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Let where liftEq = genericLiftEq instance Ord1 Let where liftCompare = genericLiftCompare @@ -103,7 +103,7 @@ instance Evaluatable Let where -- | Assignment to a variable or other lvalue. data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Assignment where liftEq = genericLiftEq instance Ord1 Assignment where liftCompare = genericLiftCompare @@ -132,7 +132,7 @@ instance Evaluatable Assignment where -- | Post increment operator (e.g. 1++ in Go, or i++ in C). newtype PostIncrement a = PostIncrement a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 PostIncrement where liftEq = genericLiftEq instance Ord1 PostIncrement where liftCompare = genericLiftCompare @@ -146,7 +146,7 @@ instance Evaluatable PostIncrement -- | Post decrement operator (e.g. 1-- in Go, or i-- in C). newtype PostDecrement a = PostDecrement a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 PostDecrement where liftEq = genericLiftEq instance Ord1 PostDecrement where liftCompare = genericLiftCompare @@ -161,7 +161,7 @@ instance Evaluatable PostDecrement -- Returns newtype Return a = Return a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Return where liftEq = genericLiftEq instance Ord1 Return where liftCompare = genericLiftCompare @@ -173,7 +173,7 @@ instance Evaluatable Return where eval (Return x) = Rval <$> (subtermValue x >>= earlyReturn) newtype Yield a = Yield a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Yield where liftEq = genericLiftEq instance Ord1 Yield where liftCompare = genericLiftCompare @@ -186,7 +186,7 @@ instance Evaluatable Yield newtype Break a = Break a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Break where liftEq = genericLiftEq instance Ord1 Break where liftCompare = genericLiftCompare @@ -198,7 +198,7 @@ instance Evaluatable Break where eval (Break x) = Rval <$> (subtermValue x >>= throwBreak) newtype Continue a = Continue a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Continue where liftEq = genericLiftEq instance Ord1 Continue where liftCompare = genericLiftCompare @@ -210,7 +210,7 @@ instance Evaluatable Continue where eval (Continue a) = Rval <$> (subtermValue a >>= throwContinue) newtype Retry a = Retry a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Retry where liftEq = genericLiftEq instance Ord1 Retry where liftCompare = genericLiftCompare @@ -223,7 +223,7 @@ instance Evaluatable Retry newtype NoOp a = NoOp a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 NoOp where liftEq = genericLiftEq instance Ord1 NoOp where liftCompare = genericLiftCompare @@ -237,7 +237,7 @@ instance Evaluatable NoOp where -- Loops data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 For where liftEq = genericLiftEq instance Ord1 For where liftCompare = genericLiftCompare @@ -250,7 +250,7 @@ instance Evaluatable For where data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 ForEach where liftEq = genericLiftEq instance Ord1 ForEach where liftCompare = genericLiftCompare @@ -263,7 +263,7 @@ instance Evaluatable ForEach data While a = While { whileCondition :: !a, whileBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 While where liftEq = genericLiftEq instance Ord1 While where liftCompare = genericLiftCompare @@ -275,7 +275,7 @@ instance Evaluatable While where eval While{..} = Rval <$> while (subtermValue whileCondition) (subtermValue whileBody) data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 DoWhile where liftEq = genericLiftEq instance Ord1 DoWhile where liftCompare = genericLiftCompare @@ -289,7 +289,7 @@ instance Evaluatable DoWhile where -- Exception handling newtype Throw a = Throw a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Throw where liftEq = genericLiftEq instance Ord1 Throw where liftCompare = genericLiftCompare @@ -302,7 +302,7 @@ instance Evaluatable Throw data Try a = Try { tryBody :: !a, tryCatch :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Try where liftEq = genericLiftEq instance Ord1 Try where liftCompare = genericLiftCompare @@ -315,7 +315,7 @@ instance Evaluatable Try data Catch a = Catch { catchException :: !a, catchBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Catch where liftEq = genericLiftEq instance Ord1 Catch where liftCompare = genericLiftCompare @@ -328,7 +328,7 @@ instance Evaluatable Catch newtype Finally a = Finally a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Finally where liftEq = genericLiftEq instance Ord1 Finally where liftCompare = genericLiftCompare @@ -344,7 +344,7 @@ instance Evaluatable Finally -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl). newtype ScopeEntry a = ScopeEntry [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 ScopeEntry where liftEq = genericLiftEq instance Ord1 ScopeEntry where liftCompare = genericLiftCompare @@ -358,7 +358,7 @@ instance Evaluatable ScopeEntry -- | ScopeExit (e.g. `END {}` block in Ruby or Perl). newtype ScopeExit a = ScopeExit [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 ScopeExit where liftEq = genericLiftEq instance Ord1 ScopeExit where liftCompare = genericLiftCompare @@ -371,7 +371,7 @@ instance Evaluatable ScopeExit -- | HashBang line (e.g. `#!/usr/bin/env node`) newtype HashBang a = HashBang ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 HashBang where liftEq = genericLiftEq instance Ord1 HashBang where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index 325cade8e..155f7d94e 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -7,7 +7,7 @@ import Diffing.Algorithm import Prologue hiding (Map) data Array a = Array { arraySize :: Maybe a, arrayElementType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Array where liftEq = genericLiftEq instance Ord1 Array where liftCompare = genericLiftCompare @@ -21,7 +21,7 @@ instance Evaluatable Array -- TODO: What about type variables? re: FreeVariables1 data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Annotation where liftEq = genericLiftEq instance Ord1 Annotation where liftCompare = genericLiftCompare @@ -35,7 +35,7 @@ instance Evaluatable Annotation where data Function a = Function { functionParameters :: [a], functionReturn :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Function where liftEq = genericLiftEq instance Ord1 Function where liftCompare = genericLiftCompare @@ -48,7 +48,7 @@ instance Evaluatable Function newtype Interface a = Interface [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Interface where liftEq = genericLiftEq instance Ord1 Interface where liftCompare = genericLiftCompare @@ -61,7 +61,7 @@ instance Evaluatable Interface data Map a = Map { mapKeyType :: a, mapElementType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Map where liftEq = genericLiftEq instance Ord1 Map where liftCompare = genericLiftCompare @@ -74,7 +74,7 @@ instance Evaluatable Map newtype Parenthesized a = Parenthesized a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Parenthesized where liftEq = genericLiftEq instance Ord1 Parenthesized where liftCompare = genericLiftCompare @@ -87,7 +87,7 @@ instance Evaluatable Parenthesized newtype Pointer a = Pointer a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Pointer where liftEq = genericLiftEq instance Ord1 Pointer where liftCompare = genericLiftCompare @@ -100,7 +100,7 @@ instance Evaluatable Pointer newtype Product a = Product [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Product where liftEq = genericLiftEq instance Ord1 Product where liftCompare = genericLiftCompare @@ -113,7 +113,7 @@ instance Evaluatable Product data Readonly a = Readonly - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Readonly where liftEq = genericLiftEq instance Ord1 Readonly where liftCompare = genericLiftCompare @@ -126,7 +126,7 @@ instance Evaluatable Readonly newtype Slice a = Slice a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Slice where liftEq = genericLiftEq instance Ord1 Slice where liftCompare = genericLiftCompare @@ -139,7 +139,7 @@ instance Evaluatable Slice newtype TypeParameters a = TypeParameters [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 TypeParameters where liftEq = genericLiftEq instance Ord1 TypeParameters where liftCompare = genericLiftCompare diff --git a/src/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs index ad2980455..883d116a6 100644 --- a/src/Diffing/Algorithm/RWS.hs +++ b/src/Diffing/Algorithm/RWS.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, DataKinds, RankNTypes, TypeOperators #-} +{-# LANGUAGE GADTs, DataKinds, DeriveAnyClass, RankNTypes, TypeOperators #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- FIXME module Diffing.Algorithm.RWS ( rws @@ -25,8 +25,6 @@ import Data.Term as Term import Diffing.Algorithm.RWS.FeatureVector import Diffing.Algorithm.SES -type Label f fields label = forall b. TermF f (Record fields) b -> label - -- | A relation on 'Term's, guaranteed constant-time in the size of the 'Term' by parametricity. -- -- This is used both to determine whether two root terms can be compared in O(1), and, recursively, to determine whether two nodes are equal in O(n); thus, comparability is defined s.t. two terms are equal if they are recursively comparable subterm-wise. @@ -104,45 +102,41 @@ toKdMap = KdMap.build unFV . fmap (rhead . termAnnotation . snd &&& id) -- | A `Gram` is a fixed-size view of some portion of a tree, consisting of a `stem` of _p_ labels for parent nodes, and a `base` of _q_ labels of sibling nodes. Collectively, the bag of `Gram`s for each node of a tree (e.g. as computed by `pqGrams`) form a summary of the tree. data Gram label = Gram { stem :: [Maybe label], base :: [Maybe label] } - deriving (Eq, Show) + deriving (Eq, Generic, Hashable, Show) -- | Annotates a term with a feature vector at each node, using the default values for the p, q, and d parameters. -defaultFeatureVectorDecorator - :: (Hashable label, Traversable f) - => Label f fields label - -> Term f (Record fields) - -> Term f (Record (FeatureVector ': fields)) -defaultFeatureVectorDecorator getLabel = featureVectorDecorator . pqGramDecorator getLabel defaultP defaultQ +defaultFeatureVectorDecorator :: (Hashable1 syntax, Traversable syntax) + => Term syntax (Record fields) + -> Term syntax (Record (FeatureVector ': fields)) +defaultFeatureVectorDecorator = featureVectorDecorator . pqGramDecorator 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 (label ': fields)) -> Term f (Record (FeatureVector ': fields)) +featureVectorDecorator :: (Foldable syntax, Functor syntax, Hashable label) => Term syntax (Record (label ': fields)) -> Term syntax (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. -pqGramDecorator - :: Traversable f - => Label f fields label -- ^ A function computing the label from an arbitrary unpacked term. This function can use the annotation and functor’s constructor, but not any recursive values inside the functor (since they’re held parametric in 'b'). - -> Int -- ^ 'p'; the desired stem length for the grams. - -> Int -- ^ 'q'; the desired base length for the grams. - -> Term f (Record fields) -- ^ The term to decorate. - -> Term f (Record (Gram label ': fields)) -- ^ The decorated term. -pqGramDecorator getLabel p q = cata algebra +pqGramDecorator :: Traversable syntax + => Int -- ^ 'p'; the desired stem length for the grams. + -> Int -- ^ 'q'; the desired base length for the grams. + -> Term syntax (Record fields) -- ^ The term to decorate. + -> Term syntax (Record (Gram (Label syntax) ': fields)) -- ^ The decorated term. +pqGramDecorator p q = cata algebra where - algebra term = let label = getLabel term in + algebra term = let label = Label (termFOut term) in termIn (gram label :. termFAnnotation term) (assignParentAndSiblingLabels (termFOut term) label) gram label = Gram (padToSize p []) (padToSize q (pure (Just label))) assignParentAndSiblingLabels functor label = (`evalState` (replicate (q `div` 2) Nothing <> siblingLabels functor)) (for functor (assignLabels label)) assignLabels :: label - -> Term f (Record (Gram label ': fields)) - -> State [Maybe label] (Term f (Record (Gram label ': fields))) + -> Term syntax (Record (Gram label ': fields)) + -> State [Maybe label] (Term syntax (Record (Gram label ': fields))) assignLabels label (Term.Term (In (gram :. rest) functor)) = do labels <- get put (drop 1 labels) pure $! termIn (gram { stem = padToSize p (Just label : stem gram), base = padToSize q labels } :. rest) functor - siblingLabels :: Traversable f => f (Term f (Record (Gram label ': fields))) -> [Maybe label] + siblingLabels :: Traversable syntax => syntax (Term syntax (Record (Gram label ': fields))) -> [Maybe label] siblingLabels = foldMap (base . rhead . termAnnotation) padToSize n list = take n (list <> repeat empty) @@ -168,8 +162,13 @@ editDistanceUpTo m a b = diffCost m (approximateDiff a b) approximateDiff a b = maybe (replacing a b) (merge (termAnnotation a, termAnnotation b)) (galignWith (Just . these deleting inserting approximateDiff) (termOut a) (termOut b)) --- Instances +data Label syntax where + Label :: syntax a -> Label syntax -instance Hashable label => Hashable (Gram label) where - hashWithSalt _ = hash - hash gram = hash (stem gram <> base gram) +instance Hashable1 syntax => Hashable (Label syntax) where hashWithSalt salt (Label syntax) = liftHashWithSalt const salt syntax + +instance Eq1 syntax => Eq (Label syntax) where Label a == Label b = liftEq (const (const True)) a b + +instance Ord1 syntax => Ord (Label syntax) where Label a `compare` Label b = liftCompare (const (const EQ)) a b + +instance Show1 syntax => Show (Label syntax) where showsPrec d (Label syntax) = liftShowsPrec (const (const id)) (const id) d syntax diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs index 6434c5a40..3d2c6adba 100644 --- a/src/Diffing/Interpreter.hs +++ b/src/Diffing/Interpreter.hs @@ -4,7 +4,6 @@ module Diffing.Interpreter , diffTermPair ) where -import Analysis.Decorator import Control.Monad.Free.Freer import Data.Align.Generic (galignWith) import Data.Diff @@ -15,16 +14,16 @@ import Diffing.Algorithm.RWS import Prologue -- | Diff two à la carte terms recursively. -diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) +diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax) => Term syntax (Record fields1) -> Term syntax (Record fields2) -> Diff syntax (Record fields1) (Record fields2) diffTerms t1 t2 = stripDiff (fromMaybe (replacing t1' t2') (runAlgorithm (diff t1' t2'))) - where (t1', t2') = ( defaultFeatureVectorDecorator constructorNameAndConstantFields t1 - , defaultFeatureVectorDecorator constructorNameAndConstantFields t2) + where (t1', t2') = ( defaultFeatureVectorDecorator t1 + , defaultFeatureVectorDecorator t2) -- | Diff a 'These' of terms. -diffTermPair :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Diff syntax (Record fields1) (Record fields2) +diffTermPair :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Diff syntax (Record fields1) (Record fields2) diffTermPair = these deleting inserting diffTerms diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index e63810a07..0329ecad3 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -14,10 +14,10 @@ import Prologue import System.FilePath.Posix data Relative = Relative | NonRelative - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show) data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: Relative } - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show) importPath :: ByteString -> ImportPath importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (pathType path) @@ -57,7 +57,7 @@ resolveGoImport (ImportPath path NonRelative) = do -- -- If the list of symbols is empty copy everything to the calling environment. data Import a = Import { importFrom :: ImportPath, importWildcardToken :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Import where liftEq = genericLiftEq instance Ord1 Import where liftCompare = genericLiftCompare @@ -79,7 +79,7 @@ instance Evaluatable Import where -- -- If the list of symbols is empty copy and qualify everything to the calling environment. data QualifiedImport a = QualifiedImport { qualifiedImportFrom :: !ImportPath, qualifiedImportAlias :: !a} - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 QualifiedImport where liftEq = genericLiftEq instance Ord1 QualifiedImport where liftCompare = genericLiftCompare @@ -101,7 +101,7 @@ instance Evaluatable QualifiedImport where -- | Side effect only imports (no symbols made available to the calling environment). data SideEffectImport a = SideEffectImport { sideEffectImportFrom :: !ImportPath, sideEffectImportToken :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 SideEffectImport where liftEq = genericLiftEq instance Ord1 SideEffectImport where liftCompare = genericLiftCompare @@ -118,7 +118,7 @@ instance Evaluatable SideEffectImport where -- A composite literal in Go data Composite a = Composite { compositeType :: !a, compositeElement :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Composite where liftEq = genericLiftEq instance Ord1 Composite where liftCompare = genericLiftCompare @@ -131,7 +131,7 @@ instance Evaluatable Composite -- | A default pattern in a Go select or switch statement (e.g. `switch { default: s() }`). newtype DefaultPattern a = DefaultPattern { defaultPatternBody :: a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 DefaultPattern where liftEq = genericLiftEq instance Ord1 DefaultPattern where liftCompare = genericLiftCompare @@ -144,7 +144,7 @@ instance Evaluatable DefaultPattern -- | A defer statement in Go (e.g. `defer x()`). newtype Defer a = Defer { deferBody :: a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Defer where liftEq = genericLiftEq instance Ord1 Defer where liftCompare = genericLiftCompare @@ -157,7 +157,7 @@ instance Evaluatable Defer -- | A go statement (i.e. go routine) in Go (e.g. `go x()`). newtype Go a = Go { goBody :: a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Go where liftEq = genericLiftEq instance Ord1 Go where liftCompare = genericLiftCompare @@ -170,7 +170,7 @@ instance Evaluatable Go -- | A label statement in Go (e.g. `label:continue`). data Label a = Label { _labelName :: !a, labelStatement :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Label where liftEq = genericLiftEq instance Ord1 Label where liftCompare = genericLiftCompare @@ -183,7 +183,7 @@ instance Evaluatable Label -- | A rune literal in Go (e.g. `'⌘'`). newtype Rune a = Rune { _runeLiteral :: ByteString } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Rune @@ -196,7 +196,7 @@ instance Show1 Rune where liftShowsPrec = genericLiftShowsPrec -- | A select statement in Go (e.g. `select { case x := <-c: x() }` where each case is a send or receive operation on channels). newtype Select a = Select { selectCases :: a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Select @@ -209,7 +209,7 @@ instance Show1 Select where liftShowsPrec = genericLiftShowsPrec -- | A send statement in Go (e.g. `channel <- value`). data Send a = Send { sendReceiver :: !a, sendValue :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Send where liftEq = genericLiftEq instance Ord1 Send where liftCompare = genericLiftCompare @@ -222,7 +222,7 @@ instance Evaluatable Send -- | A slice expression in Go (e.g. `a[1:4:3]` where a is a list, 1 is the low bound, 4 is the high bound, and 3 is the max capacity). data Slice a = Slice { sliceName :: !a, sliceLow :: !a, sliceHigh :: !a, sliceCapacity :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Slice where liftEq = genericLiftEq instance Ord1 Slice where liftCompare = genericLiftCompare @@ -235,7 +235,7 @@ instance Evaluatable Slice -- | A type switch statement in Go (e.g. `switch x.(type) { // cases }`). data TypeSwitch a = TypeSwitch { typeSwitchSubject :: !a, typeSwitchCases :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeSwitch where liftEq = genericLiftEq instance Ord1 TypeSwitch where liftCompare = genericLiftCompare @@ -248,7 +248,7 @@ instance Evaluatable TypeSwitch -- | A type switch guard statement in a Go type switch statement (e.g. `switch i := x.(type) { // cases}`). newtype TypeSwitchGuard a = TypeSwitchGuard { typeSwitchGuardSubject :: a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare @@ -261,7 +261,7 @@ instance Evaluatable TypeSwitchGuard -- | A receive statement in a Go select statement (e.g. `case value := <-channel` ) data Receive a = Receive { receiveSubject :: !a, receiveExpression :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Receive where liftEq = genericLiftEq instance Ord1 Receive where liftCompare = genericLiftCompare @@ -274,7 +274,7 @@ instance Evaluatable Receive -- | A receive operator unary expression in Go (e.g. `<-channel` ) newtype ReceiveOperator a = ReceiveOperator a - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 ReceiveOperator where liftEq = genericLiftEq instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare @@ -287,7 +287,7 @@ instance Evaluatable ReceiveOperator -- | A field declaration in a Go struct type declaration. data Field a = Field { fieldContext :: ![a], fieldName :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Field where liftEq = genericLiftEq instance Ord1 Field where liftCompare = genericLiftCompare @@ -300,7 +300,7 @@ instance Evaluatable Field data Package a = Package { packageName :: !a, packageContents :: ![a] } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Package where liftEq = genericLiftEq instance Ord1 Package where liftCompare = genericLiftCompare @@ -314,7 +314,7 @@ instance Evaluatable Package where -- | A type assertion in Go (e.g. `x.(T)` where the value of `x` is not nil and is of type `T`). data TypeAssertion a = TypeAssertion { typeAssertionSubject :: !a, typeAssertionType :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeAssertion where liftEq = genericLiftEq instance Ord1 TypeAssertion where liftCompare = genericLiftCompare @@ -327,7 +327,7 @@ instance Evaluatable TypeAssertion -- | A type conversion expression in Go (e.g. `T(x)` where `T` is a type and `x` is an expression that can be converted to type `T`). data TypeConversion a = TypeConversion { typeConversionType :: !a, typeConversionSubject :: !a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeConversion where liftEq = genericLiftEq instance Ord1 TypeConversion where liftCompare = genericLiftCompare @@ -340,7 +340,7 @@ instance Evaluatable TypeConversion -- | Variadic arguments and parameters in Go (e.g. parameter: `param ...Type`, argument: `Type...`). data Variadic a = Variadic { variadicContext :: [a], variadicIdentifier :: a } - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Variadic where liftEq = genericLiftEq instance Ord1 Variadic where liftCompare = genericLiftCompare diff --git a/src/Language/Go/Type.hs b/src/Language/Go/Type.hs index 4859e9348..8f4e927a1 100644 --- a/src/Language/Go/Type.hs +++ b/src/Language/Go/Type.hs @@ -8,7 +8,7 @@ import Diffing.Algorithm -- | A Bidirectional channel in Go (e.g. `chan`). newtype BidirectionalChannel a = BidirectionalChannel a - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 BidirectionalChannel where liftEq = genericLiftEq instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare @@ -21,7 +21,7 @@ instance Evaluatable BidirectionalChannel -- | A Receive channel in Go (e.g. `<-chan`). newtype ReceiveChannel a = ReceiveChannel a - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 ReceiveChannel where liftEq = genericLiftEq instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare @@ -34,7 +34,7 @@ instance Evaluatable ReceiveChannel -- | A Send channel in Go (e.g. `chan<-`). newtype SendChannel a = SendChannel a - deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 SendChannel where liftEq = genericLiftEq instance Ord1 SendChannel where liftCompare = genericLiftCompare diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs index 5a8aa562b..c30627b31 100644 --- a/src/Language/Markdown/Syntax.hs +++ b/src/Language/Markdown/Syntax.hs @@ -7,7 +7,7 @@ import Data.JSON.Fields import Diffing.Algorithm newtype Document a = Document [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Document @@ -19,7 +19,7 @@ instance Show1 Document where liftShowsPrec = genericLiftShowsPrec -- Block elements newtype Paragraph a = Paragraph [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Paragraph @@ -28,7 +28,7 @@ instance Ord1 Paragraph where liftCompare = genericLiftCompare instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec data Heading a = Heading { headingLevel :: Int, headingContent :: [a], sectionContent :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Heading @@ -37,7 +37,7 @@ instance Ord1 Heading where liftCompare = genericLiftCompare instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec newtype UnorderedList a = UnorderedList [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 UnorderedList @@ -48,7 +48,7 @@ instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 OrderedList newtype OrderedList a = OrderedList [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 OrderedList where liftEq = genericLiftEq instance Ord1 OrderedList where liftCompare = genericLiftCompare @@ -57,7 +57,7 @@ instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 BlockQuote newtype BlockQuote a = BlockQuote [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 BlockQuote where liftEq = genericLiftEq instance Ord1 BlockQuote where liftCompare = genericLiftCompare @@ -66,7 +66,7 @@ instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 ThematicBreak data ThematicBreak a = ThematicBreak - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 ThematicBreak where liftEq = genericLiftEq instance Ord1 ThematicBreak where liftCompare = genericLiftCompare @@ -76,14 +76,14 @@ instance ToJSONFields1 HTMLBlock where toJSONFields1 (HTMLBlock b) = noChildren [ "asString" .= unpack b ] newtype HTMLBlock a = HTMLBlock ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 HTMLBlock where liftEq = genericLiftEq instance Ord1 HTMLBlock where liftCompare = genericLiftCompare instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec newtype Table a = Table [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Table @@ -92,7 +92,7 @@ instance Ord1 Table where liftCompare = genericLiftCompare instance Show1 Table where liftShowsPrec = genericLiftShowsPrec newtype TableRow a = TableRow [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 TableRow @@ -101,7 +101,7 @@ instance Ord1 TableRow where liftCompare = genericLiftCompare instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec newtype TableCell a = TableCell [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 TableCell @@ -113,7 +113,7 @@ instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec -- Inline elements newtype Strong a = Strong [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Strong @@ -122,7 +122,7 @@ instance Ord1 Strong where liftCompare = genericLiftCompare instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec newtype Emphasis a = Emphasis [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Emphasis @@ -131,7 +131,7 @@ instance Ord1 Emphasis where liftCompare = genericLiftCompare instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec newtype Text a = Text ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Text where toJSONFields1 (Text s) = noChildren ["asString" .= unpack s ] @@ -141,7 +141,7 @@ instance Ord1 Text where liftCompare = genericLiftCompare instance Show1 Text where liftShowsPrec = genericLiftShowsPrec data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) -- TODO: Better ToJSONFields1 instance instance ToJSONFields1 Link @@ -151,7 +151,7 @@ instance Ord1 Link where liftCompare = genericLiftCompare instance Show1 Link where liftShowsPrec = genericLiftShowsPrec data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) -- TODO: Better ToJSONFields1 instance instance ToJSONFields1 Image @@ -161,7 +161,7 @@ instance Ord1 Image where liftCompare = genericLiftCompare instance Show1 Image where liftShowsPrec = genericLiftShowsPrec data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) -- TODO: Better ToJSONFields1 instance instance ToJSONFields1 Code @@ -171,7 +171,7 @@ instance Ord1 Code where liftCompare = genericLiftCompare instance Show1 Code where liftShowsPrec = genericLiftShowsPrec data LineBreak a = LineBreak - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 LineBreak @@ -182,7 +182,7 @@ instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 Strikethrough newtype Strikethrough a = Strikethrough [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Strikethrough where liftEq = genericLiftEq instance Ord1 Strikethrough where liftCompare = genericLiftCompare diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 0e6ddf407..a8f9e6364 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -12,7 +12,7 @@ import Prelude hiding (fail) import Prologue hiding (Text) newtype Text a = Text ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Text where toJSONFields1 (Text t) = noChildren ["asString" .= BC.unpack t] @@ -24,7 +24,7 @@ instance Evaluatable Text newtype VariableName a = VariableName a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 VariableName @@ -78,7 +78,7 @@ include pathTerm f = do pure (Rval v) newtype Require a = Require a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Require where liftEq = genericLiftEq instance Ord1 Require where liftCompare = genericLiftCompare @@ -91,7 +91,7 @@ instance Evaluatable Require where newtype RequireOnce a = RequireOnce a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 RequireOnce where liftEq = genericLiftEq instance Ord1 RequireOnce where liftCompare = genericLiftCompare @@ -104,7 +104,7 @@ instance Evaluatable RequireOnce where newtype Include a = Include a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Include where liftEq = genericLiftEq instance Ord1 Include where liftCompare = genericLiftCompare @@ -117,7 +117,7 @@ instance Evaluatable Include where newtype IncludeOnce a = IncludeOnce a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 IncludeOnce where liftEq = genericLiftEq instance Ord1 IncludeOnce where liftCompare = genericLiftCompare @@ -130,7 +130,7 @@ instance Evaluatable IncludeOnce where newtype ArrayElement a = ArrayElement a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ArrayElement @@ -140,7 +140,7 @@ instance Show1 ArrayElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ArrayElement newtype GlobalDeclaration a = GlobalDeclaration [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 GlobalDeclaration @@ -150,7 +150,7 @@ instance Show1 GlobalDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable GlobalDeclaration newtype SimpleVariable a = SimpleVariable a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 SimpleVariable @@ -162,7 +162,7 @@ instance Evaluatable SimpleVariable -- | TODO: Unify with TypeScript's PredefinedType newtype CastType a = CastType { _castType :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 CastType @@ -172,7 +172,7 @@ instance Show1 CastType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable CastType newtype ErrorControl a = ErrorControl a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ErrorControl @@ -182,7 +182,7 @@ instance Show1 ErrorControl where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ErrorControl newtype Clone a = Clone a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Clone @@ -192,7 +192,7 @@ instance Show1 Clone where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Clone newtype ShellCommand a = ShellCommand ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ShellCommand @@ -203,7 +203,7 @@ instance Evaluatable ShellCommand -- | TODO: Combine with TypeScript update expression. newtype Update a = Update { _updateSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Update @@ -213,7 +213,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Update newtype NewVariable a = NewVariable [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 NewVariable @@ -223,7 +223,7 @@ instance Show1 NewVariable where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NewVariable newtype RelativeScope a = RelativeScope ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 RelativeScope @@ -233,7 +233,7 @@ instance Show1 RelativeScope where liftShowsPrec = genericLiftShowsPrec instance Evaluatable RelativeScope data QualifiedName a = QualifiedName !a !a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 QualifiedName @@ -249,6 +249,7 @@ newtype NamespaceName a = NamespaceName (NonEmpty a) instance ToJSONFields1 NamespaceName +instance Hashable1 NamespaceName where liftHashWithSalt = foldl instance Eq1 NamespaceName where liftEq = genericLiftEq instance Ord1 NamespaceName where liftCompare = genericLiftCompare instance Show1 NamespaceName where liftShowsPrec = genericLiftShowsPrec @@ -257,7 +258,7 @@ instance Evaluatable NamespaceName where eval (NamespaceName xs) = Rval <$> foldl1 evaluateInScopedEnv (fmap subtermValue xs) newtype ConstDeclaration a = ConstDeclaration [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ConstDeclaration @@ -267,7 +268,7 @@ instance Show1 ConstDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstDeclaration data ClassConstDeclaration a = ClassConstDeclaration a [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ClassConstDeclaration @@ -277,7 +278,7 @@ instance Show1 ClassConstDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassConstDeclaration newtype ClassInterfaceClause a = ClassInterfaceClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ClassInterfaceClause @@ -287,7 +288,7 @@ instance Show1 ClassInterfaceClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassInterfaceClause newtype ClassBaseClause a = ClassBaseClause a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ClassBaseClause @@ -298,7 +299,7 @@ instance Evaluatable ClassBaseClause newtype UseClause a = UseClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 UseClause @@ -308,7 +309,7 @@ instance Show1 UseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable UseClause newtype ReturnType a = ReturnType a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ReturnType @@ -318,7 +319,7 @@ instance Show1 ReturnType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ReturnType newtype TypeDeclaration a = TypeDeclaration a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 TypeDeclaration @@ -328,7 +329,7 @@ instance Show1 TypeDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeDeclaration newtype BaseTypeDeclaration a = BaseTypeDeclaration a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 BaseTypeDeclaration @@ -338,7 +339,7 @@ instance Show1 BaseTypeDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable BaseTypeDeclaration newtype ScalarType a = ScalarType ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ScalarType @@ -348,7 +349,7 @@ instance Show1 ScalarType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ScalarType newtype EmptyIntrinsic a = EmptyIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 EmptyIntrinsic @@ -358,7 +359,7 @@ instance Show1 EmptyIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EmptyIntrinsic newtype ExitIntrinsic a = ExitIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ExitIntrinsic @@ -368,7 +369,7 @@ instance Show1 ExitIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExitIntrinsic newtype IssetIntrinsic a = IssetIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 IssetIntrinsic @@ -378,7 +379,7 @@ instance Show1 IssetIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IssetIntrinsic newtype EvalIntrinsic a = EvalIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 EvalIntrinsic @@ -388,7 +389,7 @@ instance Show1 EvalIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EvalIntrinsic newtype PrintIntrinsic a = PrintIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 PrintIntrinsic @@ -398,7 +399,7 @@ instance Show1 PrintIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PrintIntrinsic newtype NamespaceAliasingClause a = NamespaceAliasingClause a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 NamespaceAliasingClause @@ -408,7 +409,7 @@ instance Show1 NamespaceAliasingClause where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceAliasingClause newtype NamespaceUseDeclaration a = NamespaceUseDeclaration [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 NamespaceUseDeclaration @@ -418,7 +419,7 @@ instance Show1 NamespaceUseDeclaration where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceUseDeclaration newtype NamespaceUseClause a = NamespaceUseClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 NamespaceUseClause @@ -428,7 +429,7 @@ instance Show1 NamespaceUseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NamespaceUseClause newtype NamespaceUseGroupClause a = NamespaceUseGroupClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 NamespaceUseGroupClause @@ -438,7 +439,7 @@ instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceUseGroupClause data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance Eq1 Namespace where liftEq = genericLiftEq instance Ord1 Namespace where liftCompare = genericLiftCompare @@ -459,7 +460,7 @@ instance Evaluatable Namespace where go xs <* makeNamespace name addr Nothing data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 TraitDeclaration @@ -469,7 +470,7 @@ instance Show1 TraitDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitDeclaration data AliasAs a = AliasAs { aliasAsName :: a, aliasAsModifier :: a, aliasAsClause :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 AliasAs @@ -479,7 +480,7 @@ instance Show1 AliasAs where liftShowsPrec = genericLiftShowsPrec instance Evaluatable AliasAs data InsteadOf a = InsteadOf a a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 InsteadOf @@ -489,7 +490,7 @@ instance Show1 InsteadOf where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InsteadOf newtype TraitUseSpecification a = TraitUseSpecification [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 TraitUseSpecification @@ -499,7 +500,7 @@ instance Show1 TraitUseSpecification where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitUseSpecification data TraitUseClause a = TraitUseClause [a] a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 TraitUseClause @@ -509,7 +510,7 @@ instance Show1 TraitUseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitUseClause data DestructorDeclaration a = DestructorDeclaration [a] a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 DestructorDeclaration @@ -519,7 +520,7 @@ instance Show1 DestructorDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DestructorDeclaration newtype Static a = Static ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Static @@ -529,7 +530,7 @@ instance Show1 Static where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Static newtype ClassModifier a = ClassModifier ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ClassModifier @@ -539,7 +540,7 @@ instance Show1 ClassModifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassModifier data ConstructorDeclaration a = ConstructorDeclaration [a] [a] a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 ConstructorDeclaration @@ -549,7 +550,7 @@ instance Show1 ConstructorDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstructorDeclaration data PropertyDeclaration a = PropertyDeclaration a [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 PropertyDeclaration @@ -559,7 +560,7 @@ instance Show1 PropertyDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertyDeclaration data PropertyModifier a = PropertyModifier a a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 PropertyModifier @@ -569,7 +570,7 @@ instance Show1 PropertyModifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertyModifier data InterfaceDeclaration a = InterfaceDeclaration a a [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 InterfaceDeclaration @@ -579,7 +580,7 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InterfaceDeclaration newtype InterfaceBaseClause a = InterfaceBaseClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 InterfaceBaseClause @@ -589,7 +590,7 @@ instance Show1 InterfaceBaseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InterfaceBaseClause newtype Echo a = Echo a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Echo @@ -599,7 +600,7 @@ instance Show1 Echo where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Echo newtype Unset a = Unset a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Unset @@ -609,7 +610,7 @@ instance Show1 Unset where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Unset data Declare a = Declare a a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 Declare @@ -619,7 +620,7 @@ instance Show1 Declare where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Declare newtype DeclareDirective a = DeclareDirective a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 DeclareDirective @@ -629,7 +630,7 @@ instance Show1 DeclareDirective where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DeclareDirective newtype LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) instance ToJSONFields1 LabeledStatement diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index b30276030..58004cd42 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -22,7 +22,7 @@ import System.FilePath.Posix data QualifiedName = QualifiedName (NonEmpty FilePath) | RelativeQualifiedName FilePath (Maybe QualifiedName) - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show) qualifiedName :: NonEmpty ByteString -> QualifiedName qualifiedName xs = QualifiedName (BC.unpack <$> xs) @@ -90,7 +90,7 @@ resolvePythonModules q = do -- -- If the list of symbols is empty copy everything to the calling environment. data Import a = Import { importFrom :: QualifiedName, importSymbols :: ![(Name, Name)] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Import @@ -146,7 +146,7 @@ evalQualifiedImport name path = letrec' name $ \addr -> do unit newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 QualifiedImport @@ -170,7 +170,7 @@ instance Evaluatable QualifiedImport where makeNamespace name addr Nothing data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 QualifiedAliasedImport @@ -197,7 +197,7 @@ instance Evaluatable QualifiedAliasedImport where -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell) data Ellipsis a = Ellipsis - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Ellipsis where liftEq = genericLiftEq instance Ord1 Ellipsis where liftCompare = genericLiftCompare @@ -210,7 +210,7 @@ instance Evaluatable Ellipsis data Redirect a = Redirect !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Redirect where liftEq = genericLiftEq instance Ord1 Redirect where liftCompare = genericLiftCompare diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index b5ed836dc..4a5a65aaf 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -43,7 +43,7 @@ cleanNameOrPath :: ByteString -> String cleanNameOrPath = BC.unpack . dropRelativePrefix . stripQuotes data Send a = Send { sendReceiver :: Maybe a, sendSelector :: Maybe a, sendArgs :: [a], sendBlock :: Maybe a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Send where liftEq = genericLiftEq instance Ord1 Send where liftCompare = genericLiftCompare @@ -60,7 +60,7 @@ instance Evaluatable Send where Rval <$> call func (map subtermValue sendArgs) -- TODO pass through sendBlock data Require a = Require { requireRelative :: Bool, requirePath :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Require where liftEq = genericLiftEq instance Ord1 Require where liftCompare = genericLiftCompare @@ -90,7 +90,7 @@ doRequire path = do newtype Load a = Load { loadArgs :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Load where liftEq = genericLiftEq instance Ord1 Load where liftCompare = genericLiftCompare @@ -129,7 +129,7 @@ doLoad path shouldWrap = do -- TODO: autoload data Class a = Class { classIdentifier :: !a, classSuperClass :: !(Maybe a), classBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Class @@ -148,7 +148,7 @@ instance Evaluatable Class where subtermValue classBody <* makeNamespace name addr super) data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Module where liftEq = genericLiftEq instance Ord1 Module where liftCompare = genericLiftCompare @@ -165,7 +165,7 @@ instance Evaluatable Module where data LowPrecedenceBoolean a = LowAnd !a !a | LowOr !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 LowPrecedenceBoolean diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 977fc97fc..e5dacea1c 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -17,10 +17,10 @@ import Prologue import System.FilePath.Posix data Relative = Relative | NonRelative - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show) data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: Relative } - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show) importPath :: ByteString -> ImportPath importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (pathType path) @@ -139,7 +139,7 @@ evalRequire modulePath alias = letrec' alias $ \addr -> do unit data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Import @@ -159,7 +159,7 @@ instance Evaluatable Import where | otherwise = Env.overwrite symbols importedEnv data JavaScriptRequire a = JavaScriptRequire { javascriptRequireIden :: !a, javascriptRequireFrom :: ImportPath } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 JavaScriptRequire where liftEq = genericLiftEq instance Ord1 JavaScriptRequire where liftCompare = genericLiftCompare @@ -175,7 +175,7 @@ instance Evaluatable JavaScriptRequire where data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportAlias :: !a, qualifiedAliasedImportFrom :: ImportPath } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare @@ -190,7 +190,7 @@ instance Evaluatable QualifiedAliasedImport where Rval <$> evalRequire modulePath alias newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 SideEffectImport where liftEq = genericLiftEq instance Ord1 SideEffectImport where liftCompare = genericLiftCompare @@ -207,7 +207,7 @@ instance Evaluatable SideEffectImport where -- | Qualified Export declarations newtype QualifiedExport a = QualifiedExport { qualifiedExportSymbols :: [(Name, Name)] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 QualifiedExport where liftEq = genericLiftEq instance Ord1 QualifiedExport where liftCompare = genericLiftCompare @@ -225,7 +225,7 @@ instance Evaluatable QualifiedExport where -- | Qualified Export declarations that export from another module. data QualifiedExportFrom a = QualifiedExportFrom { qualifiedExportFrom :: ImportPath, qualifiedExportFromSymbols :: ![(Name, Name)]} - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 QualifiedExportFrom where liftEq = genericLiftEq instance Ord1 QualifiedExportFrom where liftCompare = genericLiftCompare @@ -244,7 +244,7 @@ instance Evaluatable QualifiedExportFrom where Rval <$> unit newtype DefaultExport a = DefaultExport { defaultExport :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 DefaultExport @@ -267,7 +267,7 @@ instance Evaluatable DefaultExport where -- | Lookup type for a type-level key in a typescript map. data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 LookupType @@ -278,7 +278,7 @@ instance Evaluatable LookupType -- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo } newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ShorthandPropertyIdentifier @@ -288,7 +288,7 @@ instance Show1 ShorthandPropertyIdentifier where liftShowsPrec = genericLiftShow instance Evaluatable ShorthandPropertyIdentifier data Union a = Union { _unionLeft :: !a, _unionRight :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Language.TypeScript.Syntax.Union @@ -298,7 +298,7 @@ instance Show1 Language.TypeScript.Syntax.Union where liftShowsPrec = genericLif instance Evaluatable Language.TypeScript.Syntax.Union data Intersection a = Intersection { _intersectionLeft :: !a, _intersectionRight :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Intersection @@ -308,7 +308,7 @@ instance Show1 Intersection where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Intersection data FunctionType a = FunctionType { _functionTypeParameters :: !a, _functionFormalParameters :: ![a], _functionType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 FunctionType @@ -318,7 +318,7 @@ instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable FunctionType data AmbientFunction a = AmbientFunction { _ambientFunctionContext :: ![a], _ambientFunctionIdentifier :: !a, _ambientFunctionParameters :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 AmbientFunction @@ -328,7 +328,7 @@ instance Show1 AmbientFunction where liftShowsPrec = genericLiftShowsPrec instance Evaluatable AmbientFunction data ImportRequireClause a = ImportRequireClause { _importRequireIdentifier :: !a, _importRequireSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ImportRequireClause @@ -338,7 +338,7 @@ instance Show1 ImportRequireClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportRequireClause newtype ImportClause a = ImportClause { _importClauseElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ImportClause @@ -348,7 +348,7 @@ instance Show1 ImportClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportClause newtype Tuple a = Tuple { _tupleElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Tuple @@ -360,7 +360,7 @@ instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Tuple data Constructor a = Constructor { _constructorTypeParameters :: !a, _constructorFormalParameters :: ![a], _constructorType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Language.TypeScript.Syntax.Constructor @@ -370,7 +370,7 @@ instance Show1 Language.TypeScript.Syntax.Constructor where liftShowsPrec = gene instance Evaluatable Language.TypeScript.Syntax.Constructor data TypeParameter a = TypeParameter { _typeParameter :: !a, _typeParameterConstraint :: !a, _typeParameterDefaultType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 TypeParameter @@ -380,7 +380,7 @@ instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeParameter data TypeAssertion a = TypeAssertion { _typeAssertionParameters :: !a, _typeAssertionExpression :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 TypeAssertion @@ -390,7 +390,7 @@ instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeAssertion newtype Annotation a = Annotation { _annotationType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Annotation @@ -400,7 +400,7 @@ instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Annotation newtype Decorator a = Decorator { _decoratorTerm :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Decorator @@ -410,7 +410,7 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Decorator newtype ComputedPropertyName a = ComputedPropertyName a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ComputedPropertyName @@ -420,7 +420,7 @@ instance Show1 ComputedPropertyName where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ComputedPropertyName newtype Constraint a = Constraint { _constraintType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Constraint @@ -430,7 +430,7 @@ instance Show1 Constraint where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Constraint newtype DefaultType a = DefaultType { _defaultType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 DefaultType @@ -440,7 +440,7 @@ instance Show1 DefaultType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DefaultType newtype ParenthesizedType a = ParenthesizedType { _parenthesizedType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ParenthesizedType @@ -450,7 +450,7 @@ instance Show1 ParenthesizedType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ParenthesizedType newtype PredefinedType a = PredefinedType { _predefinedType :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 PredefinedType @@ -460,7 +460,7 @@ instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PredefinedType newtype TypeIdentifier a = TypeIdentifier ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 TypeIdentifier @@ -470,7 +470,7 @@ instance Show1 TypeIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeIdentifier data NestedIdentifier a = NestedIdentifier !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 NestedIdentifier @@ -480,7 +480,7 @@ instance Show1 NestedIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NestedIdentifier data NestedTypeIdentifier a = NestedTypeIdentifier !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 NestedTypeIdentifier @@ -490,7 +490,7 @@ instance Show1 NestedTypeIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NestedTypeIdentifier data GenericType a = GenericType { _genericTypeIdentifier :: !a, _genericTypeArguments :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 GenericType @@ -500,7 +500,7 @@ instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable GenericType data TypePredicate a = TypePredicate { _typePredicateIdentifier :: !a, _typePredicateType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 TypePredicate @@ -510,7 +510,7 @@ instance Show1 TypePredicate where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypePredicate newtype ObjectType a = ObjectType { _objectTypeElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ObjectType @@ -520,7 +520,7 @@ instance Show1 ObjectType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ObjectType data With a = With { _withExpression :: !a, _withBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 With @@ -530,7 +530,7 @@ instance Show1 With where liftShowsPrec = genericLiftShowsPrec instance Evaluatable With newtype AmbientDeclaration a = AmbientDeclaration { _ambientDeclarationBody :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 AmbientDeclaration @@ -542,7 +542,7 @@ instance Evaluatable AmbientDeclaration where eval (AmbientDeclaration body) = subtermRef body data EnumDeclaration a = EnumDeclaration { enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 EnumDeclaration @@ -555,7 +555,7 @@ instance Declarations a => Declarations (EnumDeclaration a) where declaredName EnumDeclaration{..} = declaredName enumDeclarationIdentifier newtype ExtendsClause a = ExtendsClause { _extendsClauses :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ExtendsClause @@ -565,7 +565,7 @@ instance Show1 ExtendsClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExtendsClause newtype ArrayType a = ArrayType { _arrayType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ArrayType @@ -575,7 +575,7 @@ instance Show1 ArrayType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ArrayType newtype FlowMaybeType a = FlowMaybeType { _flowMaybeType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 FlowMaybeType @@ -585,7 +585,7 @@ instance Show1 FlowMaybeType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable FlowMaybeType newtype TypeQuery a = TypeQuery { _typeQuerySubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 TypeQuery @@ -595,7 +595,7 @@ instance Show1 TypeQuery where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeQuery newtype IndexTypeQuery a = IndexTypeQuery { _indexTypeQuerySubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 IndexTypeQuery @@ -605,7 +605,7 @@ instance Show1 IndexTypeQuery where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IndexTypeQuery newtype TypeArguments a = TypeArguments { _typeArguments :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 TypeArguments @@ -615,7 +615,7 @@ instance Show1 TypeArguments where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeArguments newtype ThisType a = ThisType ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ThisType @@ -625,7 +625,7 @@ instance Show1 ThisType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ThisType newtype ExistentialType a = ExistentialType ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ExistentialType @@ -635,7 +635,7 @@ instance Show1 ExistentialType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExistentialType newtype LiteralType a = LiteralType { _literalTypeSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 LiteralType @@ -645,7 +645,7 @@ instance Show1 LiteralType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable LiteralType data PropertySignature a = PropertySignature { _modifiers :: ![a], _propertySignaturePropertyName :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 PropertySignature @@ -655,7 +655,7 @@ instance Show1 PropertySignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertySignature data CallSignature a = CallSignature { _callSignatureTypeParameters :: !a, _callSignatureParameters :: ![a], _callSignatureType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 CallSignature @@ -666,7 +666,7 @@ instance Evaluatable CallSignature -- | Todo: Move type params and type to context data ConstructSignature a = ConstructSignature { _constructSignatureTypeParameters :: !a, _constructSignatureParameters :: ![a], _constructSignatureType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ConstructSignature @@ -676,7 +676,7 @@ instance Show1 ConstructSignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstructSignature data IndexSignature a = IndexSignature { _indexSignatureSubject :: a, _indexSignatureType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 IndexSignature @@ -686,7 +686,7 @@ instance Show1 IndexSignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IndexSignature data AbstractMethodSignature a = AbstractMethodSignature { _abstractMethodSignatureContext :: ![a], _abstractMethodSignatureName :: !a, _abstractMethodSignatureParameters :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 AbstractMethodSignature @@ -696,7 +696,7 @@ instance Show1 AbstractMethodSignature where liftShowsPrec = genericLiftShowsPre instance Evaluatable AbstractMethodSignature data Debugger a = Debugger - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Debugger @@ -706,7 +706,7 @@ instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Debugger data ForOf a = ForOf { _forOfBinding :: !a, _forOfSubject :: !a, _forOfBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ForOf @@ -716,7 +716,7 @@ instance Show1 ForOf where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ForOf data This a = This - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 This @@ -726,7 +726,7 @@ instance Show1 This where liftShowsPrec = genericLiftShowsPrec instance Evaluatable This data LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: !a, _labeledStatementSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 LabeledStatement @@ -736,7 +736,7 @@ instance Show1 LabeledStatement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable LabeledStatement newtype Update a = Update { _updateSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Update @@ -746,7 +746,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Update data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 Module where liftEq = genericLiftEq instance Ord1 Module where liftCompare = genericLiftCompare @@ -763,7 +763,7 @@ instance Evaluatable Module where data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 InternalModule where liftEq = genericLiftEq instance Ord1 InternalModule where liftCompare = genericLiftCompare @@ -782,7 +782,7 @@ instance Declarations a => Declarations (InternalModule a) where data ImportAlias a = ImportAlias { _importAliasSubject :: !a, _importAlias :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ImportAlias @@ -792,7 +792,7 @@ instance Show1 ImportAlias where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportAlias data Super a = Super - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Super @@ -802,7 +802,7 @@ instance Show1 Super where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Super data Undefined a = Undefined - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 Undefined @@ -812,7 +812,7 @@ instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Undefined data ClassHeritage a = ClassHeritage { _classHeritageExtendsClause :: !a, _implementsClause :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ClassHeritage @@ -822,7 +822,7 @@ instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassHeritage data AbstractClass a = AbstractClass { abstractClassIdentifier :: !a, _abstractClassTypeParameters :: !a, classHeritage :: ![a], classBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance Eq1 AbstractClass where liftEq = genericLiftEq instance Ord1 AbstractClass where liftCompare = genericLiftCompare @@ -844,7 +844,7 @@ instance Evaluatable AbstractClass where data JsxElement a = JsxElement { _jsxOpeningElement :: !a, _jsxElements :: ![a], _jsxClosingElement :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxElement @@ -854,7 +854,7 @@ instance Show1 JsxElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxElement newtype JsxText a = JsxText ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxText @@ -864,7 +864,7 @@ instance Show1 JsxText where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxText newtype JsxExpression a = JsxExpression { _jsxExpression :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxExpression @@ -874,7 +874,7 @@ instance Show1 JsxExpression where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxExpression data JsxOpeningElement a = JsxOpeningElement { _jsxOpeningElementIdentifier :: !a, _jsxAttributes :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxOpeningElement @@ -884,7 +884,7 @@ instance Show1 JsxOpeningElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxOpeningElement newtype JsxClosingElement a = JsxClosingElement { _jsxClosingElementIdentifier :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxClosingElement @@ -894,7 +894,7 @@ instance Show1 JsxClosingElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxClosingElement data JsxSelfClosingElement a = JsxSelfClosingElement { _jsxSelfClosingElementIdentifier :: !a, _jsxSelfClosingElementAttributes :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxSelfClosingElement @@ -904,7 +904,7 @@ instance Show1 JsxSelfClosingElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxSelfClosingElement data JsxAttribute a = JsxAttribute { _jsxAttributeTarget :: !a, _jsxAttributeValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxAttribute @@ -914,7 +914,7 @@ instance Show1 JsxAttribute where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxAttribute newtype ImplementsClause a = ImplementsClause { _implementsClauseTypes :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 ImplementsClause @@ -924,7 +924,7 @@ instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImplementsClause data OptionalParameter a = OptionalParameter { _optionalParameterContext :: ![a], _optionalParameterSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 OptionalParameter @@ -934,7 +934,7 @@ instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable OptionalParameter data RequiredParameter a = RequiredParameter { _requiredParameterContext :: ![a], _requiredParameterSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 RequiredParameter @@ -944,7 +944,7 @@ instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable RequiredParameter data RestParameter a = RestParameter { _restParameterContext :: ![a], _restParameterSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 RestParameter @@ -954,7 +954,7 @@ instance Show1 RestParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable RestParameter newtype JsxFragment a = JsxFragment [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxFragment @@ -964,7 +964,7 @@ instance Show1 JsxFragment where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxFragment data JsxNamespaceName a = JsxNamespaceName a a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) instance ToJSONFields1 JsxNamespaceName diff --git a/src/Prologue.hs b/src/Prologue.hs index d6a8d976a..2f4a4dc16 100644 --- a/src/Prologue.hs +++ b/src/Prologue.hs @@ -46,6 +46,7 @@ import Data.Functor.Classes as X import Data.Functor.Classes.Generic as X import Data.Functor.Foldable as X (Base, Corecursive (..), Recursive (..)) import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt) +import Data.Hashable.Lifted as X (Hashable1(..), hashWithSalt1) import Data.Mergeable as X (Mergeable) import Data.Monoid as X (First (..), Last (..), Monoid (..)) import Data.Proxy as X (Proxy (..)) diff --git a/src/Semantic/Diff.hs b/src/Semantic/Diff.hs index 249784926..96ef9b985 100644 --- a/src/Semantic/Diff.hs +++ b/src/Semantic/Diff.hs @@ -33,22 +33,22 @@ withSomeTermPair :: (forall syntax . ApplyAll typeclasses syntax => Join These ( withSomeTermPair with (SomeTermPair terms) = with terms withParsedBlobPairs :: (Members '[Distribute WrappedTask, Exc SomeException, IO, Task, Telemetry] effs, Monoid output) - => (forall syntax . (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax) => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) - -> (forall syntax . (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax) => BlobPair -> Diff syntax (Record fields) (Record fields) -> TaskEff output) + => (forall syntax . (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Hashable1 syntax, ToJSONFields1 syntax, Traversable syntax) => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) + -> (forall syntax . (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Hashable1 syntax, ToJSONFields1 syntax, Traversable syntax) => BlobPair -> Diff syntax (Record fields) (Record fields) -> TaskEff output) -> [BlobPair] -> Eff effs output withParsedBlobPairs decorate render = distributeFoldMap (\ blobs -> WrapTask (withParsedBlobPair decorate blobs >>= withSomeTermPair (diffTerms blobs >=> render blobs))) - where diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Members '[IO, Task, Telemetry] effs) => BlobPair -> Join These (Term syntax (Record fields)) -> Eff effs (Diff syntax (Record fields) (Record fields)) + where diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax, Members '[IO, Task, Telemetry] effs) => BlobPair -> Join These (Term syntax (Record fields)) -> Eff effs (Diff syntax (Record fields) (Record fields)) diffTerms blobs terms = time "diff" languageTag $ do diff <- diff (runJoin terms) diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag) where languageTag = languageTagForBlobPair blobs withParsedBlobPair :: Members '[Distribute WrappedTask, Exc SomeException, Task] effs - => (forall syntax . (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax) => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) + => (forall syntax . (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Hashable1 syntax, ToJSONFields1 syntax, Traversable syntax) => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) -> BlobPair - -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable] (Record fields)) + -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Hashable1, ToJSONFields1, Traversable] (Record fields)) withParsedBlobPair decorate blobs - | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs + | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Hashable1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs = SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob)) | otherwise = noLanguageForBlob (pathForBlobPair blobs) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index be8864242..1ed7bc300 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -104,7 +104,7 @@ decorate :: (Functor f, Member Task effs) => RAlgebra (TermF f (Record fields)) decorate algebra = send . Decorate algebra -- | A task which diffs a pair of terms using the supplied 'Differ' function. -diff :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Member Task effs) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Eff effs (Diff syntax (Record fields1) (Record fields2)) +diff :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax, Member Task effs) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Eff effs (Diff syntax (Record fields1) (Record fields2)) diff terms = send (Semantic.Task.Diff terms) -- | A task which renders some input using the supplied 'Renderer' function. @@ -147,7 +147,7 @@ data Task output where Parse :: Parser term -> Blob -> Task term Analyze :: (Analysis.TermEvaluator term location value effects a -> result) -> Analysis.TermEvaluator term location value effects a -> Task result Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> Task (Term f (Record (field ': fields))) - Diff :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Task (Diff syntax (Record fields1) (Record fields2)) + Diff :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Task (Diff syntax (Record fields1) (Record fields2)) Render :: Renderer input output -> input -> Task output Serialize :: Format input -> input -> Task Builder diff --git a/test/Diffing/Algorithm/RWS/Spec.hs b/test/Diffing/Algorithm/RWS/Spec.hs index 036e1e513..bcecbc523 100644 --- a/test/Diffing/Algorithm/RWS/Spec.hs +++ b/test/Diffing/Algorithm/RWS/Spec.hs @@ -20,10 +20,10 @@ spec = parallel $ do let positively = succ . abs describe "pqGramDecorator" $ do prop "produces grams with stems of the specified length" $ - \ (term, p, q) -> pqGramDecorator constructorNameAndConstantFields (positively p) (positively q) (term :: Term ListableSyntax (Record '[])) `shouldSatisfy` all ((== positively p) . length . stem . rhead) + \ (term, p, q) -> pqGramDecorator (positively p) (positively q) (term :: Term ListableSyntax (Record '[])) `shouldSatisfy` all ((== positively p) . length . stem . rhead) prop "produces grams with bases of the specified width" $ - \ (term, p, q) -> pqGramDecorator constructorNameAndConstantFields (positively p) (positively q) (term :: Term ListableSyntax (Record '[])) `shouldSatisfy` all ((== positively q) . length . base . rhead) + \ (term, p, q) -> pqGramDecorator (positively p) (positively q) (term :: Term ListableSyntax (Record '[])) `shouldSatisfy` all ((== positively q) . length . base . rhead) describe "rws" $ do prop "produces correct diffs" $ @@ -37,6 +37,6 @@ spec = parallel $ do let (a, b) = (decorate (termIn Nil (injectSum [ termIn Nil (injectSum (Syntax.Identifier "a")) ])), decorate (termIn Nil (injectSum [ termIn Nil (injectSum (Syntax.Identifier "b")) ]))) in fmap (bimap stripTerm stripTerm) (rws comparableTerms (equalTerms comparableTerms) [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ] - where decorate = defaultFeatureVectorDecorator constructorNameAndConstantFields + where decorate = defaultFeatureVectorDecorator diffThese = these deleting inserting replacing diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 736778d27..ec10fce16 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -8,6 +8,7 @@ import Data.Bifunctor import Data.Bifunctor.Join import Data.Diff import Data.Functor.Classes +import Data.Hashable.Lifted import Data.Patch import Data.Range import Data.Record @@ -241,6 +242,7 @@ diffWithParser :: ( HasField fields Data.Span.Span , Diffable syntax , GAlign syntax , HasDeclaration syntax + , Hashable1 syntax , Members '[Distribute WrappedTask, Task] effs ) => Parser (Term syntax (Record fields)) diff --git a/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt b/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt index 916777096..86a1afb3e 100644 --- a/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt +++ b/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt @@ -11,9 +11,9 @@ (Array (Identifier)) ( - { (Integer) - ->(Integer) } + {+(Integer)+} {+(Integer)+} { (Integer) ->(Integer) } + {-(Integer)-} {-(Integer)-}))))) diff --git a/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt b/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt index 100233173..0a6a38f42 100644 --- a/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt +++ b/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt @@ -11,9 +11,9 @@ (Array (Identifier)) ( + {+(Integer)+} + { (Integer) + ->(Integer) } { (Integer) ->(Integer) } - {+(Integer)+} - {+(Integer)+} - {-(Integer)-} {-(Integer)-}))))) diff --git a/test/fixtures/go/corpus/assignment-statements.diffB-A.txt b/test/fixtures/go/corpus/assignment-statements.diffB-A.txt index 0cf9814ad..a6bc14a38 100644 --- a/test/fixtures/go/corpus/assignment-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/assignment-statements.diffB-A.txt @@ -55,15 +55,11 @@ {+(BXOr {+(Identifier)+} {+(Integer)+})+})+} - (Assignment - { (Identifier) - ->(Identifier) } - { (Times - {-(Identifier)-} - {-(Integer)-}) - ->(Modulo + {+(Assignment + {+(Identifier)+} + {+(Modulo {+(Identifier)+} - {+(Integer)+}) }) + {+(Integer)+})+})+} {+(Assignment {+(Identifier)+} {+(Not @@ -82,6 +78,11 @@ {+(KeyValue {+(Identifier)+} {+(Integer)+})+})+})+})+})+})+} + {-(Assignment + {-(Identifier)-} + {-(Times + {-(Identifier)-} + {-(Integer)-})-})-} {-(Assignment {-(Identifier)-} {-(Plus diff --git a/test/fixtures/go/corpus/binary-expressions.diffA-B.txt b/test/fixtures/go/corpus/binary-expressions.diffA-B.txt index 94735c26b..87826e83a 100644 --- a/test/fixtures/go/corpus/binary-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/binary-expressions.diffA-B.txt @@ -33,20 +33,15 @@ ->(Identifier) } { (Identifier) ->(Identifier) })) - (LessThan - { (Identifier) - ->(Identifier) } - { (Identifier) - ->(Identifier) }) + {+(LessThan + {+(Identifier)+} + {+(Identifier)+})+} {+(LessThanEqual {+(Identifier)+} {+(Identifier)+})+} - { (LessThanEqual - {-(Identifier)-} - {-(Identifier)-}) - ->(GreaterThan + {+(GreaterThan {+(Identifier)+} - {+(Identifier)+}) } + {+(Identifier)+})+} {+(GreaterThanEqual {+(Identifier)+} {+(Identifier)+})+} @@ -83,6 +78,12 @@ {+(BAnd {+(Identifier)+} {+(Identifier)+})+} + {-(LessThan + {-(Identifier)-} + {-(Identifier)-})-} + {-(LessThanEqual + {-(Identifier)-} + {-(Identifier)-})-} {-(GreaterThan {-(Identifier)-} {-(Identifier)-})-} diff --git a/test/fixtures/go/corpus/binary-expressions.diffB-A.txt b/test/fixtures/go/corpus/binary-expressions.diffB-A.txt index 747bd93a8..87826e83a 100644 --- a/test/fixtures/go/corpus/binary-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/binary-expressions.diffB-A.txt @@ -33,11 +33,9 @@ ->(Identifier) } { (Identifier) ->(Identifier) })) - (LessThan - { (Identifier) - ->(Identifier) } - { (Identifier) - ->(Identifier) }) + {+(LessThan + {+(Identifier)+} + {+(Identifier)+})+} {+(LessThanEqual {+(Identifier)+} {+(Identifier)+})+} @@ -80,6 +78,9 @@ {+(BAnd {+(Identifier)+} {+(Identifier)+})+} + {-(LessThan + {-(Identifier)-} + {-(Identifier)-})-} {-(LessThanEqual {-(Identifier)-} {-(Identifier)-})-} diff --git a/test/fixtures/go/corpus/call-expressions.diffA-B.txt b/test/fixtures/go/corpus/call-expressions.diffA-B.txt index dba40102d..55b943cf5 100644 --- a/test/fixtures/go/corpus/call-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/call-expressions.diffA-B.txt @@ -21,14 +21,20 @@ (Identifier) (Identifier)) (Empty)) - (Call - { (Identifier) - ->(Identifier) } - ( - (Identifier) - (Variadic - (Identifier))) - (Empty)) + {+(Call + {+(Identifier)+} + {+( + {+(Identifier)+} + {+(Variadic + {+(Identifier)+})+})+} + {+(Empty)+})+} + {-(Call + {-(Identifier)-} + {-( + {-(Identifier)-} + {-(Variadic + {-(Identifier)-})-})-} + {-(Empty)-})-} {-(Call {-(Identifier)-} {-([])-} diff --git a/test/fixtures/go/corpus/call-expressions.diffB-A.txt b/test/fixtures/go/corpus/call-expressions.diffB-A.txt index e5e5e9b09..890ada670 100644 --- a/test/fixtures/go/corpus/call-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/call-expressions.diffB-A.txt @@ -21,15 +21,19 @@ (Identifier) (Identifier)) (Empty)) + {+(Call + {+(Identifier)+} + {+( + {+(Identifier)+} + {+(Variadic + {+(Identifier)+})+})+} + {+(Empty)+})+} (Call { (Identifier) ->(Identifier) } - ( - (Identifier) - (Variadic - (Identifier))) - (Empty)) - {+(Call - {+(Identifier)+} {+([])+} - {+(Empty)+})+}))) + {-( + {-(Identifier)-} + {-(Variadic + {-(Identifier)-})-})-} + (Empty))))) diff --git a/test/fixtures/go/corpus/channel-types.diffA-B.txt b/test/fixtures/go/corpus/channel-types.diffA-B.txt index 7bfa15a23..2f198a1aa 100644 --- a/test/fixtures/go/corpus/channel-types.diffA-B.txt +++ b/test/fixtures/go/corpus/channel-types.diffA-B.txt @@ -6,38 +6,58 @@ (Identifier) ([]) ( + {+(Type + {+(Identifier)+} + {+(BidirectionalChannel + {+(ReceiveChannel + {+(Identifier)+})+})+})+} + {+(Type + {+(Identifier)+} + {+(SendChannel + {+(SendChannel + {+(Constructor + {+(Empty)+} + {+([])+})+})+})+})+} (Type { (Identifier) ->(Identifier) } - (BidirectionalChannel - (ReceiveChannel - { (Identifier) - ->(Identifier) }))) - (Type - { (Identifier) - ->(Identifier) } - (SendChannel - (SendChannel - (Constructor - (Empty) - ([]))))) - (Type - { (Identifier) - ->(Identifier) } - (SendChannel - (ReceiveChannel - { (Identifier) - ->(Identifier) }))) - (Type - (Identifier) - (ReceiveChannel - (ReceiveChannel - { (Identifier) - ->(Identifier) }))) - (Type - (Identifier) - (BidirectionalChannel - (Parenthesized - (ReceiveChannel - { (Identifier) - ->(Identifier) }))))))) + { (BidirectionalChannel + {-(ReceiveChannel + {-(Identifier)-})-}) + ->(SendChannel + {+(ReceiveChannel + {+(Identifier)+})+}) }) + {+(Type + {+(Identifier)+} + {+(ReceiveChannel + {+(ReceiveChannel + {+(Identifier)+})+})+})+} + {+(Type + {+(Identifier)+} + {+(BidirectionalChannel + {+(Parenthesized + {+(ReceiveChannel + {+(Identifier)+})+})+})+})+} + {-(Type + {-(Identifier)-} + {-(SendChannel + {-(SendChannel + {-(Constructor + {-(Empty)-} + {-([])-})-})-})-})-} + {-(Type + {-(Identifier)-} + {-(SendChannel + {-(ReceiveChannel + {-(Identifier)-})-})-})-} + {-(Type + {-(Identifier)-} + {-(ReceiveChannel + {-(ReceiveChannel + {-(Identifier)-})-})-})-} + {-(Type + {-(Identifier)-} + {-(BidirectionalChannel + {-(Parenthesized + {-(ReceiveChannel + {-(Identifier)-})-})-})-})-}))) diff --git a/test/fixtures/go/corpus/channel-types.diffB-A.txt b/test/fixtures/go/corpus/channel-types.diffB-A.txt index 7bfa15a23..d79b712da 100644 --- a/test/fixtures/go/corpus/channel-types.diffB-A.txt +++ b/test/fixtures/go/corpus/channel-types.diffB-A.txt @@ -6,38 +6,59 @@ (Identifier) ([]) ( - (Type - { (Identifier) - ->(Identifier) } - (BidirectionalChannel - (ReceiveChannel - { (Identifier) - ->(Identifier) }))) - (Type - { (Identifier) - ->(Identifier) } - (SendChannel - (SendChannel - (Constructor - (Empty) - ([]))))) - (Type - { (Identifier) - ->(Identifier) } - (SendChannel - (ReceiveChannel - { (Identifier) - ->(Identifier) }))) - (Type - (Identifier) - (ReceiveChannel - (ReceiveChannel - { (Identifier) - ->(Identifier) }))) - (Type - (Identifier) - (BidirectionalChannel - (Parenthesized - (ReceiveChannel - { (Identifier) - ->(Identifier) }))))))) + {+(Type + {+(Identifier)+} + {+(BidirectionalChannel + {+(ReceiveChannel + {+(Identifier)+})+})+})+} + {+(Type + {+(Identifier)+} + {+(SendChannel + {+(SendChannel + {+(Constructor + {+(Empty)+} + {+([])+})+})+})+})+} + {+(Type + {+(Identifier)+} + {+(SendChannel + {+(ReceiveChannel + {+(Identifier)+})+})+})+} + {+(Type + {+(Identifier)+} + {+(ReceiveChannel + {+(ReceiveChannel + {+(Identifier)+})+})+})+} + {+(Type + {+(Identifier)+} + {+(BidirectionalChannel + {+(Parenthesized + {+(ReceiveChannel + {+(Identifier)+})+})+})+})+} + {-(Type + {-(Identifier)-} + {-(BidirectionalChannel + {-(ReceiveChannel + {-(Identifier)-})-})-})-} + {-(Type + {-(Identifier)-} + {-(SendChannel + {-(SendChannel + {-(Constructor + {-(Empty)-} + {-([])-})-})-})-})-} + {-(Type + {-(Identifier)-} + {-(SendChannel + {-(ReceiveChannel + {-(Identifier)-})-})-})-} + {-(Type + {-(Identifier)-} + {-(ReceiveChannel + {-(ReceiveChannel + {-(Identifier)-})-})-})-} + {-(Type + {-(Identifier)-} + {-(BidirectionalChannel + {-(Parenthesized + {-(ReceiveChannel + {-(Identifier)-})-})-})-})-}))) diff --git a/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt b/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt index 536258191..20efc4b51 100644 --- a/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt +++ b/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt @@ -14,10 +14,12 @@ ->(Identifier) } { (Identifier) ->([]) }) - (Assignment - { (Identifier) - ->(Identifier) } - ([])) + {+(Assignment + {+(Identifier)+} + {+([])+})+} + {-(Assignment + {-(Identifier)-} + {-([])-})-} {-(Assignment {-(Identifier)-} {-([])-})-}))) diff --git a/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt b/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt index e36dffe71..d5e6076f3 100644 --- a/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt @@ -6,10 +6,10 @@ {+(Identifier)+})+} {+(Import {+(TextElement)+})+} - { (QualifiedImport - {-(Identifier)-}) - ->(QualifiedImport - {+(Identifier)+}) } + {+(QualifiedImport + {+(Identifier)+})+} + {-(QualifiedImport + {-(Identifier)-})-} {-(Import {-(TextElement)-})-} {-(QualifiedImport diff --git a/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt b/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt index e36dffe71..d5e6076f3 100644 --- a/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt @@ -6,10 +6,10 @@ {+(Identifier)+})+} {+(Import {+(TextElement)+})+} - { (QualifiedImport - {-(Identifier)-}) - ->(QualifiedImport - {+(Identifier)+}) } + {+(QualifiedImport + {+(Identifier)+})+} + {-(QualifiedImport + {-(Identifier)-})-} {-(Import {-(TextElement)-})-} {-(QualifiedImport diff --git a/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt b/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt index 6e0ecab67..708a431ba 100644 --- a/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt @@ -1,18 +1,18 @@ (Program (Package (Identifier)) -{+(QualifiedImport - {+(Identifier)+})+} -{+(Import - {+(TextElement)+})+} -{+(QualifiedImport - {+(Identifier)+})+} -{-(QualifiedImport - {-(Identifier)-})-} -{-(Import - {-(TextElement)-})-} -{-(QualifiedImport - {-(Identifier)-})-} +{ (QualifiedImport + {-(Identifier)-}) +->(QualifiedImport + {+(Identifier)+}) } +{ (Import + {-(TextElement)-}) +->(Import + {+(TextElement)+}) } +{ (QualifiedImport + {-(Identifier)-}) +->(QualifiedImport + {+(Identifier)+}) } (Function (Empty) (Identifier) diff --git a/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt b/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt index 6e0ecab67..708a431ba 100644 --- a/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt @@ -1,18 +1,18 @@ (Program (Package (Identifier)) -{+(QualifiedImport - {+(Identifier)+})+} -{+(Import - {+(TextElement)+})+} -{+(QualifiedImport - {+(Identifier)+})+} -{-(QualifiedImport - {-(Identifier)-})-} -{-(Import - {-(TextElement)-})-} -{-(QualifiedImport - {-(Identifier)-})-} +{ (QualifiedImport + {-(Identifier)-}) +->(QualifiedImport + {+(Identifier)+}) } +{ (Import + {-(TextElement)-}) +->(Import + {+(TextElement)+}) } +{ (QualifiedImport + {-(Identifier)-}) +->(QualifiedImport + {+(Identifier)+}) } (Function (Empty) (Identifier) diff --git a/test/fixtures/go/corpus/slice-expressions.diffA-B.txt b/test/fixtures/go/corpus/slice-expressions.diffA-B.txt index 6dbaf1a84..8307a41d4 100644 --- a/test/fixtures/go/corpus/slice-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/slice-expressions.diffA-B.txt @@ -6,50 +6,36 @@ (Identifier) ([]) ( - {+(Slice - {+(Identifier)+} - {+(Integer)+} - {+(Empty)+} - {+(Empty)+})+} (Slice - { (Identifier) - ->(Identifier) } + (Identifier) { (Integer) - ->(Empty) } + ->(Integer) } + (Empty) + (Empty)) + (Slice + (Identifier) + (Empty) + { (Integer) + ->(Integer) } + (Empty)) + (Slice + (Identifier) + { (Empty) + ->(Integer) } { (Empty) ->(Integer) } (Empty)) - {+(Slice - {+(Identifier)+} - {+(Integer)+} - {+(Integer)+} - {+(Empty)+})+} (Slice - { (Identifier) - ->(Identifier) } - { (Empty) + (Identifier) + { (Integer) ->(Integer) } { (Integer) ->(Integer) } - { (Empty) + { (Integer) ->(Integer) }) - {+(Slice - {+(Identifier)+} - {+(Integer)+} - {+(Integer)+} - {+(Empty)+})+} - {-(Slice - {-(Identifier)-} - {-(Empty)-} - {-(Empty)-} - {-(Empty)-})-} - {-(Slice - {-(Identifier)-} - {-(Integer)-} - {-(Integer)-} - {-(Integer)-})-} - {-(Slice - {-(Identifier)-} - {-(Integer)-} - {-(Integer)-} - {-(Empty)-})-}))) + (Slice + { (Identifier) + ->(Identifier) } + (Integer) + (Integer) + (Empty))))) diff --git a/test/fixtures/go/corpus/slice-expressions.diffB-A.txt b/test/fixtures/go/corpus/slice-expressions.diffB-A.txt index 1a4e0f8b1..1a7a99db8 100644 --- a/test/fixtures/go/corpus/slice-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/slice-expressions.diffB-A.txt @@ -6,51 +6,36 @@ (Identifier) ([]) ( - {+(Slice - {+(Identifier)+} - {+(Integer)+} - {+(Empty)+} - {+(Empty)+})+} - {+(Slice - {+(Identifier)+} - {+(Empty)+} - {+(Integer)+} - {+(Empty)+})+} - {+(Slice - {+(Identifier)+} - {+(Empty)+} - {+(Empty)+} - {+(Empty)+})+} + (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) ->(Identifier) } (Integer) - { (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)-})-}))) + (Integer) + (Empty))))) diff --git a/test/fixtures/go/corpus/switch-statements.diffA-B.txt b/test/fixtures/go/corpus/switch-statements.diffA-B.txt index 9e63c7da6..f64cd3be8 100644 --- a/test/fixtures/go/corpus/switch-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/switch-statements.diffA-B.txt @@ -18,27 +18,39 @@ (Identifier) ([]) (Empty))) - (Pattern - (LessThan - { (Identifier) - ->(Identifier) } - { (Identifier) - ->(Identifier) }) + {+(Pattern + {+(LessThan + {+(Identifier)+} + {+(Identifier)+})+} + {+(Call + {+(Identifier)+} + {+([])+} + {+(Empty)+})+})+} + {+(Pattern + {+(Equal + {+(Identifier)+} + {+(Integer)+})+} + {+(Call + {+(Identifier)+} + {+([])+} + {+(Empty)+})+})+} + {-(Pattern + {-(LessThan + {-(Identifier)-} + {-(Identifier)-})-} {-(Context {-(Comment)-} - (Call - (Identifier) - ([]) - (Empty)))-}) + {-(Call + {-(Identifier)-} + {-([])-} + {-(Empty)-})-})-})-} {-(Context {-(Comment)-} - (Pattern - (Equal - { (Identifier) - ->(Identifier) } - (Integer)) - (Call - { (Identifier) - ->(Identifier) } - ([]) - (Empty))))-})))) + {-(Pattern + {-(Equal + {-(Identifier)-} + {-(Integer)-})-} + {-(Call + {-(Identifier)-} + {-([])-} + {-(Empty)-})-})-})-})))) diff --git a/test/fixtures/go/corpus/switch-statements.diffB-A.txt b/test/fixtures/go/corpus/switch-statements.diffB-A.txt index 1b3d8de5b..bb02af14b 100644 --- a/test/fixtures/go/corpus/switch-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/switch-statements.diffB-A.txt @@ -18,27 +18,35 @@ (Identifier) ([]) (Empty))) - (Pattern - (LessThan - { (Identifier) - ->(Identifier) } - { (Identifier) - ->(Identifier) }) + {+(Pattern + {+(LessThan + {+(Identifier)+} + {+(Identifier)+})+} {+(Context {+(Comment)+} - (Call - (Identifier) - ([]) - (Empty)))+}) + {+(Call + {+(Identifier)+} + {+([])+} + {+(Empty)+})+})+})+} {+(Context {+(Comment)+} (Pattern - (Equal - { (Identifier) - ->(Identifier) } - (Integer)) + { (LessThan + {-(Identifier)-} + {-(Identifier)-}) + ->(Equal + {+(Identifier)+} + {+(Integer)+}) } (Call { (Identifier) ->(Identifier) } ([]) - (Empty))))+})))) + (Empty))))+} + {-(Pattern + {-(Equal + {-(Identifier)-} + {-(Integer)-})-} + {-(Call + {-(Identifier)-} + {-([])-} + {-(Empty)-})-})-})))) diff --git a/test/fixtures/javascript/corpus/export.diffA-B.txt b/test/fixtures/javascript/corpus/export.diffA-B.txt index c988c24cc..4e6aea904 100644 --- a/test/fixtures/javascript/corpus/export.diffA-B.txt +++ b/test/fixtures/javascript/corpus/export.diffA-B.txt @@ -35,15 +35,15 @@ (Identifier) { (Empty) ->(Identifier) }) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} (Assignment (Empty) { (Identifier) ->(Identifier) } - (Empty)) - {+(Assignment - {+(Empty)+} - {+(Identifier)+} - {+(Empty)+})+})) + (Empty)))) (DefaultExport { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/javascript/corpus/export.diffB-A.txt b/test/fixtures/javascript/corpus/export.diffB-A.txt index a01398a7b..c0d98eefd 100644 --- a/test/fixtures/javascript/corpus/export.diffB-A.txt +++ b/test/fixtures/javascript/corpus/export.diffB-A.txt @@ -35,11 +35,14 @@ (Identifier) { (Identifier) ->(Empty) }) - (Assignment - (Empty) - { (Identifier) - ->(Identifier) } - (Empty)) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} + {-(Assignment + {-(Empty)-} + {-(Identifier)-} + {-(Empty)-})-} {-(Assignment {-(Empty)-} {-(Identifier)-} diff --git a/test/fixtures/javascript/corpus/import.diffA-B.txt b/test/fixtures/javascript/corpus/import.diffA-B.txt index c6a0b07ad..9e5c75bdc 100644 --- a/test/fixtures/javascript/corpus/import.diffA-B.txt +++ b/test/fixtures/javascript/corpus/import.diffA-B.txt @@ -2,10 +2,10 @@ {+(Import)+} {+(QualifiedAliasedImport {+(Identifier)+})+} -{+(Import)+} -{+(Import)+} { (Import) ->(Import) } +{+(Import)+} +{+(Import)+} {+( {+(Import)+} {+(Import)+})+} diff --git a/test/fixtures/javascript/corpus/import.diffB-A.txt b/test/fixtures/javascript/corpus/import.diffB-A.txt index c6a0b07ad..7bcd92f6a 100644 --- a/test/fixtures/javascript/corpus/import.diffB-A.txt +++ b/test/fixtures/javascript/corpus/import.diffB-A.txt @@ -4,8 +4,7 @@ {+(Identifier)+})+} {+(Import)+} {+(Import)+} -{ (Import) -->(Import) } +{+(Import)+} {+( {+(Import)+} {+(Import)+})+} @@ -14,6 +13,7 @@ {+(QualifiedAliasedImport {+(Identifier)+})+})+} {+(SideEffectImport)+} +{-(Import)-} {-(QualifiedAliasedImport {-(Identifier)-})-} {-(Import)-} diff --git a/test/fixtures/python/corpus/augmented-assignment.diffA-B.txt b/test/fixtures/python/corpus/augmented-assignment.diffA-B.txt index 2abc99677..795ae8f24 100644 --- a/test/fixtures/python/corpus/augmented-assignment.diffA-B.txt +++ b/test/fixtures/python/corpus/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/corpus/augmented-assignment.diffB-A.txt b/test/fixtures/python/corpus/augmented-assignment.diffB-A.txt index 07c8da605..21e96d951 100644 --- a/test/fixtures/python/corpus/augmented-assignment.diffB-A.txt +++ b/test/fixtures/python/corpus/augmented-assignment.diffB-A.txt @@ -7,21 +7,20 @@ ->(Plus {+(Identifier)+} {+(Integer)+}) }) +{+(Assignment + {+(Identifier)+} + {+(RShift + {+(Identifier)+} + {+(Integer)+})+})+} (Assignment { (Identifier) ->(Identifier) } - { (DividedBy + (DividedBy + { (Identifier) + ->(Identifier) } + (Integer))) +{-(Assignment + {-(Identifier)-} + {-(Plus {-(Identifier)-} - {-(Integer)-}) - ->(RShift - {+(Identifier)+} - {+(Integer)+}) }) - (Assignment - { (Identifier) - ->(Identifier) } - { (Plus - {-(Identifier)-} - {-(Integer)-}) - ->(DividedBy - {+(Identifier)+} - {+(Integer)+}) })) + {-(Integer)-})-})-}) diff --git a/test/fixtures/python/corpus/comparison-operator.diffB-A.txt b/test/fixtures/python/corpus/comparison-operator.diffB-A.txt index 1d8636d90..56d83b338 100644 --- a/test/fixtures/python/corpus/comparison-operator.diffB-A.txt +++ b/test/fixtures/python/corpus/comparison-operator.diffB-A.txt @@ -5,38 +5,40 @@ {+(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) } - { (Identifier) - ->(Identifier) })) +{+(Not + {+(Member + {+(Identifier)+} + {+(Identifier)+})+})+} {+(Not {+(Equal {+(Identifier)+} {+(Identifier)+})+})+} +{-(Not + {-(Member + {-(Identifier)-} + {-(Identifier)-})-})-} {-(Equal {-(Identifier)-} {-(Identifier)-})-} diff --git a/test/fixtures/python/corpus/exec-statement.diffA-B.txt b/test/fixtures/python/corpus/exec-statement.diffA-B.txt index cb8df8433..70f51f3a8 100644 --- a/test/fixtures/python/corpus/exec-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/exec-statement.diffA-B.txt @@ -1,21 +1,28 @@ (Program +{+(Call + {+(Identifier)+} + {+(TextElement)+} + {+(Identifier)+} + {+(Empty)+})+} +{+(Call + {+(Identifier)+} + {+(TextElement)+} + {+(Identifier)+} + {+(Identifier)+} + {+(Empty)+})+} (Call (Identifier) { (TextElement) ->(TextElement) } - {+(Identifier)+} (Empty)) - (Call - (Identifier) - (TextElement) - {+(Identifier)+} - {+(Identifier)+} +{-(Call + {-(Identifier)-} + {-(TextElement)-} {-(Null)-} - (Empty)) - (Call - (Identifier) - { (TextElement) - ->(TextElement) } + {-(Empty)-})-} +{-(Call + {-(Identifier)-} + {-(TextElement)-} {-(Identifier)-} {-(Identifier)-} - (Empty))) + {-(Empty)-})-}) diff --git a/test/fixtures/python/corpus/exec-statement.diffB-A.txt b/test/fixtures/python/corpus/exec-statement.diffB-A.txt index d61d2f5f2..25cb30a7c 100644 --- a/test/fixtures/python/corpus/exec-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/exec-statement.diffB-A.txt @@ -1,21 +1,22 @@ (Program - (Call - (Identifier) - { (TextElement) - ->(TextElement) } - {-(Identifier)-} - (Empty)) +{+(Call + {+(Identifier)+} + {+(TextElement)+} + {+(Empty)+})+} (Call (Identifier) (TextElement) {+(Null)+} - {-(Identifier)-} {-(Identifier)-} (Empty)) (Call (Identifier) - { (TextElement) - ->(TextElement) } + (TextElement) {+(Identifier)+} - {+(Identifier)+} - (Empty))) + (Identifier) + {-(Identifier)-} + (Empty)) +{-(Call + {-(Identifier)-} + {-(TextElement)-} + {-(Empty)-})-}) diff --git a/test/fixtures/python/corpus/float.diffA-B.txt b/test/fixtures/python/corpus/float.diffA-B.txt index ac2863db4..db81ffe15 100644 --- a/test/fixtures/python/corpus/float.diffA-B.txt +++ b/test/fixtures/python/corpus/float.diffA-B.txt @@ -6,14 +6,14 @@ ->(Float) } {+(Float)+} {+(Float)+} -{+(Float)+} -{+(Float)+} { (Float) ->(Float) } {+(Float)+} {+(Float)+} -{ (Float) -->(Float) } +{+(Float)+} +{+(Float)+} +{+(Float)+} +{-(Float)-} {-(Float)-} {-(Float)-} {-(Float)-} diff --git a/test/fixtures/python/corpus/float.diffB-A.txt b/test/fixtures/python/corpus/float.diffB-A.txt index 48cb37153..304dfddef 100644 --- a/test/fixtures/python/corpus/float.diffB-A.txt +++ b/test/fixtures/python/corpus/float.diffB-A.txt @@ -9,10 +9,10 @@ {+(Float)+} {+(Float)+} {+(Float)+} -{ (Float) -->(Float) } {+(Float)+} {+(Float)+} +{+(Float)+} +{-(Float)-} {-(Float)-} {-(Float)-} {-(Float)-} diff --git a/test/fixtures/python/corpus/import-from-statement.diffA-B.txt b/test/fixtures/python/corpus/import-from-statement.diffA-B.txt index 1f2444578..53c9173af 100644 --- a/test/fixtures/python/corpus/import-from-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/import-from-statement.diffA-B.txt @@ -1,12 +1,12 @@ (Program {+(Import)+} +{ (Import) +->(Import) } {+(Import)+} {+(Import)+} {+(Import)+} -{+(Import)+} -{+(Import)+} -{-(Import)-} -{-(Import)-} +{ (Import) +->(Import) } {-(Import)-} {-(Import)-} {-(Import)-}) diff --git a/test/fixtures/python/corpus/import-from-statement.diffB-A.txt b/test/fixtures/python/corpus/import-from-statement.diffB-A.txt index 994ec1050..0daabb2ab 100644 --- a/test/fixtures/python/corpus/import-from-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/import-from-statement.diffB-A.txt @@ -1,10 +1,10 @@ (Program {+(Import)+} -{+(Import)+} { (Import) ->(Import) } {+(Import)+} {+(Import)+} +{+(Import)+} {-(Import)-} {-(Import)-} {-(Import)-} diff --git a/test/fixtures/python/corpus/integer.diffA-B.txt b/test/fixtures/python/corpus/integer.diffA-B.txt index 3cdc606b4..2b582e9e5 100644 --- a/test/fixtures/python/corpus/integer.diffA-B.txt +++ b/test/fixtures/python/corpus/integer.diffA-B.txt @@ -15,9 +15,9 @@ {+(Integer)+} {+(Integer)+} {+(Integer)+} +{ (Integer) +->(Integer) } {+(Integer)+} -{+(Integer)+} -{-(Integer)-} {-(Negate {-(Integer)-})-} {-(Integer)-} diff --git a/test/fixtures/python/corpus/integer.diffB-A.txt b/test/fixtures/python/corpus/integer.diffB-A.txt index ce3dff492..2468ca1f1 100644 --- a/test/fixtures/python/corpus/integer.diffB-A.txt +++ b/test/fixtures/python/corpus/integer.diffB-A.txt @@ -5,15 +5,15 @@ { (Integer) ->(Integer) } {+(Integer)+} -{+(Integer)+} +{ (Integer) +->(Integer) } {+(Negate {+(Integer)+})+} {+(Integer)+} {+(Integer)+} {+(Integer)+} {+(Integer)+} -{ (Integer) -->(Integer) } +{+(Integer)+} {+(Integer)+} {+(Integer)+} {+(Integer)+} diff --git a/test/fixtures/python/corpus/string.diffA-B.txt b/test/fixtures/python/corpus/string.diffA-B.txt index 20712d404..9cf35b73f 100644 --- a/test/fixtures/python/corpus/string.diffA-B.txt +++ b/test/fixtures/python/corpus/string.diffA-B.txt @@ -2,12 +2,12 @@ {+(TextElement)+} (TextElement) {+(TextElement)+} -{+(TextElement)+} +{ (TextElement) +->(TextElement) } { (TextElement) ->(TextElement) } {+(TextElement)+} -{ (TextElement) -->(TextElement) } +{+(TextElement)+} {-(TextElement)-} {-(TextElement)-} {-(TextElement)-} diff --git a/test/fixtures/python/corpus/string.diffB-A.txt b/test/fixtures/python/corpus/string.diffB-A.txt index 828a6c9f0..f96350334 100644 --- a/test/fixtures/python/corpus/string.diffB-A.txt +++ b/test/fixtures/python/corpus/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/corpus/tuple.diffA-B.txt b/test/fixtures/python/corpus/tuple.diffA-B.txt index f82c12c36..d0fdb2952 100644 --- a/test/fixtures/python/corpus/tuple.diffA-B.txt +++ b/test/fixtures/python/corpus/tuple.diffA-B.txt @@ -1,14 +1,11 @@ (Program -{+(Tuple - {+(Identifier)+} - {+(Identifier)+} - {+(Identifier)+})+} (Tuple {-(Identifier)-} (Identifier) + {+(Identifier)+} {+(Identifier)+}) -{+(Identifier)+} -{-(Tuple + (Tuple {-(Identifier)-} - {-(Identifier)-} - {-(Identifier)-})-}) + (Identifier) + (Identifier)) +{+(Identifier)+}) diff --git a/test/fixtures/python/corpus/tuple.diffB-A.txt b/test/fixtures/python/corpus/tuple.diffB-A.txt index ea966d496..2418ffb6a 100644 --- a/test/fixtures/python/corpus/tuple.diffB-A.txt +++ b/test/fixtures/python/corpus/tuple.diffB-A.txt @@ -1,13 +1,11 @@ (Program -{+(Tuple - {+(Identifier)+} - {+(Identifier)+})+} + (Tuple + {-(Identifier)-} + {-(Identifier)-} + (Identifier) + {+(Identifier)+}) (Tuple {+(Identifier)+} (Identifier) - (Identifier) - {-(Identifier)-}) -{-(Tuple - {-(Identifier)-} - {-(Identifier)-})-} + (Identifier)) {-(Identifier)-}) diff --git a/test/fixtures/ruby/corpus/bitwise-operator.diffA-B.txt b/test/fixtures/ruby/corpus/bitwise-operator.diffA-B.txt index a138e990c..fc321e39c 100644 --- a/test/fixtures/ruby/corpus/bitwise-operator.diffA-B.txt +++ b/test/fixtures/ruby/corpus/bitwise-operator.diffA-B.txt @@ -9,16 +9,16 @@ {+(Identifier)+})+} {+(Send {+(Identifier)+})+}) } -{ (RShift - {-(Send - {-(Identifier)-})-} - {-(Send - {-(Identifier)-})-}) -->(LShift +{+(LShift {+(Send {+(Identifier)+})+} {+(Send - {+(Identifier)+})+}) } + {+(Identifier)+})+})+} +{-(RShift + {-(Send + {-(Identifier)-})-} + {-(Send + {-(Identifier)-})-})-} {-(BXOr {-(Send {-(Identifier)-})-} diff --git a/test/fixtures/ruby/corpus/bitwise-operator.diffB-A.txt b/test/fixtures/ruby/corpus/bitwise-operator.diffB-A.txt index 0b0691a8a..618eabcdf 100644 --- a/test/fixtures/ruby/corpus/bitwise-operator.diffB-A.txt +++ b/test/fixtures/ruby/corpus/bitwise-operator.diffB-A.txt @@ -9,18 +9,18 @@ {+(Identifier)+})+} {+(Send {+(Identifier)+})+}) } -{ (LShift - {-(Send - {-(Identifier)-})-} - {-(Send - {-(Identifier)-})-}) -->(RShift +{+(RShift {+(Send {+(Identifier)+})+} {+(Send - {+(Identifier)+})+}) } + {+(Identifier)+})+})+} {+(BXOr {+(Send {+(Identifier)+})+} {+(Send - {+(Identifier)+})+})+}) + {+(Identifier)+})+})+} +{-(LShift + {-(Send + {-(Identifier)-})-} + {-(Send + {-(Identifier)-})-})-}) diff --git a/test/fixtures/ruby/corpus/delimiter.diffB-A.txt b/test/fixtures/ruby/corpus/delimiter.diffB-A.txt index 41d9a3ae1..b5e91bd92 100644 --- a/test/fixtures/ruby/corpus/delimiter.diffB-A.txt +++ b/test/fixtures/ruby/corpus/delimiter.diffB-A.txt @@ -1,11 +1,11 @@ (Program {+(TextElement)+} {+(TextElement)+} -{+(TextElement)+} -{+(TextElement)+} { (TextElement) ->(TextElement) } {+(TextElement)+} +{+(TextElement)+} +{+(TextElement)+} {-(TextElement)-} {-(TextElement)-} {-(TextElement)-} diff --git a/test/fixtures/ruby/corpus/for.diffB-A.txt b/test/fixtures/ruby/corpus/for.diffB-A.txt index 901e1762e..a0356bb13 100644 --- a/test/fixtures/ruby/corpus/for.diffB-A.txt +++ b/test/fixtures/ruby/corpus/for.diffB-A.txt @@ -7,34 +7,33 @@ {+(Identifier)+})+} {+(Send {+(Identifier)+})+})+} -{+(ForEach - {+( - {+(Send - {+(Identifier)+})+} - {+(Send - {+(Identifier)+})+})+} - {+(Send - {+(Identifier)+})+} - {+(Send - {+(Identifier)+})+})+} (ForEach ( (Send { (Identifier) - ->(Identifier) })) + ->(Identifier) }) + {+(Send + {+(Identifier)+})+}) { (Array {-(Integer)-} {-(Integer)-} {-(Integer)-}) - ->(Enumeration - {+(Integer)+} - {+(Integer)+} - {+(Empty)+}) } - { (Send - {-(Identifier)-} + ->(Send + {+(Identifier)+}) } + (Send + { (Identifier) + ->(Identifier) } {-(Send - {-(Identifier)-})-}) - ->(Boolean) }) + {-(Identifier)-})-})) +{+(ForEach + {+( + {+(Send + {+(Identifier)+})+})+} + {+(Enumeration + {+(Integer)+} + {+(Integer)+} + {+(Empty)+})+} + {+(Boolean)+})+} {+(ForEach {+( {+(Send diff --git a/test/fixtures/ruby/corpus/hash.diffA-B.txt b/test/fixtures/ruby/corpus/hash.diffA-B.txt index fdebf7fa7..29badf95d 100644 --- a/test/fixtures/ruby/corpus/hash.diffA-B.txt +++ b/test/fixtures/ruby/corpus/hash.diffA-B.txt @@ -1,20 +1,23 @@ (Program (Hash - (KeyValue - { (Symbol) - ->(Symbol) } - { (TextElement) - ->(TextElement) }) - (KeyValue - { (Symbol) - ->(Symbol) } - { (Integer) - ->(Integer) }) - (KeyValue - { (TextElement) - ->(Symbol) } - { (Boolean) - ->(Boolean) }) + {+(KeyValue + {+(Symbol)+} + {+(TextElement)+})+} + {+(KeyValue + {+(Symbol)+} + {+(Integer)+})+} + {+(KeyValue + {+(Symbol)+} + {+(Boolean)+})+} + {-(KeyValue + {-(Symbol)-} + {-(TextElement)-})-} + {-(KeyValue + {-(Symbol)-} + {-(Integer)-})-} + {-(KeyValue + {-(TextElement)-} + {-(Boolean)-})-} {-(KeyValue {-(Symbol)-} {-(Integer)-})-}) diff --git a/test/fixtures/ruby/corpus/hash.diffB-A.txt b/test/fixtures/ruby/corpus/hash.diffB-A.txt index 6e16270ca..56b5ffa0a 100644 --- a/test/fixtures/ruby/corpus/hash.diffB-A.txt +++ b/test/fixtures/ruby/corpus/hash.diffB-A.txt @@ -1,23 +1,25 @@ (Program (Hash + {+(KeyValue + {+(Symbol)+} + {+(TextElement)+})+} + {+(KeyValue + {+(Symbol)+} + {+(Integer)+})+} + {+(KeyValue + {+(TextElement)+} + {+(Boolean)+})+} (KeyValue { (Symbol) ->(Symbol) } { (TextElement) - ->(TextElement) }) - (KeyValue - { (Symbol) - ->(Symbol) } - { (Integer) ->(Integer) }) - (KeyValue - { (Symbol) - ->(TextElement) } - { (Boolean) - ->(Boolean) }) - {+(KeyValue - {+(Symbol)+} - {+(Integer)+})+}) + {-(KeyValue + {-(Symbol)-} + {-(Integer)-})-} + {-(KeyValue + {-(Symbol)-} + {-(Boolean)-})-}) {+(Hash)+} {+(Hash {+(Context diff --git a/test/fixtures/ruby/corpus/number.diffA-B.txt b/test/fixtures/ruby/corpus/number.diffA-B.txt index c77fb3514..0049f4c90 100644 --- a/test/fixtures/ruby/corpus/number.diffA-B.txt +++ b/test/fixtures/ruby/corpus/number.diffA-B.txt @@ -1,12 +1,12 @@ (Program {+(Integer)+} -{+(Integer)+} { (Integer) ->(Integer) } {+(Integer)+} +{+(Integer)+} +{+(Integer)+} { (Integer) ->(Integer) } -{+(Integer)+} {+(Float)+} {-(Integer)-} {-(Integer)-} diff --git a/test/fixtures/ruby/corpus/number.diffB-A.txt b/test/fixtures/ruby/corpus/number.diffB-A.txt index 66875917a..433ee8148 100644 --- a/test/fixtures/ruby/corpus/number.diffB-A.txt +++ b/test/fixtures/ruby/corpus/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/corpus/symbol.diffA-B.txt b/test/fixtures/ruby/corpus/symbol.diffA-B.txt index 75121f8f8..5097907fa 100644 --- a/test/fixtures/ruby/corpus/symbol.diffA-B.txt +++ b/test/fixtures/ruby/corpus/symbol.diffA-B.txt @@ -1,7 +1,7 @@ (Program -{+(Symbol)+} { (Symbol) ->(Symbol) } -{+(Symbol)+} -{-(Symbol)-} -{-(Symbol)-}) +{ (Symbol) +->(Symbol) } +{ (Symbol) +->(Symbol) }) diff --git a/test/fixtures/ruby/corpus/symbol.diffB-A.txt b/test/fixtures/ruby/corpus/symbol.diffB-A.txt index 07ec021d6..5097907fa 100644 --- a/test/fixtures/ruby/corpus/symbol.diffB-A.txt +++ b/test/fixtures/ruby/corpus/symbol.diffB-A.txt @@ -1,7 +1,7 @@ (Program -{+(Symbol)+} { (Symbol) ->(Symbol) } { (Symbol) ->(Symbol) } -{-(Symbol)-}) +{ (Symbol) +->(Symbol) }) diff --git a/test/fixtures/typescript/corpus/export.diffA-B.txt b/test/fixtures/typescript/corpus/export.diffA-B.txt index c988c24cc..4e6aea904 100644 --- a/test/fixtures/typescript/corpus/export.diffA-B.txt +++ b/test/fixtures/typescript/corpus/export.diffA-B.txt @@ -35,15 +35,15 @@ (Identifier) { (Empty) ->(Identifier) }) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} (Assignment (Empty) { (Identifier) ->(Identifier) } - (Empty)) - {+(Assignment - {+(Empty)+} - {+(Identifier)+} - {+(Empty)+})+})) + (Empty)))) (DefaultExport { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/typescript/corpus/export.diffB-A.txt b/test/fixtures/typescript/corpus/export.diffB-A.txt index a01398a7b..c0d98eefd 100644 --- a/test/fixtures/typescript/corpus/export.diffB-A.txt +++ b/test/fixtures/typescript/corpus/export.diffB-A.txt @@ -35,11 +35,14 @@ (Identifier) { (Identifier) ->(Empty) }) - (Assignment - (Empty) - { (Identifier) - ->(Identifier) } - (Empty)) + {+(Assignment + {+(Empty)+} + {+(Identifier)+} + {+(Empty)+})+} + {-(Assignment + {-(Empty)-} + {-(Identifier)-} + {-(Empty)-})-} {-(Assignment {-(Empty)-} {-(Identifier)-} diff --git a/test/fixtures/typescript/corpus/import.diffA-B.txt b/test/fixtures/typescript/corpus/import.diffA-B.txt index d09595a71..ae75bfbfd 100644 --- a/test/fixtures/typescript/corpus/import.diffA-B.txt +++ b/test/fixtures/typescript/corpus/import.diffA-B.txt @@ -2,10 +2,10 @@ {+(Import)+} {+(QualifiedAliasedImport {+(Identifier)+})+} -{+(Import)+} -{+(Import)+} { (Import) ->(Import) } +{+(Import)+} +{+(Import)+} {+( {+(Import)+} {+(Import)+})+} diff --git a/test/fixtures/typescript/corpus/import.diffB-A.txt b/test/fixtures/typescript/corpus/import.diffB-A.txt index cc6bed6ee..475d4a5ee 100644 --- a/test/fixtures/typescript/corpus/import.diffB-A.txt +++ b/test/fixtures/typescript/corpus/import.diffB-A.txt @@ -4,8 +4,7 @@ {+(Identifier)+})+} {+(Import)+} {+(Import)+} -{ (Import) -->(Import) } +{+(Import)+} {+( {+(Import)+} {+(Import)+})+} @@ -14,10 +13,11 @@ {+(QualifiedAliasedImport {+(Identifier)+})+})+} {+(SideEffectImport)+} -{ (QualifiedAliasedImport - {-(Identifier)-}) -->(QualifiedAliasedImport - {+(Identifier)+}) } +{+(QualifiedAliasedImport + {+(Identifier)+})+} +{-(Import)-} +{-(QualifiedAliasedImport + {-(Identifier)-})-} {-(Import)-} {-(Import)-} {-(Import)-} diff --git a/vendor/fastsum b/vendor/fastsum index 10c717b8e..4a8f13592 160000 --- a/vendor/fastsum +++ b/vendor/fastsum @@ -1 +1 @@ -Subproject commit 10c717b8e081fbb1fc843c5888fb0d0f86472bef +Subproject commit 4a8f1359233bbb2bea7a0eee478c28d0184ebe6d