mirror of
https://github.com/github/semantic.git
synced 2024-11-23 08:27:56 +03:00
First pass at switching from proto3 to proto-lens
This commit is contained in:
Timothy Clem
parent
c34b8fe568
commit
c0cce3b13b
@ -4,10 +4,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-json
|
||||
tag: 6b56fa64c2a2edad6dd460a97650327cb4c6361c
|
||||
|
||||
@ -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 {
|
||||
|
||||
@ -71,8 +71,10 @@ common dependencies
|
||||
, text ^>= 1.2.3.1
|
||||
, these >= 0.7 && <1
|
||||
, unix ^>= 2.7.2.2
|
||||
, proto3-suite
|
||||
, proto3-wire
|
||||
, microlens
|
||||
, proto-lens == 0.4.0.1
|
||||
, proto-lens-json == 0.3.0.0
|
||||
, proto-lens-runtime == 0.4.0.2
|
||||
, lingo >= 0.2.0.0
|
||||
|
||||
common executable-flags
|
||||
@ -238,6 +240,8 @@ library
|
||||
-- High-level flow & operational functionality (logging, stats, etc.)
|
||||
, Semantic.Analysis
|
||||
-- API
|
||||
, Proto.Semantic
|
||||
, Proto.Semantic_Fields
|
||||
, Semantic.Api
|
||||
, Semantic.Api.Bridge
|
||||
, Semantic.Api.Diffs
|
||||
@ -245,7 +249,6 @@ library
|
||||
, Semantic.Api.Symbols
|
||||
, Semantic.Api.Terms
|
||||
, Semantic.Api.TOCSummaries
|
||||
, Semantic.Proto.SemanticPB
|
||||
, Semantic.AST
|
||||
, Semantic.CLI
|
||||
, Semantic.Config
|
||||
|
||||
@ -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)]
|
||||
|
||||
2619
src/Proto/Semantic.hs
Normal file
2619
src/Proto/Semantic.hs
Normal file
File diff suppressed because it is too large
Load Diff
423
src/Proto/Semantic_Fields.hs
Normal file
423
src/Proto/Semantic_Fields.hs
Normal file
@ -0,0 +1,423 @@
|
||||
{- 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 #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-imports#-}
|
||||
{-# 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.Word as Data.Word
|
||||
import qualified Data.ProtoLens.Runtime.Data.ProtoLens
|
||||
as Data.ProtoLens
|
||||
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.Lens.Labels as Lens.Labels
|
||||
import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read
|
||||
|
||||
after ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "after" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
after
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "after")
|
||||
afterSpan ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "afterSpan" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
afterSpan
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "afterSpan")
|
||||
afterTerm ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "afterTerm" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
afterTerm
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "afterTerm")
|
||||
before ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "before" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
before
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "before")
|
||||
beforeSpan ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "beforeSpan" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
beforeSpan
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "beforeSpan")
|
||||
beforeTerm ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "beforeTerm" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
beforeTerm
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "beforeTerm")
|
||||
blobOid ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "blobOid" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
blobOid
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "blobOid")
|
||||
blobs ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "blobs" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
blobs
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "blobs")
|
||||
category ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "category" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
category
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "category")
|
||||
changeType ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "changeType" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
changeType
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "changeType")
|
||||
changes ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "changes" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
changes
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "changes")
|
||||
column ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "column" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
column
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "column")
|
||||
content ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "content" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
content
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "content")
|
||||
deleted ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "deleted" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
deleted
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "deleted")
|
||||
diffVertexId ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "diffVertexId" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
diffVertexId
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "diffVertexId")
|
||||
docs ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "docs" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
docs
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "docs")
|
||||
docstring ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "docstring" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
docstring
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "docstring")
|
||||
edges ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "edges" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
edges
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "edges")
|
||||
end ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "end" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
end
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "end")
|
||||
error ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "error" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
error
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "error")
|
||||
errors ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "errors" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
errors
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "errors")
|
||||
files ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "files" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
files
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "files")
|
||||
hostname ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "hostname" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
hostname
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "hostname")
|
||||
inserted ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "inserted" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
inserted
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "inserted")
|
||||
kind ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "kind" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
kind
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "kind")
|
||||
language ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "language" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
language
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "language")
|
||||
line ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "line" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
line
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "line")
|
||||
maybe'after ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'after" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'after
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'after")
|
||||
maybe'afterSpan ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'afterSpan" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'afterSpan
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'afterSpan")
|
||||
maybe'before ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'before" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'before
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'before")
|
||||
maybe'beforeSpan ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'beforeSpan" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'beforeSpan
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'beforeSpan")
|
||||
maybe'deleted ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'deleted" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'deleted
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'deleted")
|
||||
maybe'diffTerm ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'diffTerm" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'diffTerm
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'diffTerm")
|
||||
maybe'docs ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'docs" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'docs
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'docs")
|
||||
maybe'end ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'end" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'end
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'end")
|
||||
maybe'inserted ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'inserted" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'inserted
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'inserted")
|
||||
maybe'merged ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'merged" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'merged
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'merged")
|
||||
maybe'replaced ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'replaced" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'replaced
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'replaced")
|
||||
maybe'span ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'span" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'span
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'span")
|
||||
maybe'start ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "maybe'start" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
maybe'start
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'start")
|
||||
merged ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "merged" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
merged
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "merged")
|
||||
path ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "path" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
path
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "path")
|
||||
replaced ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "replaced" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
replaced
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "replaced")
|
||||
service ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "service" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
service
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "service")
|
||||
sha ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "sha" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
sha
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "sha")
|
||||
source ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "source" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
source
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "source")
|
||||
span ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "span" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
span
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "span")
|
||||
start ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "start" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
start
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "start")
|
||||
status ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "status" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
status
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "status")
|
||||
symbol ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "symbol" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
symbol
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "symbol")
|
||||
symbols ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "symbols" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
symbols
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "symbols")
|
||||
target ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "target" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
target
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "target")
|
||||
term ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "term" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
term
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "term")
|
||||
timestamp ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "timestamp" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
timestamp
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "timestamp")
|
||||
vertexId ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "vertexId" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
vertexId
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "vertexId")
|
||||
vertices ::
|
||||
forall f s a .
|
||||
(Prelude.Functor f, Lens.Labels.HasLens' s "vertices" a) =>
|
||||
Lens.Family2.LensLike' f s a
|
||||
vertices
|
||||
= Lens.Labels.lensOf'
|
||||
((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "vertices")
|
||||
@ -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 x) -> [ "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,40 @@ 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 (Deleted (Just (DeletedTerm beforeName beforeSpan))) <*> diffAlgebra t2 (Inserted (Just (InsertedTerm afterName 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 +121,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
|
||||
|
||||
@ -23,23 +23,25 @@ import Data.Diff
|
||||
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 Parsing.Parser
|
||||
import Prologue
|
||||
import Proto.Semantic as P hiding (Blob, BlobPair)
|
||||
import Proto.Semantic_Fields as P
|
||||
import Rendering.Graph
|
||||
import Rendering.JSON hiding (JSON)
|
||||
import qualified Rendering.JSON
|
||||
import Semantic.Api.Bridge
|
||||
import Semantic.Proto.SemanticPB hiding (Blob, BlobPair)
|
||||
import Semantic.Task as Task
|
||||
import Semantic.Telemetry as Stat
|
||||
import Serializing.Format hiding (JSON)
|
||||
import qualified Serializing.Format as Format
|
||||
import Source.Loc
|
||||
|
||||
|
||||
data DiffOutputFormat
|
||||
= DiffJSONTree
|
||||
| DiffJSONGraph
|
||||
@ -50,7 +52,7 @@ data DiffOutputFormat
|
||||
|
||||
parseDiffBuilder :: (Traversable t, DiffEffects sig m) => DiffOutputFormat -> t BlobPair -> m Builder
|
||||
parseDiffBuilder DiffJSONTree = distributeFoldMap (jsonDiff renderJSONTree) >=> 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 DiffJSONGraph = diffGraph >=> serialize Format.JSONPB
|
||||
parseDiffBuilder DiffSExpression = distributeFoldMap sexpDiff
|
||||
parseDiffBuilder DiffShow = distributeFoldMap showDiff
|
||||
parseDiffBuilder DiffDotGraph = distributeFoldMap dotGraphDiff
|
||||
@ -67,12 +69,20 @@ renderJSONTree :: (Applicative m, ToJSONFields1 syntax) => BlobPair -> Diff synt
|
||||
renderJSONTree blobPair = pure . renderJSONDiff blobPair
|
||||
|
||||
diffGraph :: (Traversable t, DiffEffects sig m) => t BlobPair -> m DiffTreeGraphResponse
|
||||
diffGraph blobs = DiffTreeGraphResponse . V.fromList . toList <$> distributeFor blobs go
|
||||
-- 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 = doDiff blobPair (const pure) render
|
||||
`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
|
||||
@ -80,8 +90,13 @@ diffGraph blobs = DiffTreeGraphResponse . V.fromList . toList <$> distributeFor
|
||||
render :: (Foldable syntax, Functor syntax, ConstructorName syntax, Applicative m) => BlobPair -> Diff syntax Loc Loc -> m DiffTreeFileGraph
|
||||
render _ diff =
|
||||
let graph = renderTreeGraph diff
|
||||
toEdge (Edge (a, b)) = DiffTreeEdge (diffVertexId a) (diffVertexId b)
|
||||
in pure $ DiffTreeFileGraph path lang (V.fromList (vertexList graph)) (V.fromList (fmap toEdge (edgeList graph))) mempty
|
||||
toEdge (Edge (a, b)) = defMessage & P.source .~ a^.diffVertexId & P.target .~ b^.diffVertexId
|
||||
in pure $ defMessage
|
||||
& P.path .~ path
|
||||
& P.language .~ lang
|
||||
& P.vertices .~ vertexList graph
|
||||
& P.edges .~ fmap toEdge (edgeList graph)
|
||||
& P.errors .~ mempty
|
||||
|
||||
|
||||
sexpDiff :: (DiffEffects sig m) => BlobPair -> m Builder
|
||||
|
||||
@ -7,26 +7,28 @@ module Semantic.Api.Symbols
|
||||
|
||||
import Control.Effect.Error
|
||||
import Control.Exception
|
||||
import Control.Lens
|
||||
import Data.Blob hiding (File (..))
|
||||
import Data.ByteString.Builder
|
||||
import Data.Maybe
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Text (pack)
|
||||
import Parsing.Parser
|
||||
import Prologue
|
||||
import Semantic.Api.Bridge
|
||||
import qualified Semantic.Api.LegacyTypes as Legacy
|
||||
import Semantic.Api.Terms (ParseEffects, doParse)
|
||||
import Semantic.Proto.SemanticPB hiding (Blob)
|
||||
import Semantic.Task
|
||||
import Serializing.Format
|
||||
import Source.Loc
|
||||
import Tags.Taggable
|
||||
import Tags.Tagging
|
||||
|
||||
import Control.Lens
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Proto.Semantic as P hiding (Blob)
|
||||
import Proto.Semantic_Fields as P
|
||||
|
||||
legacyParseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m Legacy.ParseTreeSymbolResponse
|
||||
legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap go blobs
|
||||
where
|
||||
@ -58,14 +60,21 @@ parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t
|
||||
parseSymbolsBuilder format blobs = parseSymbols blobs >>= serialize format
|
||||
|
||||
parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
|
||||
parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
|
||||
parseSymbols blobs = do -- ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go
|
||||
terms <- distributeFor blobs go
|
||||
pure $ defMessage & P.files .~ toList terms
|
||||
where
|
||||
go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m File
|
||||
go blob@Blob{..} = (doParse blob >>= withSomeTerm renderToSymbols) `catchError` (\(SomeException e) -> pure $ errorFile (show e))
|
||||
where
|
||||
blobLanguage' = blobLanguage blob
|
||||
blobPath' = pack $ blobPath blob
|
||||
errorFile e = File blobPath' (bridging # blobLanguage blob) mempty (V.fromList [ParseError (T.pack e)]) blobOid
|
||||
errorFile e = defMessage
|
||||
& P.path .~ blobPath'
|
||||
& P.language .~ (bridging # blobLanguage blob)
|
||||
& P.symbols .~ mempty
|
||||
& P.errors .~ [defMessage & P.error .~ T.pack e]
|
||||
& P.blobOid .~ blobOid
|
||||
|
||||
symbolsToSummarize :: [Text]
|
||||
symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
|
||||
@ -74,14 +83,19 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
|
||||
renderToSymbols term = pure $ tagsToFile (runTagging blob symbolsToSummarize 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{..}
|
||||
= Symbol
|
||||
{ symbol = name
|
||||
, kind = kind
|
||||
, line = fromMaybe mempty line
|
||||
, span = converting #? span
|
||||
, docs = fmap Docstring docs
|
||||
}
|
||||
tagToSymbol Tag{..} = defMessage
|
||||
& P.symbol .~ name
|
||||
& P.kind .~ kind
|
||||
& P.line .~ fromMaybe mempty line
|
||||
& P.maybe'span .~ converting #? span
|
||||
& P.maybe'docs .~ case docs of
|
||||
Just d -> Just (defMessage & P.docstring .~ d)
|
||||
Nothing -> Nothing
|
||||
|
||||
@ -3,22 +3,24 @@ module Semantic.Api.TOCSummaries (diffSummary, legacyDiffSummary, diffSummaryBui
|
||||
|
||||
import Analysis.TOCSummary (Declaration, declarationAlgebra)
|
||||
import Control.Effect.Error
|
||||
import Control.Lens
|
||||
import Data.Aeson
|
||||
import Data.Blob
|
||||
import Data.ByteString.Builder
|
||||
import Data.Diff
|
||||
import qualified Data.Map.Monoidal as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Semilattice.Lower
|
||||
import Rendering.TOC
|
||||
import Semantic.Api.Diffs
|
||||
import Semantic.Api.Bridge
|
||||
import Semantic.Proto.SemanticPB hiding (Blob, BlobPair)
|
||||
import Semantic.Task as Task
|
||||
import Serializing.Format
|
||||
|
||||
import Control.Lens
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Proto.Semantic as P hiding (Blob, BlobPair)
|
||||
import Proto.Semantic_Fields as P
|
||||
|
||||
diffSummaryBuilder :: (DiffEffects sig m) => Format DiffTreeTOCResponse -> [BlobPair] -> m Builder
|
||||
diffSummaryBuilder format blobs = diffSummary blobs >>= serialize format
|
||||
|
||||
@ -36,29 +38,42 @@ legacyDiffSummary = distributeFoldMap go
|
||||
render blobPair = pure . renderToCDiff blobPair
|
||||
|
||||
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 = doDiff blobPair (decorate . declarationAlgebra) render
|
||||
`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
|
||||
|
||||
render :: (Foldable syntax, Functor syntax, Applicative m) => BlobPair -> Diff syntax (Maybe Declaration) (Maybe Declaration) -> m TOCSummaryFile
|
||||
render blobPair diff = pure $ foldr go (TOCSummaryFile path lang mempty mempty) (diffTOC diff)
|
||||
render blobPair diff = pure $ foldr go (defMessage & P.path .~ path & P.language .~ lang & P.changes .~ mempty & P.errors .~ mempty) (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
|
||||
|
||||
@ -16,7 +16,6 @@ module Semantic.Api.Terms
|
||||
|
||||
import Analysis.ConstructorName (ConstructorName)
|
||||
import Control.Effect.Error
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Abstract.Declarations
|
||||
@ -29,35 +28,51 @@ import Data.Language
|
||||
import Data.Quieterm
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Parsing.Parser
|
||||
import Prologue
|
||||
import Rendering.Graph
|
||||
import Rendering.JSON hiding (JSON)
|
||||
import qualified Rendering.JSON
|
||||
import Semantic.Api.Bridge
|
||||
import Semantic.Proto.SemanticPB hiding (Blob)
|
||||
import Semantic.Task
|
||||
import Serializing.Format hiding (JSON)
|
||||
import qualified Serializing.Format as Format
|
||||
import Source.Loc
|
||||
import Tags.Taggable
|
||||
|
||||
import Control.Lens
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Proto.Semantic as P hiding (Blob)
|
||||
import Proto.Semantic_Fields as P
|
||||
|
||||
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 = (doParse blob >>= withSomeTerm (pure . render))
|
||||
`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
|
||||
|
||||
render :: (Foldable syntax, Functor syntax, ConstructorName syntax) => Term syntax Loc -> ParseTreeFileGraph
|
||||
render 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
|
||||
toEdge (Edge (a, b)) = defMessage & P.source .~ a^.vertexId & P.target .~ b^.vertexId
|
||||
in defMessage
|
||||
& P.path .~ path
|
||||
& P.language .~ lang
|
||||
& P.vertices .~ vertexList graph
|
||||
& P.edges .~ fmap toEdge (edgeList graph)
|
||||
& P.errors .~ mempty
|
||||
|
||||
data TermOutputFormat
|
||||
= TermJSONTree
|
||||
@ -71,7 +86,7 @@ data TermOutputFormat
|
||||
parseTermBuilder :: (Traversable t, Member Distribute sig, ParseEffects sig m, MonadIO m)
|
||||
=> TermOutputFormat-> t Blob -> m Builder
|
||||
parseTermBuilder TermJSONTree = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs.
|
||||
parseTermBuilder TermJSONGraph = termGraph >=> serialize Format.JSON
|
||||
parseTermBuilder TermJSONGraph = termGraph >=> serialize Format.JSONPB
|
||||
parseTermBuilder TermSExpression = distributeFoldMap sexpTerm
|
||||
parseTermBuilder TermDotGraph = distributeFoldMap dotGraphTerm
|
||||
parseTermBuilder TermShow = distributeFoldMap showTerm
|
||||
|
||||
@ -91,7 +91,7 @@ diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute change
|
||||
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' (diffSummaryBuilder JSON) (long "toc" <> help "Output JSON table of contents diff summary")
|
||||
<|> flag' (diffSummaryBuilder JSONPB) (long "toc" <> help "Output JSON table of contents diff summary")
|
||||
<|> 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 (Both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin)
|
||||
@ -104,8 +104,8 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
|
||||
renderer <- flag (parseTermBuilder TermSExpression) (parseTermBuilder TermSExpression) (long "sexpression" <> help "Output s-expression parse trees (default)")
|
||||
<|> flag' (parseTermBuilder TermJSONTree) (long "json" <> help "Output JSON parse trees")
|
||||
<|> flag' (parseTermBuilder TermJSONGraph) (long "json-graph" <> help "Output JSON adjacency list")
|
||||
<|> flag' (parseSymbolsBuilder JSON) (long "symbols" <> help "Output JSON symbol list")
|
||||
<|> flag' (parseSymbolsBuilder JSON) (long "json-symbols" <> help "Output JSON symbol list")
|
||||
<|> flag' (parseSymbolsBuilder JSONPB) (long "symbols" <> help "Output JSON symbol list")
|
||||
<|> flag' (parseSymbolsBuilder JSONPB) (long "json-symbols" <> help "Output JSON symbol list")
|
||||
<|> flag' (parseSymbolsBuilder Proto) (long "proto-symbols" <> help "Output JSON symbol list")
|
||||
<|> flag' (parseTermBuilder TermDotGraph) (long "dot" <> help "Output DOT graph parse trees")
|
||||
<|> flag' (parseTermBuilder TermShow) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)")
|
||||
|
||||
@ -14,13 +14,16 @@ 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.JSON as Proto (messageToEncoding)
|
||||
import Data.ProtoLens.Message (Message)
|
||||
import Serializing.SExpression
|
||||
import Text.Show.Pretty
|
||||
|
||||
data Format input where
|
||||
DOT :: (Ord vertex, ToGraph graph, ToVertex graph ~ vertex) => Style vertex Builder -> Format graph
|
||||
JSON :: ToJSON input => Format input
|
||||
JSONPB :: Message input => Format input
|
||||
SExpression :: (Recursive input, ToSExpression (Base input)) => Options -> Format input
|
||||
Show :: Show input => Format input
|
||||
Proto :: Message input => Format input
|
||||
@ -33,4 +36,5 @@ 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 _ JSONPB = fromEncoding . Proto.messageToEncoding
|
||||
runSerialize _ Proto = Proto.buildMessage -- lazyByteString . Proto3.toLazyByteString
|
||||
|
||||
Loading…
Reference in New Issue
Block a user