From 941527c261e647a8896e8c384d196a21bbe0dc98 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 11 Jun 2020 13:53:12 -0700 Subject: [PATCH] Remove a la carte diffing and graphing --- proto/semantic.proto | 73 - semantic-proto/src/Proto/Semantic.hs | 2727 +----------------- semantic-proto/src/Proto/Semantic_Fields.hs | 135 +- semantic-proto/src/Proto/Semantic_JSON.hs | 358 --- semantic.cabal | 21 +- src/Analysis/Decorator.hs | 17 - src/Analysis/PackageDef.hs | 101 - src/Data/AST.hs | 10 - src/Data/Algebra.hs | 48 - src/Data/Blob.hs | 4 - src/Data/Diff.hs | 199 -- src/Data/Graph/Algebraic.hs | 6 - src/Data/JSON/Fields.hs | 176 -- src/Data/Syntax.hs | 19 +- src/Data/Syntax/Comment.hs | 6 +- src/Data/Syntax/Declaration.hs | 43 +- src/Data/Syntax/Directive.hs | 6 +- src/Data/Syntax/Expression.hs | 92 +- src/Data/Syntax/Literal.hs | 44 +- src/Data/Syntax/Statement.hs | 62 +- src/Data/Syntax/Type.hs | 34 +- src/Data/Term.hs | 17 - src/Diffing/Algorithm.hs | 311 -- src/Diffing/Algorithm/RWS.hs | 191 -- src/Diffing/Algorithm/RWS/FeatureVector.hs | 55 - src/Diffing/Algorithm/SES.hs | 66 - src/Diffing/Interpreter.hs | 80 - src/Language/Go/Syntax.hs | 44 +- src/Language/Go/Term.hs | 8 +- src/Language/Go/Type.hs | 8 +- src/Language/PHP/Syntax.hs | 114 +- src/Language/PHP/Term.hs | 8 +- src/Language/Python/Syntax.hs | 16 +- src/Language/Python/Term.hs | 8 +- src/Language/Ruby/Syntax.hs | 23 +- src/Language/Ruby/Term.hs | 8 +- src/Language/TSX/Syntax/JSX.hs | 20 +- src/Language/TSX/Term.hs | 8 +- src/Language/TypeScript/Syntax/Import.hs | 20 +- src/Language/TypeScript/Syntax/JavaScript.hs | 22 +- src/Language/TypeScript/Syntax/TypeScript.hs | 56 +- src/Language/TypeScript/Syntax/Types.hs | 42 +- src/Language/TypeScript/Term.hs | 8 +- src/Rendering/Graph.hs | 134 - src/Rendering/JSON.hs | 129 - src/Semantic/Api.hs | 5 +- src/Semantic/Api/Diffs.hs | 168 -- src/Semantic/CLI.hs | 54 +- src/Serializing/SExpression.hs | 9 - test/Data/Diff/Spec.hs | 12 - test/Data/Functor/Listable.hs | 24 - test/Diffing/Algorithm/RWS/Spec.hs | 46 - test/Diffing/Algorithm/SES/Spec.hs | 24 - test/Diffing/Interpreter/Spec.hs | 91 - test/Integration/Spec.hs | 17 +- test/Semantic/CLI/Spec.hs | 11 +- test/Spec.hs | 8 - test/SpecHelpers.hs | 8 - 58 files changed, 332 insertions(+), 5722 deletions(-) delete mode 100644 src/Analysis/Decorator.hs delete mode 100644 src/Analysis/PackageDef.hs delete mode 100644 src/Data/Algebra.hs delete mode 100644 src/Data/Diff.hs delete mode 100644 src/Data/JSON/Fields.hs delete mode 100644 src/Diffing/Algorithm.hs delete mode 100644 src/Diffing/Algorithm/RWS.hs delete mode 100644 src/Diffing/Algorithm/RWS/FeatureVector.hs delete mode 100644 src/Diffing/Algorithm/SES.hs delete mode 100644 src/Diffing/Interpreter.hs delete mode 100644 src/Rendering/Graph.hs delete mode 100644 src/Rendering/JSON.hs delete mode 100644 src/Semantic/Api/Diffs.hs delete mode 100644 test/Data/Diff/Spec.hs delete mode 100644 test/Diffing/Algorithm/RWS/Spec.hs delete mode 100644 test/Diffing/Algorithm/SES/Spec.hs delete mode 100644 test/Diffing/Interpreter/Spec.hs diff --git a/proto/semantic.proto b/proto/semantic.proto index b9e3f1bf3..7ce6d10bf 100644 --- a/proto/semantic.proto +++ b/proto/semantic.proto @@ -23,10 +23,6 @@ message ParseTreeSymbolResponse { repeated File files = 1; } -message ParseTreeGraphResponse { - repeated ParseTreeFileGraph files = 1; -} - message StackGraphRequest { repeated Blob blobs = 1; } @@ -35,79 +31,10 @@ message StackGraphResponse { repeated StackGraphFile files = 1; } -message ParseTreeFileGraph { - string path = 1; - string language = 2; - repeated TermVertex vertices = 3; - repeated TermEdge edges = 4; - repeated ParseError errors = 5; -} - -message TermEdge { - int32 source = 1; - int32 target = 2; -} - -message TermVertex { - int32 vertex_id = 1; - string term = 2; - Span span = 3; -} - message ParseError { string error = 1; } -message DiffTreeGraphResponse { - repeated DiffTreeFileGraph files = 1; -} - -message DiffTreeFileGraph { - string path = 1; - string language = 2; - repeated DiffTreeVertex vertices = 3; - repeated DiffTreeEdge edges = 4; - repeated ParseError errors = 5; -} - -message DiffTreeEdge { - int32 source = 1; - int32 target = 2; -} - -message DiffTreeVertex { - int32 diff_vertex_id = 1; - oneof diff_term { - DeletedTerm deleted = 2; - InsertedTerm inserted = 3; - ReplacedTerm replaced = 4; - MergedTerm merged = 5; - } -} - -message DeletedTerm { - string term = 1; - Span span = 2; -} - -message InsertedTerm { - string term = 1; - Span span = 2; -} - -message ReplacedTerm { - string before_term = 1; - Span before_span = 2; - string after_term = 3; - Span after_span = 4; -} - -message MergedTerm { - string term = 1; - Span before_span = 2; - Span after_span = 3; -} - message Blob { string content = 1; string path = 2; diff --git a/semantic-proto/src/Proto/Semantic.hs b/semantic-proto/src/Proto/Semantic.hs index cb5703542..a0c14a182 100644 --- a/semantic-proto/src/Proto/Semantic.hs +++ b/semantic-proto/src/Proto/Semantic.hs @@ -4,19 +4,13 @@ {-# OPTIONS_GHC -Wno-duplicate-exports#-} {-# OPTIONS_GHC -Wno-dodgy-exports#-} module Proto.Semantic ( - Blob(), DeletedTerm(), DiffTreeEdge(), DiffTreeFileGraph(), - DiffTreeGraphResponse(), DiffTreeVertex(), - DiffTreeVertex'DiffTerm(..), _DiffTreeVertex'Deleted, - _DiffTreeVertex'Inserted, _DiffTreeVertex'Replaced, - _DiffTreeVertex'Merged, Docstring(), File(), InsertedTerm(), - MergedTerm(), NodeType(..), NodeType(), NodeType'UnrecognizedValue, - ParseError(), ParseTreeFileGraph(), ParseTreeGraphResponse(), - ParseTreeRequest(), ParseTreeSymbolResponse(), PingRequest(), - PingResponse(), Position(), ReplacedTerm(), Span(), - StackGraphFile(), StackGraphNode(), StackGraphPath(), - StackGraphRequest(), StackGraphResponse(), Symbol(), - SyntaxType(..), SyntaxType(), SyntaxType'UnrecognizedValue, - TermEdge(), TermVertex() + Blob(), Docstring(), File(), NodeType(..), NodeType(), + NodeType'UnrecognizedValue, ParseError(), ParseTreeRequest(), + ParseTreeSymbolResponse(), PingRequest(), PingResponse(), + Position(), Span(), StackGraphFile(), StackGraphNode(), + StackGraphPath(), StackGraphRequest(), StackGraphResponse(), + Symbol(), SyntaxType(..), SyntaxType(), + SyntaxType'UnrecognizedValue ) where import qualified Data.ProtoLens.Runtime.Control.DeepSeq as Control.DeepSeq import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Prism as Data.ProtoLens.Prism @@ -255,1212 +249,6 @@ instance Control.DeepSeq.NFData Blob where (Control.DeepSeq.deepseq (_Blob'language x__) ()))) {- | Fields : - * 'Proto.Semantic_Fields.term' @:: Lens' DeletedTerm Data.Text.Text@ - * 'Proto.Semantic_Fields.span' @:: Lens' DeletedTerm Span@ - * 'Proto.Semantic_Fields.maybe'span' @:: Lens' DeletedTerm (Prelude.Maybe Span)@ -} -data DeletedTerm - = DeletedTerm'_constructor {_DeletedTerm'term :: !Data.Text.Text, - _DeletedTerm'span :: !(Prelude.Maybe Span), - _DeletedTerm'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show DeletedTerm where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField DeletedTerm "term" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DeletedTerm'term (\ x__ y__ -> x__ {_DeletedTerm'term = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DeletedTerm "span" Span where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DeletedTerm'span (\ x__ y__ -> x__ {_DeletedTerm'span = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField DeletedTerm "maybe'span" (Prelude.Maybe Span) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DeletedTerm'span (\ x__ y__ -> x__ {_DeletedTerm'span = y__})) - Prelude.id -instance Data.ProtoLens.Message DeletedTerm where - messageName _ = Data.Text.pack "github.semantic.DeletedTerm" - fieldsByTag - = let - term__field_descriptor - = Data.ProtoLens.FieldDescriptor - "term" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"term")) :: - Data.ProtoLens.FieldDescriptor DeletedTerm - span__field_descriptor - = Data.ProtoLens.FieldDescriptor - "span" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Span) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'span")) :: - Data.ProtoLens.FieldDescriptor DeletedTerm - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, term__field_descriptor), - (Data.ProtoLens.Tag 2, span__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _DeletedTerm'_unknownFields - (\ x__ y__ -> x__ {_DeletedTerm'_unknownFields = y__}) - defMessage - = DeletedTerm'_constructor - {_DeletedTerm'term = Data.ProtoLens.fieldDefault, - _DeletedTerm'span = Prelude.Nothing, - _DeletedTerm'_unknownFields = []} - parseMessage - = let - loop :: - DeletedTerm -> Data.ProtoLens.Encoding.Bytes.Parser DeletedTerm - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "term" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"term") y x) - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "span" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"span") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "DeletedTerm" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"term") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'span") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData DeletedTerm where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_DeletedTerm'_unknownFields x__) - (Control.DeepSeq.deepseq - (_DeletedTerm'term x__) - (Control.DeepSeq.deepseq (_DeletedTerm'span x__) ())) -{- | Fields : - - * 'Proto.Semantic_Fields.source' @:: Lens' DiffTreeEdge Data.Int.Int32@ - * 'Proto.Semantic_Fields.target' @:: Lens' DiffTreeEdge Data.Int.Int32@ -} -data DiffTreeEdge - = DiffTreeEdge'_constructor {_DiffTreeEdge'source :: !Data.Int.Int32, - _DiffTreeEdge'target :: !Data.Int.Int32, - _DiffTreeEdge'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show DiffTreeEdge where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField DiffTreeEdge "source" Data.Int.Int32 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeEdge'source - (\ x__ y__ -> x__ {_DiffTreeEdge'source = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DiffTreeEdge "target" Data.Int.Int32 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeEdge'target - (\ x__ y__ -> x__ {_DiffTreeEdge'target = y__})) - Prelude.id -instance Data.ProtoLens.Message DiffTreeEdge where - messageName _ = Data.Text.pack "github.semantic.DiffTreeEdge" - fieldsByTag - = let - source__field_descriptor - = Data.ProtoLens.FieldDescriptor - "source" - (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"source")) :: - Data.ProtoLens.FieldDescriptor DiffTreeEdge - target__field_descriptor - = Data.ProtoLens.FieldDescriptor - "target" - (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"target")) :: - Data.ProtoLens.FieldDescriptor DiffTreeEdge - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, source__field_descriptor), - (Data.ProtoLens.Tag 2, target__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _DiffTreeEdge'_unknownFields - (\ x__ y__ -> x__ {_DiffTreeEdge'_unknownFields = y__}) - defMessage - = DiffTreeEdge'_constructor - {_DiffTreeEdge'source = Data.ProtoLens.fieldDefault, - _DiffTreeEdge'target = Data.ProtoLens.fieldDefault, - _DiffTreeEdge'_unknownFields = []} - parseMessage - = let - loop :: - DiffTreeEdge -> Data.ProtoLens.Encoding.Bytes.Parser DiffTreeEdge - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "source" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"source") y x) - 16 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "target" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"target") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "DiffTreeEdge" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"source") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 8) - ((Prelude..) - Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) - ((Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"target") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 16) - ((Prelude..) - Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData DiffTreeEdge where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_DiffTreeEdge'_unknownFields x__) - (Control.DeepSeq.deepseq - (_DiffTreeEdge'source x__) - (Control.DeepSeq.deepseq (_DiffTreeEdge'target x__) ())) -{- | Fields : - - * 'Proto.Semantic_Fields.path' @:: Lens' DiffTreeFileGraph Data.Text.Text@ - * 'Proto.Semantic_Fields.language' @:: Lens' DiffTreeFileGraph Data.Text.Text@ - * 'Proto.Semantic_Fields.vertices' @:: Lens' DiffTreeFileGraph [DiffTreeVertex]@ - * 'Proto.Semantic_Fields.vec'vertices' @:: Lens' DiffTreeFileGraph (Data.Vector.Vector DiffTreeVertex)@ - * 'Proto.Semantic_Fields.edges' @:: Lens' DiffTreeFileGraph [DiffTreeEdge]@ - * 'Proto.Semantic_Fields.vec'edges' @:: Lens' DiffTreeFileGraph (Data.Vector.Vector DiffTreeEdge)@ - * 'Proto.Semantic_Fields.errors' @:: Lens' DiffTreeFileGraph [ParseError]@ - * 'Proto.Semantic_Fields.vec'errors' @:: Lens' DiffTreeFileGraph (Data.Vector.Vector ParseError)@ -} -data DiffTreeFileGraph - = DiffTreeFileGraph'_constructor {_DiffTreeFileGraph'path :: !Data.Text.Text, - _DiffTreeFileGraph'language :: !Data.Text.Text, - _DiffTreeFileGraph'vertices :: !(Data.Vector.Vector DiffTreeVertex), - _DiffTreeFileGraph'edges :: !(Data.Vector.Vector DiffTreeEdge), - _DiffTreeFileGraph'errors :: !(Data.Vector.Vector ParseError), - _DiffTreeFileGraph'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show DiffTreeFileGraph where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "path" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'path - (\ x__ y__ -> x__ {_DiffTreeFileGraph'path = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "language" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'language - (\ x__ y__ -> x__ {_DiffTreeFileGraph'language = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "vertices" [DiffTreeVertex] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'vertices - (\ x__ y__ -> x__ {_DiffTreeFileGraph'vertices = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "vec'vertices" (Data.Vector.Vector DiffTreeVertex) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'vertices - (\ x__ y__ -> x__ {_DiffTreeFileGraph'vertices = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "edges" [DiffTreeEdge] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'edges - (\ x__ y__ -> x__ {_DiffTreeFileGraph'edges = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "vec'edges" (Data.Vector.Vector DiffTreeEdge) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'edges - (\ x__ y__ -> x__ {_DiffTreeFileGraph'edges = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "errors" [ParseError] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'errors - (\ x__ y__ -> x__ {_DiffTreeFileGraph'errors = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField DiffTreeFileGraph "vec'errors" (Data.Vector.Vector ParseError) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'errors - (\ x__ y__ -> x__ {_DiffTreeFileGraph'errors = y__})) - Prelude.id -instance Data.ProtoLens.Message DiffTreeFileGraph where - messageName _ = Data.Text.pack "github.semantic.DiffTreeFileGraph" - fieldsByTag - = let - path__field_descriptor - = Data.ProtoLens.FieldDescriptor - "path" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"path")) :: - Data.ProtoLens.FieldDescriptor DiffTreeFileGraph - language__field_descriptor - = Data.ProtoLens.FieldDescriptor - "language" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"language")) :: - Data.ProtoLens.FieldDescriptor DiffTreeFileGraph - vertices__field_descriptor - = Data.ProtoLens.FieldDescriptor - "vertices" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor DiffTreeVertex) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked - (Data.ProtoLens.Field.field @"vertices")) :: - Data.ProtoLens.FieldDescriptor DiffTreeFileGraph - edges__field_descriptor - = Data.ProtoLens.FieldDescriptor - "edges" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor DiffTreeEdge) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"edges")) :: - Data.ProtoLens.FieldDescriptor DiffTreeFileGraph - errors__field_descriptor - = Data.ProtoLens.FieldDescriptor - "errors" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ParseError) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"errors")) :: - Data.ProtoLens.FieldDescriptor DiffTreeFileGraph - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, path__field_descriptor), - (Data.ProtoLens.Tag 2, language__field_descriptor), - (Data.ProtoLens.Tag 3, vertices__field_descriptor), - (Data.ProtoLens.Tag 4, edges__field_descriptor), - (Data.ProtoLens.Tag 5, errors__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _DiffTreeFileGraph'_unknownFields - (\ x__ y__ -> x__ {_DiffTreeFileGraph'_unknownFields = y__}) - defMessage - = DiffTreeFileGraph'_constructor - {_DiffTreeFileGraph'path = Data.ProtoLens.fieldDefault, - _DiffTreeFileGraph'language = Data.ProtoLens.fieldDefault, - _DiffTreeFileGraph'vertices = Data.Vector.Generic.empty, - _DiffTreeFileGraph'edges = Data.Vector.Generic.empty, - _DiffTreeFileGraph'errors = Data.Vector.Generic.empty, - _DiffTreeFileGraph'_unknownFields = []} - parseMessage - = let - loop :: - DiffTreeFileGraph - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld DiffTreeEdge - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld ParseError - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld DiffTreeVertex - -> Data.ProtoLens.Encoding.Bytes.Parser DiffTreeFileGraph - loop x mutable'edges mutable'errors mutable'vertices - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do frozen'edges <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'edges) - frozen'errors <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze - mutable'errors) - frozen'vertices <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze - mutable'vertices) - (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields - (\ !t -> Prelude.reverse t) - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'edges") - frozen'edges - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'errors") - frozen'errors - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'vertices") - frozen'vertices - x)))) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "path" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"path") y x) - mutable'edges - mutable'errors - mutable'vertices - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "language" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"language") y x) - mutable'edges - mutable'errors - mutable'vertices - 26 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "vertices" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'vertices y) - loop x mutable'edges mutable'errors v - 34 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "edges" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'edges y) - loop x v mutable'errors mutable'vertices - 42 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "errors" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'errors y) - loop x mutable'edges v mutable'vertices - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - mutable'edges - mutable'errors - mutable'vertices - in - (Data.ProtoLens.Encoding.Bytes.) - (do mutable'edges <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - mutable'errors <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - mutable'vertices <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - loop - Data.ProtoLens.defMessage - mutable'edges - mutable'errors - mutable'vertices) - "DiffTreeFileGraph" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"path") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"language") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view - (Data.ProtoLens.Field.field @"vec'vertices") _x)) - ((Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 34) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'edges") _x)) - ((Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 42) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral - (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'errors") _x)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x)))))) -instance Control.DeepSeq.NFData DiffTreeFileGraph where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_DiffTreeFileGraph'_unknownFields x__) - (Control.DeepSeq.deepseq - (_DiffTreeFileGraph'path x__) - (Control.DeepSeq.deepseq - (_DiffTreeFileGraph'language x__) - (Control.DeepSeq.deepseq - (_DiffTreeFileGraph'vertices x__) - (Control.DeepSeq.deepseq - (_DiffTreeFileGraph'edges x__) - (Control.DeepSeq.deepseq (_DiffTreeFileGraph'errors x__) ()))))) -{- | Fields : - - * 'Proto.Semantic_Fields.files' @:: Lens' DiffTreeGraphResponse [DiffTreeFileGraph]@ - * 'Proto.Semantic_Fields.vec'files' @:: Lens' DiffTreeGraphResponse (Data.Vector.Vector DiffTreeFileGraph)@ -} -data DiffTreeGraphResponse - = DiffTreeGraphResponse'_constructor {_DiffTreeGraphResponse'files :: !(Data.Vector.Vector DiffTreeFileGraph), - _DiffTreeGraphResponse'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show DiffTreeGraphResponse where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField DiffTreeGraphResponse "files" [DiffTreeFileGraph] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeGraphResponse'files - (\ x__ y__ -> x__ {_DiffTreeGraphResponse'files = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField DiffTreeGraphResponse "vec'files" (Data.Vector.Vector DiffTreeFileGraph) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeGraphResponse'files - (\ x__ y__ -> x__ {_DiffTreeGraphResponse'files = y__})) - Prelude.id -instance Data.ProtoLens.Message DiffTreeGraphResponse where - messageName _ - = Data.Text.pack "github.semantic.DiffTreeGraphResponse" - fieldsByTag - = let - files__field_descriptor - = Data.ProtoLens.FieldDescriptor - "files" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor DiffTreeFileGraph) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"files")) :: - Data.ProtoLens.FieldDescriptor DiffTreeGraphResponse - in - Data.Map.fromList [(Data.ProtoLens.Tag 1, files__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _DiffTreeGraphResponse'_unknownFields - (\ x__ y__ -> x__ {_DiffTreeGraphResponse'_unknownFields = y__}) - defMessage - = DiffTreeGraphResponse'_constructor - {_DiffTreeGraphResponse'files = Data.Vector.Generic.empty, - _DiffTreeGraphResponse'_unknownFields = []} - parseMessage - = let - loop :: - DiffTreeGraphResponse - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld DiffTreeFileGraph - -> Data.ProtoLens.Encoding.Bytes.Parser DiffTreeGraphResponse - loop x mutable'files - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do frozen'files <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'files) - (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields - (\ !t -> Prelude.reverse t) - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'files") frozen'files x)) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "files" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'files y) - loop x v - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - mutable'files - in - (Data.ProtoLens.Encoding.Bytes.) - (do mutable'files <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - loop Data.ProtoLens.defMessage mutable'files) - "DiffTreeGraphResponse" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'files") _x)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x)) -instance Control.DeepSeq.NFData DiffTreeGraphResponse where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_DiffTreeGraphResponse'_unknownFields x__) - (Control.DeepSeq.deepseq (_DiffTreeGraphResponse'files x__) ()) -{- | Fields : - - * 'Proto.Semantic_Fields.diffVertexId' @:: Lens' DiffTreeVertex Data.Int.Int32@ - * 'Proto.Semantic_Fields.maybe'diffTerm' @:: Lens' DiffTreeVertex (Prelude.Maybe DiffTreeVertex'DiffTerm)@ - * 'Proto.Semantic_Fields.maybe'deleted' @:: Lens' DiffTreeVertex (Prelude.Maybe DeletedTerm)@ - * 'Proto.Semantic_Fields.deleted' @:: Lens' DiffTreeVertex DeletedTerm@ - * 'Proto.Semantic_Fields.maybe'inserted' @:: Lens' DiffTreeVertex (Prelude.Maybe InsertedTerm)@ - * 'Proto.Semantic_Fields.inserted' @:: Lens' DiffTreeVertex InsertedTerm@ - * 'Proto.Semantic_Fields.maybe'replaced' @:: Lens' DiffTreeVertex (Prelude.Maybe ReplacedTerm)@ - * 'Proto.Semantic_Fields.replaced' @:: Lens' DiffTreeVertex ReplacedTerm@ - * 'Proto.Semantic_Fields.maybe'merged' @:: Lens' DiffTreeVertex (Prelude.Maybe MergedTerm)@ - * 'Proto.Semantic_Fields.merged' @:: Lens' DiffTreeVertex MergedTerm@ -} -data DiffTreeVertex - = DiffTreeVertex'_constructor {_DiffTreeVertex'diffVertexId :: !Data.Int.Int32, - _DiffTreeVertex'diffTerm :: !(Prelude.Maybe DiffTreeVertex'DiffTerm), - _DiffTreeVertex'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show DiffTreeVertex where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -data DiffTreeVertex'DiffTerm - = DiffTreeVertex'Deleted !DeletedTerm | - DiffTreeVertex'Inserted !InsertedTerm | - DiffTreeVertex'Replaced !ReplacedTerm | - DiffTreeVertex'Merged !MergedTerm - deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "diffVertexId" Data.Int.Int32 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffVertexId - (\ x__ y__ -> x__ {_DiffTreeVertex'diffVertexId = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DiffTreeVertex "maybe'diffTerm" (Prelude.Maybe DiffTreeVertex'DiffTerm) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField DiffTreeVertex "maybe'deleted" (Prelude.Maybe DeletedTerm) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Deleted x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Deleted y__)) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "deleted" DeletedTerm where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - ((Prelude..) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Deleted x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Deleted y__)) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "maybe'inserted" (Prelude.Maybe InsertedTerm) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Inserted x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Inserted y__)) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "inserted" InsertedTerm where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - ((Prelude..) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Inserted x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Inserted y__)) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "maybe'replaced" (Prelude.Maybe ReplacedTerm) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Replaced x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Replaced y__)) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "replaced" ReplacedTerm where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - ((Prelude..) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Replaced x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Replaced y__)) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "maybe'merged" (Prelude.Maybe MergedTerm) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Merged x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Merged y__)) -instance Data.ProtoLens.Field.HasField DiffTreeVertex "merged" MergedTerm where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _DiffTreeVertex'diffTerm - (\ x__ y__ -> x__ {_DiffTreeVertex'diffTerm = y__})) - ((Prelude..) - (Lens.Family2.Unchecked.lens - (\ x__ - -> case x__ of - (Prelude.Just (DiffTreeVertex'Merged x__val)) - -> Prelude.Just x__val - _otherwise -> Prelude.Nothing) - (\ _ y__ -> Prelude.fmap DiffTreeVertex'Merged y__)) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)) -instance Data.ProtoLens.Message DiffTreeVertex where - messageName _ = Data.Text.pack "github.semantic.DiffTreeVertex" - fieldsByTag - = let - diffVertexId__field_descriptor - = Data.ProtoLens.FieldDescriptor - "diff_vertex_id" - (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"diffVertexId")) :: - Data.ProtoLens.FieldDescriptor DiffTreeVertex - deleted__field_descriptor - = Data.ProtoLens.FieldDescriptor - "deleted" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor DeletedTerm) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'deleted")) :: - Data.ProtoLens.FieldDescriptor DiffTreeVertex - inserted__field_descriptor - = Data.ProtoLens.FieldDescriptor - "inserted" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor InsertedTerm) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'inserted")) :: - Data.ProtoLens.FieldDescriptor DiffTreeVertex - replaced__field_descriptor - = Data.ProtoLens.FieldDescriptor - "replaced" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ReplacedTerm) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'replaced")) :: - Data.ProtoLens.FieldDescriptor DiffTreeVertex - merged__field_descriptor - = Data.ProtoLens.FieldDescriptor - "merged" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor MergedTerm) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'merged")) :: - Data.ProtoLens.FieldDescriptor DiffTreeVertex - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, diffVertexId__field_descriptor), - (Data.ProtoLens.Tag 2, deleted__field_descriptor), - (Data.ProtoLens.Tag 3, inserted__field_descriptor), - (Data.ProtoLens.Tag 4, replaced__field_descriptor), - (Data.ProtoLens.Tag 5, merged__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _DiffTreeVertex'_unknownFields - (\ x__ y__ -> x__ {_DiffTreeVertex'_unknownFields = y__}) - defMessage - = DiffTreeVertex'_constructor - {_DiffTreeVertex'diffVertexId = Data.ProtoLens.fieldDefault, - _DiffTreeVertex'diffTerm = Prelude.Nothing, - _DiffTreeVertex'_unknownFields = []} - parseMessage - = let - loop :: - DiffTreeVertex - -> Data.ProtoLens.Encoding.Bytes.Parser DiffTreeVertex - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "diff_vertex_id" - loop - (Lens.Family2.set - (Data.ProtoLens.Field.field @"diffVertexId") y x) - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "deleted" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"deleted") y x) - 26 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "inserted" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"inserted") y x) - 34 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "replaced" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"replaced") y x) - 42 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "merged" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"merged") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "DiffTreeVertex" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let - _v - = Lens.Family2.view (Data.ProtoLens.Field.field @"diffVertexId") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 8) - ((Prelude..) - Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'diffTerm") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just (DiffTreeVertex'Deleted v)) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - v) - (Prelude.Just (DiffTreeVertex'Inserted v)) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - v) - (Prelude.Just (DiffTreeVertex'Replaced v)) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 34) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - v) - (Prelude.Just (DiffTreeVertex'Merged v)) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 42) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData DiffTreeVertex where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_DiffTreeVertex'_unknownFields x__) - (Control.DeepSeq.deepseq - (_DiffTreeVertex'diffVertexId x__) - (Control.DeepSeq.deepseq (_DiffTreeVertex'diffTerm x__) ())) -instance Control.DeepSeq.NFData DiffTreeVertex'DiffTerm where - rnf (DiffTreeVertex'Deleted x__) = Control.DeepSeq.rnf x__ - rnf (DiffTreeVertex'Inserted x__) = Control.DeepSeq.rnf x__ - rnf (DiffTreeVertex'Replaced x__) = Control.DeepSeq.rnf x__ - rnf (DiffTreeVertex'Merged x__) = Control.DeepSeq.rnf x__ -_DiffTreeVertex'Deleted :: - Data.ProtoLens.Prism.Prism' DiffTreeVertex'DiffTerm DeletedTerm -_DiffTreeVertex'Deleted - = Data.ProtoLens.Prism.prism' - DiffTreeVertex'Deleted - (\ p__ - -> case p__ of - (DiffTreeVertex'Deleted p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -_DiffTreeVertex'Inserted :: - Data.ProtoLens.Prism.Prism' DiffTreeVertex'DiffTerm InsertedTerm -_DiffTreeVertex'Inserted - = Data.ProtoLens.Prism.prism' - DiffTreeVertex'Inserted - (\ p__ - -> case p__ of - (DiffTreeVertex'Inserted p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -_DiffTreeVertex'Replaced :: - Data.ProtoLens.Prism.Prism' DiffTreeVertex'DiffTerm ReplacedTerm -_DiffTreeVertex'Replaced - = Data.ProtoLens.Prism.prism' - DiffTreeVertex'Replaced - (\ p__ - -> case p__ of - (DiffTreeVertex'Replaced p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -_DiffTreeVertex'Merged :: - Data.ProtoLens.Prism.Prism' DiffTreeVertex'DiffTerm MergedTerm -_DiffTreeVertex'Merged - = Data.ProtoLens.Prism.prism' - DiffTreeVertex'Merged - (\ p__ - -> case p__ of - (DiffTreeVertex'Merged p__val) -> Prelude.Just p__val - _otherwise -> Prelude.Nothing) -{- | Fields : - * 'Proto.Semantic_Fields.docstring' @:: Lens' Docstring Data.Text.Text@ -} data Docstring = Docstring'_constructor {_Docstring'docstring :: !Data.Text.Text, @@ -1920,386 +708,6 @@ instance Control.DeepSeq.NFData File where (Control.DeepSeq.deepseq (_File'errors x__) (Control.DeepSeq.deepseq (_File'blobOid x__) ()))))) -{- | Fields : - - * 'Proto.Semantic_Fields.term' @:: Lens' InsertedTerm Data.Text.Text@ - * 'Proto.Semantic_Fields.span' @:: Lens' InsertedTerm Span@ - * 'Proto.Semantic_Fields.maybe'span' @:: Lens' InsertedTerm (Prelude.Maybe Span)@ -} -data InsertedTerm - = InsertedTerm'_constructor {_InsertedTerm'term :: !Data.Text.Text, - _InsertedTerm'span :: !(Prelude.Maybe Span), - _InsertedTerm'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show InsertedTerm where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField InsertedTerm "term" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _InsertedTerm'term (\ x__ y__ -> x__ {_InsertedTerm'term = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField InsertedTerm "span" Span where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _InsertedTerm'span (\ x__ y__ -> x__ {_InsertedTerm'span = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField InsertedTerm "maybe'span" (Prelude.Maybe Span) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _InsertedTerm'span (\ x__ y__ -> x__ {_InsertedTerm'span = y__})) - Prelude.id -instance Data.ProtoLens.Message InsertedTerm where - messageName _ = Data.Text.pack "github.semantic.InsertedTerm" - fieldsByTag - = let - term__field_descriptor - = Data.ProtoLens.FieldDescriptor - "term" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"term")) :: - Data.ProtoLens.FieldDescriptor InsertedTerm - span__field_descriptor - = Data.ProtoLens.FieldDescriptor - "span" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Span) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'span")) :: - Data.ProtoLens.FieldDescriptor InsertedTerm - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, term__field_descriptor), - (Data.ProtoLens.Tag 2, span__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _InsertedTerm'_unknownFields - (\ x__ y__ -> x__ {_InsertedTerm'_unknownFields = y__}) - defMessage - = InsertedTerm'_constructor - {_InsertedTerm'term = Data.ProtoLens.fieldDefault, - _InsertedTerm'span = Prelude.Nothing, - _InsertedTerm'_unknownFields = []} - parseMessage - = let - loop :: - InsertedTerm -> Data.ProtoLens.Encoding.Bytes.Parser InsertedTerm - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "term" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"term") y x) - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "span" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"span") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "InsertedTerm" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"term") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'span") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData InsertedTerm where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_InsertedTerm'_unknownFields x__) - (Control.DeepSeq.deepseq - (_InsertedTerm'term x__) - (Control.DeepSeq.deepseq (_InsertedTerm'span x__) ())) -{- | Fields : - - * 'Proto.Semantic_Fields.term' @:: Lens' MergedTerm Data.Text.Text@ - * 'Proto.Semantic_Fields.beforeSpan' @:: Lens' MergedTerm Span@ - * 'Proto.Semantic_Fields.maybe'beforeSpan' @:: Lens' MergedTerm (Prelude.Maybe Span)@ - * 'Proto.Semantic_Fields.afterSpan' @:: Lens' MergedTerm Span@ - * 'Proto.Semantic_Fields.maybe'afterSpan' @:: Lens' MergedTerm (Prelude.Maybe Span)@ -} -data MergedTerm - = MergedTerm'_constructor {_MergedTerm'term :: !Data.Text.Text, - _MergedTerm'beforeSpan :: !(Prelude.Maybe Span), - _MergedTerm'afterSpan :: !(Prelude.Maybe Span), - _MergedTerm'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show MergedTerm where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField MergedTerm "term" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _MergedTerm'term (\ x__ y__ -> x__ {_MergedTerm'term = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField MergedTerm "beforeSpan" Span where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _MergedTerm'beforeSpan - (\ x__ y__ -> x__ {_MergedTerm'beforeSpan = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField MergedTerm "maybe'beforeSpan" (Prelude.Maybe Span) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _MergedTerm'beforeSpan - (\ x__ y__ -> x__ {_MergedTerm'beforeSpan = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField MergedTerm "afterSpan" Span where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _MergedTerm'afterSpan - (\ x__ y__ -> x__ {_MergedTerm'afterSpan = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField MergedTerm "maybe'afterSpan" (Prelude.Maybe Span) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _MergedTerm'afterSpan - (\ x__ y__ -> x__ {_MergedTerm'afterSpan = y__})) - Prelude.id -instance Data.ProtoLens.Message MergedTerm where - messageName _ = Data.Text.pack "github.semantic.MergedTerm" - fieldsByTag - = let - term__field_descriptor - = Data.ProtoLens.FieldDescriptor - "term" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"term")) :: - Data.ProtoLens.FieldDescriptor MergedTerm - beforeSpan__field_descriptor - = Data.ProtoLens.FieldDescriptor - "before_span" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Span) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'beforeSpan")) :: - Data.ProtoLens.FieldDescriptor MergedTerm - afterSpan__field_descriptor - = Data.ProtoLens.FieldDescriptor - "after_span" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Span) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'afterSpan")) :: - Data.ProtoLens.FieldDescriptor MergedTerm - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, term__field_descriptor), - (Data.ProtoLens.Tag 2, beforeSpan__field_descriptor), - (Data.ProtoLens.Tag 3, afterSpan__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _MergedTerm'_unknownFields - (\ x__ y__ -> x__ {_MergedTerm'_unknownFields = y__}) - defMessage - = MergedTerm'_constructor - {_MergedTerm'term = Data.ProtoLens.fieldDefault, - _MergedTerm'beforeSpan = Prelude.Nothing, - _MergedTerm'afterSpan = Prelude.Nothing, - _MergedTerm'_unknownFields = []} - parseMessage - = let - loop :: - MergedTerm -> Data.ProtoLens.Encoding.Bytes.Parser MergedTerm - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "term" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"term") y x) - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "before_span" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"beforeSpan") y x) - 26 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "after_span" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"afterSpan") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "MergedTerm" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"term") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view - (Data.ProtoLens.Field.field @"maybe'beforeSpan") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view - (Data.ProtoLens.Field.field @"maybe'afterSpan") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x)))) -instance Control.DeepSeq.NFData MergedTerm where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_MergedTerm'_unknownFields x__) - (Control.DeepSeq.deepseq - (_MergedTerm'term x__) - (Control.DeepSeq.deepseq - (_MergedTerm'beforeSpan x__) - (Control.DeepSeq.deepseq (_MergedTerm'afterSpan x__) ()))) newtype NodeType'UnrecognizedValue = NodeType'UnrecognizedValue Data.Int.Int32 deriving (Prelude.Eq, Prelude.Ord, Prelude.Show) @@ -2493,511 +901,6 @@ instance Control.DeepSeq.NFData ParseError where (Control.DeepSeq.deepseq (_ParseError'error x__) ()) {- | Fields : - * 'Proto.Semantic_Fields.path' @:: Lens' ParseTreeFileGraph Data.Text.Text@ - * 'Proto.Semantic_Fields.language' @:: Lens' ParseTreeFileGraph Data.Text.Text@ - * 'Proto.Semantic_Fields.vertices' @:: Lens' ParseTreeFileGraph [TermVertex]@ - * 'Proto.Semantic_Fields.vec'vertices' @:: Lens' ParseTreeFileGraph (Data.Vector.Vector TermVertex)@ - * 'Proto.Semantic_Fields.edges' @:: Lens' ParseTreeFileGraph [TermEdge]@ - * 'Proto.Semantic_Fields.vec'edges' @:: Lens' ParseTreeFileGraph (Data.Vector.Vector TermEdge)@ - * 'Proto.Semantic_Fields.errors' @:: Lens' ParseTreeFileGraph [ParseError]@ - * 'Proto.Semantic_Fields.vec'errors' @:: Lens' ParseTreeFileGraph (Data.Vector.Vector ParseError)@ -} -data ParseTreeFileGraph - = ParseTreeFileGraph'_constructor {_ParseTreeFileGraph'path :: !Data.Text.Text, - _ParseTreeFileGraph'language :: !Data.Text.Text, - _ParseTreeFileGraph'vertices :: !(Data.Vector.Vector TermVertex), - _ParseTreeFileGraph'edges :: !(Data.Vector.Vector TermEdge), - _ParseTreeFileGraph'errors :: !(Data.Vector.Vector ParseError), - _ParseTreeFileGraph'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show ParseTreeFileGraph where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "path" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'path - (\ x__ y__ -> x__ {_ParseTreeFileGraph'path = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "language" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'language - (\ x__ y__ -> x__ {_ParseTreeFileGraph'language = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "vertices" [TermVertex] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'vertices - (\ x__ y__ -> x__ {_ParseTreeFileGraph'vertices = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "vec'vertices" (Data.Vector.Vector TermVertex) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'vertices - (\ x__ y__ -> x__ {_ParseTreeFileGraph'vertices = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "edges" [TermEdge] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'edges - (\ x__ y__ -> x__ {_ParseTreeFileGraph'edges = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "vec'edges" (Data.Vector.Vector TermEdge) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'edges - (\ x__ y__ -> x__ {_ParseTreeFileGraph'edges = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "errors" [ParseError] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'errors - (\ x__ y__ -> x__ {_ParseTreeFileGraph'errors = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField ParseTreeFileGraph "vec'errors" (Data.Vector.Vector ParseError) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'errors - (\ x__ y__ -> x__ {_ParseTreeFileGraph'errors = y__})) - Prelude.id -instance Data.ProtoLens.Message ParseTreeFileGraph where - messageName _ = Data.Text.pack "github.semantic.ParseTreeFileGraph" - fieldsByTag - = let - path__field_descriptor - = Data.ProtoLens.FieldDescriptor - "path" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"path")) :: - Data.ProtoLens.FieldDescriptor ParseTreeFileGraph - language__field_descriptor - = Data.ProtoLens.FieldDescriptor - "language" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"language")) :: - Data.ProtoLens.FieldDescriptor ParseTreeFileGraph - vertices__field_descriptor - = Data.ProtoLens.FieldDescriptor - "vertices" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor TermVertex) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked - (Data.ProtoLens.Field.field @"vertices")) :: - Data.ProtoLens.FieldDescriptor ParseTreeFileGraph - edges__field_descriptor - = Data.ProtoLens.FieldDescriptor - "edges" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor TermEdge) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"edges")) :: - Data.ProtoLens.FieldDescriptor ParseTreeFileGraph - errors__field_descriptor - = Data.ProtoLens.FieldDescriptor - "errors" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ParseError) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"errors")) :: - Data.ProtoLens.FieldDescriptor ParseTreeFileGraph - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, path__field_descriptor), - (Data.ProtoLens.Tag 2, language__field_descriptor), - (Data.ProtoLens.Tag 3, vertices__field_descriptor), - (Data.ProtoLens.Tag 4, edges__field_descriptor), - (Data.ProtoLens.Tag 5, errors__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _ParseTreeFileGraph'_unknownFields - (\ x__ y__ -> x__ {_ParseTreeFileGraph'_unknownFields = y__}) - defMessage - = ParseTreeFileGraph'_constructor - {_ParseTreeFileGraph'path = Data.ProtoLens.fieldDefault, - _ParseTreeFileGraph'language = Data.ProtoLens.fieldDefault, - _ParseTreeFileGraph'vertices = Data.Vector.Generic.empty, - _ParseTreeFileGraph'edges = Data.Vector.Generic.empty, - _ParseTreeFileGraph'errors = Data.Vector.Generic.empty, - _ParseTreeFileGraph'_unknownFields = []} - parseMessage - = let - loop :: - ParseTreeFileGraph - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TermEdge - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld ParseError - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld TermVertex - -> Data.ProtoLens.Encoding.Bytes.Parser ParseTreeFileGraph - loop x mutable'edges mutable'errors mutable'vertices - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do frozen'edges <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'edges) - frozen'errors <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze - mutable'errors) - frozen'vertices <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze - mutable'vertices) - (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields - (\ !t -> Prelude.reverse t) - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'edges") - frozen'edges - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'errors") - frozen'errors - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'vertices") - frozen'vertices - x)))) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "path" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"path") y x) - mutable'edges - mutable'errors - mutable'vertices - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "language" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"language") y x) - mutable'edges - mutable'errors - mutable'vertices - 26 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "vertices" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'vertices y) - loop x mutable'edges mutable'errors v - 34 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "edges" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'edges y) - loop x v mutable'errors mutable'vertices - 42 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "errors" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'errors y) - loop x mutable'edges v mutable'vertices - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - mutable'edges - mutable'errors - mutable'vertices - in - (Data.ProtoLens.Encoding.Bytes.) - (do mutable'edges <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - mutable'errors <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - mutable'vertices <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - loop - Data.ProtoLens.defMessage - mutable'edges - mutable'errors - mutable'vertices) - "ParseTreeFileGraph" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"path") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"language") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view - (Data.ProtoLens.Field.field @"vec'vertices") _x)) - ((Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 34) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'edges") _x)) - ((Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 42) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral - (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'errors") _x)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x)))))) -instance Control.DeepSeq.NFData ParseTreeFileGraph where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_ParseTreeFileGraph'_unknownFields x__) - (Control.DeepSeq.deepseq - (_ParseTreeFileGraph'path x__) - (Control.DeepSeq.deepseq - (_ParseTreeFileGraph'language x__) - (Control.DeepSeq.deepseq - (_ParseTreeFileGraph'vertices x__) - (Control.DeepSeq.deepseq - (_ParseTreeFileGraph'edges x__) - (Control.DeepSeq.deepseq (_ParseTreeFileGraph'errors x__) ()))))) -{- | Fields : - - * 'Proto.Semantic_Fields.files' @:: Lens' ParseTreeGraphResponse [ParseTreeFileGraph]@ - * 'Proto.Semantic_Fields.vec'files' @:: Lens' ParseTreeGraphResponse (Data.Vector.Vector ParseTreeFileGraph)@ -} -data ParseTreeGraphResponse - = ParseTreeGraphResponse'_constructor {_ParseTreeGraphResponse'files :: !(Data.Vector.Vector ParseTreeFileGraph), - _ParseTreeGraphResponse'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show ParseTreeGraphResponse where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField ParseTreeGraphResponse "files" [ParseTreeFileGraph] where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeGraphResponse'files - (\ x__ y__ -> x__ {_ParseTreeGraphResponse'files = y__})) - (Lens.Family2.Unchecked.lens - Data.Vector.Generic.toList - (\ _ y__ -> Data.Vector.Generic.fromList y__)) -instance Data.ProtoLens.Field.HasField ParseTreeGraphResponse "vec'files" (Data.Vector.Vector ParseTreeFileGraph) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ParseTreeGraphResponse'files - (\ x__ y__ -> x__ {_ParseTreeGraphResponse'files = y__})) - Prelude.id -instance Data.ProtoLens.Message ParseTreeGraphResponse where - messageName _ - = Data.Text.pack "github.semantic.ParseTreeGraphResponse" - fieldsByTag - = let - files__field_descriptor - = Data.ProtoLens.FieldDescriptor - "files" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor ParseTreeFileGraph) - (Data.ProtoLens.RepeatedField - Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"files")) :: - Data.ProtoLens.FieldDescriptor ParseTreeGraphResponse - in - Data.Map.fromList [(Data.ProtoLens.Tag 1, files__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _ParseTreeGraphResponse'_unknownFields - (\ x__ y__ -> x__ {_ParseTreeGraphResponse'_unknownFields = y__}) - defMessage - = ParseTreeGraphResponse'_constructor - {_ParseTreeGraphResponse'files = Data.Vector.Generic.empty, - _ParseTreeGraphResponse'_unknownFields = []} - parseMessage - = let - loop :: - ParseTreeGraphResponse - -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld ParseTreeFileGraph - -> Data.ProtoLens.Encoding.Bytes.Parser ParseTreeGraphResponse - loop x mutable'files - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do frozen'files <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'files) - (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields - (\ !t -> Prelude.reverse t) - (Lens.Family2.set - (Data.ProtoLens.Field.field @"vec'files") frozen'files x)) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do !y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) - Data.ProtoLens.parseMessage) - "files" - v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - (Data.ProtoLens.Encoding.Growing.append mutable'files y) - loop x v - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - mutable'files - in - (Data.ProtoLens.Encoding.Bytes.) - (do mutable'files <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO - Data.ProtoLens.Encoding.Growing.new - loop Data.ProtoLens.defMessage mutable'files) - "ParseTreeGraphResponse" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.foldMapBuilder - (\ _v - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'files") _x)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x)) -instance Control.DeepSeq.NFData ParseTreeGraphResponse where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_ParseTreeGraphResponse'_unknownFields x__) - (Control.DeepSeq.deepseq (_ParseTreeGraphResponse'files x__) ()) -{- | Fields : - * 'Proto.Semantic_Fields.blobs' @:: Lens' ParseTreeRequest [Blob]@ * 'Proto.Semantic_Fields.vec'blobs' @:: Lens' ParseTreeRequest (Data.Vector.Vector Blob)@ -} data ParseTreeRequest @@ -3769,282 +1672,6 @@ instance Control.DeepSeq.NFData Position where (Control.DeepSeq.deepseq (_Position'column x__) ())) {- | Fields : - * 'Proto.Semantic_Fields.beforeTerm' @:: Lens' ReplacedTerm Data.Text.Text@ - * 'Proto.Semantic_Fields.beforeSpan' @:: Lens' ReplacedTerm Span@ - * 'Proto.Semantic_Fields.maybe'beforeSpan' @:: Lens' ReplacedTerm (Prelude.Maybe Span)@ - * 'Proto.Semantic_Fields.afterTerm' @:: Lens' ReplacedTerm Data.Text.Text@ - * 'Proto.Semantic_Fields.afterSpan' @:: Lens' ReplacedTerm Span@ - * 'Proto.Semantic_Fields.maybe'afterSpan' @:: Lens' ReplacedTerm (Prelude.Maybe Span)@ -} -data ReplacedTerm - = ReplacedTerm'_constructor {_ReplacedTerm'beforeTerm :: !Data.Text.Text, - _ReplacedTerm'beforeSpan :: !(Prelude.Maybe Span), - _ReplacedTerm'afterTerm :: !Data.Text.Text, - _ReplacedTerm'afterSpan :: !(Prelude.Maybe Span), - _ReplacedTerm'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show ReplacedTerm where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField ReplacedTerm "beforeTerm" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ReplacedTerm'beforeTerm - (\ x__ y__ -> x__ {_ReplacedTerm'beforeTerm = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField ReplacedTerm "beforeSpan" Span where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ReplacedTerm'beforeSpan - (\ x__ y__ -> x__ {_ReplacedTerm'beforeSpan = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField ReplacedTerm "maybe'beforeSpan" (Prelude.Maybe Span) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ReplacedTerm'beforeSpan - (\ x__ y__ -> x__ {_ReplacedTerm'beforeSpan = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField ReplacedTerm "afterTerm" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ReplacedTerm'afterTerm - (\ x__ y__ -> x__ {_ReplacedTerm'afterTerm = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField ReplacedTerm "afterSpan" Span where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ReplacedTerm'afterSpan - (\ x__ y__ -> x__ {_ReplacedTerm'afterSpan = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField ReplacedTerm "maybe'afterSpan" (Prelude.Maybe Span) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _ReplacedTerm'afterSpan - (\ x__ y__ -> x__ {_ReplacedTerm'afterSpan = y__})) - Prelude.id -instance Data.ProtoLens.Message ReplacedTerm where - messageName _ = Data.Text.pack "github.semantic.ReplacedTerm" - fieldsByTag - = let - beforeTerm__field_descriptor - = Data.ProtoLens.FieldDescriptor - "before_term" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"beforeTerm")) :: - Data.ProtoLens.FieldDescriptor ReplacedTerm - beforeSpan__field_descriptor - = Data.ProtoLens.FieldDescriptor - "before_span" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Span) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'beforeSpan")) :: - Data.ProtoLens.FieldDescriptor ReplacedTerm - afterTerm__field_descriptor - = Data.ProtoLens.FieldDescriptor - "after_term" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"afterTerm")) :: - Data.ProtoLens.FieldDescriptor ReplacedTerm - afterSpan__field_descriptor - = Data.ProtoLens.FieldDescriptor - "after_span" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Span) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'afterSpan")) :: - Data.ProtoLens.FieldDescriptor ReplacedTerm - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, beforeTerm__field_descriptor), - (Data.ProtoLens.Tag 2, beforeSpan__field_descriptor), - (Data.ProtoLens.Tag 3, afterTerm__field_descriptor), - (Data.ProtoLens.Tag 4, afterSpan__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _ReplacedTerm'_unknownFields - (\ x__ y__ -> x__ {_ReplacedTerm'_unknownFields = y__}) - defMessage - = ReplacedTerm'_constructor - {_ReplacedTerm'beforeTerm = Data.ProtoLens.fieldDefault, - _ReplacedTerm'beforeSpan = Prelude.Nothing, - _ReplacedTerm'afterTerm = Data.ProtoLens.fieldDefault, - _ReplacedTerm'afterSpan = Prelude.Nothing, - _ReplacedTerm'_unknownFields = []} - parseMessage - = let - loop :: - ReplacedTerm -> Data.ProtoLens.Encoding.Bytes.Parser ReplacedTerm - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 10 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "before_term" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"beforeTerm") y x) - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "before_span" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"beforeSpan") y x) - 26 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "after_term" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"afterTerm") y x) - 34 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "after_span" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"afterSpan") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "ReplacedTerm" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let - _v - = Lens.Family2.view (Data.ProtoLens.Field.field @"beforeTerm") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 10) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view - (Data.ProtoLens.Field.field @"maybe'beforeSpan") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - ((Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"afterTerm") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view - (Data.ProtoLens.Field.field @"maybe'afterSpan") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 34) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))))) -instance Control.DeepSeq.NFData ReplacedTerm where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_ReplacedTerm'_unknownFields x__) - (Control.DeepSeq.deepseq - (_ReplacedTerm'beforeTerm x__) - (Control.DeepSeq.deepseq - (_ReplacedTerm'beforeSpan x__) - (Control.DeepSeq.deepseq - (_ReplacedTerm'afterTerm x__) - (Control.DeepSeq.deepseq (_ReplacedTerm'afterSpan x__) ())))) -{- | Fields : - * 'Proto.Semantic_Fields.start' @:: Lens' Span Position@ * 'Proto.Semantic_Fields.maybe'start' @:: Lens' Span (Prelude.Maybe Position)@ * 'Proto.Semantic_Fields.end' @:: Lens' Span Position@ @@ -6177,342 +3804,4 @@ instance Prelude.Enum SyntaxType where instance Data.ProtoLens.FieldDefault SyntaxType where fieldDefault = FUNCTION instance Control.DeepSeq.NFData SyntaxType where - rnf x__ = Prelude.seq x__ () -{- | Fields : - - * 'Proto.Semantic_Fields.source' @:: Lens' TermEdge Data.Int.Int32@ - * 'Proto.Semantic_Fields.target' @:: Lens' TermEdge Data.Int.Int32@ -} -data TermEdge - = TermEdge'_constructor {_TermEdge'source :: !Data.Int.Int32, - _TermEdge'target :: !Data.Int.Int32, - _TermEdge'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show TermEdge where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField TermEdge "source" Data.Int.Int32 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _TermEdge'source (\ x__ y__ -> x__ {_TermEdge'source = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField TermEdge "target" Data.Int.Int32 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _TermEdge'target (\ x__ y__ -> x__ {_TermEdge'target = y__})) - Prelude.id -instance Data.ProtoLens.Message TermEdge where - messageName _ = Data.Text.pack "github.semantic.TermEdge" - fieldsByTag - = let - source__field_descriptor - = Data.ProtoLens.FieldDescriptor - "source" - (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"source")) :: - Data.ProtoLens.FieldDescriptor TermEdge - target__field_descriptor - = Data.ProtoLens.FieldDescriptor - "target" - (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"target")) :: - Data.ProtoLens.FieldDescriptor TermEdge - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, source__field_descriptor), - (Data.ProtoLens.Tag 2, target__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _TermEdge'_unknownFields - (\ x__ y__ -> x__ {_TermEdge'_unknownFields = y__}) - defMessage - = TermEdge'_constructor - {_TermEdge'source = Data.ProtoLens.fieldDefault, - _TermEdge'target = Data.ProtoLens.fieldDefault, - _TermEdge'_unknownFields = []} - parseMessage - = let - loop :: TermEdge -> Data.ProtoLens.Encoding.Bytes.Parser TermEdge - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "source" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"source") y x) - 16 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "target" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"target") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "TermEdge" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"source") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 8) - ((Prelude..) - Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) - ((Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"target") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 16) - ((Prelude..) - Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x))) -instance Control.DeepSeq.NFData TermEdge where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_TermEdge'_unknownFields x__) - (Control.DeepSeq.deepseq - (_TermEdge'source x__) - (Control.DeepSeq.deepseq (_TermEdge'target x__) ())) -{- | Fields : - - * 'Proto.Semantic_Fields.vertexId' @:: Lens' TermVertex Data.Int.Int32@ - * 'Proto.Semantic_Fields.term' @:: Lens' TermVertex Data.Text.Text@ - * 'Proto.Semantic_Fields.span' @:: Lens' TermVertex Span@ - * 'Proto.Semantic_Fields.maybe'span' @:: Lens' TermVertex (Prelude.Maybe Span)@ -} -data TermVertex - = TermVertex'_constructor {_TermVertex'vertexId :: !Data.Int.Int32, - _TermVertex'term :: !Data.Text.Text, - _TermVertex'span :: !(Prelude.Maybe Span), - _TermVertex'_unknownFields :: !Data.ProtoLens.FieldSet} - deriving (Prelude.Eq, Prelude.Ord) -instance Prelude.Show TermVertex where - showsPrec _ __x __s - = Prelude.showChar - '{' - (Prelude.showString - (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) -instance Data.ProtoLens.Field.HasField TermVertex "vertexId" Data.Int.Int32 where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _TermVertex'vertexId - (\ x__ y__ -> x__ {_TermVertex'vertexId = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField TermVertex "term" Data.Text.Text where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _TermVertex'term (\ x__ y__ -> x__ {_TermVertex'term = y__})) - Prelude.id -instance Data.ProtoLens.Field.HasField TermVertex "span" Span where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _TermVertex'span (\ x__ y__ -> x__ {_TermVertex'span = y__})) - (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage) -instance Data.ProtoLens.Field.HasField TermVertex "maybe'span" (Prelude.Maybe Span) where - fieldOf _ - = (Prelude..) - (Lens.Family2.Unchecked.lens - _TermVertex'span (\ x__ y__ -> x__ {_TermVertex'span = y__})) - Prelude.id -instance Data.ProtoLens.Message TermVertex where - messageName _ = Data.Text.pack "github.semantic.TermVertex" - fieldsByTag - = let - vertexId__field_descriptor - = Data.ProtoLens.FieldDescriptor - "vertex_id" - (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: - Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional - (Data.ProtoLens.Field.field @"vertexId")) :: - Data.ProtoLens.FieldDescriptor TermVertex - term__field_descriptor - = Data.ProtoLens.FieldDescriptor - "term" - (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: - Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) - (Data.ProtoLens.PlainField - Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"term")) :: - Data.ProtoLens.FieldDescriptor TermVertex - span__field_descriptor - = Data.ProtoLens.FieldDescriptor - "span" - (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: - Data.ProtoLens.FieldTypeDescriptor Span) - (Data.ProtoLens.OptionalField - (Data.ProtoLens.Field.field @"maybe'span")) :: - Data.ProtoLens.FieldDescriptor TermVertex - in - Data.Map.fromList - [(Data.ProtoLens.Tag 1, vertexId__field_descriptor), - (Data.ProtoLens.Tag 2, term__field_descriptor), - (Data.ProtoLens.Tag 3, span__field_descriptor)] - unknownFields - = Lens.Family2.Unchecked.lens - _TermVertex'_unknownFields - (\ x__ y__ -> x__ {_TermVertex'_unknownFields = y__}) - defMessage - = TermVertex'_constructor - {_TermVertex'vertexId = Data.ProtoLens.fieldDefault, - _TermVertex'term = Data.ProtoLens.fieldDefault, - _TermVertex'span = Prelude.Nothing, - _TermVertex'_unknownFields = []} - parseMessage - = let - loop :: - TermVertex -> Data.ProtoLens.Encoding.Bytes.Parser TermVertex - loop x - = do end <- Data.ProtoLens.Encoding.Bytes.atEnd - if end then - do (let missing = [] - in - if Prelude.null missing then - Prelude.return () - else - Prelude.fail - ((Prelude.++) - "Missing required fields: " - (Prelude.show (missing :: [Prelude.String])))) - Prelude.return - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) - else - do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt - case tag of - 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (Prelude.fmap - Prelude.fromIntegral - Data.ProtoLens.Encoding.Bytes.getVarInt) - "vertex_id" - loop - (Lens.Family2.set (Data.ProtoLens.Field.field @"vertexId") y x) - 18 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do value <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.getBytes - (Prelude.fromIntegral len) - Data.ProtoLens.Encoding.Bytes.runEither - (case Data.Text.Encoding.decodeUtf8' value of - (Prelude.Left err) - -> Prelude.Left (Prelude.show err) - (Prelude.Right r) -> Prelude.Right r)) - "term" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"term") y x) - 26 - -> do y <- (Data.ProtoLens.Encoding.Bytes.) - (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt - Data.ProtoLens.Encoding.Bytes.isolate - (Prelude.fromIntegral len) Data.ProtoLens.parseMessage) - "span" - loop (Lens.Family2.set (Data.ProtoLens.Field.field @"span") y x) - wire - -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire - wire - loop - (Lens.Family2.over - Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) - in - (Data.ProtoLens.Encoding.Bytes.) - (do loop Data.ProtoLens.defMessage) "TermVertex" - buildMessage - = \ _x - -> (Data.Monoid.<>) - (let - _v = Lens.Family2.view (Data.ProtoLens.Field.field @"vertexId") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 8) - ((Prelude..) - Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) - ((Data.Monoid.<>) - (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"term") _x - in - if (Prelude.==) _v Data.ProtoLens.fieldDefault then - Data.Monoid.mempty - else - (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 18) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.Text.Encoding.encodeUtf8 - _v)) - ((Data.Monoid.<>) - (case - Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'span") _x - of - Prelude.Nothing -> Data.Monoid.mempty - (Prelude.Just _v) - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt 26) - ((Prelude..) - (\ bs - -> (Data.Monoid.<>) - (Data.ProtoLens.Encoding.Bytes.putVarInt - (Prelude.fromIntegral (Data.ByteString.length bs))) - (Data.ProtoLens.Encoding.Bytes.putBytes bs)) - Data.ProtoLens.encodeMessage - _v)) - (Data.ProtoLens.Encoding.Wire.buildFieldSet - (Lens.Family2.view Data.ProtoLens.unknownFields _x)))) -instance Control.DeepSeq.NFData TermVertex where - rnf - = \ x__ - -> Control.DeepSeq.deepseq - (_TermVertex'_unknownFields x__) - (Control.DeepSeq.deepseq - (_TermVertex'vertexId x__) - (Control.DeepSeq.deepseq - (_TermVertex'term x__) - (Control.DeepSeq.deepseq (_TermVertex'span x__) ()))) \ No newline at end of file + rnf x__ = Prelude.seq x__ () \ No newline at end of file diff --git a/semantic-proto/src/Proto/Semantic_Fields.hs b/semantic-proto/src/Proto/Semantic_Fields.hs index 6befbcd33..cae48d156 100644 --- a/semantic-proto/src/Proto/Semantic_Fields.hs +++ b/semantic-proto/src/Proto/Semantic_Fields.hs @@ -28,30 +28,6 @@ import qualified Data.ProtoLens.Runtime.Data.Vector as Data.Vector import qualified Data.ProtoLens.Runtime.Data.Vector.Generic as Data.Vector.Generic import qualified Data.ProtoLens.Runtime.Data.Vector.Unboxed as Data.Vector.Unboxed import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read -afterSpan :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "afterSpan" a) => - Lens.Family2.LensLike' f s a -afterSpan = Data.ProtoLens.Field.field @"afterSpan" -afterTerm :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "afterTerm" a) => - Lens.Family2.LensLike' f s a -afterTerm = Data.ProtoLens.Field.field @"afterTerm" -beforeSpan :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "beforeSpan" a) => - Lens.Family2.LensLike' f s a -beforeSpan = Data.ProtoLens.Field.field @"beforeSpan" -beforeTerm :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "beforeTerm" a) => - Lens.Family2.LensLike' f s a -beforeTerm = Data.ProtoLens.Field.field @"beforeTerm" blobOid :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "blobOid" a) => @@ -72,17 +48,6 @@ content :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "content" a) => Lens.Family2.LensLike' f s a content = Data.ProtoLens.Field.field @"content" -deleted :: - forall f s a. - (Prelude.Functor f, Data.ProtoLens.Field.HasField s "deleted" a) => - Lens.Family2.LensLike' f s a -deleted = Data.ProtoLens.Field.field @"deleted" -diffVertexId :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "diffVertexId" a) => - Lens.Family2.LensLike' f s a -diffVertexId = Data.ProtoLens.Field.field @"diffVertexId" docs :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "docs" a) => @@ -147,12 +112,6 @@ id :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "id" a) => Lens.Family2.LensLike' f s a id = Data.ProtoLens.Field.field @"id" -inserted :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "inserted" a) => - Lens.Family2.LensLike' f s a -inserted = Data.ProtoLens.Field.field @"inserted" kind :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "kind" a) => @@ -169,30 +128,6 @@ line :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "line" a) => Lens.Family2.LensLike' f s a line = Data.ProtoLens.Field.field @"line" -maybe'afterSpan :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "maybe'afterSpan" a) => - Lens.Family2.LensLike' f s a -maybe'afterSpan = Data.ProtoLens.Field.field @"maybe'afterSpan" -maybe'beforeSpan :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "maybe'beforeSpan" a) => - Lens.Family2.LensLike' f s a -maybe'beforeSpan = Data.ProtoLens.Field.field @"maybe'beforeSpan" -maybe'deleted :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "maybe'deleted" a) => - Lens.Family2.LensLike' f s a -maybe'deleted = Data.ProtoLens.Field.field @"maybe'deleted" -maybe'diffTerm :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "maybe'diffTerm" a) => - Lens.Family2.LensLike' f s a -maybe'diffTerm = Data.ProtoLens.Field.field @"maybe'diffTerm" maybe'docs :: forall f s a. (Prelude.Functor f, @@ -205,24 +140,6 @@ maybe'end :: Data.ProtoLens.Field.HasField s "maybe'end" a) => Lens.Family2.LensLike' f s a maybe'end = Data.ProtoLens.Field.field @"maybe'end" -maybe'inserted :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "maybe'inserted" a) => - Lens.Family2.LensLike' f s a -maybe'inserted = Data.ProtoLens.Field.field @"maybe'inserted" -maybe'merged :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "maybe'merged" a) => - Lens.Family2.LensLike' f s a -maybe'merged = Data.ProtoLens.Field.field @"maybe'merged" -maybe'replaced :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "maybe'replaced" a) => - Lens.Family2.LensLike' f s a -maybe'replaced = Data.ProtoLens.Field.field @"maybe'replaced" maybe'span :: forall f s a. (Prelude.Functor f, @@ -235,11 +152,6 @@ maybe'start :: Data.ProtoLens.Field.HasField s "maybe'start" a) => Lens.Family2.LensLike' f s a maybe'start = Data.ProtoLens.Field.field @"maybe'start" -merged :: - forall f s a. - (Prelude.Functor f, Data.ProtoLens.Field.HasField s "merged" a) => - Lens.Family2.LensLike' f s a -merged = Data.ProtoLens.Field.field @"merged" name :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "name" a) => @@ -266,12 +178,6 @@ paths :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "paths" a) => Lens.Family2.LensLike' f s a paths = Data.ProtoLens.Field.field @"paths" -replaced :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "replaced" a) => - Lens.Family2.LensLike' f s a -replaced = Data.ProtoLens.Field.field @"replaced" service :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "service" a) => @@ -282,11 +188,6 @@ sha :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "sha" a) => Lens.Family2.LensLike' f s a sha = Data.ProtoLens.Field.field @"sha" -source :: - forall f s a. - (Prelude.Functor f, Data.ProtoLens.Field.HasField s "source" a) => - Lens.Family2.LensLike' f s a -source = Data.ProtoLens.Field.field @"source" span :: forall f s a. (Prelude.Functor f, Data.ProtoLens.Field.HasField s "span" a) => @@ -332,16 +233,6 @@ syntaxType :: Data.ProtoLens.Field.HasField s "syntaxType" a) => Lens.Family2.LensLike' f s a syntaxType = Data.ProtoLens.Field.field @"syntaxType" -target :: - forall f s a. - (Prelude.Functor f, Data.ProtoLens.Field.HasField s "target" a) => - Lens.Family2.LensLike' f s a -target = Data.ProtoLens.Field.field @"target" -term :: - forall f s a. - (Prelude.Functor f, Data.ProtoLens.Field.HasField s "term" a) => - Lens.Family2.LensLike' f s a -term = Data.ProtoLens.Field.field @"term" timestamp :: forall f s a. (Prelude.Functor f, @@ -359,12 +250,6 @@ vec'blobs :: Data.ProtoLens.Field.HasField s "vec'blobs" a) => Lens.Family2.LensLike' f s a vec'blobs = Data.ProtoLens.Field.field @"vec'blobs" -vec'edges :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "vec'edges" a) => - Lens.Family2.LensLike' f s a -vec'edges = Data.ProtoLens.Field.field @"vec'edges" vec'endingScopeStack :: forall f s a. (Prelude.Functor f, @@ -415,22 +300,4 @@ vec'symbols :: (Prelude.Functor f, Data.ProtoLens.Field.HasField s "vec'symbols" a) => Lens.Family2.LensLike' f s a -vec'symbols = Data.ProtoLens.Field.field @"vec'symbols" -vec'vertices :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "vec'vertices" a) => - Lens.Family2.LensLike' f s a -vec'vertices = Data.ProtoLens.Field.field @"vec'vertices" -vertexId :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "vertexId" a) => - Lens.Family2.LensLike' f s a -vertexId = Data.ProtoLens.Field.field @"vertexId" -vertices :: - forall f s a. - (Prelude.Functor f, - Data.ProtoLens.Field.HasField s "vertices" a) => - Lens.Family2.LensLike' f s a -vertices = Data.ProtoLens.Field.field @"vertices" +vec'symbols = Data.ProtoLens.Field.field @"vec'symbols" \ No newline at end of file diff --git a/semantic-proto/src/Proto/Semantic_JSON.hs b/semantic-proto/src/Proto/Semantic_JSON.hs index 479d92418..6fc4779eb 100644 --- a/semantic-proto/src/Proto/Semantic_JSON.hs +++ b/semantic-proto/src/Proto/Semantic_JSON.hs @@ -113,27 +113,6 @@ instance ToJSON ParseTreeSymbolResponse where toJSON = toAesonValue toEncoding = toAesonEncoding -instance FromJSONPB ParseTreeGraphResponse where - parseJSONPB = withObject "ParseTreeGraphResponse" $ \obj -> do - files' <- obj .: "files" - pure $ defMessage - & P.files .~ files' - -instance ToJSONPB ParseTreeGraphResponse where - toJSONPB x = object - [ "files" .= (x^.files) - ] - toEncodingPB x = pairs - [ "files" .= (x^.files) - ] - -instance FromJSON ParseTreeGraphResponse where - parseJSON = parseJSONPB - -instance ToJSON ParseTreeGraphResponse where - toJSON = toAesonValue - toEncoding = toAesonEncoding - instance FromJSONPB StackGraphRequest where parseJSONPB = withObject "StackGraphRequest" $ \obj -> do blobs' <- obj .: "blobs" @@ -176,97 +155,6 @@ instance ToJSON StackGraphResponse where toJSON = toAesonValue toEncoding = toAesonEncoding -instance FromJSONPB ParseTreeFileGraph where - parseJSONPB = withObject "ParseTreeFileGraph" $ \obj -> do - path' <- obj .: "path" - language' <- obj .: "language" - vertices' <- obj .: "vertices" - edges' <- obj .: "edges" - errors' <- obj .: "errors" - pure $ defMessage - & P.path .~ path' - & P.language .~ language' - & P.vertices .~ vertices' - & P.edges .~ edges' - & P.errors .~ errors' - -instance ToJSONPB ParseTreeFileGraph where - toJSONPB x = object - [ "path" .= (x^.path) - , "language" .= (x^.language) - , "vertices" .= (x^.vertices) - , "edges" .= (x^.edges) - , "errors" .= (x^.errors) - ] - toEncodingPB x = pairs - [ "path" .= (x^.path) - , "language" .= (x^.language) - , "vertices" .= (x^.vertices) - , "edges" .= (x^.edges) - , "errors" .= (x^.errors) - ] - -instance FromJSON ParseTreeFileGraph where - parseJSON = parseJSONPB - -instance ToJSON ParseTreeFileGraph where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB TermEdge where - parseJSONPB = withObject "TermEdge" $ \obj -> do - source' <- obj .: "source" - target' <- obj .: "target" - pure $ defMessage - & P.source .~ source' - & P.target .~ target' - -instance ToJSONPB TermEdge where - toJSONPB x = object - [ "source" .= (x^.source) - , "target" .= (x^.target) - ] - toEncodingPB x = pairs - [ "source" .= (x^.source) - , "target" .= (x^.target) - ] - -instance FromJSON TermEdge where - parseJSON = parseJSONPB - -instance ToJSON TermEdge where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB TermVertex where - parseJSONPB = withObject "TermVertex" $ \obj -> do - vertexId' <- obj .: "vertexId" - term' <- obj .: "term" - span' <- obj A..:? "span" - pure $ defMessage - & P.vertexId .~ vertexId' - & P.term .~ term' - & P.maybe'span .~ span' - -instance ToJSONPB TermVertex where - toJSONPB x = object - [ "vertexId" .= (x^.vertexId) - , "term" .= (x^.term) - , "span" .= (x^.maybe'span) - ] - toEncodingPB x = pairs - [ "vertexId" .= (x^.vertexId) - , "term" .= (x^.term) - , "span" .= (x^.maybe'span) - ] - -instance FromJSON TermVertex where - parseJSON = parseJSONPB - -instance ToJSON TermVertex where - toJSON = toAesonValue - toEncoding = toAesonEncoding - instance FromJSONPB ParseError where parseJSONPB = withObject "ParseError" $ \obj -> do error' <- obj .: "error" @@ -288,252 +176,6 @@ instance ToJSON ParseError where toJSON = toAesonValue toEncoding = toAesonEncoding -instance FromJSONPB DiffTreeGraphResponse where - parseJSONPB = withObject "DiffTreeGraphResponse" $ \obj -> do - files' <- obj .: "files" - pure $ defMessage - & P.files .~ files' - -instance ToJSONPB DiffTreeGraphResponse where - toJSONPB x = object - [ "files" .= (x^.files) - ] - toEncodingPB x = pairs - [ "files" .= (x^.files) - ] - -instance FromJSON DiffTreeGraphResponse where - parseJSON = parseJSONPB - -instance ToJSON DiffTreeGraphResponse where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB DiffTreeFileGraph where - parseJSONPB = withObject "DiffTreeFileGraph" $ \obj -> do - path' <- obj .: "path" - language' <- obj .: "language" - vertices' <- obj .: "vertices" - edges' <- obj .: "edges" - errors' <- obj .: "errors" - pure $ defMessage - & P.path .~ path' - & P.language .~ language' - & P.vertices .~ vertices' - & P.edges .~ edges' - & P.errors .~ errors' - -instance ToJSONPB DiffTreeFileGraph where - toJSONPB x = object - [ "path" .= (x^.path) - , "language" .= (x^.language) - , "vertices" .= (x^.vertices) - , "edges" .= (x^.edges) - , "errors" .= (x^.errors) - ] - toEncodingPB x = pairs - [ "path" .= (x^.path) - , "language" .= (x^.language) - , "vertices" .= (x^.vertices) - , "edges" .= (x^.edges) - , "errors" .= (x^.errors) - ] - -instance FromJSON DiffTreeFileGraph where - parseJSON = parseJSONPB - -instance ToJSON DiffTreeFileGraph where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB DiffTreeEdge where - parseJSONPB = withObject "DiffTreeEdge" $ \obj -> do - source' <- obj .: "source" - target' <- obj .: "target" - pure $ defMessage - & P.source .~ source' - & P.target .~ target' - -instance ToJSONPB DiffTreeEdge where - toJSONPB x = object - [ "source" .= (x^.source) - , "target" .= (x^.target) - ] - toEncodingPB x = pairs - [ "source" .= (x^.source) - , "target" .= (x^.target) - ] - -instance FromJSON DiffTreeEdge where - parseJSON = parseJSONPB - -instance ToJSON DiffTreeEdge where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB DiffTreeVertex'DiffTerm where - parseJSONPB = A.withObject "DiffTreeVertex'DiffTerm" $ \obj -> mconcat - [ - DiffTreeVertex'Deleted <$> parseField obj "deleted" - , DiffTreeVertex'Inserted <$> parseField obj "inserted" - , DiffTreeVertex'Replaced <$> parseField obj "replaced" - , DiffTreeVertex'Merged <$> parseField obj "merged" - ] - -instance ToJSONPB DiffTreeVertex'DiffTerm where - toJSONPB (DiffTreeVertex'Deleted x) = object [ "deleted" .= Just x ] - toJSONPB (DiffTreeVertex'Inserted x) = object [ "inserted" .= Just x ] - toJSONPB (DiffTreeVertex'Replaced x) = object [ "replaced" .= Just x ] - toJSONPB (DiffTreeVertex'Merged x) = object [ "merged" .= Just x ] - toEncodingPB (DiffTreeVertex'Deleted x) = pairs [ "deleted" .= Just x ] - toEncodingPB (DiffTreeVertex'Inserted x) = pairs [ "inserted" .= Just x ] - toEncodingPB (DiffTreeVertex'Replaced x) = pairs [ "replaced" .= Just x ] - toEncodingPB (DiffTreeVertex'Merged x) = pairs [ "merged" .= Just x ] - -instance FromJSON DiffTreeVertex'DiffTerm where - parseJSON = parseJSONPB - -instance ToJSON DiffTreeVertex'DiffTerm where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB DiffTreeVertex where - parseJSONPB = withObject "DiffTreeVertex" $ \obj -> do - diffVertexId' <- obj .: "diffVertexId" - diffTerm' <- obj A..:? "diffTerm" - pure $ defMessage - & P.diffVertexId .~ diffVertexId' - & P.maybe'diffTerm .~ diffTerm' - -instance ToJSONPB DiffTreeVertex where - toJSONPB x = object - [ "diffVertexId" .= (x^.diffVertexId) - , "diffTerm" .= (x^.maybe'diffTerm) - ] - toEncodingPB x = pairs - [ "diffVertexId" .= (x^.diffVertexId) - , "diffTerm" .= (x^.maybe'diffTerm) - ] - -instance FromJSON DiffTreeVertex where - parseJSON = parseJSONPB - -instance ToJSON DiffTreeVertex where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB DeletedTerm where - parseJSONPB = withObject "DeletedTerm" $ \obj -> do - term' <- obj .: "term" - span' <- obj A..:? "span" - pure $ defMessage - & P.term .~ term' - & P.maybe'span .~ span' - -instance ToJSONPB DeletedTerm where - toJSONPB x = object - [ "term" .= (x^.term) - , "span" .= (x^.maybe'span) - ] - toEncodingPB x = pairs - [ "term" .= (x^.term) - , "span" .= (x^.maybe'span) - ] - -instance FromJSON DeletedTerm where - parseJSON = parseJSONPB - -instance ToJSON DeletedTerm where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB InsertedTerm where - parseJSONPB = withObject "InsertedTerm" $ \obj -> do - term' <- obj .: "term" - span' <- obj A..:? "span" - pure $ defMessage - & P.term .~ term' - & P.maybe'span .~ span' - -instance ToJSONPB InsertedTerm where - toJSONPB x = object - [ "term" .= (x^.term) - , "span" .= (x^.maybe'span) - ] - toEncodingPB x = pairs - [ "term" .= (x^.term) - , "span" .= (x^.maybe'span) - ] - -instance FromJSON InsertedTerm where - parseJSON = parseJSONPB - -instance ToJSON InsertedTerm where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB ReplacedTerm where - parseJSONPB = withObject "ReplacedTerm" $ \obj -> do - beforeTerm' <- obj .: "beforeTerm" - beforeSpan' <- obj A..:? "beforeSpan" - afterTerm' <- obj .: "afterTerm" - afterSpan' <- obj A..:? "afterSpan" - pure $ defMessage - & P.beforeTerm .~ beforeTerm' - & P.maybe'beforeSpan .~ beforeSpan' - & P.afterTerm .~ afterTerm' - & P.maybe'afterSpan .~ afterSpan' - -instance ToJSONPB ReplacedTerm where - toJSONPB x = object - [ "beforeTerm" .= (x^.beforeTerm) - , "beforeSpan" .= (x^.maybe'beforeSpan) - , "afterTerm" .= (x^.afterTerm) - , "afterSpan" .= (x^.maybe'afterSpan) - ] - toEncodingPB x = pairs - [ "beforeTerm" .= (x^.beforeTerm) - , "beforeSpan" .= (x^.maybe'beforeSpan) - , "afterTerm" .= (x^.afterTerm) - , "afterSpan" .= (x^.maybe'afterSpan) - ] - -instance FromJSON ReplacedTerm where - parseJSON = parseJSONPB - -instance ToJSON ReplacedTerm where - toJSON = toAesonValue - toEncoding = toAesonEncoding - -instance FromJSONPB MergedTerm where - parseJSONPB = withObject "MergedTerm" $ \obj -> do - term' <- obj .: "term" - beforeSpan' <- obj A..:? "beforeSpan" - afterSpan' <- obj A..:? "afterSpan" - pure $ defMessage - & P.term .~ term' - & P.maybe'beforeSpan .~ beforeSpan' - & P.maybe'afterSpan .~ afterSpan' - -instance ToJSONPB MergedTerm where - toJSONPB x = object - [ "term" .= (x^.term) - , "beforeSpan" .= (x^.maybe'beforeSpan) - , "afterSpan" .= (x^.maybe'afterSpan) - ] - toEncodingPB x = pairs - [ "term" .= (x^.term) - , "beforeSpan" .= (x^.maybe'beforeSpan) - , "afterSpan" .= (x^.maybe'afterSpan) - ] - -instance FromJSON MergedTerm where - parseJSON = parseJSONPB - -instance ToJSON MergedTerm where - toJSON = toAesonValue - toEncoding = toAesonEncoding - instance FromJSONPB Blob where parseJSONPB = withObject "Blob" $ \obj -> do content' <- obj .: "content" diff --git a/semantic.cabal b/semantic.cabal index 4c1d83e10..138e8c602 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -92,9 +92,7 @@ library , Analysis.Abstract.Tracing , Analysis.ConstructorName , Analysis.CyclomaticComplexity - , Analysis.Decorator , Analysis.HasTextElement - , Analysis.PackageDef -- Semantic assignment , Assigning.Assignment , Assigning.Assignment.Table @@ -141,11 +139,9 @@ library , Data.Abstract.Value.Concrete , Data.Abstract.Value.Type -- General datatype definitions & generic algorithms - , Data.Algebra , Data.AST , Data.Blob , Data.Blob.IO - , Data.Diff , Data.Duration , Data.Edit , Data.Error @@ -156,13 +152,13 @@ library , Data.Handle , Data.History , Data.ImportPath - , Data.JSON.Fields , Data.Language , Data.Map.Monoidal , Data.Maybe.Exts , Data.Quieterm , Data.Semigroup.App , Data.Scientific.Exts + , Data.Term -- À la carte syntax types , Data.Syntax , Data.Syntax.Comment @@ -172,13 +168,6 @@ library , Data.Syntax.Literal , Data.Syntax.Statement , Data.Syntax.Type - , Data.Term - -- Diffing algorithms & interpretation thereof - , Diffing.Algorithm - , Diffing.Algorithm.RWS - , Diffing.Algorithm.RWS.FeatureVector - , Diffing.Algorithm.SES - , Diffing.Interpreter -- Language-specific grammar/syntax types, & assignments , Language.Go.Assignment , Language.Go.Syntax @@ -208,15 +197,11 @@ library -- Parser glue , Parsing.Parser , Parsing.TreeSitter - -- Rendering formats - , Rendering.Graph - , Rendering.JSON -- High-level flow & operational functionality (logging, stats, etc.) , Semantic.Analysis -- API , Semantic.Api , Semantic.Api.Bridge - , Semantic.Api.Diffs , Semantic.Api.StackGraph , Semantic.Api.Symbols , Semantic.Api.Terms @@ -322,7 +307,6 @@ test-suite test , Control.Abstract.Evaluator.Spec , Data.Abstract.Path.Spec , Data.Abstract.Name.Spec - , Data.Diff.Spec , Data.Functor.Classes.Generic.Spec , Data.Functor.Listable , Data.Graph.Spec @@ -331,9 +315,6 @@ test-suite test , Data.Scientific.Spec , Data.Semigroup.App.Spec , Data.Term.Spec - , Diffing.Algorithm.RWS.Spec - , Diffing.Algorithm.SES.Spec - , Diffing.Interpreter.Spec , Graphing.Calls.Spec , Integration.Spec , Numeric.Spec diff --git a/src/Analysis/Decorator.hs b/src/Analysis/Decorator.hs deleted file mode 100644 index 6b8151698..000000000 --- a/src/Analysis/Decorator.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -module Analysis.Decorator -( decoratorWithAlgebra -) where - -import Data.Algebra -import Data.Bifunctor -import Data.Functor.Foldable -import Data.Term - --- | Lift an algebra into a decorator for terms annotated with records. -decoratorWithAlgebra :: (Functor (Syntax term), IsTerm term, Recursive (term a), Base (term a) ~ TermF (Syntax term) a) - => RAlgebra (TermF (Syntax term) a) (term a) b -- ^ An R-algebra on terms. - -> term a -- ^ A term to decorate with values produced by the R-algebra. - -> term b -- ^ A term decorated with values produced by the R-algebra. -decoratorWithAlgebra alg = para $ \ c@(In _ f) -> termIn (alg (fmap (second termAnnotation) c)) (fmap snd f) diff --git a/src/Analysis/PackageDef.hs b/src/Analysis/PackageDef.hs deleted file mode 100644 index d9843d9e7..000000000 --- a/src/Analysis/PackageDef.hs +++ /dev/null @@ -1,101 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -module Analysis.PackageDef -( PackageDef(..) -, HasPackageDef -, packageDefAlgebra -) where - -import Data.Algebra -import Data.Blob -import Data.Proxy -import Data.Sum -import Data.Term -import qualified Data.Text as T -import qualified Language.Go.Syntax -import Source.Loc -import Source.Source as Source - -newtype PackageDef = PackageDef { moduleDefIdentifier :: T.Text } - deriving (Eq, Show) - --- | An r-algebra producing 'Just' a 'PackageDef' for syntax nodes corresponding to high-level declarations, or 'Nothing' otherwise. --- --- Customizing this for a given syntax type involves two steps: --- --- 1. Defining a 'CustomHasPackageDef' instance for the type. --- 2. Adding the type to the 'PackageDefStrategy' type family. --- --- If you’re getting errors about missing a 'CustomHasPackageDef' instance for your syntax type, you probably forgot step 1. --- --- If you’re getting 'Nothing' for your syntax node at runtime, you probably forgot step 2. -packageDefAlgebra :: (Foldable syntax, HasPackageDef syntax) => Blob -> RAlgebra (TermF syntax Loc) (Term syntax Loc) (Maybe PackageDef) -packageDefAlgebra blob (In ann syntax) = toPackageDef blob ann syntax - - --- | Types for which we can produce a 'PackageDef' in 'Maybe'. There is exactly one instance of this typeclass; adding customized 'PackageDef's for a new type is done by defining an instance of 'CustomHasPackageDef' instead. --- --- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap. -class HasPackageDef syntax where - -- | Compute a 'PackageDef' for a syntax type using its 'CustomHasPackageDef' instance, if any, or else falling back to the default definition (which simply returns 'Nothing'). - toPackageDef :: (Foldable whole) => Blob -> Loc -> syntax (Term whole Loc, Maybe PackageDef) -> Maybe PackageDef - --- | Define 'toPackageDef' using the 'CustomHasPackageDef' instance for a type if there is one or else use the default definition. --- --- This instance determines whether or not there is an instance for @syntax@ by looking it up in the 'PackageDefStrategy' type family. Thus producing a 'PackageDef' for a node requires both defining a 'CustomHasPackageDef' instance _and_ adding a definition for the type to the 'PackageDefStrategy' type family to return 'Custom'. --- --- Note that since 'PackageDefStrategy' has a fallback case for its final entry, this instance will hold for all types of kind @* -> *@. Thus, this must be the only instance of 'HasPackageDef', as any other instance would be indistinguishable. -instance (PackageDefStrategy syntax ~ strategy, HasPackageDefWithStrategy strategy syntax) => HasPackageDef syntax where - toPackageDef = toPackageDefWithStrategy (Proxy :: Proxy strategy) - - --- | Types for which we can produce a customized 'PackageDef'. This returns in 'Maybe' so that some values can be opted out (e.g. anonymous functions). -class CustomHasPackageDef syntax where - -- | Produce a customized 'PackageDef' for a given syntax node. - customToPackageDef :: (Foldable whole) => Blob -> Loc -> syntax (Term whole Loc, Maybe PackageDef) -> Maybe PackageDef - - -instance CustomHasPackageDef Language.Go.Syntax.Package where - customToPackageDef Blob{..} _ (Language.Go.Syntax.Package (Term (In fromAnn _), _) _) - = Just $ PackageDef (getSource fromAnn) - where getSource = toText . Source.slice blobSource . byteRange - --- | Produce a 'PackageDef' for 'Sum's using the 'HasPackageDef' instance & therefore using a 'CustomHasPackageDef' instance when one exists & the type is listed in 'PackageDefStrategy'. -instance Apply HasPackageDef fs => CustomHasPackageDef (Sum fs) where - customToPackageDef blob ann = apply @HasPackageDef (toPackageDef blob ann) - - --- | A strategy for defining a 'HasPackageDef' instance. Intended to be promoted to the kind level using @-XDataKinds@. -data Strategy = Default | Custom - --- | Produce a 'PackageDef' for a syntax node using either the 'Default' or 'Custom' strategy. --- --- You should probably be using 'CustomHasPackageDef' instead of this class; and you should not define new instances of this class. -class HasPackageDefWithStrategy (strategy :: Strategy) syntax where - toPackageDefWithStrategy :: (Foldable whole) => proxy strategy -> Blob -> Loc -> syntax (Term whole Loc, Maybe PackageDef) -> Maybe PackageDef - - --- | A predicate on syntax types selecting either the 'Custom' or 'Default' strategy. --- --- Only entries for which we want to use the 'Custom' strategy should be listed, with the exception of the final entry which maps all other types onto the 'Default' strategy. --- --- If you’re seeing errors about missing a 'CustomHasPackageDef' instance for a given type, you’ve probably listed it in here but not defined a 'CustomHasPackageDef' instance for it, or else you’ve listed the wrong type in here. Conversely, if your 'customHasPackageDef' method is never being called, you may have forgotten to list the type in here. -type family PackageDefStrategy syntax where - PackageDefStrategy Language.Go.Syntax.Package = 'Custom - PackageDefStrategy (Sum _) = 'Custom - PackageDefStrategy _ = 'Default - - --- | The 'Default' strategy produces 'Nothing'. -instance HasPackageDefWithStrategy 'Default syntax where - toPackageDefWithStrategy _ _ _ _ = Nothing - --- | The 'Custom' strategy delegates the selection of the strategy to the 'CustomHasPackageDef' instance for the type. -instance CustomHasPackageDef syntax => HasPackageDefWithStrategy 'Custom syntax where - toPackageDefWithStrategy _ = customToPackageDef diff --git a/src/Data/AST.hs b/src/Data/AST.hs index 2282cdd42..8675db876 100644 --- a/src/Data/AST.hs +++ b/src/Data/AST.hs @@ -7,9 +7,6 @@ module Data.AST ) where import Data.Term -import Data.Aeson -import Data.Text (pack) -import Data.JSON.Fields import Source.Loc as Loc -- | An AST node labelled with symbols and source location. @@ -21,13 +18,6 @@ data Node grammar = Node } deriving (Eq, Ord, Show) - -instance Show grammar => ToJSONFields (Node grammar) where - toJSONFields Node{..} = - [ "symbol" .= pack (show nodeSymbol) - , "span" .= Loc.span nodeLocation - ] - nodeSpan :: Node grammar -> Span nodeSpan = Loc.span . nodeLocation diff --git a/src/Data/Algebra.hs b/src/Data/Algebra.hs deleted file mode 100644 index ebcf660cc..000000000 --- a/src/Data/Algebra.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE DeriveGeneric, DeriveTraversable, RankNTypes #-} -module Data.Algebra - ( FAlgebra - , RAlgebra - , Subterm(..) - , SubtermAlgebra - , embedTerm - , foldSubterms - ) where - -import Data.Functor.Classes.Generic as X -import Data.Functor.Foldable ( Base - , Corecursive(embed) - , Recursive(project) - ) -import GHC.Generics - --- | An F-algebra on some 'Recursive' type @t@. --- --- An F-algebra is an evaluator for a functor (@f@) populated with the results (@a@s) of evaluating each child of the functor to a result (@a@), applied at each node starting from the leaves and working towards the root. @a@ is called the carrier type of the algebra because it carries the (results of the) functions used to compute the functor’s structure and enforce the laws of that algebra. -type FAlgebra f a = f a -> a - --- | An R-algebra on some 'Recursive' type @t@. --- --- An R-algebra is an evaluator for a functor (@f@) populated with pairs of the children (@t@) and the results (@a@s) of evaluating each child of the functor to a result (@a@), applied at each node starting from the leaves and working towards the root. --- --- See also 'FAlgebra'. -type RAlgebra f t a = f (t, a) -> a - --- | A subterm and its computed value, used in 'SubtermAlgebra'. -data Subterm t a = Subterm { subterm :: !t, subtermRef :: !a } - deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable) - -instance Eq t => Eq1 (Subterm t) where liftEq = genericLiftEq -instance Ord t => Ord1 (Subterm t) where liftCompare = genericLiftCompare -instance Show t => Show1 (Subterm t) where liftShowsPrec = genericLiftShowsPrec - --- | Like an R-algebra, but using 'Subterm' to label the fields instead of an anonymous pair. -type SubtermAlgebra f t a = f (Subterm t a) -> a - - --- | Fold a 'Recursive' structure using a 'SubtermAlgebra'. Like 'para', but with named fields for subterms and values. -foldSubterms :: Recursive t => SubtermAlgebra (Base t) t a -> t -> a -foldSubterms algebra = go where go = algebra . fmap (Subterm <*> go) . project - --- | Extract a term from the carrier tuple associated with a paramorphism. See also 'embedSubterm'. -embedTerm :: Corecursive t => Base t (t, a) -> t -embedTerm e = embed (fst <$> e) diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index b3cf3bd5a..3565369f7 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -31,7 +31,6 @@ import Data.Aeson import Data.Bifunctor import qualified Data.ByteString.Lazy as BL import Data.Edit -import Data.JSON.Fields import Data.Maybe.Exts import Data.Module import Data.List (stripPrefix) @@ -100,8 +99,5 @@ pathKeyForBlobPair = mergeEdit combine . bimap blobFilePath blobFilePath where combine before after | before == after = after | otherwise = before <> " -> " <> after -instance ToJSONFields Blob where - toJSONFields p = [ "path" .= blobFilePath p, "language" .= blobLanguage p] - decodeBlobPairs :: BL.ByteString -> Either String [BlobPair] decodeBlobPairs = fmap blobs <$> eitherDecode diff --git a/src/Data/Diff.hs b/src/Data/Diff.hs deleted file mode 100644 index 924dd33d6..000000000 --- a/src/Data/Diff.hs +++ /dev/null @@ -1,199 +0,0 @@ -{-# LANGUAGE DataKinds, LambdaCase, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables, UndecidableInstances #-} -module Data.Diff -( Diff(..) -, DiffF(..) -, comparing -, compareF -, inserting -, insertF -, deleting -, deleteF -, merge -, mergeF -, merging -, diffPatches -) where - -import Data.Aeson -import Data.Bifoldable -import Data.Bifunctor -import Data.Bitraversable -import Data.Edit -import Data.Functor.Classes -import Data.Functor.Foldable -import Data.JSON.Fields -import Data.Term -import Text.Show - --- | A recursive structure indicating the changed & unchanged portions of a labelled tree. -newtype Diff syntax ann1 ann2 = Diff { unDiff :: DiffF syntax ann1 ann2 (Diff syntax ann1 ann2) } - --- | A single entry within a recursive 'Diff'. -data DiffF syntax ann1 ann2 recur - -- | A changed node, represented as 'Insert'ed, 'Delete'd, or 'Compare'd 'TermF's, consisting of syntax labelled with an annotation. - = Patch (Edit (TermF syntax ann1 recur) - (TermF syntax ann2 recur)) - -- | An unchanged node, consisting of syntax labelled with both the original annotations. - | Merge (TermF syntax (ann1, ann2) recur) - --- | Constructs a 'Diff' comparing one 'Term' with another recursively. -comparing :: Functor syntax => Term syntax ann1 -> Term syntax ann2 -> Diff syntax ann1 ann2 -comparing (Term (In a1 r1)) (Term (In a2 r2)) = compareF (In a1 (deleting <$> r1)) (In a2 (inserting <$> r2)) - --- | Constructs a 'Diff' comparing one 'TermF' populated by further 'Diff's with another. -compareF :: TermF syntax ann1 (Diff syntax ann1 ann2) -> TermF syntax ann2 (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2 -compareF t1 t2 = Diff (Patch (Compare t1 t2)) - --- | Constructs a 'Diff' inserting a 'Term' recursively. -inserting :: Functor syntax => Term syntax ann2 -> Diff syntax ann1 ann2 -inserting = cata insertF - --- | Constructs a 'Diff' inserting a single 'TermF' populated by further 'Diff's. -insertF :: TermF syntax ann2 (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2 -insertF = Diff . Patch . Insert - --- | Constructs a 'Diff' deleting a 'Term' recursively. -deleting :: Functor syntax => Term syntax ann1 -> Diff syntax ann1 ann2 -deleting = cata deleteF - --- | Constructs a 'Diff' deleting a single 'TermF' populated by further 'Diff's. -deleteF :: TermF syntax ann1 (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2 -deleteF = Diff . Patch . Delete - --- | Constructs a 'Diff' merging two annotations for a single syntax functor populated by further 'Diff's. -merge :: (ann1, ann2) -> syntax (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2 -merge = fmap mergeF . In - --- | Constructs a 'Diff' merging a single 'TermF' populated by further 'Diff's. -mergeF :: TermF syntax (ann1, ann2) (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2 -mergeF = Diff . Merge - --- | Constructs a 'Diff' merging a 'Term' recursively. --- --- Note that since this simply duplicates the 'Term'’s annotations, it is only really useful in tests or other contexts where preserving annotations from both sides is unnecessary. -merging :: Functor syntax => Term syntax ann -> Diff syntax ann ann -merging = cata (\ (In ann syntax) -> mergeF (In (ann, ann) syntax)) - - -diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann1 ann2 -> [Edit (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2))] -diffPatches = para $ \case - Patch patch -> bimap (fmap fst) (fmap fst) patch : bifoldMap (foldMap snd) (foldMap snd) patch - Merge merge -> foldMap snd merge - - -type instance Base (Diff syntax ann1 ann2) = DiffF syntax ann1 ann2 - -instance Functor syntax => Recursive (Diff syntax ann1 ann2) where project = unDiff -instance Functor syntax => Corecursive (Diff syntax ann1 ann2) where embed = Diff - - -instance Eq1 syntax => Eq2 (Diff syntax) where - liftEq2 eq1 eq2 = go where go (Diff d1) (Diff d2) = liftEq3 eq1 eq2 go d1 d2 - -instance (Eq1 syntax, Eq ann1, Eq ann2) => Eq (Diff syntax ann1 ann2) where - (==) = eq2 - -instance Eq1 syntax => Eq3 (DiffF syntax) where - liftEq3 eq1 eq2 eqRecur d1 d2 = case (d1, d2) of - (Patch p1, Patch p2) -> liftEq2 (liftEq2 eq1 eqRecur) (liftEq2 eq2 eqRecur) p1 p2 - (Merge t1, Merge t2) -> liftEq2 (liftEq2 eq1 eq2) eqRecur t1 t2 - _ -> False - -instance (Eq1 syntax, Eq ann1, Eq ann2) => Eq1 (DiffF syntax ann1 ann2) where - liftEq = liftEq3 (==) (==) - -instance (Eq1 syntax, Eq ann1, Eq ann2, Eq recur) => Eq (DiffF syntax ann1 ann2 recur) where - (==) = eq3 - - -instance Show1 syntax => Show2 (Diff syntax) where - liftShowsPrec2 sp1 sl1 sp2 sl2 = go where go d = showsUnaryWith (liftShowsPrec3 sp1 sl1 sp2 sl2 go (showListWith (go 0))) "Diff" d . unDiff - -instance (Show1 syntax, Show ann1, Show ann2) => Show (Diff syntax ann1 ann2) where - showsPrec = showsPrec2 - -instance Show1 syntax => Show3 (DiffF syntax) where - liftShowsPrec3 sp1 sl1 sp2 sl2 spRecur slRecur d diff = case diff of - Patch patch -> showsUnaryWith (liftShowsPrec2 (liftShowsPrec2 sp1 sl1 spRecur slRecur) (liftShowList2 sp1 sl1 spRecur slRecur) (liftShowsPrec2 sp2 sl2 spRecur slRecur) (liftShowList2 sp2 sl2 spRecur slRecur)) "Patch" d patch - Merge term -> showsUnaryWith (liftShowsPrec2 spBoth slBoth spRecur slRecur) "Merge" d term - where spBoth = liftShowsPrec2 sp1 sl1 sp2 sl2 - slBoth = liftShowList2 sp1 sl1 sp2 sl2 - -instance (Show1 syntax, Show ann1, Show ann2) => Show1 (DiffF syntax ann1 ann2) where - liftShowsPrec = liftShowsPrec3 showsPrec showList showsPrec showList - -instance (Show1 syntax, Show ann1, Show ann2, Show recur) => Show (DiffF syntax ann1 ann2 recur) where - showsPrec = showsPrec3 - -instance Functor syntax => Bifunctor (Diff syntax) where - bimap f g = go where go = Diff . trimap f g go . unDiff - -instance Foldable syntax => Bifoldable (Diff syntax) where - bifoldMap f g = go where go = trifoldMap f g go . unDiff - -instance Traversable syntax => Bitraversable (Diff syntax) where - bitraverse f g = go where go = fmap Diff . tritraverse f g go . unDiff - - -instance Functor syntax => Functor (DiffF syntax ann1 ann2) where - fmap = trimap id id - -instance Functor syntax => Trifunctor (DiffF syntax) where - trimap f g h (Patch patch) = Patch (bimap (bimap f h) (bimap g h) patch) - trimap f g h (Merge term) = Merge (bimap (bimap f g) h term) - -instance Foldable syntax => Foldable (DiffF syntax ann1 ann2) where - foldMap = trifoldMap (const mempty) (const mempty) - -instance Foldable syntax => Trifoldable (DiffF syntax) where - trifoldMap f g h (Patch patch) = bifoldMap (bifoldMap f h) (bifoldMap g h) patch - trifoldMap f g h (Merge term) = bifoldMap (bifoldMap f g) h term - -instance Traversable syntax => Traversable (DiffF syntax ann1 ann2) where - traverse = tritraverse pure pure - -instance Traversable syntax => Tritraversable (DiffF syntax) where - tritraverse f g h (Patch patch) = Patch <$> bitraverse (bitraverse f h) (bitraverse g h) patch - tritraverse f g h (Merge term) = Merge <$> bitraverse (bitraverse f g) h term - - -instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2) => ToJSON (Diff syntax ann1 ann2) where - toJSON = object . toJSONFields - toEncoding = pairs . mconcat . toJSONFields - -instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2) => ToJSONFields (Diff syntax ann1 ann2) where - toJSONFields = toJSONFields . unDiff - -instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2) => ToJSONFields1 (DiffF syntax ann1 ann2) where - toJSONFields1 (Patch patch) = [ "patch" .= JSONFields patch ] - toJSONFields1 (Merge term) = [ "merge" .= JSONFields term ] - -instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2, ToJSON recur) => ToJSONFields (DiffF syntax ann1 ann2 recur) where - toJSONFields = toJSONFields1 - -instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2, ToJSON recur) => ToJSON (DiffF syntax ann1 ann2 recur) where - toJSON = object . toJSONFields - toEncoding = pairs . mconcat . toJSONFields - - -class Eq3 f where - liftEq3 :: (a1 -> a2 -> Bool) -> (b1 -> b2 -> Bool) -> (c1 -> c2 -> Bool) -> f a1 b1 c1 -> f a2 b2 c2 -> Bool - -eq3 :: (Eq3 f, Eq a, Eq b, Eq c) => f a b c -> f a b c -> Bool -eq3 = liftEq3 (==) (==) (==) - - -class Show3 f where - liftShowsPrec3 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> (Int -> c -> ShowS) -> ([c] -> ShowS) -> Int -> f a b c -> ShowS - -showsPrec3 :: (Show3 f, Show a, Show b, Show c) => Int -> f a b c -> ShowS -showsPrec3 = liftShowsPrec3 showsPrec showList showsPrec showList showsPrec showList - -class Trifunctor f where - trimap :: (a -> a') -> (b -> b') -> (c -> c') -> f a b c -> f a' b' c' - -class Trifoldable f where - trifoldMap :: Monoid m => (a -> m) -> (b -> m) -> (c -> m) -> f a b c -> m - -class Tritraversable f where - tritraverse :: Applicative g => (a -> g a') -> (b -> g b') -> (c -> g c') -> f a b c -> g (f a' b' c') diff --git a/src/Data/Graph/Algebraic.hs b/src/Data/Graph/Algebraic.hs index bdf09ebd0..54ffa21c5 100644 --- a/src/Data/Graph/Algebraic.hs +++ b/src/Data/Graph/Algebraic.hs @@ -25,15 +25,12 @@ import qualified Algebra.Graph.Class as Class import qualified Algebra.Graph.ToGraph as Class import Control.Applicative import Control.Carrier.State.Strict -import Control.Lens (view) import Data.Aeson import Data.Foldable import Data.Function import Data.Semilattice.Lower import Data.Set (Set) import qualified Data.Set as Set -import Proto.Semantic as P -import Proto.Semantic_Fields as P -- | An algebraic graph with 'Ord', 'Semigroup', and 'Monoid' instances. newtype Graph vertex = Graph { unGraph :: G.Graph vertex } @@ -110,9 +107,6 @@ instance Ord vertex => Ord (Graph vertex) where class VertexTag vertex where uniqueTag :: vertex -> Int -instance VertexTag DiffTreeVertex where uniqueTag = fromIntegral . view diffVertexId -instance VertexTag TermVertex where uniqueTag = fromIntegral . view vertexId - instance (Ord vertex, ToJSON vertex, VertexTag vertex) => ToJSON (Graph vertex) where toJSON (Graph graph) = object ["vertices" .= G.vertexList graph, "edges" .= (Edge <$> G.edgeList graph)] toEncoding (Graph graph) = pairs ("vertices" .= G.vertexList graph <> "edges" .= (Edge <$> G.edgeList graph)) diff --git a/src/Data/JSON/Fields.hs b/src/Data/JSON/Fields.hs deleted file mode 100644 index cf98bb5d4..000000000 --- a/src/Data/JSON/Fields.hs +++ /dev/null @@ -1,176 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -module Data.JSON.Fields - ( JSONFields (..) - , JSONFields1 (..) - , ToJSONFields (..) - , ToJSONFields1 (..) - , (.=) - ) where - -import Data.Aeson -import Data.Bifunctor.Join -import Data.Edit -import qualified Data.Map as Map -import Data.Maybe -import Data.ScopeGraph -import Data.Sum -import Data.Text (Text) -import qualified Data.Text as Text -import GHC.Generics -import Source.Loc -import Source.Range - -class ToJSONFields a where - toJSONFields :: KeyValue kv => a -> [kv] - -class ToJSONFields1 f where - toJSONFields1 :: (KeyValue kv, ToJSON a) => f a -> [kv] - default toJSONFields1 :: (KeyValue kv, ToJSON a, GToJSONFields1 (Rep1 f), GConstructorName1 (Rep1 f), Generic1 f) => f a -> [kv] - toJSONFields1 s = let r = from1 s in - "term" .= gconstructorName1 r : Map.foldrWithKey m [] (gtoJSONFields1 r) - where - m _ [] acc = acc - m k [v] acc = (k .= v) : acc - m k vs acc = (k .= vs) : acc - -instance ToJSONFields a => ToJSONFields (Join (,) a) where - toJSONFields (Join (a, b)) = [ "before" .= object (toJSONFields a), "after" .= object (toJSONFields b) ] - -instance ToJSONFields a => ToJSONFields (Maybe a) where - toJSONFields = maybe [] toJSONFields - -instance ToJSON a => ToJSONFields [a] where - toJSONFields list = [ "children" .= list ] - -instance ToJSONFields1 [] where - toJSONFields1 list = [ "children" .= list ] - -instance Apply ToJSONFields1 fs => ToJSONFields1 (Sum fs) where - toJSONFields1 = apply @ToJSONFields1 toJSONFields1 - -instance (ToJSONFields a, ToJSONFields b) => ToJSONFields (a, b) where - toJSONFields (a, b) = [ "before" .= JSONFields a, "after" .= JSONFields b ] - -instance ToJSONFields Range where - toJSONFields Range{..} = ["sourceRange" .= [ start, end ]] - -instance ToJSONFields Span where - toJSONFields sourceSpan = [ "sourceSpan" .= sourceSpan ] - -instance ToJSONFields Loc where - toJSONFields Loc{..} = toJSONFields byteRange <> toJSONFields span - -instance (ToJSONFields a, ToJSONFields b) => ToJSONFields (Edit a b) where - toJSONFields (Insert a) = [ "insert" .= object (toJSONFields a) ] - toJSONFields (Delete a) = [ "delete" .= object (toJSONFields a) ] - toJSONFields (Compare a b) = [ "replace" .= [object (toJSONFields a), object (toJSONFields b)] ] - - -newtype JSONFields a = JSONFields { unJSONFields :: a } - -instance ToJSONFields a => ToJSONFields (JSONFields a) where - toJSONFields = toJSONFields . unJSONFields - -instance ToJSONFields a => ToJSON (JSONFields a) where - toJSON = object . toJSONFields . unJSONFields - toEncoding = pairs . mconcat . toJSONFields . unJSONFields - -instance ToJSONFields AccessControl where - toJSONFields accessControl = ["accessControl" .= accessControl] - -newtype JSONFields1 f a = JSONFields1 { unJSONFields1 :: f a } - -instance ToJSONFields1 f => ToJSONFields1 (JSONFields1 f) where - toJSONFields1 = toJSONFields1 . unJSONFields1 - -instance (ToJSON a, ToJSONFields1 f) => ToJSONFields (JSONFields1 f a) where - toJSONFields = toJSONFields1 . unJSONFields1 - -instance (ToJSON a, ToJSONFields1 f) => ToJSON (JSONFields1 f a) where - toJSON = object . toJSONFields1 . unJSONFields1 - toEncoding = pairs . mconcat . toJSONFields1 . unJSONFields1 - - --- | A typeclass to retrieve the name of a data constructor. -class GConstructorName1 f where - gconstructorName1 :: f a -> String - -instance Apply GConstructorName1 fs => GConstructorName1 (Sum fs) where - gconstructorName1 = apply @GConstructorName1 gconstructorName1 - -instance GConstructorName1 f => GConstructorName1 (M1 D c f) where - gconstructorName1 = gconstructorName1 . unM1 - -instance Constructor c => GConstructorName1 (M1 C c f) where - gconstructorName1 = conName - -instance (GConstructorName1 f, GConstructorName1 g) => GConstructorName1 (f :+: g) where - gconstructorName1 (L1 l) = gconstructorName1 l - gconstructorName1 (R1 r) = gconstructorName1 r - - --- | A typeclass to calculate a list of 'KeyValue's describing the record selector names and associated values on a datatype. -class GToJSONFields1 f where - -- FIXME: Not ideal to allocate a Map each time here, but not an obvious way - -- to deal with product types without record selectors that all end up as an - -- array under a "children" property. - gtoJSONFields1 :: (ToJSON a) => f a -> Map.Map Text [SomeJSON] - -instance GToJSONFields1 f => GToJSONFields1 (M1 D c f) where - gtoJSONFields1 = gtoJSONFields1 . unM1 - -instance GToJSONFields1 f => GToJSONFields1 (M1 C c f) where - gtoJSONFields1 = gtoJSONFields1 . unM1 - -instance GToJSONFields1 U1 where - gtoJSONFields1 _ = mempty - -instance (Selector c, GSelectorJSONValue1 f) => GToJSONFields1 (M1 S c f) where - gtoJSONFields1 m1 = Map.fromList [gselectorJSONValue1 keyName (unM1 m1)] - where keyName = case selName m1 of - "" -> Nothing - n -> Just (Text.pack n) - -instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :+: g) where - gtoJSONFields1 (L1 l) = gtoJSONFields1 l - gtoJSONFields1 (R1 r) = gtoJSONFields1 r - -instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :*: g) where - gtoJSONFields1 (x :*: y) = Map.unionWith (<>) (gtoJSONFields1 x) (gtoJSONFields1 y) - --- | A typeclass to retrieve the JSON 'Value' of a record selector. -class GSelectorJSONValue1 f where - gselectorJSONValue1 :: (ToJSON a) => Maybe Text -> f a -> (Text, [SomeJSON]) - -instance GSelectorJSONValue1 Par1 where - gselectorJSONValue1 k x = (fromMaybe "children" k, [SomeJSON (unPar1 x)]) - -instance ToJSON1 f => GSelectorJSONValue1 (Rec1 f) where - gselectorJSONValue1 k x = (fromMaybe "children" k, [SomeJSON (SomeJSON1 (unRec1 x))]) - -instance ToJSON k => GSelectorJSONValue1 (K1 r k) where - gselectorJSONValue1 k x = (fromMaybe "value" k, [SomeJSON (unK1 x)]) - --- | An existential type wrapping an JSON-compatible data type. -data SomeJSON where - SomeJSON :: ToJSON a => a -> SomeJSON - -instance ToJSON SomeJSON where - toJSON (SomeJSON a) = toJSON a - toEncoding (SomeJSON a) = toEncoding a - -data SomeJSON1 where - SomeJSON1 :: (ToJSON1 f, ToJSON a) => f a -> SomeJSON1 - -instance ToJSON SomeJSON1 where - toJSON (SomeJSON1 fa) = toJSON1 fa - toEncoding (SomeJSON1 fa) = toEncoding1 fa diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index d9742e4b0..0e880bb99 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -17,12 +17,14 @@ {-# LANGUAGE UndecidableInstances #-} module Data.Syntax (module Data.Syntax) where + import qualified Assigning.Assignment as Assignment import Control.Abstract.Heap (deref, lookupSlot) import Control.Abstract.ScopeGraph (Declaration (..), Reference (..), reference) import Data.Abstract.Evaluatable hiding (Empty, Error) import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Aeson as Aeson (ToJSON (..), object) +import Data.Aeson ((.=)) import Data.Bifunctor import qualified Data.Error as Error import Data.Foldable @@ -33,7 +35,6 @@ import Data.Functor.Foldable (cata) import Data.Hashable import Data.Hashable.Lifted import Data.Ix -import Data.JSON.Fields import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import Data.Proxy import Data.Semigroup (sconcat) @@ -41,7 +42,6 @@ import qualified Data.Set as Set import Data.Sum import Data.Term import Data.Text (Text) -import Diffing.Algorithm import GHC.Generics import GHC.Stack import GHC.TypeLits @@ -143,7 +143,7 @@ instance (Element f all, c f, Generate c all fs) => Generate c all (f ': fs) whe -- | 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 :: Name } - deriving (Diffable, Foldable, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, Functor, Generic1, Hashable1, Traversable) instance Eq1 Identifier where liftEq = genericLiftEq instance Ord1 Identifier where liftCompare = genericLiftCompare @@ -169,7 +169,7 @@ instance Declarations1 Identifier where -- | An accessibility modifier, e.g. private, public, protected, etc. newtype AccessibilityModifier a = AccessibilityModifier { contents :: Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AccessibilityModifier where liftEq = genericLiftEq instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare @@ -182,7 +182,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Empty where liftEq = genericLiftEq instance Ord1 Empty where liftCompare = genericLiftCompare @@ -193,7 +193,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Error where liftEq = genericLiftEq instance Ord1 Error where liftCompare = genericLiftCompare @@ -257,17 +257,12 @@ instance (Error :< fs, Apply Foldable fs, Apply Functor fs) => HasErrors (Term ( data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a } - deriving (Foldable, FreeVariables1, Functor, Generic1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Traversable) instance Eq1 Context where liftEq = genericLiftEq instance Ord1 Context where liftCompare = genericLiftCompare instance Show1 Context where liftShowsPrec = genericLiftShowsPrec -instance Diffable Context where - subalgorithmFor blur focus (Context n s) = Context <$> traverse blur n <*> focus s - - equivalentBySubterm = Just . contextSubject - instance Hashable1 Context where liftHashWithSalt = foldl instance Evaluatable Context where diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index 2496782ae..485f6113d 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -8,14 +8,12 @@ module Data.Syntax.Comment (module Data.Syntax.Comment) where import Data.Abstract.Evaluatable import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import Data.Text (Text) -import Diffing.Algorithm import GHC.Generics (Generic1) -- | An unnested comment (line or block). newtype Comment a = Comment { commentContent :: Text } - deriving (Diffable, Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1, ToJSONFields1) + deriving (Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1) instance Eq1 Comment where liftEq = genericLiftEq instance Ord1 Comment where liftCompare = genericLiftCompare @@ -31,7 +29,7 @@ instance Evaluatable Comment where -- | HashBang line (e.g. `#!/usr/bin/env node`) newtype HashBang a = HashBang { value :: Text } - deriving (Diffable, Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1, ToJSONFields1) + deriving (Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1) instance Eq1 HashBang where liftEq = genericLiftEq instance Ord1 HashBang where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 0c8622466..49184c783 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -25,20 +25,15 @@ import GHC.Generics (Generic1) import Control.Abstract hiding (AccessControl (..), Function) import Data.Abstract.Evaluatable import qualified Data.Abstract.ScopeGraph as ScopeGraph -import Data.JSON.Fields -import Diffing.Algorithm import Source.Span data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a } - deriving (Foldable, Traversable, Functor, Generic1, Hashable1, ToJSONFields1) + deriving (Foldable, Traversable, Functor, Generic1, Hashable1) instance Eq1 Function where liftEq = genericLiftEq instance Ord1 Function where liftCompare = genericLiftCompare instance Show1 Function where liftShowsPrec = genericLiftShowsPrec -instance Diffable Function where - equivalentBySubterm = Just . functionName - -- TODO: Filter the closed-over environment by the free variables in the term. -- TODO: How should we represent function types, where applicable? @@ -87,15 +82,12 @@ data Method a = Method , methodBody :: a , methodAccessControl :: ScopeGraph.AccessControl } - deriving (Foldable, Traversable, Functor, Generic1, Hashable1, ToJSONFields1) + deriving (Foldable, Traversable, Functor, Generic1, Hashable1) instance Eq1 Method where liftEq = genericLiftEq instance Ord1 Method where liftCompare = genericLiftCompare instance Show1 Method where liftShowsPrec = genericLiftShowsPrec -instance Diffable Method where - equivalentBySubterm = Just . methodName - -- Evaluating a Method creates a closure and makes that value available in the -- local environment. instance Evaluatable Method where @@ -126,7 +118,7 @@ data MethodSignature a = MethodSignature , methodSignatureParameters :: [a] , methodSignatureAccessControl :: ScopeGraph.AccessControl } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 MethodSignature where liftEq = genericLiftEq instance Ord1 MethodSignature where liftCompare = genericLiftCompare @@ -137,7 +129,7 @@ instance Evaluatable MethodSignature newtype RequiredParameter a = RequiredParameter { requiredParameter :: a } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 RequiredParameter where liftEq = genericLiftEq instance Ord1 RequiredParameter where liftCompare = genericLiftCompare @@ -155,7 +147,7 @@ instance Evaluatable RequiredParameter where newtype OptionalParameter a = OptionalParameter { optionalParameter :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 OptionalParameter where liftEq = genericLiftEq instance Ord1 OptionalParameter where liftCompare = genericLiftCompare @@ -170,7 +162,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 VariableDeclaration where liftEq = genericLiftEq instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare @@ -193,7 +185,7 @@ instance Declarations a => Declarations (VariableDeclaration a) where -- | A TypeScript/Java style interface declaration to implement. data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationSuperInterfaces :: ![a], interfaceDeclarationBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare @@ -213,7 +205,7 @@ data PublicFieldDefinition a = PublicFieldDefinition , publicFieldValue :: a , publicFieldAccessControl :: ScopeGraph.AccessControl } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PublicFieldDefinition where liftEq = genericLiftEq instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare @@ -230,7 +222,7 @@ instance Evaluatable PublicFieldDefinition where unit data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Variable where liftEq = genericLiftEq instance Ord1 Variable where liftCompare = genericLiftCompare @@ -240,7 +232,7 @@ instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Variable data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a } - deriving (Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1, ToJSONFields1) + deriving (Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1) instance Eq1 Class where liftEq = genericLiftEq instance Ord1 Class where liftCompare = genericLiftCompare @@ -249,9 +241,6 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec instance Declarations a => Declarations (Class a) where declaredName (Class _ name _ _) = declaredName name -instance Diffable Class where - equivalentBySubterm = Just . classIdentifier - instance Evaluatable Class where eval eval _ Class{..} = do span <- ask @Span @@ -288,7 +277,7 @@ instance Declarations1 Class where -- | A decorator in Python data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Decorator where liftEq = genericLiftEq instance Ord1 Decorator where liftCompare = genericLiftCompare @@ -302,7 +291,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 { datatypeContext :: a, datatypeName :: a, datatypeConstructors :: [a], datatypeDeriving :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Datatype where liftEq = genericLiftEq instance Ord1 Datatype where liftCompare = genericLiftCompare @@ -314,7 +303,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 { constructorContext :: [a], constructorName :: a, constructorFields :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Constructor where liftEq = genericLiftEq instance Ord1 Constructor where liftCompare = genericLiftCompare @@ -326,7 +315,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Comprehension where liftEq = genericLiftEq instance Ord1 Comprehension where liftCompare = genericLiftCompare @@ -338,7 +327,7 @@ instance Evaluatable Comprehension -- | A declared type (e.g. `a []int` in Go). data Type a = Type { typeName :: !a, typeKind :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Type where liftEq = genericLiftEq instance Ord1 Type where liftCompare = genericLiftCompare @@ -350,7 +339,7 @@ instance Evaluatable Type -- | Type alias declarations in Javascript/Haskell, etc. data TypeAlias a = TypeAlias { typeAliasContext :: ![a], typeAliasIdentifier :: !a, typeAliasKind :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) 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 75d55f10a..4d8d27a79 100644 --- a/src/Data/Syntax/Directive.hs +++ b/src/Data/Syntax/Directive.hs @@ -10,16 +10,14 @@ import Data.Abstract.Evaluatable import Data.Abstract.Module (ModuleInfo (..)) import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import qualified Data.Text as T -import Diffing.Algorithm import GHC.Generics (Generic1) import Source.Span import qualified System.Path as Path -- A file directive like the Ruby constant `__FILE__`. data File a = File - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 File where liftEq = genericLiftEq instance Ord1 File where liftCompare = genericLiftCompare @@ -31,7 +29,7 @@ instance Evaluatable File where -- A line directive like the Ruby constant `__LINE__`. data Line a = Line - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) 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 486401303..beb7ae5ef 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -25,19 +25,17 @@ import Data.Fixed import Data.Foldable (for_) import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import Data.List (find) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map.Strict as Map import Data.Maybe import Data.Maybe.Exts -import Diffing.Algorithm hiding (Delete) import GHC.Generics (Generic1) -- | 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, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Call where liftEq = genericLiftEq instance Ord1 Call where liftCompare = genericLiftCompare @@ -53,7 +51,7 @@ instance Evaluatable Call where call op args data LessThan a = LessThan { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LessThan where liftEq = genericLiftEq instance Ord1 LessThan where liftCompare = genericLiftCompare @@ -64,7 +62,7 @@ instance Evaluatable LessThan where go (LessThan a b) = liftComparison (Concrete (<)) a b data LessThanEqual a = LessThanEqual { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LessThanEqual where liftEq = genericLiftEq instance Ord1 LessThanEqual where liftCompare = genericLiftCompare @@ -75,7 +73,7 @@ instance Evaluatable LessThanEqual where go (LessThanEqual a b) = liftComparison (Concrete (<=)) a b data GreaterThan a = GreaterThan { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 GreaterThan where liftEq = genericLiftEq instance Ord1 GreaterThan where liftCompare = genericLiftCompare @@ -86,7 +84,7 @@ instance Evaluatable GreaterThan where go (GreaterThan a b) = liftComparison (Concrete (>)) a b data GreaterThanEqual a = GreaterThanEqual { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 GreaterThanEqual where liftEq = genericLiftEq instance Ord1 GreaterThanEqual where liftCompare = genericLiftCompare @@ -97,7 +95,7 @@ instance Evaluatable GreaterThanEqual where go (GreaterThanEqual a b) = liftComparison (Concrete (>=)) a b data Equal a = Equal { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Equal where liftEq = genericLiftEq instance Ord1 Equal where liftCompare = genericLiftCompare @@ -110,7 +108,7 @@ instance Evaluatable Equal where go (Equal a b) = liftComparison (Concrete (==)) a b data StrictEqual a = StrictEqual { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 StrictEqual where liftEq = genericLiftEq instance Ord1 StrictEqual where liftCompare = genericLiftCompare @@ -123,7 +121,7 @@ instance Evaluatable StrictEqual where go (StrictEqual a b) = liftComparison (Concrete (==)) a b data Comparison a = Comparison { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Comparison where liftEq = genericLiftEq instance Ord1 Comparison where liftCompare = genericLiftCompare @@ -134,7 +132,7 @@ instance Evaluatable Comparison where go (Comparison a b) = liftComparison (Concrete (==)) a b data Plus a = Plus { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Plus where liftEq = genericLiftEq instance Ord1 Plus where liftCompare = genericLiftCompare @@ -145,7 +143,7 @@ instance Evaluatable Plus where go (Plus a b) = liftNumeric2 add a b where add = liftReal (+) data Minus a = Minus { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Minus where liftEq = genericLiftEq instance Ord1 Minus where liftCompare = genericLiftCompare @@ -156,7 +154,7 @@ instance Evaluatable Minus where go (Minus a b) = liftNumeric2 (liftReal (-)) a b data Times a = Times { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Times where liftEq = genericLiftEq instance Ord1 Times where liftCompare = genericLiftCompare @@ -167,7 +165,7 @@ instance Evaluatable Times where go (Times a b) = liftNumeric2 (liftReal (*)) a b data DividedBy a = DividedBy { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 DividedBy where liftEq = genericLiftEq instance Ord1 DividedBy where liftCompare = genericLiftCompare @@ -178,7 +176,7 @@ instance Evaluatable DividedBy where go (DividedBy a b) = liftNumeric2 (liftIntegralFrac div (/)) a b data Modulo a = Modulo { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Modulo where liftEq = genericLiftEq instance Ord1 Modulo where liftCompare = genericLiftCompare @@ -189,7 +187,7 @@ instance Evaluatable Modulo where go (Modulo a b) = liftNumeric2 (liftIntegralFrac mod mod') a b data Power a = Power { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Power where liftEq = genericLiftEq instance Ord1 Power where liftCompare = genericLiftCompare @@ -200,7 +198,7 @@ instance Evaluatable Power where go (Power a b) = liftNumeric2 liftedExponent a b newtype Negate a = Negate { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Negate where liftEq = genericLiftEq instance Ord1 Negate where liftCompare = genericLiftCompare @@ -211,7 +209,7 @@ instance Evaluatable Negate where go (Negate a) = liftNumeric negate a data FloorDivision a = FloorDivision { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 FloorDivision where liftEq = genericLiftEq instance Ord1 FloorDivision where liftCompare = genericLiftCompare @@ -223,7 +221,7 @@ instance Evaluatable FloorDivision where -- | Regex matching operators (Ruby's =~ and ~!) data Matches a = Matches { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Matches where liftEq = genericLiftEq instance Ord1 Matches where liftCompare = genericLiftCompare @@ -232,7 +230,7 @@ instance Show1 Matches where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Matches data NotMatches a = NotMatches { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NotMatches where liftEq = genericLiftEq instance Ord1 NotMatches where liftCompare = genericLiftCompare @@ -241,7 +239,7 @@ instance Show1 NotMatches where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NotMatches data Or a = Or { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Or where liftEq = genericLiftEq instance Ord1 Or where liftCompare = genericLiftCompare @@ -253,7 +251,7 @@ instance Evaluatable Or where ifthenelse a' (pure a') (eval b) data And a = And { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 And where liftEq = genericLiftEq instance Ord1 And where liftCompare = genericLiftCompare @@ -265,7 +263,7 @@ instance Evaluatable And where ifthenelse a' (eval b) (pure a') newtype Not a = Not { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Not where liftEq = genericLiftEq instance Ord1 Not where liftCompare = genericLiftCompare @@ -275,7 +273,7 @@ instance Evaluatable Not where eval eval _ (Not a) = eval a >>= asBool >>= boolean . not data XOr a = XOr { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 XOr where liftEq = genericLiftEq instance Ord1 XOr where liftCompare = genericLiftCompare @@ -287,7 +285,7 @@ instance Evaluatable XOr where -- | Javascript delete operator newtype Delete a = Delete { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Delete where liftEq = genericLiftEq instance Ord1 Delete where liftCompare = genericLiftCompare @@ -298,7 +296,7 @@ instance Evaluatable Delete where -- | A sequence expression such as Javascript or C's comma operator. data SequenceExpression a = SequenceExpression { firstExpression :: !a, secondExpression :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 SequenceExpression where liftEq = genericLiftEq instance Ord1 SequenceExpression where liftCompare = genericLiftCompare @@ -310,7 +308,7 @@ instance Evaluatable SequenceExpression where -- | Javascript void operator newtype Void a = Void { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Void where liftEq = genericLiftEq instance Ord1 Void where liftCompare = genericLiftCompare @@ -322,7 +320,7 @@ instance Evaluatable Void where -- | Javascript typeof operator newtype Typeof a = Typeof { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Typeof where liftEq = genericLiftEq instance Ord1 Typeof where liftCompare = genericLiftCompare @@ -333,7 +331,7 @@ instance Evaluatable Typeof -- | Bitwise operators. data BOr a = BOr { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 BOr where liftEq = genericLiftEq instance Ord1 BOr where liftCompare = genericLiftCompare @@ -346,7 +344,7 @@ instance Evaluatable BOr where liftBitwise2 (.|.) a' b' data BAnd a = BAnd { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 BAnd where liftEq = genericLiftEq instance Ord1 BAnd where liftCompare = genericLiftCompare @@ -359,7 +357,7 @@ instance Evaluatable BAnd where liftBitwise2 (.&.) a' b' data BXOr a = BXOr { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 BXOr where liftEq = genericLiftEq instance Ord1 BXOr where liftCompare = genericLiftCompare @@ -372,7 +370,7 @@ instance Evaluatable BXOr where liftBitwise2 xor a' b' data LShift a = LShift { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LShift where liftEq = genericLiftEq instance Ord1 LShift where liftCompare = genericLiftCompare @@ -387,7 +385,7 @@ instance Evaluatable LShift where shiftL' a b = shiftL a (fromIntegral (toInteger b)) data RShift a = RShift { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 RShift where liftEq = genericLiftEq instance Ord1 RShift where liftCompare = genericLiftCompare @@ -402,7 +400,7 @@ instance Evaluatable RShift where shiftR' a b = shiftR a (fromIntegral (toInteger b)) data UnsignedRShift a = UnsignedRShift { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 UnsignedRShift where liftEq = genericLiftEq instance Ord1 UnsignedRShift where liftCompare = genericLiftCompare @@ -415,7 +413,7 @@ instance Evaluatable UnsignedRShift where unsignedRShift a' b' newtype Complement a = Complement { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Complement where liftEq = genericLiftEq instance Ord1 Complement where liftCompare = genericLiftCompare @@ -428,7 +426,7 @@ instance Evaluatable Complement where -- | Member Access (e.g. a.b) data MemberAccess a = MemberAccess { lhs :: a, rhs :: a } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 MemberAccess where liftEq = genericLiftEq instance Ord1 MemberAccess where liftCompare = genericLiftCompare @@ -479,7 +477,7 @@ instance Evaluatable MemberAccess where -- | Subscript (e.g a[1]) data Subscript a = Subscript { lhs :: a, rhs :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Subscript where liftEq = genericLiftEq instance Ord1 Subscript where liftCompare = genericLiftCompare @@ -492,7 +490,7 @@ instance Evaluatable Subscript where eval _ _ (Subscript _ _) = throwUnspecializedError (UnspecializedError "Eval unspecialized for subscript with slices") data Member a = Member { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Member where liftEq = genericLiftEq instance Ord1 Member where liftCompare = genericLiftCompare @@ -502,7 +500,7 @@ instance Evaluatable Member 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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Enumeration where liftEq = genericLiftEq instance Ord1 Enumeration where liftCompare = genericLiftCompare @@ -513,7 +511,7 @@ instance Evaluatable Enumeration -- | InstanceOf (e.g. a instanceof b in JavaScript data InstanceOf a = InstanceOf { instanceOfSubject :: !a, instanceOfObject :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 InstanceOf where liftEq = genericLiftEq instance Ord1 InstanceOf where liftCompare = genericLiftCompare @@ -525,7 +523,7 @@ instance Evaluatable InstanceOf -- | ScopeResolution (e.g. import a.b in Python or a::b in C++) newtype ScopeResolution a = ScopeResolution { scopes :: NonEmpty a } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Traversable) instance Eq1 ScopeResolution where liftEq = genericLiftEq instance Ord1 ScopeResolution where liftCompare = genericLiftCompare @@ -540,7 +538,7 @@ instance Declarations1 ScopeResolution where -- | A non-null expression such as Typescript or Swift's ! expression. newtype NonNullExpression a = NonNullExpression { nonNullExpression :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NonNullExpression where liftEq = genericLiftEq instance Ord1 NonNullExpression where liftCompare = genericLiftCompare @@ -552,7 +550,7 @@ instance Evaluatable NonNullExpression -- | An await expression in Javascript or C#. newtype Await a = Await { awaitSubject :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Await where liftEq = genericLiftEq instance Ord1 Await where liftCompare = genericLiftCompare @@ -564,7 +562,7 @@ instance Evaluatable Await where -- | An object constructor call in Javascript, Java, etc. data New a = New { newSubject :: a , newTypeParameters :: a, newArguments :: [a] } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 New where liftEq = genericLiftEq instance Ord1 New where liftCompare = genericLiftCompare @@ -610,7 +608,7 @@ instance Evaluatable New where -- | A cast expression to a specified type. data Cast a = Cast { castSubject :: !a, castType :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Cast where liftEq = genericLiftEq instance Ord1 Cast where liftCompare = genericLiftCompare @@ -619,7 +617,7 @@ instance Show1 Cast where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Cast data Super a = Super - deriving (Diffable, Foldable, Functor, Generic1, Traversable, FreeVariables1, Declarations1, ToJSONFields1, Hashable1) + deriving (Foldable, Functor, Generic1, Traversable, FreeVariables1, Declarations1, Hashable1) instance Eq1 Super where liftEq = genericLiftEq instance Ord1 Super where liftCompare = genericLiftCompare @@ -628,7 +626,7 @@ instance Show1 Super where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Super data This a = This - deriving (Diffable, Foldable, Functor, Generic1, Traversable, FreeVariables1, Declarations1, ToJSONFields1, Hashable1) + deriving (Foldable, Functor, Generic1, Traversable, FreeVariables1, Declarations1, Hashable1) instance Eq1 This where liftEq = genericLiftEq instance Ord1 This where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index c8d139d40..74a9d176d 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -14,11 +14,9 @@ import Control.Monad import Data.Abstract.Evaluatable as Eval import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import Data.Scientific.Exts import Data.Text (Text) import qualified Data.Text as T -import Diffing.Algorithm import GHC.Generics (Generic1) import Numeric.Exts import Text.Read (readMaybe) @@ -26,7 +24,7 @@ import Text.Read (readMaybe) -- Boolean newtype Boolean a = Boolean { booleanContent :: Bool } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Boolean where liftEq = genericLiftEq instance Ord1 Boolean where liftCompare = genericLiftCompare @@ -43,7 +41,7 @@ instance Evaluatable Boolean where -- | A literal integer of unspecified width. No particular base is implied. newtype Integer a = Integer { integerContent :: Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare @@ -57,7 +55,7 @@ instance Evaluatable Data.Syntax.Literal.Integer where -- | A literal float of unspecified width. newtype Float a = Float { floatContent :: Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Float where liftCompare = genericLiftCompare @@ -70,7 +68,7 @@ instance Evaluatable Data.Syntax.Literal.Float where -- Rational literals e.g. `2/3r` newtype Rational a = Rational { value :: Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare @@ -85,7 +83,7 @@ instance Evaluatable Data.Syntax.Literal.Rational where -- Complex literals e.g. `3 + 2i` newtype Complex a = Complex { value :: Text } - deriving (Diffable, Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1, ToJSONFields1) + deriving (Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1) instance Eq1 Complex where liftEq = genericLiftEq instance Ord1 Complex where liftCompare = genericLiftCompare @@ -97,7 +95,7 @@ instance Evaluatable Complex -- Strings, symbols newtype String a = String { stringElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.String where liftCompare = genericLiftCompare @@ -109,7 +107,7 @@ instance Show1 Data.Syntax.Literal.String where liftShowsPrec = genericLiftShows instance Evaluatable Data.Syntax.Literal.String newtype Character a = Character { characterContent :: Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Character where liftEq = genericLiftEq instance Ord1 Character where liftCompare = genericLiftCompare @@ -119,7 +117,7 @@ instance Evaluatable Data.Syntax.Literal.Character -- | An interpolation element within a string literal. newtype InterpolationElement a = InterpolationElement { interpolationBody :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 InterpolationElement where liftEq = genericLiftEq instance Ord1 InterpolationElement where liftCompare = genericLiftCompare @@ -130,7 +128,7 @@ instance Evaluatable InterpolationElement -- | A sequence of textual contents within a string literal. newtype TextElement a = TextElement { textElementContent :: Text } - deriving (Diffable, Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1, ToJSONFields1) + deriving (Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1) instance Eq1 TextElement where liftEq = genericLiftEq instance Ord1 TextElement where liftCompare = genericLiftCompare @@ -149,7 +147,7 @@ quoted t = TextElement ("\"" <> t <> "\"") -- | A sequence of textual contents within a string literal. newtype EscapeSequence a = EscapeSequence { value :: Text } - deriving (Diffable, Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1, ToJSONFields1) + deriving (Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1) instance Eq1 EscapeSequence where liftEq = genericLiftEq instance Ord1 EscapeSequence where liftCompare = genericLiftCompare @@ -159,7 +157,7 @@ instance Show1 EscapeSequence where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EscapeSequence data Null a = Null - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Null where liftEq = genericLiftEq instance Ord1 Null where liftCompare = genericLiftCompare @@ -168,7 +166,7 @@ instance Show1 Null where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Null where eval _ _ _ = pure null newtype Symbol a = Symbol { symbolElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Symbol where liftEq = genericLiftEq instance Ord1 Symbol where liftCompare = genericLiftCompare @@ -178,7 +176,7 @@ instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Symbol newtype SymbolElement a = SymbolElement { symbolContent :: Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 SymbolElement where liftEq = genericLiftEq instance Ord1 SymbolElement where liftCompare = genericLiftCompare @@ -188,7 +186,7 @@ instance Evaluatable SymbolElement where eval _ _ (SymbolElement s) = string s newtype Regex a = Regex { regexContent :: Text } - deriving (Diffable, Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1, ToJSONFields1) + deriving (Foldable, Functor, Generic1, Hashable1, Traversable, FreeVariables1, Declarations1) instance Eq1 Regex where liftEq = genericLiftEq instance Ord1 Regex where liftCompare = genericLiftCompare @@ -203,7 +201,7 @@ instance Evaluatable Regex where -- Collections newtype Array a = Array { arrayElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Array where liftEq = genericLiftEq instance Ord1 Array where liftCompare = genericLiftCompare @@ -213,7 +211,7 @@ instance Evaluatable Array where eval eval _ Array{..} = array =<< traverse eval arrayElements newtype Hash a = Hash { hashElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Hash where liftEq = genericLiftEq instance Ord1 Hash where liftCompare = genericLiftCompare @@ -225,7 +223,7 @@ instance Evaluatable Hash where Eval.hash elements data KeyValue a = KeyValue { key :: !a, value :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 KeyValue where liftEq = genericLiftEq instance Ord1 KeyValue where liftCompare = genericLiftCompare @@ -238,7 +236,7 @@ instance Evaluatable KeyValue where kvPair k v newtype Tuple a = Tuple { tupleContents :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Tuple where liftEq = genericLiftEq instance Ord1 Tuple where liftCompare = genericLiftCompare @@ -248,7 +246,7 @@ instance Evaluatable Tuple where eval eval _ (Tuple cs) = tuple =<< traverse eval cs newtype Set a = Set { setElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Set where liftEq = genericLiftEq instance Ord1 Set where liftCompare = genericLiftCompare @@ -262,7 +260,7 @@ instance Evaluatable Set -- | A declared pointer (e.g. var pointer *int in Go) newtype Pointer a = Pointer { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Pointer where liftEq = genericLiftEq instance Ord1 Pointer where liftCompare = genericLiftCompare @@ -274,7 +272,7 @@ instance Evaluatable Pointer -- | A reference to a pointer's address (e.g. &pointer in Go) newtype Reference a = Reference { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) 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 ab2bd5dbb..1c6b956c0 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -15,13 +15,11 @@ import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Aeson (ToJSON1 (..)) import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as Map import Data.Maybe.Exts import Data.Semigroup.App import Data.Semigroup.Foldable -import Diffing.Algorithm import GHC.Generics (Generic1) -- | Imperative sequence of statements/declarations s.t.: @@ -31,7 +29,7 @@ import GHC.Generics (Generic1) -- 3. Only the last statement’s return value is returned. -- TODO: Separate top-level statement nodes into non-lexical Statement and lexical StatementBlock nodes newtype Statements a = Statements { statements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Statements where liftEq = genericLiftEq instance Ord1 Statements where liftCompare = genericLiftCompare @@ -44,7 +42,7 @@ instance Evaluatable Statements where maybe unit (runApp . foldMap1 (App . eval)) (nonEmpty xs) newtype StatementBlock a = StatementBlock { statements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 StatementBlock where liftEq = genericLiftEq instance Ord1 StatementBlock where liftCompare = genericLiftCompare @@ -58,7 +56,7 @@ instance Evaluatable StatementBlock where -- | 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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 If where liftEq = genericLiftEq instance Ord1 If where liftCompare = genericLiftCompare @@ -72,7 +70,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Else where liftEq = genericLiftEq instance Ord1 Else where liftCompare = genericLiftCompare @@ -86,7 +84,7 @@ instance Evaluatable Else -- | Goto statement (e.g. `goto a` in Go). newtype Goto a = Goto { gotoLocation :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Goto where liftEq = genericLiftEq instance Ord1 Goto where liftCompare = genericLiftCompare @@ -97,7 +95,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Match where liftEq = genericLiftEq instance Ord1 Match where liftCompare = genericLiftCompare @@ -109,7 +107,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 { value :: !a, patternBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Pattern where liftEq = genericLiftEq instance Ord1 Pattern where liftCompare = genericLiftCompare @@ -120,7 +118,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Let where liftEq = genericLiftEq instance Ord1 Let where liftCompare = genericLiftCompare @@ -145,7 +143,7 @@ instance Evaluatable Let where -- AugmentedAssignment newtype AugmentedAssignment a = AugmentedAssignment { augmentedAssignmentTarget :: a } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AugmentedAssignment where liftEq = genericLiftEq instance Ord1 AugmentedAssignment where liftCompare = genericLiftCompare @@ -161,7 +159,7 @@ instance Evaluatable AugmentedAssignment -- | Assignment to a variable or other lvalue. data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Assignment where liftEq = genericLiftEq instance Ord1 Assignment where liftCompare = genericLiftCompare @@ -191,7 +189,7 @@ instance Evaluatable Assignment where -- | Post increment operator (e.g. 1++ in Go, or i++ in C). newtype PostIncrement a = PostIncrement { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PostIncrement where liftEq = genericLiftEq instance Ord1 PostIncrement where liftCompare = genericLiftCompare @@ -203,7 +201,7 @@ instance Evaluatable PostIncrement -- | Post decrement operator (e.g. 1-- in Go, or i-- in C). newtype PostDecrement a = PostDecrement { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PostDecrement where liftEq = genericLiftEq instance Ord1 PostDecrement where liftCompare = genericLiftCompare @@ -214,7 +212,7 @@ instance Evaluatable PostDecrement -- | Pre increment operator (e.g. ++1 in C or Java). newtype PreIncrement a = PreIncrement { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PreIncrement where liftEq = genericLiftEq instance Ord1 PreIncrement where liftCompare = genericLiftCompare @@ -226,7 +224,7 @@ instance Evaluatable PreIncrement -- | Pre decrement operator (e.g. --1 in C or Java). newtype PreDecrement a = PreDecrement { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PreDecrement where liftEq = genericLiftEq instance Ord1 PreDecrement where liftCompare = genericLiftCompare @@ -239,7 +237,7 @@ instance Evaluatable PreDecrement -- Returns newtype Return a = Return { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Return where liftEq = genericLiftEq instance Ord1 Return where liftCompare = genericLiftCompare @@ -249,7 +247,7 @@ instance Evaluatable Return where eval eval _ (Return x) = eval x >>= earlyReturn newtype Yield a = Yield { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Yield where liftEq = genericLiftEq instance Ord1 Yield where liftCompare = genericLiftCompare @@ -260,7 +258,7 @@ instance Evaluatable Yield newtype Break a = Break { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Break where liftEq = genericLiftEq instance Ord1 Break where liftCompare = genericLiftCompare @@ -270,7 +268,7 @@ instance Evaluatable Break where eval eval _ (Break x) = eval x >>= throwBreak newtype Continue a = Continue { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Continue where liftEq = genericLiftEq instance Ord1 Continue where liftCompare = genericLiftCompare @@ -280,7 +278,7 @@ instance Evaluatable Continue where eval eval _ (Continue x) = eval x >>= throwContinue newtype Retry a = Retry { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Retry where liftEq = genericLiftEq instance Ord1 Retry where liftCompare = genericLiftCompare @@ -290,7 +288,7 @@ instance Show1 Retry where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Retry newtype NoOp a = NoOp { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NoOp where liftEq = genericLiftEq instance Ord1 NoOp where liftCompare = genericLiftCompare @@ -302,7 +300,7 @@ instance Evaluatable NoOp where -- Loops data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 For where liftEq = genericLiftEq instance Ord1 For where liftCompare = genericLiftCompare @@ -312,7 +310,7 @@ instance Evaluatable For where eval eval _ (fmap eval -> For before cond step body) = forLoop before cond step body data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ForEach where liftEq = genericLiftEq instance Ord1 ForEach where liftCompare = genericLiftCompare @@ -322,7 +320,7 @@ instance Show1 ForEach where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ForEach data While a = While { whileCondition :: !a, whileBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 While where liftEq = genericLiftEq instance Ord1 While where liftCompare = genericLiftCompare @@ -332,7 +330,7 @@ instance Evaluatable While where eval eval _ While{..} = while (eval whileCondition) (eval whileBody) data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 DoWhile where liftEq = genericLiftEq instance Ord1 DoWhile where liftCompare = genericLiftCompare @@ -344,7 +342,7 @@ instance Evaluatable DoWhile where -- Exception handling newtype Throw a = Throw { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Throw where liftEq = genericLiftEq instance Ord1 Throw where liftCompare = genericLiftCompare @@ -355,7 +353,7 @@ instance Evaluatable Throw data Try a = Try { tryBody :: !a, tryCatch :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Try where liftEq = genericLiftEq instance Ord1 Try where liftCompare = genericLiftCompare @@ -365,7 +363,7 @@ instance Show1 Try where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Try data Catch a = Catch { catchException :: !a, catchBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Catch where liftEq = genericLiftEq instance Ord1 Catch where liftCompare = genericLiftCompare @@ -375,7 +373,7 @@ instance Show1 Catch where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Catch newtype Finally a = Finally { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Finally where liftEq = genericLiftEq instance Ord1 Finally where liftCompare = genericLiftCompare @@ -388,7 +386,7 @@ instance Evaluatable Finally -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl). newtype ScopeEntry a = ScopeEntry { terms :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ScopeEntry where liftEq = genericLiftEq instance Ord1 ScopeEntry where liftCompare = genericLiftCompare @@ -400,7 +398,7 @@ instance Evaluatable ScopeEntry -- | ScopeExit (e.g. `END {}` block in Ruby or Perl). newtype ScopeExit a = ScopeExit { terms :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ScopeExit where liftEq = genericLiftEq instance Ord1 ScopeExit where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index bb6e39b6d..ec2147f38 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -11,13 +11,11 @@ module Data.Syntax.Type (module Data.Syntax.Type) where import Data.Abstract.Evaluatable import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields -import Diffing.Algorithm import GHC.Generics (Generic1) import Prelude hiding (Bool, Double, Float, Int) data Array a = Array { arraySize :: Maybe a, arrayElementType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Array where liftEq = genericLiftEq instance Ord1 Array where liftCompare = genericLiftCompare @@ -29,7 +27,7 @@ instance Evaluatable Array -- TODO: What about type variables? re: FreeVariables1 data Annotation a = Annotation { annotationSubject :: a, annotationType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Annotation where liftEq = genericLiftEq instance Ord1 Annotation where liftCompare = genericLiftCompare @@ -41,7 +39,7 @@ instance Evaluatable Annotation where data Function a = Function { functionParameters :: [a], functionReturn :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Function where liftEq = genericLiftEq instance Ord1 Function where liftCompare = genericLiftCompare @@ -52,7 +50,7 @@ instance Evaluatable Function newtype Interface a = Interface { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Interface where liftEq = genericLiftEq instance Ord1 Interface where liftCompare = genericLiftCompare @@ -62,7 +60,7 @@ instance Show1 Interface where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Interface data Map a = Map { mapKeyType :: a, mapElementType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Map where liftEq = genericLiftEq instance Ord1 Map where liftCompare = genericLiftCompare @@ -72,7 +70,7 @@ instance Show1 Map where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Map newtype Parenthesized a = Parenthesized { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Parenthesized where liftEq = genericLiftEq instance Ord1 Parenthesized where liftCompare = genericLiftCompare @@ -82,7 +80,7 @@ instance Show1 Parenthesized where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Parenthesized newtype Pointer a = Pointer { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Pointer where liftEq = genericLiftEq instance Ord1 Pointer where liftCompare = genericLiftCompare @@ -92,7 +90,7 @@ instance Show1 Pointer where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Pointer newtype Product a = Product { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Product where liftEq = genericLiftEq instance Ord1 Product where liftCompare = genericLiftCompare @@ -103,7 +101,7 @@ instance Evaluatable Product data Readonly a = Readonly - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Readonly where liftEq = genericLiftEq instance Ord1 Readonly where liftCompare = genericLiftCompare @@ -113,7 +111,7 @@ instance Show1 Readonly where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Readonly newtype Slice a = Slice { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Slice where liftEq = genericLiftEq instance Ord1 Slice where liftCompare = genericLiftCompare @@ -123,7 +121,7 @@ instance Show1 Slice where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Slice newtype TypeParameters a = TypeParameters { terms :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeParameters where liftEq = genericLiftEq instance Ord1 TypeParameters where liftCompare = genericLiftCompare @@ -134,7 +132,7 @@ instance Evaluatable TypeParameters -- data instead of newtype because no payload data Void a = Void - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Void where liftEq = genericLiftEq instance Ord1 Void where liftCompare = genericLiftCompare @@ -145,7 +143,7 @@ instance Evaluatable Void -- data instead of newtype because no payload data Int a = Int - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Int where liftEq = genericLiftEq instance Ord1 Int where liftCompare = genericLiftCompare @@ -155,7 +153,7 @@ instance Show1 Int where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Int data Float a = Float - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Float where liftEq = genericLiftEq instance Ord1 Float where liftCompare = genericLiftCompare @@ -165,7 +163,7 @@ instance Show1 Float where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Float data Double a = Double - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Double where liftEq = genericLiftEq instance Ord1 Double where liftCompare = genericLiftCompare @@ -175,7 +173,7 @@ instance Show1 Double where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Double data Bool a = Bool - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Bool where liftEq = genericLiftEq instance Ord1 Bool where liftCompare = genericLiftCompare diff --git a/src/Data/Term.hs b/src/Data/Term.hs index 9ad310865..9f96e48f6 100644 --- a/src/Data/Term.hs +++ b/src/Data/Term.hs @@ -24,13 +24,11 @@ module Data.Term ) where import Control.Lens.Lens -import Data.Aeson import Data.Bifoldable import Data.Bifunctor import Data.Bitraversable import Data.Functor.Classes import Data.Functor.Foldable -import Data.JSON.Fields import Data.Sum import qualified Data.Sum as Sum import GHC.Generics (Generic1) @@ -142,21 +140,6 @@ instance Ord1 f => Ord2 (TermF f) where instance (Ord1 f, Ord a) => Ord1 (TermF f a) where liftCompare = liftCompare2 compare -instance (ToJSONFields a, ToJSONFields1 f) => ToJSON (Term f a) where - toJSON = object . toJSONFields - toEncoding = pairs . mconcat . toJSONFields - -instance (ToJSONFields a, ToJSONFields1 f) => ToJSONFields (Term f a) where - toJSONFields = toJSONFields . unTerm - -instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSONFields (TermF f a b) where - toJSONFields (In a f) = toJSONFields1 f <> toJSONFields a - -instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSON (TermF f a b) where - toJSON = object . toJSONFields - toEncoding = pairs . mconcat . toJSONFields - - class IsTerm term where type Syntax term :: * -> * diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs deleted file mode 100644 index 98694b776..000000000 --- a/src/Diffing/Algorithm.hs +++ /dev/null @@ -1,311 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -module Diffing.Algorithm - ( Diff (..) - , Algorithm(..) - , Diffable (..) - , Equivalence (..) - , diff - , diffEdit - , diffMaybe - , linearly - , byReplacing - , comparableTerms - , equivalentTerms - , algorithmForTerms - ) where - -import Control.Algebra hiding ((:+:)) -import Control.Applicative -import Control.Effect.NonDet -import qualified Data.Diff as Diff -import qualified Data.Edit as Edit -import Data.Functor -import Data.Functor.Classes -import Data.List.NonEmpty -import Data.Maybe -import Data.Maybe.Exts -import Data.Sum -import Data.Term -import GHC.Generics - --- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm. -data Diff term1 term2 diff (m :: * -> *) k - -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion. - = Diff term1 term2 (diff -> m k) - -- | Diff two terms recursively in O(n) time, resulting in a single diff node. - | Linear term1 term2 (diff -> m k) - -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs. - | RWS [term1] [term2] ([diff] -> m k) - -- | Delete a term. - | Delete term1 (diff -> m k) - -- | Insert a term. - | Insert term2 (diff -> m k) - -- | Replace one term with another. - | Replace term1 term2 (diff -> m k) - deriving (Functor, Generic1) - -instance HFunctor (Diff term1 term2 diff) -instance Effect (Diff term1 term2 diff) - -newtype Algorithm term1 term2 diff m a = Algorithm { runAlgorithm :: m a } - deriving (Applicative, Alternative, Functor, Monad) - -instance Algebra sig m => Algebra sig (Algorithm term1 term2 diff m) where - alg = Algorithm . alg . handleCoercible - - --- DSL - --- | Diff two terms without specifying the algorithm to be used. -diff :: Has (Diff term1 term2 diff) sig m => term1 -> term2 -> m diff -diff a1 a2 = send (Diff a1 a2 pure) - --- | Diff an 'Edit.Edit' of terms without specifying the algorithm to be used. -diffEdit :: Has (Diff term1 term2 diff) sig m => Edit.Edit term1 term2 -> Algorithm term1 term2 diff m diff -diffEdit = Edit.edit byDeleting byInserting diff - --- | Diff a pair of optional terms without specifying the algorithm to be used. -diffMaybe :: Has (Diff term1 term2 diff) sig m => Maybe term1 -> Maybe term2 -> Algorithm term1 term2 diff m (Maybe diff) -diffMaybe (Just a1) (Just a2) = Just <$> diff a1 a2 -diffMaybe (Just a1) _ = Just <$> byDeleting a1 -diffMaybe _ (Just a2) = Just <$> byInserting a2 -diffMaybe _ _ = pure Nothing - --- | Diff two terms linearly. -linearly :: Has (Diff term1 term2 diff) sig m => term1 -> term2 -> Algorithm term1 term2 diff m diff -linearly f1 f2 = send (Linear f1 f2 pure) - --- | Diff two terms using RWS. -byRWS :: Has (Diff term1 term2 diff) sig m => [term1] -> [term2] -> Algorithm term1 term2 diff m [diff] -byRWS as1 as2 = send (RWS as1 as2 pure) - --- | Delete a term. -byDeleting :: Has (Diff term1 term2 diff) sig m => term1 -> Algorithm term1 term2 diff m diff -byDeleting a1 = sendDiff (Delete a1 pure) - --- | Insert a term. -byInserting :: Has (Diff term1 term2 diff) sig m => term2 -> Algorithm term1 term2 diff m diff -byInserting a2 = sendDiff (Insert a2 pure) - --- | Replace one term with another. -byReplacing :: Has (Diff term1 term2 diff) sig m => term1 -> term2 -> Algorithm term1 term2 diff m diff -byReplacing a1 a2 = send (Replace a1 a2 pure) - -sendDiff :: Has (Diff term1 term2 diff) sig m => Diff term1 term2 diff m a -> Algorithm term1 term2 diff m a -sendDiff = Algorithm . send - - --- | Diff two terms based on their 'Diffable' instances, performing substructural comparisons iff the initial comparison fails. -algorithmForTerms :: (Diffable syntax, Has (Diff (Term syntax ann1) (Term syntax ann2) (Diff.Diff syntax ann1 ann2)) sig m, Has NonDet sig m, Alternative m) - => Term syntax ann1 - -> Term syntax ann2 - -> Algorithm (Term syntax ann1) (Term syntax ann2) (Diff.Diff syntax ann1 ann2) m (Diff.Diff syntax ann1 ann2) -algorithmForTerms t1@(Term (In ann1 f1)) t2@(Term (In ann2 f2)) - = mergeFor t1 t2 - <|> Diff.deleteF . In ann1 <$> subalgorithmFor byDeleting (`mergeFor` t2) f1 - <|> Diff.insertF . In ann2 <$> subalgorithmFor byInserting (mergeFor t1) f2 - where mergeFor (Term (In ann1 f1)) (Term (In ann2 f2)) = Diff.merge (ann1, ann2) <$> algorithmFor f1 f2 - --- | An O(1) relation on terms indicating their non-recursive comparability (i.e. are they of the same “kind” in a way that warrants comparison), defined in terms of the comparability of their respective syntax. -comparableTerms :: Diffable syntax - => TermF syntax ann1 term1 - -> TermF syntax ann2 term2 - -> Bool -comparableTerms (In _ syntax1) (In _ syntax2) = comparableTo syntax1 syntax2 - --- | An O(n) relation on terms indicating their recursive equivalence (i.e. are they _notionally_ “the same,” as distinct from literal equality), defined at each node in terms of the equivalence of their respective syntax, computed first on a nominated subterm (if any), falling back to substructural equivalence (e.g. equivalence of one term against the subject of the other, annotating term), and finally to equality. -equivalentTerms :: (Diffable syntax, Eq1 syntax) - => Term syntax ann1 - -> Term syntax ann2 - -> Bool -equivalentTerms term1@(Term (In _ syntax1)) term2@(Term (In _ syntax2)) - = fromMaybe False (equivalentTerms <$> equivalentBySubterm syntax1 <*> equivalentBySubterm syntax2) - || runEquivalence (subalgorithmFor pure (Equivalence . flip equivalentTerms term2) syntax1) - || runEquivalence (subalgorithmFor pure (Equivalence . equivalentTerms term1) syntax2) - || liftEq equivalentTerms syntax1 syntax2 - --- | A constant 'Alternative' functor used by 'equivalentTerms' to compute the substructural equivalence of syntax. -newtype Equivalence a = Equivalence { runEquivalence :: Bool } - deriving (Eq, Functor) - -instance Applicative Equivalence where - pure _ = Equivalence True - Equivalence a <*> Equivalence b = Equivalence (a && b) - -instance Alternative Equivalence where - empty = Equivalence False - Equivalence a <|> Equivalence b = Equivalence (a || b) - --- | A type class for determining what algorithm to use for diffing two terms. -class Diffable f where - -- | Construct an algorithm to diff a pair of @f@s populated with disjoint terms. - algorithmFor :: (Alternative m, Has (Diff term1 term2 diff) sig m, Has NonDet sig m) - => f term1 - -> f term2 - -> Algorithm term1 term2 diff m (f diff) - default - algorithmFor :: (Alternative m, Generic1 f, GDiffable (Rep1 f), Has (Diff term1 term2 diff) sig m, Has NonDet sig m) - => f term1 - -> f term2 - -> Algorithm term1 term2 diff m (f diff) - algorithmFor = genericAlgorithmFor - - tryAlignWith :: Alternative g => (Edit.Edit a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) - default tryAlignWith :: (Alternative g, Generic1 f, GDiffable (Rep1 f)) => (Edit.Edit a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) - tryAlignWith f a b = to1 <$> gtryAlignWith f (from1 a) (from1 b) - - -- | Construct an algorithm to diff against positions inside an @f@. - -- - -- This is very like 'traverse', with two key differences: - -- - -- 1. The traversal distributes through an 'Alternative' functor, not just an 'Applicative'. - -- 2. The traversal is mediated by two different functions, one for positions which should be ignored for substructural diffing, the other for positions which should be diffed substructurally. - -- - -- These two functions allow us to say e.g. that comparisons against 'Data.Syntax.Context' should also be made against its subject, but not against any of the comments, resulting in the insertion of both comments and context when documenting an existing function. - -- - -- By default, 'subalgorithmFor' produces 'empty', rejecting substructural comparisons. This is important for performance, as alternations with 'empty' are eliminated at construction time. - -- ^ The 'Alternative' instance will in general be 'Diff', but left opaque to make it harder to shoot oneself in the foot. - subalgorithmFor :: Alternative g - => (a -> g b) -- ^ A “blur” function to traverse positions which should not be diffed against. - -> (a -> g b) -- ^ A “focus” function to traverse positions which should be diffed against. - -> f a -- ^ The syntax to diff inside of. - -> g (f b) -- ^ The resulting algorithm (or other 'Alternative' context), producing the traversed syntax. - subalgorithmFor _ _ _ = empty - - -- | Syntax having a human-provided identifier, such as function/method definitions, can use equivalence of identifiers as a proxy for their overall equivalence, improving the quality & efficiency of the diff as a whole. - -- - -- This can also be used for annotation nodes to ensure that their subjects’ equivalence is weighed appropriately. - -- - -- Other syntax should use the default definition, and thus have equivalence computed piece-wise. - equivalentBySubterm :: f a -> Maybe a - equivalentBySubterm _ = Nothing - - -- | A relation on syntax values indicating their In general this should be true iff both values have the same constructor (this is the relation computed by the default, generic definition). - -- - -- For syntax with constant fields which serve as a classifier, this method can be overloaded to consider equality on that classifier in addition to/instead of the constructors themselves, and thus limit the comparisons accordingly. - comparableTo :: f term1 -> f term2 -> Bool - default comparableTo :: (Generic1 f, GDiffable (Rep1 f)) => f term1 -> f term2 -> Bool - comparableTo = genericComparableTo - -genericAlgorithmFor :: (Alternative m, Generic1 f, GDiffable (Rep1 f),Has (Diff term1 term2 diff) sig m, Has NonDet sig m) - => f term1 - -> f term2 - -> Algorithm term1 term2 diff m (f diff) -genericAlgorithmFor a1 a2 = to1 <$> galgorithmFor (from1 a1) (from1 a2) - -genericComparableTo :: (Generic1 f, GDiffable (Rep1 f)) => f term1 -> f term2 -> Bool -genericComparableTo a1 a2 = gcomparableTo (from1 a1) (from1 a2) - - --- | 'Diffable' for 'Sum's of syntax functors is defined in general by straightforward lifting of each method into the functors in the 'Sum'. -instance Apply Diffable fs => Diffable (Sum fs) where - algorithmFor u1 u2 = fromMaybe empty (apply2' @Diffable (\ inj f1 f2 -> inj <$> algorithmFor f1 f2) u1 u2) - - tryAlignWith f u1 u2 = fromMaybe empty (apply2' @Diffable (\ inj t1 t2 -> inj <$> tryAlignWith f t1 t2) u1 u2) - - subalgorithmFor blur focus = apply' @Diffable (\ inj f -> inj <$> subalgorithmFor blur focus f) - - equivalentBySubterm = apply @Diffable equivalentBySubterm - - -- | Comparability on 'Sum's is defined first by comparability of their contained functors (when they’re the same), falling back to using 'subalgorithmFor' to opt substructurally-diffable syntax into comparisons (e.g. to allow annotating nodes to be compared against the kind of nodes they annotate). - comparableTo u1 u2 = fromMaybe False (apply2 @Diffable comparableTo u1 u2 <|> True <$ subalgorithmFor pure pure u1 <|> True <$ subalgorithmFor pure pure u2) - --- | Diff two 'Maybe's. -instance Diffable Maybe where - algorithmFor = diffMaybe - - tryAlignWith f (Just a1) (Just a2) = Just <$> f (Edit.Compare a1 a2) - tryAlignWith f (Just a1) Nothing = Just <$> f (Edit.Delete a1) - tryAlignWith f Nothing (Just a2) = Just <$> f (Edit.Insert a2) - tryAlignWith _ Nothing Nothing = pure Nothing - --- | Diff two lists using RWS. -instance Diffable [] where - algorithmFor = byRWS - - tryAlignWith f (a1:as1) (a2:as2) = (:) <$> f (Edit.Compare a1 a2) <*> tryAlignWith f as1 as2 - tryAlignWith f [] as2 = traverse (f . Edit.Insert) as2 - tryAlignWith f as1 [] = traverse (f . Edit.Delete) as1 - --- | Diff two non-empty lists using RWS. -instance Diffable NonEmpty where - algorithmFor (a1:|as1) (a2:|as2) = nonEmpty <$> byRWS (a1:as1) (a2:as2) >>= maybeM empty - - tryAlignWith f (a1:|as1) (a2:|as2) = (:|) <$> f (Edit.Compare a1 a2) <*> tryAlignWith f as1 as2 - --- | A generic type class for diffing two terms defined by the Generic1 interface. -class GDiffable f where - galgorithmFor :: (Alternative m, Has (Diff term1 term2 diff) sig m, Has NonDet sig m) => f term1 -> f term2 -> Algorithm term1 term2 diff m (f diff) - - gtryAlignWith :: Alternative g => (Edit.Edit a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) - - gcomparableTo :: f term1 -> f term2 -> Bool - gcomparableTo _ _ = True - --- | Diff two constructors (M1 is the Generic1 newtype for meta-information (possibly related to type constructors, record selectors, and data types)) -instance GDiffable f => GDiffable (M1 i c f) where - galgorithmFor (M1 a1) (M1 a2) = M1 <$> galgorithmFor a1 a2 - - gtryAlignWith f (M1 a) (M1 b) = M1 <$> gtryAlignWith f a b - - gcomparableTo (M1 a1) (M1 a2) = gcomparableTo a1 a2 - --- | Diff the fields of a product type. --- i.e. data Foo a b = Foo a b (the 'Foo a b' is captured by 'a :*: b'). -instance (GDiffable f, GDiffable g) => GDiffable (f :*: g) where - galgorithmFor (a1 :*: b1) (a2 :*: b2) = (:*:) <$> galgorithmFor a1 a2 <*> galgorithmFor b1 b2 - - gtryAlignWith f (a1 :*: b1) (a2 :*: b2) = (:*:) <$> gtryAlignWith f a1 a2 <*> gtryAlignWith f b1 b2 - --- | Diff the constructors of a sum type. --- i.e. data Foo a = Foo a | Bar a (the 'Foo a' is captured by L1 and 'Bar a' is R1). -instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where - galgorithmFor (L1 a1) (L1 a2) = L1 <$> galgorithmFor a1 a2 - galgorithmFor (R1 b1) (R1 b2) = R1 <$> galgorithmFor b1 b2 - galgorithmFor _ _ = empty - - gtryAlignWith f a b = case (a, b) of - (L1 a, L1 b) -> L1 <$> gtryAlignWith f a b - (R1 a, R1 b) -> R1 <$> gtryAlignWith f a b - _ -> empty - - gcomparableTo (L1 _) (L1 _) = True - gcomparableTo (R1 _) (R1 _) = True - gcomparableTo _ _ = False - --- | Diff two parameters (Par1 is the Generic1 newtype representing a type parameter). --- i.e. data Foo a = Foo a (the 'a' is captured by Par1). -instance GDiffable Par1 where - galgorithmFor (Par1 a1) (Par1 a2) = Par1 <$> diff a1 a2 - - gtryAlignWith f (Par1 a) (Par1 b) = Par1 <$> f (Edit.Compare a b) - --- | Diff two constant parameters (K1 is the Generic1 newtype representing type parameter constants). --- i.e. data Foo = Foo Int (the 'Int' is a constant parameter). -instance Eq c => GDiffable (K1 i c) where - galgorithmFor (K1 a1) (K1 a2) = guard (a1 == a2) $> K1 a1 - - gtryAlignWith _ (K1 a) (K1 b) = guard (a == b) $> K1 b - --- | Diff two terms whose constructors contain 0 type parameters. --- i.e. data Foo = Foo. -instance GDiffable U1 where - galgorithmFor _ _ = pure U1 - - gtryAlignWith _ _ _ = pure U1 - --- | Diff two 'Diffable' containers of parameters. -instance Diffable f => GDiffable (Rec1 f) where - galgorithmFor a1 a2 = Rec1 <$> algorithmFor (unRec1 a1) (unRec1 a2) - - gtryAlignWith f (Rec1 a) (Rec1 b) = Rec1 <$> tryAlignWith f a b diff --git a/src/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs deleted file mode 100644 index 99b8aaad8..000000000 --- a/src/Diffing/Algorithm/RWS.hs +++ /dev/null @@ -1,191 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- FIXME -module Diffing.Algorithm.RWS -( rws -, Options(..) -, defaultOptions -, ComparabilityRelation -, FeatureVector -, defaultFeatureVectorDecorator -, featureVectorDecorator -, pqGramDecorator -, Gram(..) -, canCompareTerms -, equalTerms -) where - -import Control.Applicative -import Control.Arrow ((&&&)) -import Control.Monad.State.Strict -import Data.Diff (DiffF (..), comparing, deleting, inserting, merge) -import Data.Edit -import Data.Foldable -import Data.Function -import Data.Functor.Classes -import Data.Functor.Foldable (cata) -import Data.Hashable -import Data.Hashable.Lifted -import Data.Ix (inRange) -import qualified Data.KdMap.Static as KdMap -import Data.List (sortOn) -import Data.Maybe -import Data.Term as Term -import Data.Traversable -import Diffing.Algorithm (Diffable (..)) -import Diffing.Algorithm.RWS.FeatureVector -import Diffing.Algorithm.SES -import GHC.Generics (Generic) - --- | 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. -type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a -> TermF syntax ann2 b -> Bool - -rws :: (Foldable syntax, Functor syntax, Diffable syntax) - => ComparabilityRelation syntax (FeatureVector, ann1) (FeatureVector, ann2) - -> (Term syntax (FeatureVector, ann1) -> Term syntax (FeatureVector, ann2) -> Bool) - -> [Term syntax (FeatureVector, ann1)] - -> [Term syntax (FeatureVector, ann2)] - -> [Edit (Term syntax (FeatureVector, ann1)) (Term syntax (FeatureVector, ann2))] -rws _ _ as [] = Delete <$> as -rws _ _ [] bs = Insert <$> bs -rws canCompare _ [a] [b] = if canCompareTerms canCompare a b then [Compare a b] else [Insert b, Delete a] -rws canCompare equivalent as bs - = ses equivalent as bs - & mapContiguous [] [] - where Options{..} = defaultOptions - - -- Map contiguous sequences of unmapped terms separated by SES-mapped equivalencies. - mapContiguous as bs [] = mapSimilar (reverse as) (reverse bs) - mapContiguous as bs (first : rest) = case first of - Delete a -> mapContiguous (a : as) bs rest - Insert b -> mapContiguous as (b : bs) rest - Compare _ _ -> mapSimilar (reverse as) (reverse bs) <> (first : mapContiguous [] [] rest) - - -- Map comparable, mutually similar terms, inserting & deleting surrounding terms. - mapSimilar as' bs' = go as bs - where go as [] = Delete . snd <$> as - go [] bs = Insert . snd <$> bs - go [a] [b] | canCompareTerms canCompare (snd a) (snd b) = [Compare (snd a) (snd b)] - | otherwise = [Insert (snd b), Delete (snd a)] - go as@((i, _) : _) ((j, b) : restB) = - fromMaybe (Insert b : go as restB) $ do - -- Look up the most similar term to b near i. - (i', a) <- mostSimilarMatching (\ i' a -> inRange (i, i + optionsLookaheadPlaces) i' && canCompareTerms canCompare a b) kdMapA b - -- Look up the most similar term to a near j. - (j', _) <- mostSimilarMatching (\ j' b -> inRange (j, j + optionsLookaheadPlaces) j' && canCompareTerms canCompare a b) kdMapB a - -- Fail out if there’s a better match for a nearby. - guard (j == j') - -- Delete any elements of as before the selected element. - let (deleted, _ : restA) = span ((< i') . fst) as - pure $! (Delete . snd <$> deleted) <> (Compare a b : go restA restB) - (as, bs) = (zip [0..] as', zip [0..] bs') - (kdMapA, kdMapB) = (toKdMap as, toKdMap bs) - - -- Find the most similar term matching a predicate, if any. - -- - -- RWS can produce false positives in the case of e.g. hash collisions. Therefore, we find the _l_ nearest candidates, filter out any which don’t match the predicate, and select the minimum of the remaining by (a constant-time approximation of) edit distance. - -- - -- cf §4.2 of RWS-Diff - mostSimilarMatching isEligible tree term = listToMaybe (sortOn (editDistanceUpTo optionsNodeComparisons term . snd) candidates) - where candidates = filter (uncurry isEligible) (snd <$> KdMap.kNearest tree optionsMaxSimilarTerms (fst (termAnnotation term))) - -data Options = Options - { optionsLookaheadPlaces :: {-# UNPACK #-} !Int -- ^ How many places ahead should we look for similar terms? - , optionsMaxSimilarTerms :: {-# UNPACK #-} !Int -- ^ The maximum number of similar terms to consider. - , optionsNodeComparisons :: {-# UNPACK #-} !Int -- ^ The number of nodes to compare when selecting the most similar term. - } - -defaultOptions :: Options -defaultOptions = Options - { optionsLookaheadPlaces = 0 - , optionsMaxSimilarTerms = 2 - , optionsNodeComparisons = 10 - } - -defaultP, defaultQ :: Int -defaultP = 0 -defaultQ = 3 - - -toKdMap :: [(Int, Term syntax (FeatureVector, ann))] -> KdMap.KdMap Double FeatureVector (Int, Term syntax (FeatureVector, ann)) -toKdMap = KdMap.build unFV . fmap (fst . 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, 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 :: (Hashable1 syntax, Traversable syntax) - => Term syntax ann - -> Term syntax (FeatureVector, ann) -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 syntax, Functor syntax, Hashable label) => Term syntax (Gram label, ann) -> Term syntax (FeatureVector, ann) -featureVectorDecorator = cata (\ (In (label, ann) functor) -> - termIn (foldl' addSubtermVector (unitVector (hash label)) functor, ann) functor) - where addSubtermVector v term = addVectors v (fst (termAnnotation term)) - --- | Annotates a term with the corresponding p,q-gram at each node. -pqGramDecorator :: Traversable syntax - => Int -- ^ 'p'; the desired stem length for the grams. - -> Int -- ^ 'q'; the desired base length for the grams. - -> Term syntax ann -- ^ The term to decorate. - -> Term syntax (Gram (Label syntax), ann) -- ^ The decorated term. -pqGramDecorator p q = cata algebra - where - 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 syntax (Gram label, ann) - -> State [Maybe label] (Term syntax (Gram label, ann)) - 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 syntax => syntax (Term syntax (Gram label, ann)) -> [Maybe label] - siblingLabels = foldMap (base . fst . termAnnotation) - padToSize n list = take n (list <> repeat empty) - --- | Test the comparability of two root 'Term's in O(1). -canCompareTerms :: ComparabilityRelation syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Bool -canCompareTerms canCompare t1 t2 = canCompare (unTerm t1) (unTerm t2) - --- | Recursively test the equality of two 'Term's in O(n). -equalTerms :: Eq1 syntax => ComparabilityRelation syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Bool -equalTerms canCompare = go - where go a b = canCompareTerms canCompare a b && liftEq go (termOut a) (termOut b) - - --- | Return an edit distance between two terms, up to a certain depth. --- --- Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost. -editDistanceUpTo :: (Diffable syntax, Foldable syntax, Functor syntax) => Int -> Term syntax ann1 -> Term syntax ann2 -> Int -editDistanceUpTo m a b = diffCost m (approximateDiff a b) - where diffCost = flip . cata $ \ diff m -> case diff of - _ | m <= 0 -> 0 - Merge body -> sum (fmap ($ pred m) body) - body -> succ (sum (fmap ($ pred m) body)) - approximateDiff a b = maybe (comparing a b) (merge (termAnnotation a, termAnnotation b)) (tryAlignWith (Just . edit deleting inserting approximateDiff) (termOut a) (termOut b)) - - -data Label syntax where - Label :: syntax a -> Label syntax - -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/Algorithm/RWS/FeatureVector.hs b/src/Diffing/Algorithm/RWS/FeatureVector.hs deleted file mode 100644 index 71237af7e..000000000 --- a/src/Diffing/Algorithm/RWS/FeatureVector.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE BangPatterns, MagicHash #-} -module Diffing.Algorithm.RWS.FeatureVector -( FeatureVector -, unFV -, unitVector -, addVectors -) where - -import GHC.Prim -import GHC.Types -import System.Random.Mersenne.Pure64 - --- | A 15-dimensional feature vector represented with machine doubles. --- --- 15 dimensions ought to be enough for anyone. cf §5.2 of RWS-Diff: “We obtained best results with 10 ≤ d ≤ 20.” -data FeatureVector = FV !Double# !Double# !Double# !Double# !Double# - !Double# !Double# !Double# !Double# !Double# - !Double# !Double# !Double# !Double# !Double# - -unFV :: FeatureVector -> [Double] -unFV (FV d00 d01 d02 d03 d04 d05 d06 d07 d08 d09 d10 d11 d12 d13 d14) - = [ D# d00, D# d01, D# d02, D# d03, D# d04 - , D# d05, D# d06, D# d07, D# d08, D# d09 - , D# d10, D# d11, D# d12, D# d13, D# d14 ] - --- | Computes a unit vector of the specified dimension from a hash. -unitVector :: Int -> FeatureVector -unitVector !hash = - let !(D# d00, r00) = randomDouble (pureMT (fromIntegral hash)) - !(D# d01, r01) = randomDouble r00 - !(D# d02, r02) = randomDouble r01 - !(D# d03, r03) = randomDouble r02 - !(D# d04, r04) = randomDouble r03 - !(D# d05, r05) = randomDouble r04 - !(D# d06, r06) = randomDouble r05 - !(D# d07, r07) = randomDouble r06 - !(D# d08, r08) = randomDouble r07 - !(D# d09, r09) = randomDouble r08 - !(D# d10, r10) = randomDouble r09 - !(D# d11, r11) = randomDouble r10 - !(D# d12, r12) = randomDouble r11 - !(D# d13, r13) = randomDouble r12 - !(D# d14, _) = randomDouble r13 - !(D# one) = 1 - !invMagnitude = one /## sqrtDouble# (d00 *## d00 +## d01 *## d01 +## d02 *## d02 +## d03 *## d03 +## d04 *## d04 +## d05 *## d05 +## d06 *## d06 +## d07 *## d07 +## d08 *## d08 +## d09 *## d09 +## d10 *## d10 +## d11 *## d11 +## d12 *## d12 +## d13 *## d13 +## d14 *## d14) - in FV (invMagnitude *## d00) (invMagnitude *## d01) (invMagnitude *## d02) (invMagnitude *## d03) (invMagnitude *## d04) - (invMagnitude *## d05) (invMagnitude *## d06) (invMagnitude *## d07) (invMagnitude *## d08) (invMagnitude *## d09) - (invMagnitude *## d10) (invMagnitude *## d11) (invMagnitude *## d12) (invMagnitude *## d13) (invMagnitude *## d14) - -addVectors :: FeatureVector -> FeatureVector -> FeatureVector -addVectors (FV a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14) - (FV b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14) - = FV (a00 +## b00) (a01 +## b01) (a02 +## b02) (a03 +## b03) (a04 +## b04) - (a05 +## b05) (a06 +## b06) (a07 +## b07) (a08 +## b08) (a09 +## b09) - (a10 +## b10) (a11 +## b11) (a12 +## b12) (a13 +## b13) (a14 +## b14) diff --git a/src/Diffing/Algorithm/SES.hs b/src/Diffing/Algorithm/SES.hs deleted file mode 100644 index 067120436..000000000 --- a/src/Diffing/Algorithm/SES.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE BangPatterns, GADTs, MultiParamTypeClasses, ScopedTypeVariables #-} -module Diffing.Algorithm.SES -( ses -) where - -import Data.Array ((!)) -import qualified Data.Array as Array -import Data.Edit -import Data.Foldable (find, toList) -import Data.Ix - -data Endpoint a b = Endpoint { x :: {-# UNPACK #-} !Int, _y :: {-# UNPACK #-} !Int, _script :: [Edit a b] } - deriving (Eq, Show) - - --- | Compute the shortest edit script using Myers’ algorithm. -ses :: (Foldable t, Foldable u) => (a -> b -> Bool) -> t a -> u b -> [Edit a b] -ses eq as' bs' - | null bs = Delete <$> toList as - | null as = Insert <$> toList bs - | otherwise = reverse (searchUpToD 0 (Array.array (1, 1) [(1, Endpoint 0 (-1) [])])) - where (as, bs) = (Array.listArray (0, pred n) (toList as'), Array.listArray (0, pred m) (toList bs')) - (!n, !m) = (length as', length bs') - - -- Search an edit graph for the shortest edit script up to a given proposed edit distance, building on the results of previous searches. - searchUpToD !d !v = - let !endpoints = slideFrom . searchAlongK <$> [ k | k <- [-d, -d + 2 .. d], inRange (-m, n) k ] in - case find isComplete endpoints of - Just (Endpoint _ _ script) -> script - _ -> searchUpToD (succ d) (Array.array (-d, d) ((\ e@(Endpoint x y _) -> (x - y, e)) <$> endpoints)) - where isComplete (Endpoint x y _) = x >= n && y >= m - - -- Search an edit graph for the shortest edit script along a specific diagonal, moving onto a given diagonal from one of its in-bounds adjacent diagonals (if any). - searchAlongK !k - | k == -d = moveDownFrom (v ! succ k) - | k == d = moveRightFrom (v ! pred k) - | k == -m = moveDownFrom (v ! succ k) - | k == n = moveRightFrom (v ! pred k) - | otherwise = - let left = v ! pred k - up = v ! succ k in - if x left < x up then - moveDownFrom up - else - moveRightFrom left - - -- | Move downward from a given vertex, inserting the element for the corresponding row. - moveDownFrom (Endpoint x y script) = Endpoint x (succ y) $ maybe script ((: script) . Insert) (bs !? y) - {-# INLINE moveDownFrom #-} - - -- | Move rightward from a given vertex, deleting the element for the corresponding column. - moveRightFrom (Endpoint x y script) = Endpoint (succ x) y $ maybe script ((: script) . Delete) (as !? x) - {-# INLINE moveRightFrom #-} - - -- | Slide down any diagonal edges from a given vertex. - slideFrom (Endpoint x y script) - | Just a <- as !? x - , Just b <- bs !? y - , a `eq` b = slideFrom (Endpoint (succ x) (succ y) (Compare a b : script)) - | otherwise = Endpoint x y script - - -(!?) :: Ix i => Array.Array i a -> i -> Maybe a -v !? i | inRange (Array.bounds v) i, !a <- v ! i = Just a - | otherwise = Nothing -{-# INLINE (!?) #-} diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs deleted file mode 100644 index 2e2ae638d..000000000 --- a/src/Diffing/Interpreter.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -module Diffing.Interpreter -( diffTerms -, DiffTerms(..) -, stripDiff -) where - - -import Control.Algebra -import Control.Carrier.Cull.Church -import Control.Monad.IO.Class -import Data.Bifunctor -import qualified Data.Diff as Diff -import Data.Edit (Edit, edit) -import Data.Functor.Classes -import Data.Hashable.Lifted -import Data.Maybe -import Data.Term -import Diffing.Algorithm -import Diffing.Algorithm.RWS - --- | Diff two à la carte terms recursively. -diffTerms :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) - => Term syntax ann1 - -> Term syntax ann2 - -> Diff.Diff syntax ann1 ann2 -diffTerms t1 t2 = stripDiff (fromMaybe (Diff.comparing t1' t2') (run (runCullA (cull (runDiff (algorithmForTerms t1' t2')))))) - where (t1', t2') = ( defaultFeatureVectorDecorator t1 - , defaultFeatureVectorDecorator t2) - --- | Strips the head annotation off a diff annotated with non-empty records. -stripDiff :: Functor syntax - => Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2) - -> Diff.Diff syntax ann1 ann2 -stripDiff = bimap snd snd - --- | The class of term types for which we can compute a diff. -class IsTerm term => DiffTerms term where - -- | Diff an 'Edit' of terms. - diffTermPair :: Edit (term ann1) (term ann2) -> Diff.Diff (Syntax term) ann1 ann2 - -instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => DiffTerms (Term syntax) where - diffTermPair = edit Diff.deleting Diff.inserting diffTerms - - --- | Run an 'Algorithm' to completion in an 'Alternative' context using the supplied comparability & equivalence relations. -runDiff :: Algorithm - (Term syntax (FeatureVector, ann1)) - (Term syntax (FeatureVector, ann2)) - (Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2)) - (DiffC (Term syntax (FeatureVector, ann1)) (Term syntax (FeatureVector, ann2)) (Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2)) m) - result - -> m result -runDiff = runDiffC . runAlgorithm - - -newtype DiffC term1 term2 diff m a = DiffC { runDiffC :: m a } - deriving (Alternative, Applicative, Functor, Monad, MonadIO) - -instance ( Alternative m - , Diffable syntax - , Eq1 syntax - , Has NonDet sig m - , Traversable syntax - ) - => Algebra - (Diff (Term syntax (FeatureVector, ann1)) (Term syntax (FeatureVector, ann2)) (Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2)) :+: sig) - (DiffC (Term syntax (FeatureVector, ann1)) (Term syntax (FeatureVector, ann2)) (Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2)) m) where - alg (L op) = case op of - Diff t1 t2 k -> runDiff (algorithmForTerms t1 t2) <|> pure (Diff.comparing t1 t2) >>= k - Linear (Term (In ann1 f1)) (Term (In ann2 f2)) k -> Diff.merge (ann1, ann2) <$> tryAlignWith (runDiff . diffEdit) f1 f2 >>= k - RWS as bs k -> traverse (runDiff . diffEdit) (rws comparableTerms equivalentTerms as bs) >>= k - Delete a k -> k (Diff.deleting a) - Insert b k -> k (Diff.inserting b) - Replace a b k -> k (Diff.comparing a b) - alg (R other) = DiffC . alg . handleCoercible $ other diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index dc72f17aa..aba5611c2 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -18,14 +18,12 @@ import Data.Functor.Classes import Data.Functor.Classes.Generic import Data.Hashable.Lifted import Data.ImportPath -import Data.JSON.Fields import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as Map import Data.Semigroup.App import Data.Semigroup.Foldable import Data.Text (Text) import qualified Data.Text as T -import Diffing.Algorithm import GHC.Generics (Generic1) import qualified System.Path as Path import System.FilePath.Posix @@ -61,7 +59,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Import where liftEq = genericLiftEq instance Ord1 Import where liftCompare = genericLiftCompare @@ -82,7 +80,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 QualifiedImport where liftEq = genericLiftEq instance Ord1 QualifiedImport where liftCompare = genericLiftCompare @@ -115,7 +113,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 SideEffectImport where liftEq = genericLiftEq instance Ord1 SideEffectImport where liftCompare = genericLiftCompare @@ -131,7 +129,7 @@ instance Evaluatable SideEffectImport where -- A composite literal in Go data Composite a = Composite { compositeType :: !a, compositeElement :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Composite where liftEq = genericLiftEq instance Ord1 Composite where liftCompare = genericLiftCompare @@ -142,7 +140,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 DefaultPattern where liftEq = genericLiftEq instance Ord1 DefaultPattern where liftCompare = genericLiftCompare @@ -153,7 +151,7 @@ instance Evaluatable DefaultPattern -- | A defer statement in Go (e.g. `defer x()`). newtype Defer a = Defer { deferBody :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Defer where liftEq = genericLiftEq instance Ord1 Defer where liftCompare = genericLiftCompare @@ -164,7 +162,7 @@ instance Evaluatable Defer -- | A go statement (i.e. go routine) in Go (e.g. `go x()`). newtype Go a = Go { goBody :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Go where liftEq = genericLiftEq instance Ord1 Go where liftCompare = genericLiftCompare @@ -175,7 +173,7 @@ instance Evaluatable Go -- | A label statement in Go (e.g. `label:continue`). data Label a = Label { labelName :: !a, labelStatement :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Label where liftEq = genericLiftEq instance Ord1 Label where liftCompare = genericLiftCompare @@ -186,7 +184,7 @@ instance Evaluatable Label -- | A rune literal in Go (e.g. `'⌘'`). newtype Rune a = Rune { runeLiteral :: Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Rune where liftEq = genericLiftEq instance Ord1 Rune where liftCompare = genericLiftCompare @@ -197,7 +195,7 @@ instance Evaluatable Rune -- | 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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Select where liftEq = genericLiftEq instance Ord1 Select where liftCompare = genericLiftCompare @@ -208,7 +206,7 @@ instance Evaluatable Select -- | A send statement in Go (e.g. `channel <- value`). data Send a = Send { sendReceiver :: !a, sendValue :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Send where liftEq = genericLiftEq instance Ord1 Send where liftCompare = genericLiftCompare @@ -219,7 +217,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Slice where liftEq = genericLiftEq instance Ord1 Slice where liftCompare = genericLiftCompare @@ -230,7 +228,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeSwitch where liftEq = genericLiftEq instance Ord1 TypeSwitch where liftCompare = genericLiftCompare @@ -241,7 +239,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare @@ -252,7 +250,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Receive where liftEq = genericLiftEq instance Ord1 Receive where liftCompare = genericLiftCompare @@ -263,7 +261,7 @@ instance Evaluatable Receive -- | A receive operator unary expression in Go (e.g. `<-channel` ) newtype ReceiveOperator a = ReceiveOperator { value :: a} - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ReceiveOperator where liftEq = genericLiftEq instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare @@ -274,7 +272,7 @@ instance Evaluatable ReceiveOperator -- | A field declaration in a Go struct type declaration. data Field a = Field { fieldContext :: ![a], fieldName :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Field where liftEq = genericLiftEq instance Ord1 Field where liftCompare = genericLiftCompare @@ -284,7 +282,7 @@ instance Show1 Field where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Field data Package a = Package { packageName :: !a, packageContents :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Package where liftEq = genericLiftEq instance Ord1 Package where liftCompare = genericLiftCompare @@ -295,7 +293,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeAssertion where liftEq = genericLiftEq instance Ord1 TypeAssertion where liftCompare = genericLiftCompare @@ -306,7 +304,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeConversion where liftEq = genericLiftEq instance Ord1 TypeConversion where liftCompare = genericLiftCompare @@ -317,7 +315,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Variadic where liftEq = genericLiftEq instance Ord1 Variadic where liftCompare = genericLiftCompare diff --git a/src/Language/Go/Term.hs b/src/Language/Go/Term.hs index d68838636..0305ac278 100644 --- a/src/Language/Go/Term.hs +++ b/src/Language/Go/Term.hs @@ -7,8 +7,6 @@ module Language.Go.Term import Control.Lens.Lens import Data.Abstract.Declarations import Data.Abstract.FreeVariables -import Data.Aeson (ToJSON) -import Data.Bifunctor import Data.Bitraversable import Data.Coerce import Data.Foldable (fold) @@ -24,7 +22,6 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Data.Term as Term import Data.Traversable -import Diffing.Interpreter import Language.Go.Syntax as Go.Syntax import Language.Go.Type as Go.Type import Source.Loc @@ -137,7 +134,7 @@ type Syntax = newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) } - deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON) + deriving (Eq, Declarations, FreeVariables, Ord, Show) instance Term.IsTerm Term where type Syntax Term = Sum.Sum Syntax @@ -161,9 +158,6 @@ instance Syntax.HasErrors Term where maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax) -instance DiffTerms Term where - diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term) - type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann instance Recursive (Term ann) where diff --git a/src/Language/Go/Type.hs b/src/Language/Go/Type.hs index d24445146..788dbaac1 100644 --- a/src/Language/Go/Type.hs +++ b/src/Language/Go/Type.hs @@ -7,13 +7,11 @@ module Language.Go.Type (module Language.Go.Type) where import Data.Abstract.Evaluatable import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields -import Diffing.Algorithm import GHC.Generics (Generic1) -- | A Bidirectional channel in Go (e.g. `chan`). newtype BidirectionalChannel a = BidirectionalChannel { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 BidirectionalChannel where liftEq = genericLiftEq instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare @@ -24,7 +22,7 @@ instance Evaluatable BidirectionalChannel -- | A Receive channel in Go (e.g. `<-chan`). newtype ReceiveChannel a = ReceiveChannel { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ReceiveChannel where liftEq = genericLiftEq instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare @@ -35,7 +33,7 @@ instance Evaluatable ReceiveChannel -- | A Send channel in Go (e.g. `chan<-`). newtype SendChannel a = SendChannel { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 SendChannel where liftEq = genericLiftEq instance Ord1 SendChannel where liftCompare = genericLiftCompare diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index d040dbfa2..dd6197556 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -21,14 +21,12 @@ import Data.Abstract.Evaluatable as Abstract import Data.Abstract.Module import Data.Abstract.Path import qualified Data.Abstract.ScopeGraph as ScopeGraph -import Data.JSON.Fields import qualified Data.Language as Language -import Diffing.Algorithm import Source.Span import qualified System.Path as Path newtype Text a = Text { value :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Text where liftEq = genericLiftEq instance Ord1 Text where liftCompare = genericLiftCompare @@ -37,7 +35,7 @@ instance Show1 Text where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Text newtype VariableName a = VariableName { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 VariableName where liftEq = genericLiftEq instance Ord1 VariableName where liftCompare = genericLiftCompare @@ -93,7 +91,7 @@ include eval pathTerm f = do pure v newtype Require a = Require { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Require where liftEq = genericLiftEq instance Ord1 Require where liftCompare = genericLiftCompare @@ -104,7 +102,7 @@ instance Evaluatable Require where newtype RequireOnce a = RequireOnce { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 RequireOnce where liftEq = genericLiftEq instance Ord1 RequireOnce where liftCompare = genericLiftCompare @@ -114,7 +112,7 @@ instance Evaluatable RequireOnce where eval eval _ (RequireOnce path) = include eval path require newtype Include a = Include { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Include where liftEq = genericLiftEq instance Ord1 Include where liftCompare = genericLiftCompare @@ -124,7 +122,7 @@ instance Evaluatable Include where eval eval _ (Include path) = include eval path load newtype IncludeOnce a = IncludeOnce { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 IncludeOnce where liftEq = genericLiftEq instance Ord1 IncludeOnce where liftCompare = genericLiftCompare @@ -134,7 +132,7 @@ instance Evaluatable IncludeOnce where eval eval _ (IncludeOnce path) = include eval path require newtype ArrayElement a = ArrayElement { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ArrayElement where liftEq = genericLiftEq instance Ord1 ArrayElement where liftCompare = genericLiftCompare @@ -143,7 +141,7 @@ instance Show1 ArrayElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ArrayElement newtype GlobalDeclaration a = GlobalDeclaration { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 GlobalDeclaration where liftEq = genericLiftEq instance Ord1 GlobalDeclaration where liftCompare = genericLiftCompare @@ -152,7 +150,7 @@ instance Show1 GlobalDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable GlobalDeclaration newtype SimpleVariable a = SimpleVariable { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 SimpleVariable where liftEq = genericLiftEq instance Ord1 SimpleVariable where liftCompare = genericLiftCompare @@ -161,7 +159,7 @@ instance Show1 SimpleVariable where liftShowsPrec = genericLiftShowsPrec instance Evaluatable SimpleVariable data Concat a = Concat { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Concat where liftEq = genericLiftEq instance Ord1 Concat where liftCompare = genericLiftCompare @@ -171,7 +169,7 @@ instance Evaluatable Concat -- | TODO: Unify with TypeScript's PredefinedType newtype CastType a = CastType { _castType :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 CastType where liftEq = genericLiftEq instance Ord1 CastType where liftCompare = genericLiftCompare @@ -180,7 +178,7 @@ instance Show1 CastType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable CastType newtype ErrorControl a = ErrorControl { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ErrorControl where liftEq = genericLiftEq instance Ord1 ErrorControl where liftCompare = genericLiftCompare @@ -189,7 +187,7 @@ instance Show1 ErrorControl where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ErrorControl newtype Clone a = Clone { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Clone where liftEq = genericLiftEq instance Ord1 Clone where liftCompare = genericLiftCompare @@ -198,7 +196,7 @@ instance Show1 Clone where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Clone newtype ShellCommand a = ShellCommand { value :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ShellCommand where liftEq = genericLiftEq instance Ord1 ShellCommand where liftCompare = genericLiftCompare @@ -208,7 +206,7 @@ instance Evaluatable ShellCommand -- | TODO: Combine with TypeScript update expression. newtype Update a = Update { _updateSubject :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Update where liftEq = genericLiftEq instance Ord1 Update where liftCompare = genericLiftCompare @@ -216,7 +214,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Update newtype NewVariable a = NewVariable { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NewVariable where liftEq = genericLiftEq instance Ord1 NewVariable where liftCompare = genericLiftCompare @@ -225,7 +223,7 @@ instance Show1 NewVariable where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NewVariable newtype RelativeScope a = RelativeScope { value :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 RelativeScope where liftEq = genericLiftEq instance Ord1 RelativeScope where liftCompare = genericLiftCompare @@ -234,7 +232,7 @@ instance Show1 RelativeScope where liftShowsPrec = genericLiftShowsPrec instance Evaluatable RelativeScope data QualifiedName a = QualifiedName { name :: a, identifier :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 QualifiedName where liftEq = genericLiftEq instance Ord1 QualifiedName where liftCompare = genericLiftCompare @@ -262,7 +260,7 @@ instance Evaluatable QualifiedName where unit newtype NamespaceName a = NamespaceName { names :: NonEmpty a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Traversable) instance Eq1 NamespaceName where liftEq = genericLiftEq instance Ord1 NamespaceName where liftCompare = genericLiftCompare @@ -273,7 +271,7 @@ instance Hashable1 NamespaceName where liftHashWithSalt = foldl instance Evaluatable NamespaceName newtype ConstDeclaration a = ConstDeclaration { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ConstDeclaration where liftEq = genericLiftEq instance Ord1 ConstDeclaration where liftCompare = genericLiftCompare @@ -282,7 +280,7 @@ instance Show1 ConstDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstDeclaration data ClassConstDeclaration a = ClassConstDeclaration { visibility :: a, elements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ClassConstDeclaration where liftEq = genericLiftEq instance Ord1 ClassConstDeclaration where liftCompare = genericLiftCompare @@ -291,7 +289,7 @@ instance Show1 ClassConstDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassConstDeclaration newtype ClassInterfaceClause a = ClassInterfaceClause { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ClassInterfaceClause where liftEq = genericLiftEq instance Ord1 ClassInterfaceClause where liftCompare = genericLiftCompare @@ -300,7 +298,7 @@ instance Show1 ClassInterfaceClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassInterfaceClause newtype ClassBaseClause a = ClassBaseClause { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ClassBaseClause where liftEq = genericLiftEq instance Ord1 ClassBaseClause where liftCompare = genericLiftCompare @@ -309,7 +307,7 @@ instance Show1 ClassBaseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassBaseClause newtype UseClause a = UseClause { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 UseClause where liftEq = genericLiftEq instance Ord1 UseClause where liftCompare = genericLiftCompare @@ -318,7 +316,7 @@ instance Show1 UseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable UseClause newtype ReturnType a = ReturnType { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ReturnType where liftEq = genericLiftEq instance Ord1 ReturnType where liftCompare = genericLiftCompare @@ -327,7 +325,7 @@ instance Show1 ReturnType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ReturnType newtype TypeDeclaration a = TypeDeclaration { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeDeclaration where liftEq = genericLiftEq instance Ord1 TypeDeclaration where liftCompare = genericLiftCompare @@ -336,7 +334,7 @@ instance Show1 TypeDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeDeclaration newtype BaseTypeDeclaration a = BaseTypeDeclaration { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 BaseTypeDeclaration where liftEq = genericLiftEq instance Ord1 BaseTypeDeclaration where liftCompare = genericLiftCompare @@ -344,7 +342,7 @@ instance Show1 BaseTypeDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable BaseTypeDeclaration newtype ScalarType a = ScalarType { value :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ScalarType where liftEq = genericLiftEq instance Ord1 ScalarType where liftCompare = genericLiftCompare @@ -353,7 +351,7 @@ instance Show1 ScalarType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ScalarType newtype EmptyIntrinsic a = EmptyIntrinsic { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 EmptyIntrinsic where liftEq = genericLiftEq instance Ord1 EmptyIntrinsic where liftCompare = genericLiftCompare @@ -362,7 +360,7 @@ instance Show1 EmptyIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EmptyIntrinsic newtype ExitIntrinsic a = ExitIntrinsic { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ExitIntrinsic where liftEq = genericLiftEq instance Ord1 ExitIntrinsic where liftCompare = genericLiftCompare @@ -371,7 +369,7 @@ instance Show1 ExitIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExitIntrinsic newtype IssetIntrinsic a = IssetIntrinsic { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 IssetIntrinsic where liftEq = genericLiftEq instance Ord1 IssetIntrinsic where liftCompare = genericLiftCompare @@ -380,7 +378,7 @@ instance Show1 IssetIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IssetIntrinsic newtype EvalIntrinsic a = EvalIntrinsic { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 EvalIntrinsic where liftEq = genericLiftEq instance Ord1 EvalIntrinsic where liftCompare = genericLiftCompare @@ -389,7 +387,7 @@ instance Show1 EvalIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EvalIntrinsic newtype PrintIntrinsic a = PrintIntrinsic { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PrintIntrinsic where liftEq = genericLiftEq instance Ord1 PrintIntrinsic where liftCompare = genericLiftCompare @@ -398,7 +396,7 @@ instance Show1 PrintIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PrintIntrinsic newtype NamespaceAliasingClause a = NamespaceAliasingClause { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NamespaceAliasingClause where liftEq = genericLiftEq instance Ord1 NamespaceAliasingClause where liftCompare = genericLiftCompare @@ -406,7 +404,7 @@ instance Show1 NamespaceAliasingClause where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceAliasingClause newtype NamespaceUseDeclaration a = NamespaceUseDeclaration { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NamespaceUseDeclaration where liftEq = genericLiftEq instance Ord1 NamespaceUseDeclaration where liftCompare = genericLiftCompare @@ -415,7 +413,7 @@ instance Show1 NamespaceUseDeclaration where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceUseDeclaration newtype NamespaceUseClause a = NamespaceUseClause { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NamespaceUseClause where liftEq = genericLiftEq instance Ord1 NamespaceUseClause where liftCompare = genericLiftCompare @@ -424,7 +422,7 @@ instance Show1 NamespaceUseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NamespaceUseClause newtype NamespaceUseGroupClause a = NamespaceUseGroupClause { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NamespaceUseGroupClause where liftEq = genericLiftEq instance Ord1 NamespaceUseGroupClause where liftCompare = genericLiftCompare @@ -433,7 +431,7 @@ instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceUseGroupClause data Namespace a = Namespace { namespaceName :: [a], namespaceBody :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Namespace where liftEq = genericLiftEq instance Ord1 Namespace where liftCompare = genericLiftCompare @@ -442,7 +440,7 @@ instance Show1 Namespace where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Namespace data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TraitDeclaration where liftEq = genericLiftEq instance Ord1 TraitDeclaration where liftCompare = genericLiftCompare @@ -451,7 +449,7 @@ instance Show1 TraitDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitDeclaration data AliasAs a = AliasAs { aliasAsName :: a, aliasAsModifier :: a, aliasAsClause :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AliasAs where liftEq = genericLiftEq instance Ord1 AliasAs where liftCompare = genericLiftCompare @@ -460,7 +458,7 @@ instance Show1 AliasAs where liftShowsPrec = genericLiftShowsPrec instance Evaluatable AliasAs data InsteadOf a = InsteadOf { left :: a, right :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 InsteadOf where liftEq = genericLiftEq instance Ord1 InsteadOf where liftCompare = genericLiftCompare @@ -469,7 +467,7 @@ instance Show1 InsteadOf where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InsteadOf newtype TraitUseSpecification a = TraitUseSpecification { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TraitUseSpecification where liftEq = genericLiftEq instance Ord1 TraitUseSpecification where liftCompare = genericLiftCompare @@ -478,7 +476,7 @@ instance Show1 TraitUseSpecification where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitUseSpecification data TraitUseClause a = TraitUseClause { namespace :: [a], alias :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TraitUseClause where liftEq = genericLiftEq instance Ord1 TraitUseClause where liftCompare = genericLiftCompare @@ -487,7 +485,7 @@ instance Show1 TraitUseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitUseClause data DestructorDeclaration a = DestructorDeclaration { body:: [a], name :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 DestructorDeclaration where liftEq = genericLiftEq instance Ord1 DestructorDeclaration where liftCompare = genericLiftCompare @@ -496,7 +494,7 @@ instance Show1 DestructorDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DestructorDeclaration newtype Static a = Static { value :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Static where liftEq = genericLiftEq instance Ord1 Static where liftCompare = genericLiftCompare @@ -505,7 +503,7 @@ instance Show1 Static where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Static newtype ClassModifier a = ClassModifier { value :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ClassModifier where liftEq = genericLiftEq instance Ord1 ClassModifier where liftCompare = genericLiftCompare @@ -514,7 +512,7 @@ instance Show1 ClassModifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassModifier data ConstructorDeclaration a = ConstructorDeclaration { modifiers :: [a], parameters :: [a], body :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ConstructorDeclaration where liftEq = genericLiftEq instance Ord1 ConstructorDeclaration where liftCompare = genericLiftCompare @@ -522,7 +520,7 @@ instance Show1 ConstructorDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstructorDeclaration data PropertyDeclaration a = PropertyDeclaration { modifier :: a, elements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PropertyDeclaration where liftEq = genericLiftEq instance Ord1 PropertyDeclaration where liftCompare = genericLiftCompare @@ -531,7 +529,7 @@ instance Show1 PropertyDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertyDeclaration data PropertyModifier a = PropertyModifier { visibility :: a , static :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PropertyModifier where liftEq = genericLiftEq instance Ord1 PropertyModifier where liftCompare = genericLiftCompare @@ -540,7 +538,7 @@ instance Show1 PropertyModifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertyModifier data InterfaceDeclaration a = InterfaceDeclaration { name :: a, base :: a, declarations :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare @@ -549,7 +547,7 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InterfaceDeclaration newtype InterfaceBaseClause a = InterfaceBaseClause { values :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 InterfaceBaseClause where liftEq = genericLiftEq instance Ord1 InterfaceBaseClause where liftCompare = genericLiftCompare @@ -558,7 +556,7 @@ instance Show1 InterfaceBaseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InterfaceBaseClause newtype Echo a = Echo { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Echo where liftEq = genericLiftEq instance Ord1 Echo where liftCompare = genericLiftCompare @@ -567,7 +565,7 @@ instance Show1 Echo where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Echo newtype Unset a = Unset { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Unset where liftEq = genericLiftEq instance Ord1 Unset where liftCompare = genericLiftCompare @@ -576,7 +574,7 @@ instance Show1 Unset where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Unset data Declare a = Declare { left :: a, right :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Declare where liftEq = genericLiftEq instance Ord1 Declare where liftCompare = genericLiftCompare @@ -585,7 +583,7 @@ instance Show1 Declare where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Declare newtype DeclareDirective a = DeclareDirective { value :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 DeclareDirective where liftEq = genericLiftEq instance Ord1 DeclareDirective where liftCompare = genericLiftCompare @@ -594,7 +592,7 @@ instance Show1 DeclareDirective where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DeclareDirective newtype LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LabeledStatement where liftEq = genericLiftEq instance Ord1 LabeledStatement where liftCompare = genericLiftCompare diff --git a/src/Language/PHP/Term.hs b/src/Language/PHP/Term.hs index 0f2d68d08..e4a7e2f02 100644 --- a/src/Language/PHP/Term.hs +++ b/src/Language/PHP/Term.hs @@ -7,8 +7,6 @@ module Language.PHP.Term import Control.Lens.Lens import Data.Abstract.Declarations import Data.Abstract.FreeVariables -import Data.Aeson (ToJSON) -import Data.Bifunctor import Data.Bitraversable import Data.Coerce import Data.Foldable (fold) @@ -24,7 +22,6 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Data.Term as Term import Data.Traversable -import Diffing.Interpreter import qualified Language.PHP.Syntax as Syntax import Source.Loc import Source.Span @@ -157,7 +154,7 @@ type Syntax = newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) } - deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON) + deriving (Eq, Declarations, FreeVariables, Ord, Show) instance Term.IsTerm Term where type Syntax Term = Sum.Sum Syntax @@ -181,9 +178,6 @@ instance Syntax.HasErrors Term where maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax) -instance DiffTerms Term where - diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term) - type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann instance Recursive (Term ann) where diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 040435474..d193f2fc5 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -30,9 +30,7 @@ import Data.Abstract.BaseError import Data.Abstract.Evaluatable import Data.Abstract.Module import qualified Data.Abstract.ScopeGraph as ScopeGraph -import Data.JSON.Fields import qualified Data.Language as Language -import Diffing.Algorithm import Source.Span import qualified System.Path as Path @@ -104,7 +102,7 @@ resolvePythonModules q = do maybeM (throwResolutionError $ NotFoundError (Path.absRel path) searchPaths Language.Python) modulePath data Alias a = Alias { aliasValue :: a, aliasName :: a} - deriving (Generic1, Diffable, Foldable, FreeVariables1, Functor, Hashable1, ToJSONFields1, Traversable) + deriving (Generic1, Foldable, FreeVariables1, Functor, Hashable1, Traversable) instance Eq1 Alias where liftEq = genericLiftEq instance Ord1 Alias where liftCompare = genericLiftCompare @@ -120,14 +118,14 @@ instance Evaluatable Alias where -- -- If the list of symbols is empty copy everything to the calling environment. data Import a = Import { importFrom :: QualifiedName, importSymbols :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Import where liftEq = genericLiftEq instance Ord1 Import where liftCompare = genericLiftCompare instance Show1 Import where liftShowsPrec = genericLiftShowsPrec newtype FutureImport a = FutureImport { futureImportSymbols :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 FutureImport where liftEq = genericLiftEq instance Ord1 FutureImport where liftCompare = genericLiftCompare @@ -199,7 +197,7 @@ instance Evaluatable Import where unit newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: NonEmpty a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Traversable) instance Eq1 QualifiedImport where liftEq = genericLiftEq instance Ord1 QualifiedImport where liftCompare = genericLiftCompare @@ -242,7 +240,7 @@ instance Evaluatable QualifiedImport where fun (Map.singleton moduleScope moduleFrame) data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare @@ -272,7 +270,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 (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Ellipsis where liftEq = genericLiftEq instance Ord1 Ellipsis where liftCompare = genericLiftCompare @@ -282,7 +280,7 @@ instance Show1 Ellipsis where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Ellipsis data Redirect a = Redirect { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Redirect where liftEq = genericLiftEq instance Ord1 Redirect where liftCompare = genericLiftCompare diff --git a/src/Language/Python/Term.hs b/src/Language/Python/Term.hs index 44494c2ff..9a11945c5 100644 --- a/src/Language/Python/Term.hs +++ b/src/Language/Python/Term.hs @@ -7,8 +7,6 @@ module Language.Python.Term import Control.Lens.Lens import Data.Abstract.Declarations import Data.Abstract.FreeVariables -import Data.Aeson (ToJSON) -import Data.Bifunctor import Data.Bitraversable import Data.Coerce import Data.Foldable (fold) @@ -24,7 +22,6 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Data.Term as Term import Data.Traversable -import Diffing.Interpreter import Language.Python.Syntax as Python.Syntax import Source.Loc import Source.Span @@ -112,7 +109,7 @@ type Syntax = newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) } - deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON) + deriving (Eq, Declarations, FreeVariables, Ord, Show) instance Term.IsTerm Term where type Syntax Term = Sum.Sum Syntax @@ -136,9 +133,6 @@ instance Syntax.HasErrors Term where maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax) -instance DiffTerms Term where - diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term) - type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann instance Recursive (Term ann) where diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 9bb59306b..09ffda5b6 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -20,7 +20,6 @@ import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Functor.Classes import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import qualified Data.Language as Language import Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as Map @@ -30,7 +29,6 @@ import Data.Semigroup.Foldable import Data.Text (Text) import qualified Data.Text as T import Data.Traversable (for) -import Diffing.Algorithm import GHC.Generics (Generic1) import qualified System.Path as Path @@ -67,7 +65,7 @@ cleanNameOrPath :: Text -> Path.AbsRelFile cleanNameOrPath = Path.absRel . T.unpack . dropRelativePrefix . stripQuotes data Send a = Send { sendReceiver :: Maybe a, sendSelector :: Maybe a, sendArgs :: [a], sendBlock :: Maybe a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Send where liftEq = genericLiftEq instance Ord1 Send where liftCompare = genericLiftCompare @@ -94,7 +92,7 @@ instance Evaluatable Send where maybe callFunction (`withScopeAndFrame` callFunction) lhsFrame data Require a = Require { requireRelative :: Bool, requirePath :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Require where liftEq = genericLiftEq instance Ord1 Require where liftCompare = genericLiftCompare @@ -123,7 +121,7 @@ doRequire path = do data Load a = Load { loadPath :: a, loadWrap :: Maybe a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Load where liftEq = genericLiftEq instance Ord1 Load where liftCompare = genericLiftCompare @@ -166,15 +164,12 @@ doLoad path shouldWrap = do -- TODO: autoload data Class a = Class { classIdentifier :: !a, classSuperClass :: !(Maybe a), classBody :: !a } - deriving (Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1, ToJSONFields1) + deriving (Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1) instance Eq1 Class where liftEq = genericLiftEq instance Ord1 Class where liftCompare = genericLiftCompare instance Show1 Class where liftShowsPrec = genericLiftShowsPrec -instance Diffable Class where - equivalentBySubterm = Just . classIdentifier - instance Evaluatable Class where eval eval _ Class{..} = do (name, relation) <- case declaredName classIdentifier of @@ -226,7 +221,7 @@ instance Declarations1 Class where data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Module where liftEq = genericLiftEq instance Ord1 Module where liftCompare = genericLiftCompare @@ -273,7 +268,7 @@ instance Declarations1 Module where data LowPrecedenceAnd a = LowPrecedenceAnd { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LowPrecedenceAnd where liftEq = genericLiftEq instance Ord1 LowPrecedenceAnd where liftCompare = genericLiftCompare @@ -288,7 +283,7 @@ instance Evaluatable LowPrecedenceAnd where data LowPrecedenceOr a = LowPrecedenceOr { lhs :: a, rhs :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LowPrecedenceOr where liftEq = genericLiftEq instance Ord1 LowPrecedenceOr where liftCompare = genericLiftCompare @@ -302,7 +297,7 @@ instance Evaluatable LowPrecedenceOr where ifthenelse cond (pure cond) b data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Assignment where liftEq = genericLiftEq instance Ord1 Assignment where liftCompare = genericLiftCompare @@ -342,7 +337,7 @@ instance Evaluatable Assignment where -- the semantics of invoking @super()@ but implicitly passing the current function's -- arguments to the @super()@ invocation. data ZSuper a = ZSuper - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ZSuper where liftEq = genericLiftEq instance Ord1 ZSuper where liftCompare = genericLiftCompare diff --git a/src/Language/Ruby/Term.hs b/src/Language/Ruby/Term.hs index a9b8a7778..316405b0b 100644 --- a/src/Language/Ruby/Term.hs +++ b/src/Language/Ruby/Term.hs @@ -7,8 +7,6 @@ module Language.Ruby.Term import Control.Lens.Lens import Data.Abstract.Declarations import Data.Abstract.FreeVariables -import Data.Aeson (ToJSON) -import Data.Bifunctor import Data.Bitraversable import Data.Coerce import Data.Foldable (fold) @@ -24,7 +22,6 @@ import qualified Data.Syntax.Literal as Literal import qualified Data.Syntax.Statement as Statement import qualified Data.Term as Term import Data.Traversable -import Diffing.Interpreter import qualified Language.Ruby.Syntax as Ruby.Syntax import Source.Loc import Source.Span @@ -122,7 +119,7 @@ type Syntax = newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) } - deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON) + deriving (Eq, Declarations, FreeVariables, Ord, Show) instance Term.IsTerm Term where type Syntax Term = Sum.Sum Syntax @@ -146,9 +143,6 @@ instance Syntax.HasErrors Term where maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax) -instance DiffTerms Term where - diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term) - type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann instance Recursive (Term ann) where diff --git a/src/Language/TSX/Syntax/JSX.hs b/src/Language/TSX/Syntax/JSX.hs index 577b01916..23ac6970e 100644 --- a/src/Language/TSX/Syntax/JSX.hs +++ b/src/Language/TSX/Syntax/JSX.hs @@ -7,14 +7,12 @@ module Language.TSX.Syntax.JSX (module Language.TSX.Syntax.JSX) where import Data.Abstract.Evaluatable import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import qualified Data.Text as T -import Diffing.Algorithm import GHC.Generics (Generic1) data JsxElement a = JsxElement { jsxOpeningElement :: !a, jsxElements :: ![a], jsxClosingElement :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxElement where liftEq = genericLiftEq instance Ord1 JsxElement where liftCompare = genericLiftCompare @@ -23,7 +21,7 @@ instance Show1 JsxElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxElement newtype JsxText a = JsxText { contents :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxText where liftEq = genericLiftEq instance Ord1 JsxText where liftCompare = genericLiftCompare @@ -32,7 +30,7 @@ instance Show1 JsxText where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxText newtype JsxExpression a = JsxExpression { jsxExpression :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxExpression where liftEq = genericLiftEq instance Ord1 JsxExpression where liftCompare = genericLiftCompare @@ -41,7 +39,7 @@ instance Show1 JsxExpression where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxExpression data JsxOpeningElement a = JsxOpeningElement { jsxOpeningElementIdentifier :: !a, jsxOpeningElementTypeArguments :: a, jsxAttributes :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxOpeningElement where liftEq = genericLiftEq instance Ord1 JsxOpeningElement where liftCompare = genericLiftCompare @@ -50,7 +48,7 @@ instance Show1 JsxOpeningElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxOpeningElement newtype JsxClosingElement a = JsxClosingElement { jsxClosingElementIdentifier :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxClosingElement where liftEq = genericLiftEq instance Ord1 JsxClosingElement where liftCompare = genericLiftCompare @@ -59,7 +57,7 @@ instance Show1 JsxClosingElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxClosingElement data JsxSelfClosingElement a = JsxSelfClosingElement { jsxSelfClosingElementIdentifier :: !a, jsxSelfClosingElementAttributes :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxSelfClosingElement where liftEq = genericLiftEq instance Ord1 JsxSelfClosingElement where liftCompare = genericLiftCompare @@ -68,7 +66,7 @@ instance Show1 JsxSelfClosingElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxSelfClosingElement data JsxAttribute a = JsxAttribute { jsxAttributeTarget :: !a, jsxAttributeValue :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxAttribute where liftEq = genericLiftEq instance Ord1 JsxAttribute where liftCompare = genericLiftCompare @@ -77,7 +75,7 @@ instance Show1 JsxAttribute where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxAttribute newtype JsxFragment a = JsxFragment { terms :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxFragment where liftEq = genericLiftEq instance Ord1 JsxFragment where liftCompare = genericLiftCompare @@ -86,7 +84,7 @@ instance Show1 JsxFragment where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxFragment data JsxNamespaceName a = JsxNamespaceName { left :: a, right :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JsxNamespaceName where liftEq = genericLiftEq instance Ord1 JsxNamespaceName where liftCompare = genericLiftCompare diff --git a/src/Language/TSX/Term.hs b/src/Language/TSX/Term.hs index b7b8738c8..d4a35e671 100644 --- a/src/Language/TSX/Term.hs +++ b/src/Language/TSX/Term.hs @@ -7,8 +7,6 @@ module Language.TSX.Term import Control.Lens.Lens import Data.Abstract.Declarations import Data.Abstract.FreeVariables -import Data.Aeson (ToJSON) -import Data.Bifunctor import Data.Bitraversable import Data.Coerce import Data.Foldable (fold) @@ -24,7 +22,6 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Data.Term as Term import Data.Traversable -import Diffing.Interpreter import qualified Language.TSX.Syntax as TSX.Syntax import Source.Loc import Source.Span @@ -202,7 +199,7 @@ type Syntax = newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) } - deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON) + deriving (Eq, Declarations, FreeVariables, Ord, Show) instance Term.IsTerm Term where type Syntax Term = Sum.Sum Syntax @@ -226,9 +223,6 @@ instance Syntax.HasErrors Term where maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax) -instance DiffTerms Term where - diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term) - type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann instance Recursive (Term ann) where diff --git a/src/Language/TypeScript/Syntax/Import.hs b/src/Language/TypeScript/Syntax/Import.hs index 7a17be14f..1045d0628 100644 --- a/src/Language/TypeScript/Syntax/Import.hs +++ b/src/Language/TypeScript/Syntax/Import.hs @@ -17,15 +17,13 @@ import Data.Foldable import Data.Functor.Classes.Generic import Data.Hashable import Data.Hashable.Lifted -import Data.JSON.Fields import qualified Data.Map.Strict as Map -import Diffing.Algorithm import GHC.Generics (Generic, Generic1) import Language.TypeScript.Resolution import Source.Span data Import a = Import { importSymbols :: ![Alias], importFrom :: ImportPath } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Import where liftEq = genericLiftEq instance Ord1 Import where liftCompare = genericLiftCompare @@ -58,7 +56,7 @@ instance Evaluatable Import where unit data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportAlias :: !a, qualifiedAliasedImportFrom :: ImportPath } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare @@ -80,7 +78,7 @@ instance Evaluatable QualifiedAliasedImport where unit newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 SideEffectImport where liftEq = genericLiftEq instance Ord1 SideEffectImport where liftCompare = genericLiftCompare @@ -94,7 +92,7 @@ instance Evaluatable SideEffectImport where -- | Qualified Export declarations newtype QualifiedExport a = QualifiedExport { qualifiedExportSymbols :: [Alias] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 QualifiedExport where liftEq = genericLiftEq instance Ord1 QualifiedExport where liftCompare = genericLiftCompare @@ -123,7 +121,7 @@ toTuple Alias{..} = (aliasValue, aliasName) -- | Qualified Export declarations that export from another module. data QualifiedExportFrom a = QualifiedExportFrom { qualifiedExportFrom :: ImportPath, qualifiedExportFromSymbols :: ![Alias]} - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 QualifiedExportFrom where liftEq = genericLiftEq instance Ord1 QualifiedExportFrom where liftCompare = genericLiftCompare @@ -148,7 +146,7 @@ instance Evaluatable QualifiedExportFrom where unit newtype DefaultExport a = DefaultExport { defaultExport :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 DefaultExport where liftEq = genericLiftEq instance Ord1 DefaultExport where liftCompare = genericLiftCompare @@ -174,7 +172,7 @@ instance Evaluatable DefaultExport where unit data ImportRequireClause a = ImportRequireClause { importRequireIdentifier :: !a, importRequireSubject :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ImportRequireClause where liftEq = genericLiftEq instance Ord1 ImportRequireClause where liftCompare = genericLiftCompare @@ -183,7 +181,7 @@ instance Show1 ImportRequireClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportRequireClause newtype ImportClause a = ImportClause { importClauseElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ImportClause where liftEq = genericLiftEq instance Ord1 ImportClause where liftCompare = genericLiftCompare @@ -192,7 +190,7 @@ instance Show1 ImportClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportClause data ImportAlias a = ImportAlias { importAliasSubject :: !a, importAlias :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ImportAlias where liftEq = genericLiftEq instance Ord1 ImportAlias where liftCompare = genericLiftCompare diff --git a/src/Language/TypeScript/Syntax/JavaScript.hs b/src/Language/TypeScript/Syntax/JavaScript.hs index 6577dba90..95bff3e5d 100644 --- a/src/Language/TypeScript/Syntax/JavaScript.hs +++ b/src/Language/TypeScript/Syntax/JavaScript.hs @@ -12,14 +12,12 @@ import Data.Abstract.Evaluatable import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import qualified Data.Map.Strict as Map -import Diffing.Algorithm import GHC.Generics (Generic1) import Language.TypeScript.Resolution newtype ImplementsClause a = ImplementsClause { implementsClauseTypes :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ImplementsClause where liftEq = genericLiftEq instance Ord1 ImplementsClause where liftCompare = genericLiftCompare @@ -28,7 +26,7 @@ instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImplementsClause data OptionalParameter a = OptionalParameter { optionalParameterContext :: ![a], optionalParameterSubject :: !a, optionalParameterAccessControl :: AccessControl } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 OptionalParameter where liftEq = genericLiftEq instance Ord1 OptionalParameter where liftCompare = genericLiftCompare @@ -37,7 +35,7 @@ instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable OptionalParameter data RequiredParameter a = RequiredParameter { requiredParameterContext :: [a], requiredParameterSubject :: a, requiredParameterValue :: a, requiredParameterAccessControl :: AccessControl } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 RequiredParameter where liftEq = genericLiftEq instance Ord1 RequiredParameter where liftCompare = genericLiftCompare @@ -69,7 +67,7 @@ instance Evaluatable RequiredParameter where pure rhs data RestParameter a = RestParameter { restParameterContext :: ![a], restParameterSubject :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 RestParameter where liftEq = genericLiftEq instance Ord1 RestParameter where liftCompare = genericLiftCompare @@ -79,7 +77,7 @@ instance Evaluatable RestParameter data JavaScriptRequire a = JavaScriptRequire { javascriptRequireIden :: !a, javascriptRequireFrom :: ImportPath } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 JavaScriptRequire where liftEq = genericLiftEq instance Ord1 JavaScriptRequire where liftCompare = genericLiftCompare @@ -105,7 +103,7 @@ instance Evaluatable JavaScriptRequire where unit data Debugger a = Debugger - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Debugger where liftEq = genericLiftEq instance Ord1 Debugger where liftCompare = genericLiftCompare @@ -114,7 +112,7 @@ instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Debugger data Super a = Super - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Super where liftEq = genericLiftEq instance Ord1 Super where liftCompare = genericLiftCompare @@ -123,7 +121,7 @@ instance Show1 Super where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Super data Undefined a = Undefined - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Undefined where liftEq = genericLiftEq instance Ord1 Undefined where liftCompare = genericLiftCompare @@ -132,7 +130,7 @@ instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Undefined data With a = With { withExpression :: !a, withBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 With where liftEq = genericLiftEq instance Ord1 With where liftCompare = genericLiftCompare @@ -142,7 +140,7 @@ instance Evaluatable With -- | A sequence expression such as Javascript or C's comma operator. data AnnotatedExpression a = AnnotatedExpression { expression :: !a, typeAnnotation :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AnnotatedExpression where liftEq = genericLiftEq instance Ord1 AnnotatedExpression where liftCompare = genericLiftCompare diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs index 76e16447a..5d4e188bc 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/src/Language/TypeScript/Syntax/TypeScript.hs @@ -15,7 +15,6 @@ import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Foldable import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as Map import Data.Maybe.Exts @@ -23,12 +22,11 @@ import Data.Semigroup.App import Data.Semigroup.Foldable import qualified Data.Text as T import Data.Traversable -import Diffing.Algorithm import GHC.Generics (Generic1) -- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo } newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier { contents :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ShorthandPropertyIdentifier where liftEq = genericLiftEq instance Ord1 ShorthandPropertyIdentifier where liftCompare = genericLiftCompare @@ -37,7 +35,7 @@ instance Show1 ShorthandPropertyIdentifier where liftShowsPrec = genericLiftShow instance Evaluatable ShorthandPropertyIdentifier data Union a = Union { unionLeft :: !a, unionRight :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Union where liftEq = genericLiftEq instance Ord1 Union where liftCompare = genericLiftCompare @@ -46,7 +44,7 @@ instance Show1 Union where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Language.TypeScript.Syntax.TypeScript.Union data Intersection a = Intersection { intersectionLeft :: !a, intersectionRight :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Intersection where liftEq = genericLiftEq instance Ord1 Intersection where liftCompare = genericLiftCompare @@ -55,7 +53,7 @@ instance Show1 Intersection where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Intersection data AmbientFunction a = AmbientFunction { ambientFunctionContext :: ![a], ambientFunctionIdentifier :: !a, ambientFunctionParameters :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AmbientFunction where liftEq = genericLiftEq instance Ord1 AmbientFunction where liftCompare = genericLiftCompare @@ -64,7 +62,7 @@ instance Show1 AmbientFunction where liftShowsPrec = genericLiftShowsPrec instance Evaluatable AmbientFunction newtype Tuple a = Tuple { tupleElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Tuple where liftEq = genericLiftEq instance Ord1 Tuple where liftCompare = genericLiftCompare @@ -74,7 +72,7 @@ instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Tuple data Constructor a = Constructor { constructorTypeParameters :: !a, constructorFormalParameters :: ![a], constructorType :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Constructor where liftEq = genericLiftEq instance Ord1 Constructor where liftCompare = genericLiftCompare @@ -84,7 +82,7 @@ instance Evaluatable Language.TypeScript.Syntax.TypeScript.Constructor newtype Annotation a = Annotation { annotationType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Annotation where liftEq = genericLiftEq instance Ord1 Annotation where liftCompare = genericLiftCompare @@ -93,7 +91,7 @@ instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Annotation newtype Decorator a = Decorator { decoratorTerm :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Decorator where liftEq = genericLiftEq instance Ord1 Decorator where liftCompare = genericLiftCompare @@ -102,7 +100,7 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Decorator newtype ComputedPropertyName a = ComputedPropertyName { propertyName :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ComputedPropertyName where liftEq = genericLiftEq instance Ord1 ComputedPropertyName where liftCompare = genericLiftCompare @@ -111,7 +109,7 @@ instance Show1 ComputedPropertyName where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ComputedPropertyName newtype Constraint a = Constraint { constraintType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Constraint where liftEq = genericLiftEq instance Ord1 Constraint where liftCompare = genericLiftCompare @@ -120,7 +118,7 @@ instance Show1 Constraint where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Constraint data NestedIdentifier a = NestedIdentifier { left :: !a, right :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NestedIdentifier where liftEq = genericLiftEq instance Ord1 NestedIdentifier where liftCompare = genericLiftCompare @@ -129,7 +127,7 @@ instance Show1 NestedIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NestedIdentifier newtype AmbientDeclaration a = AmbientDeclaration { ambientDeclarationBody :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AmbientDeclaration where liftEq = genericLiftEq instance Ord1 AmbientDeclaration where liftCompare = genericLiftCompare @@ -139,7 +137,7 @@ instance Evaluatable AmbientDeclaration where eval eval _ (AmbientDeclaration body) = eval body data EnumDeclaration a = EnumDeclaration { enumDeclarationIdentifier :: !a, enumDeclarationBody :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 EnumDeclaration where liftEq = genericLiftEq instance Ord1 EnumDeclaration where liftCompare = genericLiftCompare @@ -151,7 +149,7 @@ instance Declarations a => Declarations (EnumDeclaration a) where declaredName EnumDeclaration{..} = declaredName enumDeclarationIdentifier newtype ExtendsClause a = ExtendsClause { extendsClauses :: [a] } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ExtendsClause where liftEq = genericLiftEq instance Ord1 ExtendsClause where liftCompare = genericLiftCompare @@ -169,7 +167,7 @@ instance Evaluatable ExtendsClause where unit data PropertySignature a = PropertySignature { modifiers :: [a], propertySignaturePropertyName :: a, propertySignatureAccessControl :: AccessControl } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PropertySignature where liftEq = genericLiftEq instance Ord1 PropertySignature where liftCompare = genericLiftCompare @@ -178,7 +176,7 @@ instance Show1 PropertySignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertySignature data CallSignature a = CallSignature { callSignatureTypeParameters :: !a, callSignatureParameters :: ![a], callSignatureType :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 CallSignature where liftEq = genericLiftEq instance Ord1 CallSignature where liftCompare = genericLiftCompare @@ -188,7 +186,7 @@ instance Evaluatable CallSignature -- | Todo: Move type params and type to context data ConstructSignature a = ConstructSignature { constructSignatureTypeParameters :: !a, constructSignatureParameters :: ![a], constructSignatureType :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ConstructSignature where liftEq = genericLiftEq instance Ord1 ConstructSignature where liftCompare = genericLiftCompare @@ -197,7 +195,7 @@ instance Show1 ConstructSignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstructSignature data IndexSignature a = IndexSignature { subject :: a, subjectType :: a, typeAnnotation :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 IndexSignature where liftEq = genericLiftEq instance Ord1 IndexSignature where liftCompare = genericLiftCompare @@ -206,7 +204,7 @@ instance Show1 IndexSignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IndexSignature data AbstractMethodSignature a = AbstractMethodSignature { abstractMethodSignatureContext :: ![a], abstractMethodSignatureName :: a, abstractMethodSignatureParameters :: [a], abstractMethodAccessControl :: AccessControl } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AbstractMethodSignature where liftEq = genericLiftEq instance Ord1 AbstractMethodSignature where liftCompare = genericLiftCompare @@ -215,7 +213,7 @@ instance Show1 AbstractMethodSignature where liftShowsPrec = genericLiftShowsPre instance Evaluatable AbstractMethodSignature data ForOf a = ForOf { forOfBinding :: !a, forOfSubject :: !a, forOfBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ForOf where liftEq = genericLiftEq instance Ord1 ForOf where liftCompare = genericLiftCompare @@ -224,7 +222,7 @@ instance Show1 ForOf where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ForOf data LabeledStatement a = LabeledStatement { labeledStatementIdentifier :: !a, labeledStatementSubject :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LabeledStatement where liftEq = genericLiftEq instance Ord1 LabeledStatement where liftCompare = genericLiftCompare @@ -233,7 +231,7 @@ instance Show1 LabeledStatement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable LabeledStatement newtype Update a = Update { updateSubject :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Update where liftEq = genericLiftEq instance Ord1 Update where liftCompare = genericLiftCompare @@ -242,7 +240,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Update data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 Module where liftEq = genericLiftEq instance Ord1 Module where liftCompare = genericLiftCompare @@ -313,7 +311,7 @@ instance Declarations1 Module where liftDeclaredName declaredName = declaredName . moduleIdentifier data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 InternalModule where liftEq = genericLiftEq instance Ord1 InternalModule where liftCompare = genericLiftCompare @@ -327,7 +325,7 @@ instance Declarations a => Declarations (InternalModule a) where declaredName InternalModule{..} = declaredName internalModuleIdentifier data ClassHeritage a = ClassHeritage { classHeritageExtendsClause :: !a, implementsClause :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ClassHeritage where liftEq = genericLiftEq instance Ord1 ClassHeritage where liftCompare = genericLiftCompare @@ -336,7 +334,7 @@ instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassHeritage data AbstractClass a = AbstractClass { abstractClassIdentifier :: !a, abstractClassTypeParameters :: !a, classHeritage :: ![a], classBody :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 AbstractClass where liftEq = genericLiftEq instance Ord1 AbstractClass where liftCompare = genericLiftCompare @@ -377,7 +375,7 @@ instance Evaluatable AbstractClass where unit data MetaProperty a = MetaProperty - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 MetaProperty where liftEq = genericLiftEq instance Ord1 MetaProperty where liftCompare = genericLiftCompare diff --git a/src/Language/TypeScript/Syntax/Types.hs b/src/Language/TypeScript/Syntax/Types.hs index b0788ba83..028dfb154 100644 --- a/src/Language/TypeScript/Syntax/Types.hs +++ b/src/Language/TypeScript/Syntax/Types.hs @@ -11,14 +11,12 @@ import Data.Abstract.Evaluatable as Evaluatable import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Functor.Classes.Generic import Data.Hashable.Lifted -import Data.JSON.Fields import qualified Data.Text as T -import Diffing.Algorithm import GHC.Generics (Generic1) -- | Lookup type for a type-level key in a typescript map. data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LookupType where liftEq = genericLiftEq instance Ord1 LookupType where liftCompare = genericLiftCompare @@ -27,7 +25,7 @@ instance Show1 LookupType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable LookupType data FunctionType a = FunctionType { functionTypeParameters :: !a, functionFormalParameters :: ![a], functionType :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 FunctionType where liftEq = genericLiftEq instance Ord1 FunctionType where liftCompare = genericLiftCompare @@ -36,7 +34,7 @@ instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable FunctionType data TypeParameter a = TypeParameter { typeParameter :: !a, typeParameterConstraint :: !a, typeParameterDefaultType :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeParameter where liftEq = genericLiftEq instance Ord1 TypeParameter where liftCompare = genericLiftCompare @@ -45,7 +43,7 @@ instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeParameter data TypeAssertion a = TypeAssertion { typeAssertionParameters :: !a, typeAssertionExpression :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeAssertion where liftEq = genericLiftEq instance Ord1 TypeAssertion where liftCompare = genericLiftCompare @@ -54,7 +52,7 @@ instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeAssertion newtype DefaultType a = DefaultType { defaultType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 DefaultType where liftEq = genericLiftEq instance Ord1 DefaultType where liftCompare = genericLiftCompare @@ -63,7 +61,7 @@ instance Show1 DefaultType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DefaultType newtype ParenthesizedType a = ParenthesizedType { parenthesizedType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ParenthesizedType where liftEq = genericLiftEq instance Ord1 ParenthesizedType where liftCompare = genericLiftCompare @@ -72,7 +70,7 @@ instance Show1 ParenthesizedType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ParenthesizedType newtype PredefinedType a = PredefinedType { predefinedType :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 PredefinedType where liftEq = genericLiftEq instance Ord1 PredefinedType where liftCompare = genericLiftCompare @@ -82,7 +80,7 @@ instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PredefinedType newtype TypeIdentifier a = TypeIdentifier { contents :: T.Text } - deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeIdentifier where liftEq = genericLiftEq instance Ord1 TypeIdentifier where liftCompare = genericLiftCompare @@ -100,7 +98,7 @@ instance Evaluatable TypeIdentifier where unit data NestedTypeIdentifier a = NestedTypeIdentifier { left :: !a, right :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 NestedTypeIdentifier where liftEq = genericLiftEq instance Ord1 NestedTypeIdentifier where liftCompare = genericLiftCompare @@ -109,7 +107,7 @@ instance Show1 NestedTypeIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NestedTypeIdentifier data GenericType a = GenericType { genericTypeIdentifier :: !a, genericTypeArguments :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 GenericType where liftEq = genericLiftEq instance Ord1 GenericType where liftCompare = genericLiftCompare @@ -118,7 +116,7 @@ instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable GenericType data TypePredicate a = TypePredicate { typePredicateIdentifier :: !a, typePredicateType :: !a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypePredicate where liftEq = genericLiftEq instance Ord1 TypePredicate where liftCompare = genericLiftCompare @@ -127,7 +125,7 @@ instance Show1 TypePredicate where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypePredicate newtype ObjectType a = ObjectType { objectTypeElements :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ObjectType where liftEq = genericLiftEq instance Ord1 ObjectType where liftCompare = genericLiftCompare @@ -136,7 +134,7 @@ instance Show1 ObjectType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ObjectType newtype ArrayType a = ArrayType { arrayType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ArrayType where liftEq = genericLiftEq instance Ord1 ArrayType where liftCompare = genericLiftCompare @@ -145,7 +143,7 @@ instance Show1 ArrayType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ArrayType newtype FlowMaybeType a = FlowMaybeType { flowMaybeType :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 FlowMaybeType where liftEq = genericLiftEq instance Ord1 FlowMaybeType where liftCompare = genericLiftCompare @@ -154,7 +152,7 @@ instance Show1 FlowMaybeType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable FlowMaybeType newtype TypeQuery a = TypeQuery { typeQuerySubject :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeQuery where liftEq = genericLiftEq instance Ord1 TypeQuery where liftCompare = genericLiftCompare @@ -163,7 +161,7 @@ instance Show1 TypeQuery where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeQuery newtype IndexTypeQuery a = IndexTypeQuery { indexTypeQuerySubject :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 IndexTypeQuery where liftEq = genericLiftEq instance Ord1 IndexTypeQuery where liftCompare = genericLiftCompare @@ -172,7 +170,7 @@ instance Show1 IndexTypeQuery where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IndexTypeQuery newtype TypeArguments a = TypeArguments { typeArguments :: [a] } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 TypeArguments where liftEq = genericLiftEq instance Ord1 TypeArguments where liftCompare = genericLiftCompare @@ -181,7 +179,7 @@ instance Show1 TypeArguments where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeArguments newtype ThisType a = ThisType { contents :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ThisType where liftEq = genericLiftEq instance Ord1 ThisType where liftCompare = genericLiftCompare @@ -190,7 +188,7 @@ instance Show1 ThisType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ThisType newtype ExistentialType a = ExistentialType { contents :: T.Text } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 ExistentialType where liftEq = genericLiftEq instance Ord1 ExistentialType where liftCompare = genericLiftCompare @@ -199,7 +197,7 @@ instance Show1 ExistentialType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExistentialType newtype LiteralType a = LiteralType { literalTypeSubject :: a } - deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) + deriving (Declarations1, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Traversable) instance Eq1 LiteralType where liftEq = genericLiftEq instance Ord1 LiteralType where liftCompare = genericLiftCompare diff --git a/src/Language/TypeScript/Term.hs b/src/Language/TypeScript/Term.hs index 5bc9841c6..7f097b49c 100644 --- a/src/Language/TypeScript/Term.hs +++ b/src/Language/TypeScript/Term.hs @@ -7,8 +7,6 @@ module Language.TypeScript.Term import Control.Lens.Lens import Data.Abstract.Declarations import Data.Abstract.FreeVariables -import Data.Aeson (ToJSON) -import Data.Bifunctor import Data.Bitraversable import Data.Coerce import Data.Foldable (fold) @@ -24,7 +22,6 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Data.Term as Term import Data.Traversable -import Diffing.Interpreter import qualified Language.TypeScript.Syntax as TypeScript.Syntax import Source.Loc import Source.Span @@ -193,7 +190,7 @@ type Syntax = newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) } - deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON) + deriving (Eq, Declarations, FreeVariables, Ord, Show) instance Term.IsTerm Term where type Syntax Term = Sum.Sum Syntax @@ -217,9 +214,6 @@ instance Syntax.HasErrors Term where maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax) -instance DiffTerms Term where - diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term) - type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann instance Recursive (Term ann) where diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs deleted file mode 100644 index ac1b448ce..000000000 --- a/src/Rendering/Graph.hs +++ /dev/null @@ -1,134 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE OverloadedStrings #-} -module Rendering.Graph -( renderTreeGraph -, termStyle -, diffStyle -, ToTreeGraph(..) -) where - -import Algebra.Graph.Export.Dot -import Analysis.ConstructorName -import Control.Carrier.Fresh.Strict -import Control.Carrier.Reader -import Control.Carrier.State.Strict -import Control.Lens -import Data.Diff -import Data.Edit -import Data.Foldable -import Data.Functor.Foldable -import Data.Graph.Algebraic -import Data.ProtoLens (defMessage) -import Data.String (IsString (..)) -import Data.Term -import Proto.Semantic as P -import Proto.Semantic_Fields as P -import Semantic.Api.Bridge -import Source.Loc as Loc - -import qualified Data.Text as T - --- TODO: rename as this isn't a render -renderTreeGraph :: (Ord vertex, Recursive t, ToTreeGraph vertex (Base t)) => t -> Graph vertex -renderTreeGraph = simplify . runGraph . cata toTreeGraph - -runGraph :: ReaderC (Graph vertex) - (FreshC Identity) (Graph vertex) - -> Graph vertex -runGraph = run . runFresh' . runReader mempty - where - -- NB: custom runFresh so that we count starting at 1 in order to avoid - -- default values for proto encoding. - runFresh' = evalState 1 . runFreshC - runFreshC (FreshC a) = a - --- | GraphViz styling for terms -termStyle :: (IsString string, Monoid string) => String -> Style TermVertex string -termStyle name = (defaultStyle (fromString . show . view vertexId)) - { graphName = fromString (quote name) - , vertexAttributes = vertexAttributes } - where quote a = "\"" <> a <> "\"" - vertexAttributes v = ["label" := fromString (T.unpack (v^.term))] - --- | Graphviz styling for diffs -diffStyle :: (IsString string, Monoid string) => String -> Style DiffTreeVertex string -diffStyle name = (defaultStyle (fromString . show . view diffVertexId)) - { graphName = fromString (quote name) - , vertexAttributes = vertexAttributes } - where quote a = "\"" <> a <> "\"" - vertexAttributes v = case v^.maybe'diffTerm of - Just (DiffTreeVertex'Deleted x) -> [ "label" := fromString (T.unpack (x^.term)), "color" := "red" ] - Just (DiffTreeVertex'Inserted x) -> [ "label" := fromString (T.unpack (x^.term)), "color" := "green" ] - Just (DiffTreeVertex'Replaced _) -> [ "label" := "Replacement", "color" := "orange", "style" := "dashed" ] - Just (DiffTreeVertex'Merged x) -> [ "label" := fromString (T.unpack (x^.term)) ] - _ -> [] - -class ToTreeGraph vertex t | t -> vertex where - toTreeGraph :: (Has Fresh sig m, Has (Reader (Graph vertex)) sig m) => t (m (Graph vertex)) -> m (Graph vertex) - -instance (ConstructorName syntax, Foldable syntax) => - ToTreeGraph TermVertex (TermF syntax Loc) where - toTreeGraph = termAlgebra where - termAlgebra :: - ( ConstructorName syntax - , Foldable syntax - , Has Fresh sig m - , Has (Reader (Graph TermVertex)) sig m - ) - => TermF syntax Loc (m (Graph TermVertex)) - -> m (Graph TermVertex) - termAlgebra (In ann syntax) = do - i <- fresh - parent <- ask - let root = vertex $ defMessage - & P.vertexId .~ fromIntegral i - & P.term .~ T.pack (constructorName syntax) - & P.maybe'span .~ (converting #? Loc.span ann) - subGraph <- foldl' (\acc x -> overlay <$> acc <*> local (const root) x) (pure mempty) syntax - pure (parent `connect` root `overlay` subGraph) - -instance (ConstructorName syntax, Foldable syntax) => - ToTreeGraph DiffTreeVertex (DiffF syntax Loc Loc) where - toTreeGraph d = case d of - Merge t@(In (a1, a2) syntax) -> diffAlgebra t . DiffTreeVertex'Merged $ defMessage - & P.term .~ T.pack (constructorName syntax) - & P.maybe'beforeSpan .~ ann a1 - & P.maybe'afterSpan .~ ann a2 - Patch (Delete t1@(In a1 syntax)) -> diffAlgebra t1 . DiffTreeVertex'Deleted $ defMessage - & P.term .~ T.pack (constructorName syntax) - & P.maybe'span .~ ann a1 - Patch (Insert t2@(In a2 syntax)) -> diffAlgebra t2 . DiffTreeVertex'Inserted $ defMessage - & P.term .~ T.pack (constructorName syntax) - & P.maybe'span .~ ann a2 - Patch (Compare t1@(In a1 syntax1) t2@(In a2 syntax2)) -> do - i <- fresh - parent <- ask - let (beforeName, beforeSpan) = (T.pack (constructorName syntax1), ann a1) - let (afterName, afterSpan) = (T.pack (constructorName syntax2), ann a2) - let replace = vertex $ defMessage - & P.diffVertexId .~ fromIntegral i - & P.maybe'replaced ?~ (defMessage - & P.beforeTerm .~ beforeName - & P.maybe'beforeSpan .~ beforeSpan - & P.afterTerm .~ afterName - & P.maybe'afterSpan .~ afterSpan) - graph <- local (const replace) (overlay <$> diffAlgebra t1 (DiffTreeVertex'Deleted (defMessage & P.term .~ beforeName & P.maybe'span .~ beforeSpan)) <*> diffAlgebra t2 (DiffTreeVertex'Inserted (defMessage & P.term .~ afterName & P.maybe'span .~ afterSpan))) - pure (parent `connect` replace `overlay` graph) - where - ann a = converting #? Loc.span a - diffAlgebra :: - ( Foldable f - , Has Fresh sig m - , Has (Reader (Graph DiffTreeVertex)) sig m - ) => f (m (Graph DiffTreeVertex)) -> DiffTreeVertex'DiffTerm -> m (Graph DiffTreeVertex) - diffAlgebra syntax a = do - i <- fresh - parent <- ask - let root = vertex $ defMessage - & P.diffVertexId .~ fromIntegral i - & P.maybe'diffTerm ?~ a - subGraph <- foldl' (\acc x -> overlay <$> acc <*> local (const root) x) (pure mempty) syntax - pure (parent `connect` root `overlay` subGraph) diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs deleted file mode 100644 index 7f7b0f74a..000000000 --- a/src/Rendering/JSON.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -module Rendering.JSON -( JSON(..) -, renderJSONDiff -, renderJSONAdjDiff -, renderJSONTerm -, renderJSONAdjTerm -, renderJSONAST -, renderSymbolTerms -, renderJSONError -, renderJSONSymbolError -, renderJSONDiffError -, SomeJSON(..) -) where - -import Data.Aeson as A -import Data.Blob -import Data.Foldable (fold) -import Data.JSON.Fields -import Data.Text (pack) -import GHC.TypeLits - -newtype JSON (key :: Symbol) a = JSON { unJSON :: [a] } - deriving (Eq, Monoid, Semigroup, Show) - -instance (KnownSymbol key, ToJSON a) => ToJSON (JSON key a) where - toJSON (JSON as) = object [ pack (symbolVal @key undefined) .= as ] - toEncoding (JSON as) = pairs (pack (symbolVal @key undefined) .= as) - - --- | Render a diff to a value representing its JSON. -renderJSONDiff :: ToJSON a => BlobPair -> a -> JSON "diffs" SomeJSON -renderJSONDiff blobs diff = JSON [ SomeJSON (JSONDiff (JSONStat blobs) diff) ] - -data JSONDiff a = JSONDiff { jsonDiffStat :: JSONStat, jsonDiff :: a } - deriving (Eq, Show) - -instance ToJSON a => ToJSON (JSONDiff a) where - toJSON JSONDiff{..} = object [ "diff" .= jsonDiff, "stat" .= jsonDiffStat ] - toEncoding JSONDiff{..} = pairs ("diff" .= jsonDiff <> "stat" .= jsonDiffStat) - --- | Render a diff to a value representing its JSON. -renderJSONAdjDiff :: ToJSON a => BlobPair -> a -> JSON "diffs" SomeJSON -renderJSONAdjDiff blobs diff = JSON [ SomeJSON (JSONAdjDiff (JSONStat blobs) diff) ] - -data JSONAdjDiff a = JSONAdjDiff { jsonAdjDiffStat :: JSONStat, jsonAdjDiff :: a } - deriving (Eq, Show) - -instance ToJSON a => ToJSON (JSONAdjDiff a) where - toJSON JSONAdjDiff{..} = object [ "graph" .= jsonAdjDiff, "stat" .= jsonAdjDiffStat ] - toEncoding JSONAdjDiff{..} = pairs ("graph" .= jsonAdjDiff <> "stat" .= jsonAdjDiffStat) - -newtype JSONStat = JSONStat { jsonStatBlobs :: BlobPair } - deriving (Eq, Show) - -instance ToJSON JSONStat where - toJSON JSONStat{..} = object ("path" .= pathKeyForBlobPair jsonStatBlobs : toJSONFields jsonStatBlobs) - toEncoding JSONStat{..} = pairs (fold ("path" .= pathKeyForBlobPair jsonStatBlobs : toJSONFields jsonStatBlobs)) - --- | Render a term to a value representing its JSON. -renderJSONTerm :: ToJSON a => Blob -> a -> JSON "trees" SomeJSON -renderJSONTerm blob content = JSON [ SomeJSON (JSONTerm blob content) ] - -data JSONTerm a = JSONTerm { jsonTermBlob :: Blob, jsonTerm :: a } - deriving (Eq, Show) - -instance ToJSON a => ToJSON (JSONTerm a) where - toJSON JSONTerm{..} = object ("tree" .= jsonTerm : toJSONFields jsonTermBlob) - toEncoding JSONTerm{..} = pairs (fold ("tree" .= jsonTerm : toJSONFields jsonTermBlob)) - -renderJSONAdjTerm :: ToJSON a => Blob -> a -> JSON "trees" SomeJSON -renderJSONAdjTerm blob content = JSON [ SomeJSON (JSONAdjTerm blob content) ] - -data JSONAdjTerm a = JSONAdjTerm { jsonAdjTermBlob :: Blob, jsonAdjTerm :: a } - deriving (Eq, Show) - -instance ToJSON a => ToJSON (JSONAdjTerm a) where - toJSON JSONAdjTerm{..} = object ("graph" .= jsonAdjTerm : toJSONFields jsonAdjTermBlob) - toEncoding JSONAdjTerm{..} = pairs (fold ("graph" .= jsonAdjTerm : toJSONFields jsonAdjTermBlob)) - -renderJSONAST :: ToJSON a => Blob -> a -> JSON "trees" SomeJSON -renderJSONAST blob content = JSON [ SomeJSON (JSONAST blob content) ] - -data JSONAST a = JSONAST { jsonASTBlob :: Blob, jsonAST :: a } - deriving (Eq, Show) - -instance ToJSON a => ToJSON (JSONAST a) where - toJSON JSONAST{..} = object ("ast" .= jsonAST : toJSONFields jsonASTBlob) - toEncoding JSONAST{..} = pairs (fold ("ast" .= jsonAST : toJSONFields jsonASTBlob)) - - --- | Render terms to final JSON structure. -renderSymbolTerms :: ToJSON a => [a] -> JSON "files" SomeJSON -renderSymbolTerms = JSON . map SomeJSON - --- | Render an error for symbols. -renderJSONSymbolError :: Blob -> String -> JSON "files" SomeJSON -renderJSONSymbolError blob e = JSON [ renderError blob e ] - --- | Render an error for terms. -renderJSONError :: Blob -> String -> JSON "trees" SomeJSON -renderJSONError blob e = JSON [ renderError blob e ] - --- | Render an error for a particular blob. -renderError :: ToJSON a => Blob -> a -> SomeJSON -renderError b e = SomeJSON $ object - [ "error" .= e - , "path" .= blobFilePath b - , "language" .= blobLanguage b - ] - --- | Render an error for diffs. -renderJSONDiffError :: BlobPair -> String -> JSON "diffs" SomeJSON -renderJSONDiffError pair e = JSON [ SomeJSON (object [ "error" .= err ]) ] - where err = object ["message" .= e, "stat" .= toJSON (JSONStat pair)] - -data SomeJSON where - SomeJSON :: ToJSON a => a -> SomeJSON - -instance ToJSON SomeJSON where - toJSON (SomeJSON a) = toJSON a - toEncoding (SomeJSON a) = toEncoding a diff --git a/src/Semantic/Api.hs b/src/Semantic/Api.hs index 7fb9613a5..0f7d9ab9c 100644 --- a/src/Semantic/Api.hs +++ b/src/Semantic/Api.hs @@ -1,13 +1,10 @@ module Semantic.Api - ( - module DiffsAPI - , module SymbolsAPI + ( module SymbolsAPI , module StackGraphAPI , module TermsAPI , module Types ) where -import Semantic.Api.Diffs as DiffsAPI import Semantic.Api.Symbols as SymbolsAPI import Semantic.Api.StackGraph as StackGraphAPI import Semantic.Api.Terms as TermsAPI diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs deleted file mode 100644 index 5c3d22d6a..000000000 --- a/src/Semantic/Api/Diffs.hs +++ /dev/null @@ -1,168 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE UndecidableInstances #-} -module Semantic.Api.Diffs - ( parseDiffBuilder - , DiffOutputFormat(..) - - , diffTerms - , diffGraph - ) where - -import Analysis.ConstructorName (ConstructorName) -import Control.Effect.Error -import Control.Effect.Parse -import Control.Effect.Reader -import Control.Exception -import Control.Lens -import Control.Monad -import Control.Monad.IO.Class -import Data.Bifoldable -import Data.Blob -import Data.ByteString.Builder -import Data.Diff -import Data.Edit -import Data.Foldable -import Data.Functor.Classes -import Data.Graph.Algebraic -import Data.JSON.Fields (ToJSONFields1) -import Data.Language -import Data.Map.Strict (Map) -import Data.ProtoLens (defMessage) -import Data.Term (IsTerm (..)) -import qualified Data.Text as T -import Diffing.Interpreter (DiffTerms (..)) -import Parsing.Parser -import Proto.Semantic as P hiding (Blob) -import Proto.Semantic_Fields as P -import Proto.Semantic_JSON () -import Rendering.Graph -import Rendering.JSON hiding (JSON) -import qualified Rendering.JSON -import Semantic.Api.Bridge -import Semantic.Config -import Semantic.Task as Task -import Semantic.Telemetry as Stat -import Serializing.Format hiding (JSON) -import qualified Serializing.Format as Format -import Source.Loc -import qualified System.Path as Path - -data DiffOutputFormat - = DiffJSONTree - | DiffJSONGraph - | DiffSExpression - | DiffShow - | DiffDotGraph - deriving (Eq, Show) - -parseDiffBuilder :: (Traversable t, Has (Error SomeException) sig m, Has (Reader Config) sig m, Has Telemetry sig m, Has Distribute sig m, Has Parse sig m, MonadIO m) => DiffOutputFormat -> t BlobPair -> m Builder -parseDiffBuilder DiffJSONTree = distributeFoldMap jsonDiff >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blob pairs. -parseDiffBuilder DiffJSONGraph = diffGraph >=> serialize Format.JSON -parseDiffBuilder DiffSExpression = distributeFoldMap (parsePairWith diffParsers sexprDiff) -parseDiffBuilder DiffShow = distributeFoldMap (parsePairWith diffParsers showDiff) -parseDiffBuilder DiffDotGraph = distributeFoldMap (parsePairWith diffParsers dotGraphDiff) - -jsonDiff :: (Has (Error SomeException) sig m, Has Telemetry sig m, Has Parse sig m, MonadIO m) => BlobPair -> m (Rendering.JSON.JSON "diffs" SomeJSON) -jsonDiff blobPair = parsePairWith diffParsers jsonTreeDiff blobPair `catchError` jsonError blobPair - -jsonError :: Applicative m => BlobPair -> SomeException -> m (Rendering.JSON.JSON "diffs" SomeJSON) -jsonError blobPair (SomeException e) = pure $ renderJSONDiffError blobPair (show e) - -diffGraph :: (Traversable t, Has (Error SomeException) sig m, Has Telemetry sig m, Has Distribute sig m, Has Parse sig m, MonadIO m) => t BlobPair -> m DiffTreeGraphResponse -diffGraph blobs = do - graph <- distributeFor blobs go - pure $ defMessage & P.files .~ toList graph - where - go :: (Has (Error SomeException) sig m, Has Telemetry sig m, Has Parse sig m, MonadIO m) => BlobPair -> m DiffTreeFileGraph - go blobPair = parsePairWith diffParsers jsonGraphDiff blobPair - `catchError` \(SomeException e) -> - pure $ defMessage - & P.path .~ path - & P.language .~ lang - & P.vertices .~ mempty - & P.edges .~ mempty - & P.errors .~ [defMessage & P.error .~ T.pack (show e)] - where - path = T.pack . Path.toString $ pathForBlobPair blobPair - lang = bridging # languageForBlobPair blobPair - - -class DOTGraphDiff term where - dotGraphDiff :: (Has (Reader Config) sig m, Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder - -instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => DOTGraphDiff term where - dotGraphDiff = serialize (DOT (diffStyle "diffs")) . renderTreeGraph <=< diffTerms - - -class JSONGraphDiff term where - jsonGraphDiff :: (Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m DiffTreeFileGraph - -instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => JSONGraphDiff term where - jsonGraphDiff terms = do - diff <- diffTerms terms - let blobPair = bimap fst fst terms - graph = renderTreeGraph diff - toEdge (Edge (a, b)) = defMessage & P.source .~ a^.diffVertexId & P.target .~ b^.diffVertexId - path = T.pack . Path.toString $ pathForBlobPair blobPair - lang = bridging # languageForBlobPair blobPair - pure $! defMessage - & P.path .~ path - & P.language .~ lang - & P.vertices .~ vertexList graph - & P.edges .~ fmap toEdge (edgeList graph) - & P.errors .~ mempty - - -class JSONTreeDiff term where - jsonTreeDiff :: (Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m (Rendering.JSON.JSON "diffs" SomeJSON) - -instance (DiffTerms term, Foldable (Syntax term), ToJSONFields1 (Syntax term)) => JSONTreeDiff term where - jsonTreeDiff terms = renderJSONDiff (bimap fst fst terms) <$> diffTerms terms - - -class SExprDiff term where - sexprDiff :: (Has (Reader Config) sig m, Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder - -instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => SExprDiff term where - sexprDiff = serialize (SExpression ByConstructorName) <=< diffTerms - - -class ShowDiff term where - showDiff :: (Has (Reader Config) sig m, Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder - -instance (DiffTerms term, Foldable (Syntax term), Show1 (Syntax term)) => ShowDiff term where - showDiff = serialize Show <=< diffTerms - - -diffTerms :: (DiffTerms term, Foldable (Syntax term), Has Telemetry sig m, MonadIO m) - => Edit (Blob, term ann) (Blob, term ann) -> m (Diff (Syntax term) ann ann) -diffTerms terms = time "diff" languageTag $ do - let diff = diffTermPair (bimap snd snd terms) - diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag) - where languageTag = languageTagForBlobPair blobs - blobs = bimap fst fst terms - -diffParsers :: Map Language (SomeParser Anything Loc) -diffParsers = aLaCarteParsers - -class - ( DiffTerms term - , ConstructorName (Syntax term) - , Foldable (Syntax term) - , Functor (Syntax term) - , Show1 (Syntax term) - , ToJSONFields1 (Syntax term) - ) => Anything term -instance - ( DiffTerms term - , ConstructorName (Syntax term) - , Foldable (Syntax term) - , Functor (Syntax term) - , Show1 (Syntax term) - , ToJSONFields1 (Syntax term) - ) => Anything term diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index c7680809d..f8a1f9bf8 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -3,23 +3,16 @@ module Semantic.CLI (main) where import qualified Analysis.File as File -import Analysis.Project import qualified Control.Carrier.Parse.Measured as Parse -import Control.Carrier.Reader import Control.Exception -import Control.Monad.IO.Class -import Data.Blob.IO -import Data.Either import qualified Data.Flag as Flag import Data.Foldable import Data.Handle import qualified Data.Language as Language import Data.List (intercalate) -import Data.Maybe.Exts import Options.Applicative hiding (style) import Semantic.Api hiding (File) import Semantic.Config -import qualified Semantic.Graph as Graph import qualified Semantic.Task as Task import Semantic.Task.Files import Semantic.Telemetry @@ -83,22 +76,10 @@ optionsParser = do argumentsParser :: Parser (Parse.ParseC Task.TaskC ()) argumentsParser = do - subparser <- hsubparser (diffCommand <> parseCommand <> graphCommand) + subparser <- hsubparser parseCommand output <- ToPath <$> pathOption (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout) pure $ subparser >>= Task.write output -diffCommand :: Mod CommandFields (Parse.ParseC Task.TaskC Builder) -diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute changes between paths")) - where - diffArgumentsParser = do - renderer <- flag (parseDiffBuilder DiffSExpression) (parseDiffBuilder DiffSExpression) (long "sexpression" <> help "Output s-expression diff tree (default)") - <|> flag' (parseDiffBuilder DiffJSONTree) (long "json" <> help "Output JSON diff trees") - <|> flag' (parseDiffBuilder DiffJSONGraph) (long "json-graph" <> help "Output JSON diff trees") - <|> flag' (parseDiffBuilder DiffDotGraph) (long "dot" <> help "Output the diff as a DOT graph") - <|> flag' (parseDiffBuilder DiffShow) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") - filesOrStdin <- Right <$> some ((,) <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin) - pure $ Task.readBlobPairs filesOrStdin >>= runReader Language.aLaCarteLanguageModes . renderer - parseCommand :: Mod CommandFields (Parse.ParseC Task.TaskC Builder) parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)")) where @@ -125,39 +106,6 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa <|> pure (FilesFromHandle stdin) pure $ Task.readBlobs filesOrStdin >>= renderer -graphCommand :: Mod CommandFields (Parse.ParseC Task.TaskC Builder) -graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a graph for a directory or from a top-level entry point module")) - where - graphArgumentsParser = makeGraphTask - <$> graphType - <*> switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module") - <*> serializer - <*> (readProjectRecursively <|> readProjectFromPaths) - graphType = flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") - <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") - serializer = flag (Task.serialize (DOT Graph.style)) (Task.serialize (DOT Graph.style)) (long "dot" <> help "Output in DOT graph format (default)") - <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") - <|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") - readProjectFromPaths = makeReadProjectFromPathsTask - <$> ( Just <$> some (strArgument (metavar "FILES...")) - <|> flag' Nothing (long "stdin" <> help "Read a list of newline-separated paths to analyze from stdin.")) - makeReadProjectFromPathsTask maybePaths = do - strPaths <- maybeM (liftIO (many getLine)) maybePaths - let paths = rights (Path.parse <$> strPaths) - blobs <- traverse readBlobFromPath paths - case paths of - (x:_) -> pure $! Project (Path.takeDirectory x) blobs (Language.forPath x) mempty - _ -> pure $! Project (Path.toAbsRel Path.rootDir) mempty Language.Unknown mempty - - allLanguages = intercalate "|" . fmap show $ [Language.Go .. maxBound] - readProjectRecursively = makeReadProjectRecursivelyTask - <$> option auto (long "language" <> help "The language for the analysis." <> metavar allLanguages) - <*> optional (pathOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR")) - <*> many (pathOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) - <*> argument path (metavar "PATH") - makeReadProjectRecursivelyTask language rootDir excludeDirs dir = Task.readProject rootDir dir language excludeDirs - makeGraphTask graphType includePackages serializer projectTask = projectTask >>= Graph.runGraph graphType includePackages >>= serializer - filePathReader :: ReadM (File.File Language.Language) filePathReader = File.fromPath <$> path diff --git a/src/Serializing/SExpression.hs b/src/Serializing/SExpression.hs index 40ad06f26..d93311662 100644 --- a/src/Serializing/SExpression.hs +++ b/src/Serializing/SExpression.hs @@ -11,7 +11,6 @@ module Serializing.SExpression import Analysis.ConstructorName import Data.ByteString.Builder -import Data.Diff import Data.Edit import Data.Functor.Foldable import Data.Term @@ -41,11 +40,3 @@ class ToSExpression base where instance (ConstructorName syntax, Foldable syntax, Show ann) => ToSExpression (TermF syntax ann) where toSExpression options term n = nl n <> pad n <> namedBranch options term n - -instance (ConstructorName syntax, Foldable syntax, Show ann1, Show ann2) => ToSExpression (DiffF syntax ann1 ann2) where - toSExpression options diff n = case diff of - Patch (Delete term) -> nl n <> pad (n - 1) <> "{-" <> namedBranch options term n <> "-}" - Patch (Insert term) -> nl n <> pad (n - 1) <> "{+" <> namedBranch options term n <> "+}" - Patch (Compare term1 term2) -> nl n <> pad (n - 1) <> "{ " <> namedBranch options term1 n - <> nl (n + 1) <> pad (n - 1) <> "->" <> namedBranch options term2 n <> " }" - Merge term -> nl n <> pad n <> namedBranch options term n diff --git a/test/Data/Diff/Spec.hs b/test/Data/Diff/Spec.hs deleted file mode 100644 index 451dfc764..000000000 --- a/test/Data/Diff/Spec.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE DataKinds #-} -module Data.Diff.Spec (spec) where - -import Data.Diff -import Data.Functor.Listable (ListableSyntax) -import Test.Hspec -import Test.Hspec.LeanCheck - -spec :: Spec -spec = do - prop "equality is reflexive" $ - \ diff -> diff `shouldBe` (diff :: Diff ListableSyntax () ()) diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs index 52f84c240..cf46e9c62 100644 --- a/test/Data/Functor/Listable.hs +++ b/test/Data/Functor/Listable.hs @@ -19,7 +19,6 @@ module Data.Functor.Listable import qualified Analysis.Name as Name import Data.Abstract.ScopeGraph (AccessControl(..)) import Data.Bifunctor.Join -import Data.Diff import Data.Edit import qualified Data.Language as Language import Data.List.NonEmpty @@ -56,13 +55,6 @@ tiers2 :: (Listable a, Listable b, Listable2 l) => [Tier (l a b)] tiers2 = liftTiers2 tiers tiers -class Listable3 l where - liftTiers3 :: [Tier a] -> [Tier b] -> [Tier c] -> [Tier (l a b c)] - -tiers3 :: (Listable3 l, Listable a, Listable b, Listable c) => [Tier (l a b c)] -tiers3 = liftTiers3 tiers tiers tiers - - -- | Lifts a unary constructor to a list of tiers, given a list of tiers for its argument. -- -- Commonly used in the definition of 'Listable1' and 'Listable2' instances. @@ -136,25 +128,9 @@ instance Listable1 f => Listable1 (Term f) where instance (Listable1 f, Listable a) => Listable (Term f a) where tiers = tiers1 - -instance (Listable1 syntax) => Listable3 (DiffF syntax) where - liftTiers3 ann1Tiers ann2Tiers recurTiers - = liftCons1 (liftTiers2 (liftTiers2 ann1Tiers recurTiers) (liftTiers2 ann2Tiers recurTiers)) Patch - \/ liftCons1 (liftTiers2 (liftTiers2 ann1Tiers ann2Tiers) recurTiers) Merge - -instance (Listable1 syntax, Listable ann1, Listable ann2, Listable recur) => Listable (DiffF syntax ann1 ann2 recur) where - tiers = tiers3 - instance Listable AccessControl where tiers = cons0 Public \/ cons0 Protected \/ cons0 Private -instance Listable1 f => Listable2 (Diff f) where - liftTiers2 annTiers1 annTiers2 = go where go = liftCons1 (liftTiers3 annTiers1 annTiers2 go) Diff - -instance (Listable1 syntax, Listable ann1, Listable ann2) => Listable (Diff syntax ann1 ann2) where - tiers = tiers2 - - instance Listable2 Edit where liftTiers2 t1 t2 = liftCons1 t2 Insert \/ liftCons1 t1 Delete \/ liftCons2 t1 t2 Compare diff --git a/test/Diffing/Algorithm/RWS/Spec.hs b/test/Diffing/Algorithm/RWS/Spec.hs deleted file mode 100644 index 63414505e..000000000 --- a/test/Diffing/Algorithm/RWS/Spec.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE DataKinds, OverloadedStrings, TypeOperators #-} -module Diffing.Algorithm.RWS.Spec (spec) where - -import Data.Bifunctor -import Data.Diff -import Data.Sum -import qualified Data.Syntax as Syntax -import Data.Term -import Diffing.Algorithm (comparableTerms) -import Diffing.Interpreter (stripDiff) -import Diffing.Algorithm.RWS -import Diffing.Interpreter.Spec (afterTerm, beforeTerm) -import Test.Hspec.LeanCheck -import SpecHelpers - -spec :: Spec -spec = do - let positively = succ . abs - describe "pqGramDecorator" $ do - prop "produces grams with stems of the specified length" $ - \ (term, p, q) -> pqGramDecorator (positively p) (positively q) (term :: Term ListableSyntax ()) `shouldSatisfy` all ((== positively p) . length . stem . fst) - - prop "produces grams with bases of the specified width" $ - \ (term, p, q) -> pqGramDecorator (positively p) (positively q) (term :: Term ListableSyntax ()) `shouldSatisfy` all ((== positively q) . length . base . fst) - - describe "rws" $ do - prop "produces correct diffs" $ - \ (as, bs) -> let tas = decorate <$> (as :: [Term ListableSyntax ()]) - tbs = decorate <$> (bs :: [Term ListableSyntax ()]) - wrap = termIn emptyAnnotation . inject - diff = merge (emptyAnnotation, emptyAnnotation) (inject (stripDiff . diffEdit <$> rws comparableTerms (equalTerms comparableTerms) tas tbs)) in - (beforeTerm diff, afterTerm diff) `shouldBe` (Just (wrap (stripTerm <$> tas)), Just (wrap (stripTerm <$> tbs))) - - it "produces unbiased insertions within branches" $ - let (a, b) = (decorate (termIn emptyAnnotation (inject [ termIn emptyAnnotation (inject (Syntax.Identifier "a")) ])), decorate (termIn emptyAnnotation (inject [ termIn emptyAnnotation (inject (Syntax.Identifier "b")) ]))) in - fmap (bimap stripTerm stripTerm) (rws comparableTerms (equalTerms comparableTerms) [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ Insert a, Compare b b ] - - where decorate = defaultFeatureVectorDecorator - - diffEdit = edit deleting inserting comparing - -stripTerm :: Functor f => Term f (FeatureVector, ()) -> Term f () -stripTerm = fmap snd - -emptyAnnotation :: () -emptyAnnotation = () diff --git a/test/Diffing/Algorithm/SES/Spec.hs b/test/Diffing/Algorithm/SES/Spec.hs deleted file mode 100644 index 53e136475..000000000 --- a/test/Diffing/Algorithm/SES/Spec.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Diffing.Algorithm.SES.Spec (spec) where - -import Data.Edit -import Diffing.Algorithm.SES -import Test.Hspec -import Test.Hspec.LeanCheck - -spec :: Spec -spec = do - describe "ses" $ do - prop "returns equal lists in Compare" $ - \ as -> (ses (==) as as :: [Edit Char Char]) `shouldBe` zipWith Compare as as - - prop "returns deletions in Delete" $ - \ as -> (ses (==) as [] :: [Edit Char Char]) `shouldBe` fmap Delete as - - prop "returns insertions in Insert" $ - \ bs -> (ses (==) [] bs :: [Edit Char Char]) `shouldBe` fmap Insert bs - - prop "returns all elements individually for disjoint inputs" $ - \ as bs -> length (ses (==) ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])) `shouldBe` length as + length bs - - prop "is lossless w.r.t. both input elements & ordering" $ - \ as bs -> foldr (\ each (as, bs) -> edit (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (ses (==) as bs :: [Edit Char Char]) `shouldBe` (as, bs) diff --git a/test/Diffing/Interpreter/Spec.hs b/test/Diffing/Interpreter/Spec.hs deleted file mode 100644 index 652186af5..000000000 --- a/test/Diffing/Interpreter/Spec.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# LANGUAGE DataKinds, OverloadedStrings, TypeApplications #-} -module Diffing.Interpreter.Spec (spec, afterTerm, beforeTerm) where - -import Control.Applicative ((<|>)) -import Data.Diff -import Data.Foldable (asum) -import Data.Functor.Foldable (cata) -import Data.Functor.Listable -import Data.Maybe -import Data.Mergeable -import Data.Sum -import Data.Term -import Diffing.Interpreter -import qualified Data.Syntax as Syntax -import Test.Hspec (Spec, describe, it) -import Test.Hspec.Expectations -import Test.Hspec.LeanCheck -import Test.LeanCheck.Core -import SpecHelpers (Edit(..), edit) - -spec :: Spec -spec = do - describe "diffTerms" $ do - it "returns a replacement when comparing two unicode equivalent terms" $ - let termA = termIn emptyAnnotation (inject (Syntax.Identifier "t\776")) - termB = termIn emptyAnnotation (inject (Syntax.Identifier "\7831")) in - diffTerms termA termB `shouldBe` comparing termA (termB :: Term ListableSyntax ()) - - prop "produces correct diffs" $ - \ a b -> let diff = diffTerms a b :: Diff ListableSyntax () () in - (beforeTerm diff, afterTerm diff) `shouldBe` (Just a, Just b) - - prop "produces identity diffs for equal terms " $ - \ a -> let diff = diffTerms a a :: Diff ListableSyntax () () in - length (diffPatches diff) `shouldBe` 0 - - it "produces unbiased insertions within branches" $ - let term s = termIn emptyAnnotation (inject [ termIn emptyAnnotation (inject (Syntax.Identifier s)) ]) :: Term ListableSyntax () - wrap = termIn emptyAnnotation . inject in - diffTerms (wrap [ term "b" ]) (wrap [ term "a", term "b" ]) `shouldBe` merge (emptyAnnotation, emptyAnnotation) (inject [ inserting (term "a"), merging (term "b") ]) - - let noContext :: Term ListableSyntax a -> Bool - noContext = isNothing . project @Syntax.Context . termOut - - prop "compares nodes against context" . forAll (filterT (noContext . fst) tiers) $ - \ (a, b) -> diffTerms a (termIn emptyAnnotation (inject (Syntax.Context (pure b) a))) `shouldBe` insertF (In emptyAnnotation (inject (Syntax.Context (pure (inserting b)) (merging (a :: Term ListableSyntax ()))))) - - prop "diffs forward permutations as changes" $ - \ a -> let wrap = termIn emptyAnnotation . inject - b = wrap [a] - c = wrap [a, b] in - diffTerms (wrap [a, b, c]) (wrap [c, a, b :: Term ListableSyntax ()]) `shouldBe` merge (emptyAnnotation, emptyAnnotation) (inject [ inserting c, merging a, merging b, deleting c ]) - - prop "diffs backward permutations as changes" $ - \ a -> let wrap = termIn emptyAnnotation . inject - b = wrap [a] - c = wrap [a, b] in - diffTerms (wrap [a, b, c]) (wrap [b, c, a :: Term ListableSyntax ()]) `shouldBe` merge (emptyAnnotation, emptyAnnotation) (inject [ deleting a, merging b, merging c, inserting a ]) - - describe "diffTermPair" $ do - prop "produces an Insert when the first term is missing" $ do - \ after -> let diff = diffTermPair (Insert after) :: Diff ListableSyntax () () in - diff `shouldBe` inserting after - - prop "produces a Delete when the second term is missing" $ do - \ before -> let diff = diffTermPair (Delete before) :: Diff ListableSyntax () () in - diff `shouldBe` deleting before - - --- | Recover the before state of a diff. -beforeTerm :: (Foldable syntax, Mergeable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann1) -beforeTerm = cata $ \ diff -> case diff of - Patch patch -> (before patch >>= \ (In a l) -> termIn a <$> sequenceAlt l) <|> (after patch >>= asum) - Merge (In (a, _) l) -> termIn a <$> sequenceAlt l - --- | Recover the after state of a diff. -afterTerm :: (Foldable syntax, Mergeable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann2) -afterTerm = cata $ \ diff -> case diff of - Patch patch -> (after patch >>= \ (In b r) -> termIn b <$> sequenceAlt r) <|> (before patch >>= asum) - Merge (In (_, b) r) -> termIn b <$> sequenceAlt r - --- | Return the item from the after side of the patch. -after :: Edit l r -> Maybe r -after = edit (const Nothing) Just (\ _ b -> Just b) - --- | Return the item from the before side of the patch. -before :: Edit l r -> Maybe l -before = edit Just (const Nothing) (\ a _ -> Just a) - -emptyAnnotation :: () -emptyAnnotation = () diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index 0f84ba328..42e198788 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -28,19 +28,11 @@ testsForLanguage language = do localOption (mkTimeout 3000000) $ testGroup (Path.toString language) $ fmap testForExample items {-# NOINLINE testsForLanguage #-} -data Example = DiffExample Path.RelFile Path.RelFile Path.RelFile - | ParseExample Path.RelFile Path.RelFile +data Example = ParseExample Path.RelFile Path.RelFile deriving (Eq, Show) testForExample :: (?session :: TaskSession) => Example -> TestTree -testForExample = \case - DiffExample fileA fileB diffOutput -> - goldenVsStringDiff - ("diffs " <> Path.toString diffOutput) - (\ref new -> ["git", "diff", ref, new]) - (Path.toString diffOutput) - (BL.fromStrict <$> diffFilePaths ?session fileA fileB) - ParseExample file parseOutput -> +testForExample (ParseExample file parseOutput) = goldenVsStringDiff ("parses " <> Path.toString parseOutput) (\ref new -> ["git", "diff", ref, new]) @@ -68,14 +60,11 @@ examples directory = do sExpDiffsAB <- globFor "*.diffA-B.txt" sExpDiffsBA <- globFor "*.diffB-A.txt" - let exampleDiff lefts rights out name = DiffExample (lookupNormalized name lefts) (lookupNormalized name rights) out let exampleParse files out name = ParseExample (lookupNormalized name files) out let keys = (normalizeName <$> as) `union` (normalizeName <$> bs) pure $ merge [ getExamples (exampleParse as) sExpAs keys - , getExamples (exampleParse bs) sExpBs keys - , getExamples (exampleDiff as bs) sExpDiffsAB keys - , getExamples (exampleDiff bs as) sExpDiffsBA keys ] + , getExamples (exampleParse bs) sExpBs keys ] where merge = concat . transpose -- Only returns examples if they exist diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 0526395bb..e1a954b6e 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -19,8 +19,7 @@ import Test.Tasty.Golden testTree :: TestTree testTree = testGroup "Semantic.CLI" - [ testGroup "parseDiffBuilder" $ fmap testForDiffFixture diffFixtures - , testGroup "parseTermBuilder" $ fmap testForParseFixture parseFixtures + [ testGroup "parseTermBuilder" $ fmap testForParseFixture parseFixtures ] -- We provide this function to the golden tests so as to have better @@ -62,11 +61,3 @@ parseFixtures = path'' = [File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.A.rb") lowerBound Ruby] prefix = Path.relDir "test/fixtures/cli" run = runReader defaultLanguageModes - -diffFixtures :: [(String, [BlobPair] -> ParseC TaskC Builder, [(File Language, File Language)], Path.RelFile)] -diffFixtures = - [ ("json diff", parseDiffBuilder DiffJSONTree, pathMode, prefix Path.file "diff-tree.json") - , ("s-expression diff", parseDiffBuilder DiffSExpression, pathMode, Path.relFile "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt") - ] - where pathMode = [(File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.A.rb") lowerBound Ruby, File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.B.rb") lowerBound Ruby)] - prefix = Path.relDir "test/fixtures/cli" diff --git a/test/Spec.hs b/test/Spec.hs index e35a10568..36967ed14 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -9,7 +9,6 @@ import qualified Analysis.Ruby.Spec import qualified Analysis.TypeScript.Spec import qualified Assigning.Assignment.Spec import qualified Control.Abstract.Evaluator.Spec -import qualified Data.Diff.Spec import qualified Data.Abstract.Name.Spec import qualified Data.Abstract.Path.Spec import qualified Data.Functor.Classes.Generic.Spec @@ -18,9 +17,6 @@ import qualified Data.Language.Spec import qualified Data.Scientific.Spec import qualified Data.Semigroup.App.Spec import qualified Data.Term.Spec -import qualified Diffing.Algorithm.RWS.Spec -import qualified Diffing.Algorithm.SES.Spec -import qualified Diffing.Interpreter.Spec import qualified Graphing.Calls.Spec import qualified Integration.Spec import qualified Numeric.Spec @@ -70,15 +66,11 @@ legacySpecs = parallel $ do describe "Analysis.TypeScript" Analysis.TypeScript.Spec.spec describe "Assigning.Assignment" Assigning.Assignment.Spec.spec describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec - describe "Data.Diff" Data.Diff.Spec.spec describe "Data.Graph" Data.Graph.Spec.spec describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec describe "Data.Term" Data.Term.Spec.spec - describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec - describe "Diffing.Algorithm.SES" Diffing.Algorithm.SES.Spec.spec - describe "Diffing.Interpreter" Diffing.Interpreter.Spec.spec describe "Graphing.Calls" Graphing.Calls.Spec.spec describe "Tags.Spec" Tags.Spec.spec describe "Semantic" Semantic.Spec.spec diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index eae7171bd..df7d5f992 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -5,7 +5,6 @@ module SpecHelpers ( module X , runBuilder -, diffFilePaths , parseFilePath , readFilePathPair , runTaskOrDie @@ -91,13 +90,6 @@ instance Lower X.Span where runBuilder :: Builder -> ByteString runBuilder = toStrict . toLazyByteString --- | Returns an s-expression formatted diff for the specified FilePath pair. -diffFilePaths :: TaskSession -> Path.RelFile -> Path.RelFile -> IO ByteString -diffFilePaths session p1 p2 = do - blobs <- readFilePathPair p1 p2 - builder <- runTask session (runParse (configTreeSitterParseTimeout (config session)) (parseDiffBuilder DiffSExpression [ blobs ])) - either (die . displayException) (pure . runBuilder) builder - -- | Returns an s-expression parse tree for the specified path. parseFilePath :: TaskSession -> Path.RelFile -> IO (Either SomeException ByteString) parseFilePath session path = do