mirror of
https://github.com/github/semantic.git
synced 2024-12-25 16:02:43 +03:00
Merge remote-tracking branch 'origin/semantic-java' into precise-s-expressions
This commit is contained in:
Rob Rix
commit
2791018ce0
1
.gitignore
vendored
1
.gitignore
vendored
@ -24,6 +24,7 @@ tmp/
|
||||
*.hp
|
||||
*.prof
|
||||
*.pyc
|
||||
/hie.yaml
|
||||
|
||||
/test.*
|
||||
/*.html
|
||||
|
||||
14
Dockerfile
14
Dockerfile
@ -1,5 +1,10 @@
|
||||
# Put protoc and twirp tooling in its own image
|
||||
FROM golang:1.12-stretch AS protoc
|
||||
FROM haskell:8.6 as haskell
|
||||
RUN cabal new-update hackage.haskell.org,HEAD
|
||||
RUN cabal new-install proto-lens-protoc
|
||||
RUN which proto-lens-protoc
|
||||
|
||||
FROM golang:1.13-stretch AS protoc
|
||||
RUN apt-get update && apt-get install -y unzip
|
||||
ENV PROTOBUF_VERSION=3.7.1
|
||||
RUN wget "https://github.com/protocolbuffers/protobuf/releases/download/v3.7.1/protoc-$PROTOBUF_VERSION-linux-x86_64.zip" && \
|
||||
@ -7,10 +12,11 @@ RUN wget "https://github.com/protocolbuffers/protobuf/releases/download/v3.7.1/p
|
||||
|
||||
RUN go get github.com/golang/protobuf/proto && \
|
||||
go get github.com/twitchtv/protogen/typemap && \
|
||||
go get github.com/tclem/twirp-haskell/pkg/gen/haskell && \
|
||||
go get github.com/tclem/twirp-haskell/protoc-gen-haskell
|
||||
GO111MODULE=on go get github.com/tclem/proto-lens-jsonpb/protoc-gen-jsonpb_haskell@e4d10b77f57ee25beb759a33e63e2061420d3dc2
|
||||
|
||||
ENTRYPOINT ["/protobuf/bin/protoc", "-I/protobuf", "-I=/go/src/github.com/tclem/twirp-haskell"]
|
||||
COPY --from=haskell /root/.cabal/bin/proto-lens-protoc /usr/local/bin/proto-lens-protoc
|
||||
|
||||
ENTRYPOINT ["/protobuf/bin/protoc", "-I/protobuf", "--plugin=protoc-gen-haskell=/usr/local/bin/proto-lens-protoc"]
|
||||
|
||||
# Build semantic
|
||||
FROM haskell:8.6 as build
|
||||
|
||||
@ -9,10 +9,5 @@ jobs: $ncpus
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/joshvera/proto3-suite.git
|
||||
tag: 83f3352f0c7c94ea091e6087f60692eda9991fae
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/joshvera/proto3-wire.git
|
||||
tag: 84664e22f01beb67870368f1f88ada5d0ad01f56
|
||||
location: https://github.com/tclem/proto-lens-jsonpb
|
||||
tag: e4d10b77f57ee25beb759a33e63e2061420d3dc2
|
||||
|
||||
@ -1,10 +1,7 @@
|
||||
syntax = "proto3";
|
||||
|
||||
import "pkg/gen/haskell/haskell.proto";
|
||||
|
||||
package github.semantic;
|
||||
|
||||
option (haskell.haskell_package) = "Semantic.Proto";
|
||||
option ruby_package = "Semantic::Proto";
|
||||
|
||||
message PingRequest {
|
||||
|
||||
@ -14,6 +14,7 @@ export PROJECT="github.com/github/semantic"
|
||||
|
||||
# Generate Haskell for semantic's protobuf types
|
||||
docker run --rm --user $(id -u):$(id -g) -v $(pwd):/go/src/$PROJECT -w /go/src/$PROJECT \
|
||||
semantic-protoc \
|
||||
--proto_path=proto --haskell_out=src/Semantic/Proto \
|
||||
semantic-protoc --proto_path=proto \
|
||||
--haskell_out=./src \
|
||||
--jsonpb_haskell_out=./src \
|
||||
semantic.proto
|
||||
|
||||
9
semantic-source/CHANGELOG.md
Normal file
9
semantic-source/CHANGELOG.md
Normal file
@ -0,0 +1,9 @@
|
||||
# 0.0.0.1
|
||||
|
||||
- Loosens the upper bound on `hashable`.
|
||||
- Adds support for GHC 8.8.1.
|
||||
|
||||
|
||||
# 0.0.0.0
|
||||
|
||||
Initial release
|
||||
@ -1,7 +1,7 @@
|
||||
cabal-version: 2.4
|
||||
|
||||
name: semantic-source
|
||||
version: 0.0.0.0
|
||||
version: 0.0.0.1
|
||||
synopsis: Types and functionality for working with source code
|
||||
description: Types and functionality for working with source code (program text).
|
||||
homepage: https://github.com/github/semantic/tree/master/semantic-source#readme
|
||||
@ -15,11 +15,12 @@ category: Data
|
||||
build-type: Simple
|
||||
stability: alpha
|
||||
extra-source-files:
|
||||
CHANGELOG.md
|
||||
README.md
|
||||
|
||||
|
||||
tested-with:
|
||||
GHC == 8.6.5
|
||||
GHC == 8.8.1
|
||||
|
||||
common common
|
||||
default-language: Haskell2010
|
||||
@ -35,6 +36,8 @@ common common
|
||||
-Wno-missed-specialisations
|
||||
-Wno-all-missed-specialisations
|
||||
-Wno-star-is-type
|
||||
if (impl(ghc >= 8.8))
|
||||
ghc-options: -Wno-missing-deriving-strategies
|
||||
|
||||
library
|
||||
import: common
|
||||
@ -43,15 +46,13 @@ library
|
||||
Source.Range
|
||||
Source.Source
|
||||
Source.Span
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends:
|
||||
aeson ^>= 1.4.2.0
|
||||
, base >= 4.12 && < 5
|
||||
, bytestring ^>= 0.10.8.2
|
||||
, deepseq ^>= 1.4.4.0
|
||||
, generic-monoid ^>= 0.1.0.0
|
||||
, hashable ^>= 1.2.7.0
|
||||
, hashable >= 1.2.7 && < 1.4
|
||||
, semilattices ^>= 0.0.0.3
|
||||
, text ^>= 1.2.3.1
|
||||
hs-source-dirs: src
|
||||
|
||||
@ -71,8 +71,6 @@ common dependencies
|
||||
, text ^>= 1.2.3.1
|
||||
, these >= 0.7 && <1
|
||||
, unix ^>= 2.7.2.2
|
||||
, proto3-suite
|
||||
, proto3-wire
|
||||
, lingo >= 0.2.0.0
|
||||
|
||||
common executable-flags
|
||||
@ -240,6 +238,9 @@ library
|
||||
-- High-level flow & operational functionality (logging, stats, etc.)
|
||||
, Semantic.Analysis
|
||||
-- API
|
||||
, Proto.Semantic
|
||||
, Proto.Semantic_Fields
|
||||
, Proto.Semantic_JSON
|
||||
, Semantic.Api
|
||||
, Semantic.Api.Bridge
|
||||
, Semantic.Api.Diffs
|
||||
@ -247,7 +248,6 @@ library
|
||||
, Semantic.Api.Symbols
|
||||
, Semantic.Api.Terms
|
||||
, Semantic.Api.TOCSummaries
|
||||
, Semantic.Proto.SemanticPB
|
||||
, Semantic.AST
|
||||
, Semantic.CLI
|
||||
, Semantic.Config
|
||||
@ -303,6 +303,9 @@ library
|
||||
, prettyprinter ^>= 1.2.1
|
||||
, pretty-show ^>= 1.9.5
|
||||
, profunctors ^>= 5.3
|
||||
, proto-lens ^>= 0.5.1.0
|
||||
, proto-lens-jsonpb
|
||||
, proto-lens-runtime ^>= 0.5.0.0
|
||||
, reducers ^>= 3.12.3
|
||||
, semantic-java ^>= 0
|
||||
, semantic-python ^>= 0
|
||||
|
||||
@ -21,9 +21,11 @@ import Algebra.Graph.Class (connect, overlay, vertex)
|
||||
import qualified Algebra.Graph.Class as Class
|
||||
import qualified Algebra.Graph.ToGraph as Class
|
||||
import Control.Effect.State
|
||||
import Control.Lens (view)
|
||||
import Data.Aeson
|
||||
import qualified Data.Set as Set
|
||||
import Semantic.Proto.SemanticPB
|
||||
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 }
|
||||
@ -100,8 +102,8 @@ instance Ord vertex => Ord (Graph vertex) where
|
||||
class VertexTag vertex where
|
||||
uniqueTag :: vertex -> Int
|
||||
|
||||
instance VertexTag DiffTreeVertex where uniqueTag = fromIntegral . diffVertexId
|
||||
instance VertexTag TermVertex where uniqueTag = fromIntegral . vertexId
|
||||
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)]
|
||||
|
||||
5553
src/Proto/Semantic.hs
Normal file
5553
src/Proto/Semantic.hs
Normal file
File diff suppressed because it is too large
Load Diff
404
src/Proto/Semantic_Fields.hs
Normal file
404
src/Proto/Semantic_Fields.hs
Normal file
@ -0,0 +1,404 @@
|
||||
{- This file was auto-generated from semantic.proto by the proto-lens-protoc program. -}
|
||||
{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies,
|
||||
UndecidableInstances, GeneralizedNewtypeDeriving,
|
||||
MultiParamTypeClasses, FlexibleContexts, FlexibleInstances,
|
||||
PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds,
|
||||
BangPatterns, TypeApplications #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-imports#-}
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-} -- Manually added for semantic's project settings
|
||||
{-# OPTIONS_GHC -fno-warn-duplicate-exports#-}
|
||||
module Proto.Semantic_Fields where
|
||||
import qualified Data.ProtoLens.Runtime.Prelude as Prelude
|
||||
import qualified Data.ProtoLens.Runtime.Data.Int as Data.Int
|
||||
import qualified Data.ProtoLens.Runtime.Data.Monoid as Data.Monoid
|
||||
import qualified Data.ProtoLens.Runtime.Data.Word as Data.Word
|
||||
import qualified Data.ProtoLens.Runtime.Data.ProtoLens
|
||||
as Data.ProtoLens
|
||||
import qualified
|
||||
Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes
|
||||
as Data.ProtoLens.Encoding.Bytes
|
||||
import qualified
|
||||
Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing
|
||||
as Data.ProtoLens.Encoding.Growing
|
||||
import qualified
|
||||
Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe
|
||||
as Data.ProtoLens.Encoding.Parser.Unsafe
|
||||
import qualified
|
||||
Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire
|
||||
as Data.ProtoLens.Encoding.Wire
|
||||
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Field
|
||||
as Data.ProtoLens.Field
|
||||
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum
|
||||
as Data.ProtoLens.Message.Enum
|
||||
import qualified
|
||||
Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types
|
||||
as Data.ProtoLens.Service.Types
|
||||
import qualified Data.ProtoLens.Runtime.Lens.Family2
|
||||
as Lens.Family2
|
||||
import qualified Data.ProtoLens.Runtime.Lens.Family2.Unchecked
|
||||
as Lens.Family2.Unchecked
|
||||
import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text
|
||||
import qualified Data.ProtoLens.Runtime.Data.Map as Data.Map
|
||||
import qualified Data.ProtoLens.Runtime.Data.ByteString
|
||||
as Data.ByteString
|
||||
import qualified Data.ProtoLens.Runtime.Data.ByteString.Char8
|
||||
as Data.ByteString.Char8
|
||||
import qualified Data.ProtoLens.Runtime.Data.Text.Encoding
|
||||
as Data.Text.Encoding
|
||||
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
|
||||
|
||||
after ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "after" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
after = Data.ProtoLens.Field.field @"after"
|
||||
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"
|
||||
before ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "before" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
before = Data.ProtoLens.Field.field @"before"
|
||||
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) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
blobOid = Data.ProtoLens.Field.field @"blobOid"
|
||||
blobs ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "blobs" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
blobs = Data.ProtoLens.Field.field @"blobs"
|
||||
category ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "category" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
category = Data.ProtoLens.Field.field @"category"
|
||||
changeType ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "changeType" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
changeType = Data.ProtoLens.Field.field @"changeType"
|
||||
changes ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "changes" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
changes = Data.ProtoLens.Field.field @"changes"
|
||||
column ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "column" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
column = Data.ProtoLens.Field.field @"column"
|
||||
content ::
|
||||
forall f s a .
|
||||
(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) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
docs = Data.ProtoLens.Field.field @"docs"
|
||||
docstring ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "docstring" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
docstring = Data.ProtoLens.Field.field @"docstring"
|
||||
edges ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "edges" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
edges = Data.ProtoLens.Field.field @"edges"
|
||||
end ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "end" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
end = Data.ProtoLens.Field.field @"end"
|
||||
error ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "error" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
error = Data.ProtoLens.Field.field @"error"
|
||||
errors ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "errors" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
errors = Data.ProtoLens.Field.field @"errors"
|
||||
files ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "files" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
files = Data.ProtoLens.Field.field @"files"
|
||||
hostname ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "hostname" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
hostname = Data.ProtoLens.Field.field @"hostname"
|
||||
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) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
kind = Data.ProtoLens.Field.field @"kind"
|
||||
language ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "language" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
language = Data.ProtoLens.Field.field @"language"
|
||||
line ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "line" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
line = Data.ProtoLens.Field.field @"line"
|
||||
maybe'after ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "maybe'after" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'after = Data.ProtoLens.Field.field @"maybe'after"
|
||||
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'before ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "maybe'before" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'before = Data.ProtoLens.Field.field @"maybe'before"
|
||||
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,
|
||||
Data.ProtoLens.Field.HasField s "maybe'docs" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'docs = Data.ProtoLens.Field.field @"maybe'docs"
|
||||
maybe'end ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
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,
|
||||
Data.ProtoLens.Field.HasField s "maybe'span" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'span = Data.ProtoLens.Field.field @"maybe'span"
|
||||
maybe'start ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
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"
|
||||
path ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "path" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
path = Data.ProtoLens.Field.field @"path"
|
||||
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) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
service = Data.ProtoLens.Field.field @"service"
|
||||
sha ::
|
||||
forall f s a .
|
||||
(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) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
span = Data.ProtoLens.Field.field @"span"
|
||||
start ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "start" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
start = Data.ProtoLens.Field.field @"start"
|
||||
status ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "status" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
status = Data.ProtoLens.Field.field @"status"
|
||||
symbol ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "symbol" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
symbol = Data.ProtoLens.Field.field @"symbol"
|
||||
symbols ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Data.ProtoLens.Field.HasField s "symbols" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
symbols = Data.ProtoLens.Field.field @"symbols"
|
||||
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,
|
||||
Data.ProtoLens.Field.HasField s "timestamp" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
timestamp = Data.ProtoLens.Field.field @"timestamp"
|
||||
vec'blobs ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "vec'blobs" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
vec'blobs = Data.ProtoLens.Field.field @"vec'blobs"
|
||||
vec'changes ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "vec'changes" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
vec'changes = Data.ProtoLens.Field.field @"vec'changes"
|
||||
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'errors ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "vec'errors" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
vec'errors = Data.ProtoLens.Field.field @"vec'errors"
|
||||
vec'files ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f,
|
||||
Data.ProtoLens.Field.HasField s "vec'files" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
vec'files = Data.ProtoLens.Field.field @"vec'files"
|
||||
vec'symbols ::
|
||||
forall f s a .
|
||||
(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"
|
||||
842
src/Proto/Semantic_JSON.hs
Normal file
842
src/Proto/Semantic_JSON.hs
Normal file
@ -0,0 +1,842 @@
|
||||
-- Code generated by protoc-gen-jsonpb_haskell 0.1.0, DO NOT EDIT.
|
||||
{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports -Wno-missing-export-lists #-}
|
||||
module Proto.Semantic_JSON where
|
||||
|
||||
import Prelude(($), (.), (<$>), pure, show, Maybe(..))
|
||||
|
||||
import Data.ProtoLens.Runtime.Lens.Family2 ((^.), (.~), (&))
|
||||
import Data.Monoid (mconcat)
|
||||
import Control.Monad (msum)
|
||||
import Data.ProtoLens (defMessage)
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Encoding as E
|
||||
import Data.ProtoLens.JSONPB as JSONPB
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Proto.Semantic as P
|
||||
import Proto.Semantic_Fields as P
|
||||
|
||||
instance FromJSONPB PingRequest where
|
||||
parseJSONPB = withObject "PingRequest" $ \obj -> do
|
||||
service' <- obj .: "service"
|
||||
pure $ defMessage
|
||||
& P.service .~ service'
|
||||
|
||||
instance ToJSONPB PingRequest where
|
||||
toJSONPB x = object
|
||||
[ "service" .= (x^.service)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "service" .= (x^.service)
|
||||
]
|
||||
|
||||
instance FromJSON PingRequest where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON PingRequest where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB PingResponse where
|
||||
parseJSONPB = withObject "PingResponse" $ \obj -> do
|
||||
status' <- obj .: "status"
|
||||
hostname' <- obj .: "hostname"
|
||||
timestamp' <- obj .: "timestamp"
|
||||
sha' <- obj .: "sha"
|
||||
pure $ defMessage
|
||||
& P.status .~ status'
|
||||
& P.hostname .~ hostname'
|
||||
& P.timestamp .~ timestamp'
|
||||
& P.sha .~ sha'
|
||||
|
||||
instance ToJSONPB PingResponse where
|
||||
toJSONPB x = object
|
||||
[ "status" .= (x^.status)
|
||||
, "hostname" .= (x^.hostname)
|
||||
, "timestamp" .= (x^.timestamp)
|
||||
, "sha" .= (x^.sha)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "status" .= (x^.status)
|
||||
, "hostname" .= (x^.hostname)
|
||||
, "timestamp" .= (x^.timestamp)
|
||||
, "sha" .= (x^.sha)
|
||||
]
|
||||
|
||||
instance FromJSON PingResponse where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON PingResponse where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB ParseTreeRequest where
|
||||
parseJSONPB = withObject "ParseTreeRequest" $ \obj -> do
|
||||
blobs' <- obj .: "blobs"
|
||||
pure $ defMessage
|
||||
& P.blobs .~ blobs'
|
||||
|
||||
instance ToJSONPB ParseTreeRequest where
|
||||
toJSONPB x = object
|
||||
[ "blobs" .= (x^.blobs)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "blobs" .= (x^.blobs)
|
||||
]
|
||||
|
||||
instance FromJSON ParseTreeRequest where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON ParseTreeRequest where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB ParseTreeSymbolResponse where
|
||||
parseJSONPB = withObject "ParseTreeSymbolResponse" $ \obj -> do
|
||||
files' <- obj .: "files"
|
||||
pure $ defMessage
|
||||
& P.files .~ files'
|
||||
|
||||
instance ToJSONPB ParseTreeSymbolResponse where
|
||||
toJSONPB x = object
|
||||
[ "files" .= (x^.files)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "files" .= (x^.files)
|
||||
]
|
||||
|
||||
instance FromJSON ParseTreeSymbolResponse where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
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 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"
|
||||
pure $ defMessage
|
||||
& P.error .~ error'
|
||||
|
||||
instance ToJSONPB ParseError where
|
||||
toJSONPB x = object
|
||||
[ "error" .= (x^.error)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "error" .= (x^.error)
|
||||
]
|
||||
|
||||
instance FromJSON ParseError where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON ParseError where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB DiffTreeRequest where
|
||||
parseJSONPB = withObject "DiffTreeRequest" $ \obj -> do
|
||||
blobs' <- obj .: "blobs"
|
||||
pure $ defMessage
|
||||
& P.blobs .~ blobs'
|
||||
|
||||
instance ToJSONPB DiffTreeRequest where
|
||||
toJSONPB x = object
|
||||
[ "blobs" .= (x^.blobs)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "blobs" .= (x^.blobs)
|
||||
]
|
||||
|
||||
instance FromJSON DiffTreeRequest where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON DiffTreeRequest where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB DiffTreeTOCResponse where
|
||||
parseJSONPB = withObject "DiffTreeTOCResponse" $ \obj -> do
|
||||
files' <- obj .: "files"
|
||||
pure $ defMessage
|
||||
& P.files .~ files'
|
||||
|
||||
instance ToJSONPB DiffTreeTOCResponse where
|
||||
toJSONPB x = object
|
||||
[ "files" .= (x^.files)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "files" .= (x^.files)
|
||||
]
|
||||
|
||||
instance FromJSON DiffTreeTOCResponse where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON DiffTreeTOCResponse where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB TOCSummaryFile where
|
||||
parseJSONPB = withObject "TOCSummaryFile" $ \obj -> do
|
||||
path' <- obj .: "path"
|
||||
language' <- obj .: "language"
|
||||
changes' <- obj .: "changes"
|
||||
errors' <- obj .: "errors"
|
||||
pure $ defMessage
|
||||
& P.path .~ path'
|
||||
& P.language .~ language'
|
||||
& P.changes .~ changes'
|
||||
& P.errors .~ errors'
|
||||
|
||||
instance ToJSONPB TOCSummaryFile where
|
||||
toJSONPB x = object
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "changes" .= (x^.changes)
|
||||
, "errors" .= (x^.errors)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "changes" .= (x^.changes)
|
||||
, "errors" .= (x^.errors)
|
||||
]
|
||||
|
||||
instance FromJSON TOCSummaryFile where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON TOCSummaryFile where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB TOCSummaryChange where
|
||||
parseJSONPB = withObject "TOCSummaryChange" $ \obj -> do
|
||||
category' <- obj .: "category"
|
||||
term' <- obj .: "term"
|
||||
span' <- obj A..:? "span"
|
||||
changeType' <- obj .: "changeType"
|
||||
pure $ defMessage
|
||||
& P.category .~ category'
|
||||
& P.term .~ term'
|
||||
& P.maybe'span .~ span'
|
||||
& P.changeType .~ changeType'
|
||||
|
||||
instance ToJSONPB TOCSummaryChange where
|
||||
toJSONPB x = object
|
||||
[ "category" .= (x^.category)
|
||||
, "term" .= (x^.term)
|
||||
, "span" .= (x^.maybe'span)
|
||||
, "changeType" .= (x^.changeType)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "category" .= (x^.category)
|
||||
, "term" .= (x^.term)
|
||||
, "span" .= (x^.maybe'span)
|
||||
, "changeType" .= (x^.changeType)
|
||||
]
|
||||
|
||||
instance FromJSON TOCSummaryChange where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON TOCSummaryChange where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB TOCSummaryError where
|
||||
parseJSONPB = withObject "TOCSummaryError" $ \obj -> do
|
||||
error' <- obj .: "error"
|
||||
span' <- obj A..:? "span"
|
||||
pure $ defMessage
|
||||
& P.error .~ error'
|
||||
& P.maybe'span .~ span'
|
||||
|
||||
instance ToJSONPB TOCSummaryError where
|
||||
toJSONPB x = object
|
||||
[ "error" .= (x^.error)
|
||||
, "span" .= (x^.maybe'span)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "error" .= (x^.error)
|
||||
, "span" .= (x^.maybe'span)
|
||||
]
|
||||
|
||||
instance FromJSON TOCSummaryError where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON TOCSummaryError 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"
|
||||
path' <- obj .: "path"
|
||||
language' <- obj .: "language"
|
||||
pure $ defMessage
|
||||
& P.content .~ content'
|
||||
& P.path .~ path'
|
||||
& P.language .~ language'
|
||||
|
||||
instance ToJSONPB Blob where
|
||||
toJSONPB x = object
|
||||
[ "content" .= (x^.content)
|
||||
, "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "content" .= (x^.content)
|
||||
, "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
]
|
||||
|
||||
instance FromJSON Blob where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON Blob where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB BlobPair where
|
||||
parseJSONPB = withObject "BlobPair" $ \obj -> do
|
||||
before' <- obj A..:? "before"
|
||||
after' <- obj A..:? "after"
|
||||
pure $ defMessage
|
||||
& P.maybe'before .~ before'
|
||||
& P.maybe'after .~ after'
|
||||
|
||||
instance ToJSONPB BlobPair where
|
||||
toJSONPB x = object
|
||||
[ "before" .= (x^.maybe'before)
|
||||
, "after" .= (x^.maybe'after)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "before" .= (x^.maybe'before)
|
||||
, "after" .= (x^.maybe'after)
|
||||
]
|
||||
|
||||
instance FromJSON BlobPair where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON BlobPair where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB File where
|
||||
parseJSONPB = withObject "File" $ \obj -> do
|
||||
path' <- obj .: "path"
|
||||
language' <- obj .: "language"
|
||||
symbols' <- obj .: "symbols"
|
||||
errors' <- obj .: "errors"
|
||||
blobOid' <- obj .: "blobOid"
|
||||
pure $ defMessage
|
||||
& P.path .~ path'
|
||||
& P.language .~ language'
|
||||
& P.symbols .~ symbols'
|
||||
& P.errors .~ errors'
|
||||
& P.blobOid .~ blobOid'
|
||||
|
||||
instance ToJSONPB File where
|
||||
toJSONPB x = object
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "symbols" .= (x^.symbols)
|
||||
, "errors" .= (x^.errors)
|
||||
, "blobOid" .= (x^.blobOid)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "symbols" .= (x^.symbols)
|
||||
, "errors" .= (x^.errors)
|
||||
, "blobOid" .= (x^.blobOid)
|
||||
]
|
||||
|
||||
instance FromJSON File where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON File where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB Symbol where
|
||||
parseJSONPB = withObject "Symbol" $ \obj -> do
|
||||
symbol' <- obj .: "symbol"
|
||||
kind' <- obj .: "kind"
|
||||
line' <- obj .: "line"
|
||||
span' <- obj A..:? "span"
|
||||
docs' <- obj A..:? "docs"
|
||||
pure $ defMessage
|
||||
& P.symbol .~ symbol'
|
||||
& P.kind .~ kind'
|
||||
& P.line .~ line'
|
||||
& P.maybe'span .~ span'
|
||||
& P.maybe'docs .~ docs'
|
||||
|
||||
instance ToJSONPB Symbol where
|
||||
toJSONPB x = object
|
||||
[ "symbol" .= (x^.symbol)
|
||||
, "kind" .= (x^.kind)
|
||||
, "line" .= (x^.line)
|
||||
, "span" .= (x^.maybe'span)
|
||||
, "docs" .= (x^.maybe'docs)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "symbol" .= (x^.symbol)
|
||||
, "kind" .= (x^.kind)
|
||||
, "line" .= (x^.line)
|
||||
, "span" .= (x^.maybe'span)
|
||||
, "docs" .= (x^.maybe'docs)
|
||||
]
|
||||
|
||||
instance FromJSON Symbol where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON Symbol where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB Docstring where
|
||||
parseJSONPB = withObject "Docstring" $ \obj -> do
|
||||
docstring' <- obj .: "docstring"
|
||||
pure $ defMessage
|
||||
& P.docstring .~ docstring'
|
||||
|
||||
instance ToJSONPB Docstring where
|
||||
toJSONPB x = object
|
||||
[ "docstring" .= (x^.docstring)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "docstring" .= (x^.docstring)
|
||||
]
|
||||
|
||||
instance FromJSON Docstring where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON Docstring where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB Position where
|
||||
parseJSONPB = withObject "Position" $ \obj -> do
|
||||
line' <- obj .: "line"
|
||||
column' <- obj .: "column"
|
||||
pure $ defMessage
|
||||
& P.line .~ line'
|
||||
& P.column .~ column'
|
||||
|
||||
instance ToJSONPB Position where
|
||||
toJSONPB x = object
|
||||
[ "line" .= (x^.line)
|
||||
, "column" .= (x^.column)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "line" .= (x^.line)
|
||||
, "column" .= (x^.column)
|
||||
]
|
||||
|
||||
instance FromJSON Position where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON Position where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB Span where
|
||||
parseJSONPB = withObject "Span" $ \obj -> do
|
||||
start' <- obj A..:? "start"
|
||||
end' <- obj A..:? "end"
|
||||
pure $ defMessage
|
||||
& P.maybe'start .~ start'
|
||||
& P.maybe'end .~ end'
|
||||
|
||||
instance ToJSONPB Span where
|
||||
toJSONPB x = object
|
||||
[ "start" .= (x^.maybe'start)
|
||||
, "end" .= (x^.maybe'end)
|
||||
]
|
||||
toEncodingPB x = pairs
|
||||
[ "start" .= (x^.maybe'start)
|
||||
, "end" .= (x^.maybe'end)
|
||||
]
|
||||
|
||||
instance FromJSON Span where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON Span where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
|
||||
instance FromJSONPB ChangeType where
|
||||
parseJSONPB (JSONPB.String "NONE") = pure NONE
|
||||
parseJSONPB (JSONPB.String "ADDED") = pure ADDED
|
||||
parseJSONPB (JSONPB.String "REMOVED") = pure REMOVED
|
||||
parseJSONPB (JSONPB.String "MODIFIED") = pure MODIFIED
|
||||
parseJSONPB x = typeMismatch "ChangeType" x
|
||||
|
||||
instance ToJSONPB ChangeType where
|
||||
toJSONPB x _ = A.String . T.toUpper . T.pack $ show x
|
||||
toEncodingPB x _ = E.text . T.toUpper . T.pack $ show x
|
||||
|
||||
instance FromJSON ChangeType where
|
||||
parseJSON = parseJSONPB
|
||||
|
||||
instance ToJSON ChangeType where
|
||||
toJSON = toAesonValue
|
||||
toEncoding = toAesonEncoding
|
||||
@ -12,14 +12,17 @@ import Control.Effect.Fresh
|
||||
import Control.Effect.Pure
|
||||
import Control.Effect.Reader
|
||||
import Control.Effect.State
|
||||
import Control.Lens
|
||||
import Data.Diff
|
||||
import Data.Graph
|
||||
import Data.Patch
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Data.String (IsString (..))
|
||||
import Data.Term
|
||||
import Prologue
|
||||
import Semantic.Api.Bridge
|
||||
import Semantic.Proto.SemanticPB
|
||||
import Proto.Semantic as P
|
||||
import Proto.Semantic_Fields as P
|
||||
import Source.Loc as Loc
|
||||
|
||||
import qualified Data.Text as T
|
||||
@ -39,23 +42,24 @@ runGraph = run . runFresh' . runReader mempty
|
||||
|
||||
-- | GraphViz styling for terms
|
||||
termStyle :: (IsString string, Monoid string) => String -> Style TermVertex string
|
||||
termStyle name = (defaultStyle (fromString . show . vertexId))
|
||||
termStyle name = (defaultStyle (fromString . show . view vertexId))
|
||||
{ graphName = fromString (quote name)
|
||||
, vertexAttributes = vertexAttributes }
|
||||
where quote a = "\"" <> a <> "\""
|
||||
vertexAttributes TermVertex{..} = ["label" := fromString name]
|
||||
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 . diffVertexId))
|
||||
diffStyle name = (defaultStyle (fromString . show . view diffVertexId))
|
||||
{ graphName = fromString (quote name)
|
||||
, vertexAttributes = vertexAttributes }
|
||||
where quote a = "\"" <> a <> "\""
|
||||
vertexAttributes (DiffTreeVertex _ (Just (Deleted (Just DeletedTerm{..})))) = [ "label" := fromString (T.unpack term), "color" := "red" ]
|
||||
vertexAttributes (DiffTreeVertex _ (Just (Inserted (Just InsertedTerm{..})))) = [ "label" := fromString (T.unpack term), "color" := "green" ]
|
||||
vertexAttributes (DiffTreeVertex _ (Just (Replaced (Just ReplacedTerm{..})))) = [ "label" := "Replacement", "color" := "orange", "style" := "dashed" ]
|
||||
vertexAttributes (DiffTreeVertex _ (Just (Merged (Just MergedTerm{..})))) = [ "label" := fromString (T.unpack term) ]
|
||||
vertexAttributes _ = []
|
||||
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 :: (Member Fresh sig, Member (Reader (Graph vertex)) sig, Carrier sig m) => t (m (Graph vertex)) -> m (Graph vertex)
|
||||
@ -75,23 +79,39 @@ instance (ConstructorName syntax, Foldable syntax) =>
|
||||
termAlgebra (In ann syntax) = do
|
||||
i <- fresh
|
||||
parent <- ask
|
||||
let root = vertex $ TermVertex (fromIntegral i) (T.pack (constructorName syntax)) (converting #? Loc.span ann)
|
||||
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 (Merged (Just (MergedTerm (T.pack (constructorName syntax)) (ann a1) (ann a2))))
|
||||
Patch (Delete t1@(In a1 syntax)) -> diffAlgebra t1 (Deleted (Just (DeletedTerm (T.pack (constructorName syntax)) (ann a1))))
|
||||
Patch (Insert t2@(In a2 syntax)) -> diffAlgebra t2 (Inserted (Just (InsertedTerm (T.pack (constructorName syntax)) (ann a2))))
|
||||
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 (Replace 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 (DiffTreeVertex (fromIntegral i) (Just (Replaced (Just (ReplacedTerm beforeName beforeSpan afterName afterSpan)))))
|
||||
graph <- local (const replace) (overlay <$> diffAlgebra t1 (Deleted (Just (DeletedTerm beforeName beforeSpan))) <*> diffAlgebra t2 (Inserted (Just (InsertedTerm afterName afterSpan))))
|
||||
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
|
||||
@ -100,10 +120,12 @@ instance (ConstructorName syntax, Foldable syntax) =>
|
||||
, Member Fresh sig
|
||||
, Member (Reader (Graph DiffTreeVertex)) sig
|
||||
, Carrier sig m
|
||||
) => f (m (Graph DiffTreeVertex)) -> DiffTreeVertexDiffTerm -> m (Graph DiffTreeVertex)
|
||||
) => f (m (Graph DiffTreeVertex)) -> DiffTreeVertex'DiffTerm -> m (Graph DiffTreeVertex)
|
||||
diffAlgebra syntax a = do
|
||||
i <- fresh
|
||||
parent <- ask
|
||||
let root = vertex (DiffTreeVertex (fromIntegral i) (Just a))
|
||||
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)
|
||||
|
||||
@ -11,4 +11,4 @@ import Semantic.Api.Diffs as DiffsAPI
|
||||
import Semantic.Api.Symbols as SymbolsAPI
|
||||
import Semantic.Api.Terms as TermsAPI
|
||||
import Semantic.Api.TOCSummaries as TOCSummariesAPI
|
||||
import Semantic.Proto.SemanticPB as Types
|
||||
import Proto.Semantic as Types
|
||||
|
||||
@ -8,9 +8,11 @@ module Semantic.Api.Bridge
|
||||
import Control.Lens
|
||||
import qualified Data.Blob as Data
|
||||
import qualified Data.Language as Data
|
||||
import Data.ProtoLens (defMessage)
|
||||
import qualified Data.Text as T
|
||||
import qualified Semantic.Api.LegacyTypes as Legacy
|
||||
import qualified Semantic.Proto.SemanticPB as API
|
||||
import qualified Proto.Semantic as API
|
||||
import Proto.Semantic_Fields as P
|
||||
import Source.Source (fromText, toText)
|
||||
import qualified Source.Span as Source
|
||||
|
||||
@ -50,13 +52,13 @@ instance APIBridge Legacy.Position Source.Pos where
|
||||
|
||||
instance APIBridge API.Position Source.Pos where
|
||||
bridging = iso fromAPI toAPI where
|
||||
toAPI Source.Pos{..} = API.Position (fromIntegral line) (fromIntegral column)
|
||||
fromAPI API.Position{..} = Source.Pos (fromIntegral line) (fromIntegral column)
|
||||
toAPI Source.Pos{..} = defMessage & P.line .~ fromIntegral line & P.column .~ fromIntegral column
|
||||
fromAPI position = Source.Pos (fromIntegral (position^.line)) (fromIntegral (position^.column))
|
||||
|
||||
instance APIConvert API.Span Source.Span where
|
||||
converting = prism' toAPI fromAPI where
|
||||
toAPI Source.Span{..} = API.Span (bridging #? start) (bridging #? end)
|
||||
fromAPI API.Span{..} = Source.Span <$> (start >>= preview bridging) <*> (end >>= preview bridging)
|
||||
toAPI Source.Span{..} = defMessage & P.maybe'start .~ (bridging #? start) & P.maybe'end .~ (bridging #? end)
|
||||
fromAPI span = Source.Span <$> (span^.maybe'start >>= preview bridging) <*> (span^.maybe'end >>= preview bridging)
|
||||
|
||||
instance APIConvert Legacy.Span Source.Span where
|
||||
converting = prism' toAPI fromAPI where
|
||||
@ -68,18 +70,19 @@ instance APIBridge T.Text Data.Language where
|
||||
|
||||
instance APIBridge API.Blob Data.Blob where
|
||||
bridging = iso apiBlobToBlob blobToApiBlob where
|
||||
blobToApiBlob b = API.Blob (toText (Data.blobSource b)) (T.pack (Data.blobPath b)) (bridging # Data.blobLanguage b)
|
||||
apiBlobToBlob API.Blob{..} = Data.makeBlob (fromText content) (T.unpack path) (language ^. bridging) mempty
|
||||
blobToApiBlob b = defMessage & P.content .~ toText (Data.blobSource b) & P.path .~ T.pack (Data.blobPath b) & P.language .~ (bridging # Data.blobLanguage b)
|
||||
apiBlobToBlob blob = Data.makeBlob (fromText (blob^.content)) (T.unpack (blob^.path)) (blob^.(language . bridging)) mempty
|
||||
|
||||
|
||||
instance APIConvert API.BlobPair Data.BlobPair where
|
||||
converting = prism' blobPairToApiBlobPair apiBlobPairToBlobPair where
|
||||
|
||||
apiBlobPairToBlobPair (API.BlobPair (Just before) (Just after)) = Just $ Data.Diffing (before^.bridging) (after^.bridging)
|
||||
apiBlobPairToBlobPair (API.BlobPair (Just before) Nothing) = Just $ Data.Deleting (before^.bridging)
|
||||
apiBlobPairToBlobPair (API.BlobPair Nothing (Just after)) = Just $ Data.Inserting (after^.bridging)
|
||||
apiBlobPairToBlobPair _ = Nothing
|
||||
apiBlobPairToBlobPair blobPair = case (blobPair^.maybe'before, blobPair^.maybe'after) of
|
||||
(Just before, Just after) -> Just $ Data.Diffing (before^.bridging) (after^.bridging)
|
||||
(Just before, Nothing) -> Just $ Data.Deleting (before^.bridging)
|
||||
(Nothing, Just after) -> Just $ Data.Inserting (after^.bridging)
|
||||
_ -> Nothing
|
||||
|
||||
blobPairToApiBlobPair (Data.Diffing before after) = API.BlobPair (bridging #? before) (bridging #? after)
|
||||
blobPairToApiBlobPair (Data.Inserting after) = API.BlobPair Nothing (bridging #? after)
|
||||
blobPairToApiBlobPair (Data.Deleting before) = API.BlobPair (bridging #? before) Nothing
|
||||
blobPairToApiBlobPair (Data.Diffing before after) = defMessage & P.maybe'before .~ (bridging #? before) & P.maybe'after .~ (bridging #? after)
|
||||
blobPairToApiBlobPair (Data.Inserting after) = defMessage & P.maybe'before .~ Nothing & P.maybe'after .~ (bridging #? after)
|
||||
blobPairToApiBlobPair (Data.Deleting before) = defMessage & P.maybe'before .~ (bridging #? before) & P.maybe'after .~ Nothing
|
||||
|
||||
@ -27,20 +27,22 @@ import Data.ByteString.Builder
|
||||
import Data.Graph
|
||||
import Data.JSON.Fields
|
||||
import Data.Language
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Diffing.Algorithm (Diffable)
|
||||
import Diffing.Interpreter (DiffTerms(..))
|
||||
import Parsing.Parser
|
||||
import Prologue
|
||||
import Proto.Semantic as P hiding (Blob, BlobPair)
|
||||
import Proto.Semantic_Fields as P
|
||||
import Proto.Semantic_JSON()
|
||||
import Rendering.Graph
|
||||
import Rendering.JSON hiding (JSON)
|
||||
import qualified Rendering.JSON
|
||||
import Rendering.TOC
|
||||
import Semantic.Api.Bridge
|
||||
import Semantic.Config
|
||||
import Semantic.Proto.SemanticPB hiding (Blob, BlobPair)
|
||||
import Semantic.Task as Task
|
||||
import Semantic.Telemetry as Stat
|
||||
import Serializing.Format hiding (JSON)
|
||||
@ -69,12 +71,19 @@ jsonError :: Applicative m => BlobPair -> SomeException -> m (Rendering.JSON.JSO
|
||||
jsonError blobPair (SomeException e) = pure $ renderJSONDiffError blobPair (show e)
|
||||
|
||||
diffGraph :: (Traversable t, DiffEffects sig m) => t BlobPair -> m DiffTreeGraphResponse
|
||||
diffGraph blobs = DiffTreeGraphResponse . V.fromList . toList <$> distributeFor blobs go
|
||||
diffGraph blobs = do
|
||||
graph <- distributeFor blobs go
|
||||
pure $ defMessage & P.files .~ toList graph
|
||||
where
|
||||
go :: DiffEffects sig m => BlobPair -> m DiffTreeFileGraph
|
||||
go blobPair = diffWith jsonGraphDiffParsers (pure . jsonGraphDiff blobPair) blobPair
|
||||
`catchError` \(SomeException e) ->
|
||||
pure (DiffTreeFileGraph path lang mempty mempty (V.fromList [ParseError (T.pack (show 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 $ pathForBlobPair blobPair
|
||||
lang = bridging # languageForBlobPair blobPair
|
||||
@ -101,10 +110,15 @@ class DiffTerms term => JSONGraphDiff term where
|
||||
instance (ConstructorName syntax, Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => JSONGraphDiff (Term syntax) where
|
||||
jsonGraphDiff blobPair diff
|
||||
= let graph = renderTreeGraph diff
|
||||
toEdge (Edge (a, b)) = DiffTreeEdge (diffVertexId a) (diffVertexId b)
|
||||
in DiffTreeFileGraph path lang (V.fromList (vertexList graph)) (V.fromList (fmap toEdge (edgeList graph))) mempty where
|
||||
path = T.pack $ pathForBlobPair blobPair
|
||||
lang = bridging # languageForBlobPair blobPair
|
||||
toEdge (Edge (a, b)) = defMessage & P.source .~ a^.diffVertexId & P.target .~ b^.diffVertexId
|
||||
path = T.pack $ pathForBlobPair blobPair
|
||||
lang = bridging # languageForBlobPair blobPair
|
||||
in defMessage
|
||||
& P.path .~ path
|
||||
& P.language .~ lang
|
||||
& P.vertices .~ vertexList graph
|
||||
& P.edges .~ fmap toEdge (edgeList graph)
|
||||
& P.errors .~ mempty
|
||||
|
||||
|
||||
jsonTreeDiffParsers :: Map Language (SomeParser JSONTreeDiff Loc)
|
||||
@ -158,22 +172,29 @@ class DiffTerms term => SummarizeDiff term where
|
||||
|
||||
instance (Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax, Traversable syntax) => SummarizeDiff (Term syntax) where
|
||||
decorateTerm = decoratorWithAlgebra . declarationAlgebra
|
||||
summarizeDiff blobPair diff = foldr go (TOCSummaryFile path lang mempty mempty) (diffTOC diff)
|
||||
summarizeDiff blobPair diff = foldr go (defMessage & P.path .~ path & P.language .~ lang) (diffTOC diff)
|
||||
where
|
||||
path = T.pack $ pathKeyForBlobPair blobPair
|
||||
lang = bridging # languageForBlobPair blobPair
|
||||
|
||||
toChangeType = \case
|
||||
"added" -> Added
|
||||
"modified" -> Modified
|
||||
"removed" -> Removed
|
||||
_ -> None
|
||||
"added" -> ADDED
|
||||
"modified" -> MODIFIED
|
||||
"removed" -> REMOVED
|
||||
_ -> NONE
|
||||
|
||||
go :: TOCSummary -> TOCSummaryFile -> TOCSummaryFile
|
||||
go TOCSummary{..} TOCSummaryFile{..}
|
||||
= TOCSummaryFile path language (V.cons (TOCSummaryChange summaryCategoryName summaryTermName (converting #? summarySpan) (toChangeType summaryChangeType)) changes) errors
|
||||
go ErrorSummary{..} TOCSummaryFile{..}
|
||||
= TOCSummaryFile path language changes (V.cons (TOCSummaryError errorText (converting #? errorSpan)) errors)
|
||||
go TOCSummary{..} file = defMessage
|
||||
& P.path .~ file^.P.path
|
||||
& P.language .~ file^.P.language
|
||||
& P.changes .~ (defMessage & P.category .~ summaryCategoryName & P.term .~ summaryTermName & P.maybe'span .~ (converting #? summarySpan) & P.changeType .~ toChangeType summaryChangeType) : file^.P.changes
|
||||
& P.errors .~ file^.P.errors
|
||||
|
||||
go ErrorSummary{..} file = defMessage
|
||||
& P.path .~ file^.P.path
|
||||
& P.language .~ file^.P.language
|
||||
& P.changes .~ file^.P.changes
|
||||
& P.errors .~ (defMessage & P.error .~ errorText & P.maybe'span .~ converting #? errorSpan) : file^.P.errors
|
||||
|
||||
|
||||
-- | Parse a 'BlobPair' using one of the provided parsers, diff the resulting terms, and run an action on the abstracted diff.
|
||||
|
||||
@ -13,17 +13,18 @@ import Control.Lens
|
||||
import Data.Blob hiding (File (..))
|
||||
import Data.ByteString.Builder
|
||||
import Data.Language
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Text (pack)
|
||||
import qualified Language.Java as Java
|
||||
import qualified Language.Python as Python
|
||||
import qualified Parsing.Parser as Parser
|
||||
import Prologue
|
||||
import Proto.Semantic as P hiding (Blob, BlobPair)
|
||||
import Proto.Semantic_Fields as P
|
||||
import Proto.Semantic_JSON ()
|
||||
import Semantic.Api.Bridge
|
||||
import qualified Semantic.Api.LegacyTypes as Legacy
|
||||
import Semantic.Proto.SemanticPB hiding (Blob)
|
||||
import Semantic.Config
|
||||
import Semantic.Task
|
||||
import Serializing.Format (Format)
|
||||
@ -64,7 +65,9 @@ parseSymbolsBuilder :: (Member Distribute sig, Member (Error SomeException) sig,
|
||||
parseSymbolsBuilder format blobs = parseSymbols blobs >>= serialize format
|
||||
|
||||
parseSymbols :: (Member Distribute sig, Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Carrier sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
|
||||
parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
|
||||
parseSymbols blobs = do
|
||||
terms <- distributeFor blobs go
|
||||
pure $ defMessage & P.files .~ toList terms
|
||||
where
|
||||
go :: (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Carrier sig m) => Blob -> m File
|
||||
go blob@Blob{..} = catching $ asks toTagsParsers >>= \ p -> parseWith p (pure . renderToSymbols) blob
|
||||
@ -72,27 +75,35 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
|
||||
catching m = m `catchError` (\(SomeException e) -> pure $ errorFile (show e))
|
||||
blobLanguage' = blobLanguage blob
|
||||
blobPath' = pack $ blobPath blob
|
||||
errorFile e = File blobPath' (bridging # blobLanguage') mempty (V.fromList [ParseError (T.pack e)]) blobOid
|
||||
errorFile e = defMessage
|
||||
& P.path .~ blobPath'
|
||||
& P.language .~ (bridging # blobLanguage')
|
||||
& P.symbols .~ mempty
|
||||
& P.errors .~ [defMessage & P.error .~ pack e]
|
||||
& P.blobOid .~ blobOid
|
||||
|
||||
renderToSymbols :: ToTags t => t Loc -> File
|
||||
renderToSymbols term = tagsToFile (tags (blobLanguage blob) symbolsToSummarize blobSource term)
|
||||
|
||||
tagsToFile :: [Tag] -> File
|
||||
tagsToFile tags = File blobPath' (bridging # blobLanguage') (V.fromList (fmap tagToSymbol tags)) mempty blobOid
|
||||
tagsToFile tags = defMessage
|
||||
& P.path .~ blobPath'
|
||||
& P.language .~ (bridging # blobLanguage')
|
||||
& P.symbols .~ fmap tagToSymbol tags
|
||||
& P.errors .~ mempty
|
||||
& P.blobOid .~ blobOid
|
||||
|
||||
tagToSymbol :: Tag -> Symbol
|
||||
tagToSymbol Tag{..} = defMessage
|
||||
& P.symbol .~ name
|
||||
& P.kind .~ pack (show kind)
|
||||
& P.line .~ line
|
||||
& P.maybe'span .~ converting #? span
|
||||
& P.maybe'docs .~ fmap (flip (set P.docstring) defMessage) docs
|
||||
|
||||
symbolsToSummarize :: [Text]
|
||||
symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
|
||||
|
||||
tagToSymbol :: Tag -> Symbol
|
||||
tagToSymbol Tag{..} = Symbol
|
||||
{ symbol = name
|
||||
, kind = pack (show kind)
|
||||
, line = line
|
||||
, span = converting #? span
|
||||
, docs = fmap Docstring docs
|
||||
}
|
||||
|
||||
|
||||
class ToTags t where
|
||||
tags :: Language -> [Text] -> Source -> t Loc -> [Tag]
|
||||
|
||||
|
||||
@ -6,13 +6,14 @@ import Data.Aeson
|
||||
import Data.Blob
|
||||
import Data.ByteString.Builder
|
||||
import qualified Data.Map.Monoidal as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Data.Semilattice.Lower
|
||||
import qualified Data.Text as T
|
||||
import Proto.Semantic as P hiding (Blob, BlobPair)
|
||||
import Proto.Semantic_Fields as P
|
||||
import Rendering.TOC
|
||||
import Semantic.Api.Diffs
|
||||
import Semantic.Api.Bridge
|
||||
import Semantic.Proto.SemanticPB hiding (Blob, BlobPair)
|
||||
import Semantic.Api.Diffs
|
||||
import Semantic.Task as Task
|
||||
import Serializing.Format
|
||||
|
||||
@ -31,11 +32,17 @@ legacyDiffSummary = distributeFoldMap go
|
||||
|
||||
|
||||
diffSummary :: DiffEffects sig m => [BlobPair] -> m DiffTreeTOCResponse
|
||||
diffSummary blobs = DiffTreeTOCResponse . V.fromList <$> distributeFor blobs go
|
||||
diffSummary blobs = do
|
||||
diff <- distributeFor blobs go
|
||||
pure $ defMessage & P.files .~ diff
|
||||
where
|
||||
go :: DiffEffects sig m => BlobPair -> m TOCSummaryFile
|
||||
go blobPair = decoratingDiffWith summarizeDiffParsers decorateTerm (pure . summarizeDiff blobPair) blobPair
|
||||
`catchError` \(SomeException e) ->
|
||||
pure $ TOCSummaryFile path lang mempty (V.fromList [TOCSummaryError (T.pack (show e)) Nothing])
|
||||
pure $ defMessage
|
||||
& P.path .~ path
|
||||
& P.language .~ lang
|
||||
& P.changes .~ mempty
|
||||
& P.errors .~ [defMessage & P.error .~ T.pack (show e) & P.maybe'span .~ Nothing]
|
||||
where path = T.pack $ pathKeyForBlobPair blobPair
|
||||
lang = bridging # languageForBlobPair blobPair
|
||||
|
||||
@ -18,18 +18,20 @@ import Data.Either
|
||||
import Data.Graph
|
||||
import Data.JSON.Fields
|
||||
import Data.Language
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Data.Quieterm
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Parsing.Parser
|
||||
import Prologue
|
||||
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.Proto.SemanticPB hiding (Blob)
|
||||
import Semantic.Task
|
||||
import Serializing.Format hiding (JSON)
|
||||
import qualified Serializing.Format as Format
|
||||
@ -40,18 +42,26 @@ import Source.Loc
|
||||
import qualified Language.Java as Java
|
||||
import qualified Language.Python as Python
|
||||
|
||||
|
||||
termGraph :: (Traversable t, Member Distribute sig, ParseEffects sig m) => t Blob -> m ParseTreeGraphResponse
|
||||
termGraph blobs = ParseTreeGraphResponse . V.fromList . toList <$> distributeFor blobs go
|
||||
termGraph blobs = do
|
||||
terms <- distributeFor blobs go
|
||||
pure $ defMessage
|
||||
& P.files .~ toList terms
|
||||
where
|
||||
go :: ParseEffects sig m => Blob -> m ParseTreeFileGraph
|
||||
go blob = parseWith jsonGraphTermParsers (pure . jsonGraphTerm blob) blob
|
||||
`catchError` \(SomeException e) ->
|
||||
pure (ParseTreeFileGraph path lang mempty mempty (V.fromList [ParseError (T.pack (show 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 $ blobPath blob
|
||||
lang = bridging # blobLanguage blob
|
||||
|
||||
|
||||
data TermOutputFormat
|
||||
= TermJSONTree
|
||||
| TermJSONGraph
|
||||
@ -149,7 +159,12 @@ class JSONGraphTerm term where
|
||||
instance (Foldable syntax, Functor syntax, ConstructorName syntax) => JSONGraphTerm (Term syntax) where
|
||||
jsonGraphTerm blob t
|
||||
= let graph = renderTreeGraph t
|
||||
toEdge (Edge (a, b)) = TermEdge (vertexId a) (vertexId b)
|
||||
in ParseTreeFileGraph path lang (V.fromList (vertexList graph)) (V.fromList (fmap toEdge (edgeList graph))) mempty where
|
||||
path = T.pack $ blobPath blob
|
||||
lang = bridging # blobLanguage blob
|
||||
toEdge (Edge (a, b)) = defMessage & P.source .~ a^.vertexId & P.target .~ b^.vertexId
|
||||
path = T.pack $ blobPath blob
|
||||
lang = bridging # blobLanguage blob
|
||||
in defMessage
|
||||
& P.path .~ path
|
||||
& P.language .~ lang
|
||||
& P.vertices .~ vertexList graph
|
||||
& P.edges .~ fmap toEdge (edgeList graph)
|
||||
& P.errors .~ mempty
|
||||
|
||||
@ -33,6 +33,7 @@ import Control.Exception (Exception(..), throwTo)
|
||||
import Data.Typeable (Typeable)
|
||||
import System.Posix.Signals
|
||||
import System.Mem.Weak (deRefWeak)
|
||||
import Proto.Semantic_JSON()
|
||||
|
||||
newtype SignalException = SignalException Signal
|
||||
deriving (Show, Typeable)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -14,7 +14,8 @@ import Data.ByteString.Builder
|
||||
import Language.Haskell.HsColour
|
||||
import Language.Haskell.HsColour.Colourise
|
||||
import Prologue
|
||||
import Proto3.Suite as Proto3
|
||||
import Data.ProtoLens.Encoding as Proto
|
||||
import Data.ProtoLens.Message (Message)
|
||||
import Serializing.SExpression
|
||||
import Text.Show.Pretty
|
||||
|
||||
@ -33,4 +34,4 @@ runSerialize _ JSON = (<> "\n") . fromEncoding . toEncodin
|
||||
runSerialize _ (SExpression opts) = serializeSExpression opts
|
||||
runSerialize Colourful Show = (<> "\n") . stringUtf8 . hscolour TTY defaultColourPrefs False False "" False . ppShow
|
||||
runSerialize Plain Show = (<> "\n") . stringUtf8 . show
|
||||
runSerialize _ Proto = lazyByteString . Proto3.toLazyByteString
|
||||
runSerialize _ Proto = Proto.buildMessage
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
module Graphing.Calls.Spec ( spec ) where
|
||||
|
||||
import Prelude hiding (readFile)
|
||||
import SpecHelpers hiding (readFile)
|
||||
import SpecHelpers
|
||||
|
||||
import Algebra.Graph
|
||||
|
||||
|
||||
@ -15,7 +15,7 @@ import Data.Blob
|
||||
import Data.Handle
|
||||
import qualified Semantic.Git as Git
|
||||
import Shelly (cd, run_, shelly, silently, touchfile, writefile)
|
||||
import SpecHelpers hiding (readFile)
|
||||
import SpecHelpers
|
||||
import System.Path ((</>))
|
||||
import qualified System.Path as Path
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user