mirror of
https://github.com/github/semantic.git
synced 2024-12-27 00:44:57 +03:00
Write out custom To/FromJSON instances
This commit is contained in:
Timothy Clem
parent
cba98ae288
commit
fccbe6aa58
@ -72,7 +72,6 @@ common dependencies
|
||||
, these >= 0.7 && <1
|
||||
, unix ^>= 2.7.2.2
|
||||
, proto-lens == 0.5.1.0
|
||||
, proto-lens-json == 0.3.0.0
|
||||
, proto-lens-runtime == 0.5.0.0
|
||||
, lingo >= 0.2.0.0
|
||||
|
||||
|
||||
@ -2,11 +2,17 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
module Proto.Semantic_JSON where
|
||||
|
||||
import Control.Lens hiding ((.=))
|
||||
import Data.Aeson as A
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Proto.Semantic as P
|
||||
import Proto.Semantic_Fields as P
|
||||
import Control.Lens hiding ((.=))
|
||||
import Control.Monad (msum)
|
||||
import Data.Aeson as A
|
||||
import qualified Data.Aeson.Encoding as E
|
||||
import Data.Aeson.Types (parseField)
|
||||
import Data.ProtoLens (defMessage)
|
||||
import qualified Data.Text as T
|
||||
import Prelude hiding (error, span)
|
||||
import Proto.Semantic as P
|
||||
import Proto.Semantic_Fields as P
|
||||
|
||||
|
||||
instance FromJSON PingRequest where
|
||||
parseJSON = withObject "PingRequest" $ \obj -> do
|
||||
@ -41,3 +47,456 @@ instance ToJSON PingResponse where
|
||||
<> "hostname" .= (x^.hostname)
|
||||
<> "timestamp" .= (x^.timestamp)
|
||||
<> "sha" .= (x^.sha)
|
||||
|
||||
instance FromJSON ParseTreeRequest where
|
||||
parseJSON = withObject "ParseTreeRequest" $ \obj -> do
|
||||
blobs <- obj .: "blobs"
|
||||
pure $ defMessage & P.blobs .~ blobs
|
||||
|
||||
instance ToJSON ParseTreeRequest where
|
||||
toJSON x = object [ "blobs" .= (x^.blobs) ]
|
||||
toEncoding x = pairs $ "blobs" .= (x^.blobs)
|
||||
|
||||
instance FromJSON Blob where
|
||||
parseJSON = 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 ToJSON Blob where
|
||||
toJSON x = object
|
||||
[ "content" .= (x^.content)
|
||||
, "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"content" .= (x^.content)
|
||||
<> "path" .= (x^.path)
|
||||
<> "language" .= (x^.language)
|
||||
|
||||
instance FromJSON ParseTreeSymbolResponse where
|
||||
parseJSON = withObject "ParseTreeSymbolResponse" $ \obj -> do
|
||||
files <- obj .: "files"
|
||||
pure $ defMessage & P.files .~ files
|
||||
|
||||
instance ToJSON ParseTreeSymbolResponse where
|
||||
toJSON x = object [ "files" .= (x^.files) ]
|
||||
toEncoding x = pairs $ "files" .= (x^.files)
|
||||
|
||||
instance FromJSON ParseTreeGraphResponse where
|
||||
parseJSON = withObject "ParseTreeGraphResponse" $ \obj -> do
|
||||
files <- obj .: "files"
|
||||
pure $ defMessage & P.files .~ files
|
||||
|
||||
instance ToJSON ParseTreeGraphResponse where
|
||||
toJSON x = object [ "files" .= (x^.files) ]
|
||||
toEncoding x = pairs $ "files" .= (x^.files)
|
||||
|
||||
instance FromJSON ParseTreeFileGraph where
|
||||
parseJSON = 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 ToJSON ParseTreeFileGraph where
|
||||
toJSON x = object
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "vertices" .= (x^.vertices)
|
||||
, "edges" .= (x^.edges)
|
||||
, "errors" .= (x^.errors)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"path" .= (x^.path)
|
||||
<> "language" .= (x^.language)
|
||||
<> "vertices" .= (x^.vertices)
|
||||
<> "edges" .= (x^.edges)
|
||||
<> "errors" .= (x^.errors)
|
||||
|
||||
instance FromJSON TermEdge where
|
||||
parseJSON = withObject "TermEdge" $ \obj -> do
|
||||
source <- obj .: "source"
|
||||
target <- obj .: "target"
|
||||
pure $ defMessage & P.source .~ source & P.target .~ target
|
||||
|
||||
instance ToJSON TermEdge where
|
||||
toJSON x = object [ "source" .= (x^.source), "target" .= (x^.target) ]
|
||||
toEncoding x = pairs $ "source" .= (x^.source) <> "target" .= (x^.target)
|
||||
|
||||
instance FromJSON TermVertex where
|
||||
parseJSON = withObject "TermVertex" $ \obj -> do
|
||||
vertexId <- obj .: "vertexId"
|
||||
term <- obj .: "term"
|
||||
span <- obj .: "span"
|
||||
pure $ defMessage
|
||||
& P.vertexId .~ vertexId
|
||||
& P.term .~ term
|
||||
& P.span .~ span
|
||||
|
||||
instance ToJSON TermVertex where
|
||||
toJSON x = object
|
||||
[ "vertexId" .= (x^.vertexId)
|
||||
, "term" .= (x^.term)
|
||||
, "span" .= (x^.span)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"vertexId" .= (x^.vertexId)
|
||||
<> "term" .= (x^.term)
|
||||
<> "span" .= (x^.span)
|
||||
|
||||
instance FromJSON File where
|
||||
parseJSON = 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 ToJSON File where
|
||||
toJSON x = object
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "symbols" .= (x^.symbols)
|
||||
, "errors" .= (x^.errors)
|
||||
, "blobOid" .= (x^.blobOid)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"path" .= (x^.path)
|
||||
<> "language" .= (x^.language)
|
||||
<> "symbols" .= (x^.symbols)
|
||||
<> "errors" .= (x^.errors)
|
||||
<> "blobOid" .= (x^.blobOid)
|
||||
|
||||
instance FromJSON Symbol where
|
||||
parseJSON = withObject "Symbol" $ \obj -> do
|
||||
symbol <- obj .: "symbol"
|
||||
kind <- obj .: "kind"
|
||||
line <- obj .: "line"
|
||||
span <- obj .: "span"
|
||||
docs <- obj .: "docs"
|
||||
pure $ defMessage
|
||||
& P.symbol .~ symbol
|
||||
& P.kind .~ kind
|
||||
& P.line .~ line
|
||||
& P.span .~ span
|
||||
& P.docs .~ docs
|
||||
|
||||
instance ToJSON Symbol where
|
||||
toJSON x = object
|
||||
[ "symbol" .= (x^.symbol)
|
||||
, "kind" .= (x^.kind)
|
||||
, "line" .= (x^.line)
|
||||
, "span" .= (x^.span)
|
||||
, "docs" .= (x^.docs)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"symbol" .= (x^.symbol)
|
||||
<> "kind" .= (x^.kind)
|
||||
<> "line" .= (x^.line)
|
||||
<> "span" .= (x^.span)
|
||||
<> "docs" .= (x^.docs)
|
||||
|
||||
instance FromJSON Span where
|
||||
parseJSON = withObject "Span" $ \obj -> do
|
||||
start <- obj .: "start"
|
||||
end <- obj .: "end"
|
||||
pure $ defMessage & P.start .~ start & P.end .~ end
|
||||
|
||||
instance ToJSON Span where
|
||||
toJSON x = object [ "start" .= (x^.start) , "end" .= (x^.end) ]
|
||||
toEncoding x = pairs $ "start" .= (x^.start) <> "end" .= (x^.end)
|
||||
|
||||
instance FromJSON Position where
|
||||
parseJSON = withObject "Position" $ \obj -> do
|
||||
line <- obj .: "line"
|
||||
column <- obj .: "column"
|
||||
pure $ defMessage & P.line .~ line & P.column .~ column
|
||||
|
||||
instance ToJSON Position where
|
||||
toJSON x = object [ "line" .= (x^.line) , "column" .= (x^.column) ]
|
||||
toEncoding x = pairs $ "line" .= (x^.line) <> "column" .= (x^.column)
|
||||
|
||||
instance FromJSON Docstring where
|
||||
parseJSON = withObject "Docstring" $ \obj -> do
|
||||
docstring <- obj .: "docstring"
|
||||
pure $ defMessage & P.docstring .~ docstring
|
||||
|
||||
instance ToJSON Docstring where
|
||||
toJSON x = object [ "docstring" .= (x^.docstring) ]
|
||||
toEncoding x = pairs $ "docstring" .= (x^.docstring)
|
||||
|
||||
instance FromJSON ParseError where
|
||||
parseJSON = withObject "ParseError" $ \obj -> do
|
||||
error <- obj .: "error"
|
||||
pure $ defMessage & P.error .~ error
|
||||
|
||||
instance ToJSON ParseError where
|
||||
toJSON x = object [ "error" .= (x^.error) ]
|
||||
toEncoding x = pairs $ "error" .= (x^.error)
|
||||
|
||||
instance FromJSON DiffTreeRequest where
|
||||
parseJSON = withObject "DiffTreeRequest" $ \obj -> do
|
||||
blobs <- obj .: "blobs"
|
||||
pure $ defMessage & P.blobs .~ blobs
|
||||
|
||||
instance ToJSON DiffTreeRequest where
|
||||
toJSON x = object [ "blobs" .= (x^.blobs) ]
|
||||
toEncoding x = pairs $ "blobs" .= (x^.blobs)
|
||||
|
||||
instance FromJSON BlobPair where
|
||||
parseJSON = withObject "BlobPair" $ \obj -> do
|
||||
before <- obj .: "before"
|
||||
after <- obj .: "after"
|
||||
pure $ defMessage & P.before .~ before & P.after .~ after
|
||||
|
||||
instance ToJSON BlobPair where
|
||||
toJSON x = object [ "before" .= (x^.before), "after" .= (x^.after) ]
|
||||
toEncoding x = pairs $ "before" .= (x^.before) <> "after" .= (x^.after)
|
||||
|
||||
instance FromJSON DiffTreeTOCResponse where
|
||||
parseJSON = withObject "DiffTreeTOCResponse" $ \obj -> do
|
||||
files <- obj .: "files"
|
||||
pure $ defMessage & P.files .~ files
|
||||
|
||||
instance ToJSON DiffTreeTOCResponse where
|
||||
toJSON x = object [ "files" .= (x^.files) ]
|
||||
toEncoding x = pairs $ "files" .= (x^.files)
|
||||
|
||||
instance FromJSON TOCSummaryFile where
|
||||
parseJSON = 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 ToJSON TOCSummaryFile where
|
||||
toJSON x = object
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "changes" .= (x^.changes)
|
||||
, "errors" .= (x^.errors)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"path" .= (x^.path)
|
||||
<> "language" .= (x^.language)
|
||||
<> "changes" .= (x^.changes)
|
||||
<> "errors" .= (x^.errors)
|
||||
|
||||
instance FromJSON TOCSummaryChange where
|
||||
parseJSON = withObject "TOCSummaryChange" $ \obj -> do
|
||||
category <- obj .: "category"
|
||||
term <- obj .: "term"
|
||||
span <- obj .: "span"
|
||||
changeType <- obj .: "changeType"
|
||||
pure $ defMessage
|
||||
& P.category .~ category
|
||||
& P.term .~ term
|
||||
& P.span .~ span
|
||||
& P.changeType .~ changeType
|
||||
|
||||
instance ToJSON TOCSummaryChange where
|
||||
toJSON x = object
|
||||
[ "category" .= (x^.category)
|
||||
, "term" .= (x^.term)
|
||||
, "span" .= (x^.span)
|
||||
, "changeType" .= (x^.changeType)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"category" .= (x^.category)
|
||||
<> "term" .= (x^.term)
|
||||
<> "span" .= (x^.span)
|
||||
<> "changeType" .= (x^.changeType)
|
||||
|
||||
instance FromJSON TOCSummaryError where
|
||||
parseJSON = withObject "TOCSummaryError" $ \obj -> do
|
||||
error <- obj .: "error"
|
||||
span <- obj .: "span"
|
||||
pure $ defMessage & P.error .~ error & P.span .~ span
|
||||
|
||||
instance ToJSON TOCSummaryError where
|
||||
toJSON x = object [ "error" .= (x^.error), "span" .= (x^.span) ]
|
||||
toEncoding x = pairs $ "error" .= (x^.error) <> "span" .= (x^.span)
|
||||
|
||||
instance FromJSON ChangeType where
|
||||
parseJSON (A.String "NONE") = pure NONE
|
||||
parseJSON (A.String "ADDED") = pure ADDED
|
||||
parseJSON (A.String "REMOVED") = pure REMOVED
|
||||
parseJSON (A.String "MODIFIED") = pure MODIFIED
|
||||
parseJSON _ = fail "unexpected ChangeType"
|
||||
|
||||
instance ToJSON ChangeType where
|
||||
toJSON x = A.String . T.toUpper . T.pack $ show x
|
||||
toEncoding x = E.text . T.toUpper . T.pack $ show x
|
||||
|
||||
instance FromJSON DiffTreeGraphResponse where
|
||||
parseJSON = withObject "DiffTreeGraphResponse" $ \obj -> do
|
||||
files <- obj .: "files"
|
||||
pure $ defMessage & P.files .~ files
|
||||
|
||||
instance ToJSON DiffTreeGraphResponse where
|
||||
toJSON x = object [ "files" .= (x^.files) ]
|
||||
toEncoding x = pairs $ "files" .= (x^.files)
|
||||
|
||||
instance FromJSON DiffTreeFileGraph where
|
||||
parseJSON = 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 ToJSON DiffTreeFileGraph where
|
||||
toJSON x = object
|
||||
[ "path" .= (x^.path)
|
||||
, "language" .= (x^.language)
|
||||
, "vertices" .= (x^.vertices)
|
||||
, "edges" .= (x^.edges)
|
||||
, "errors" .= (x^.errors)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"path" .= (x^.path)
|
||||
<> "language" .= (x^.language)
|
||||
<> "vertices" .= (x^.vertices)
|
||||
<> "edges" .= (x^.edges)
|
||||
<> "errors" .= (x^.errors)
|
||||
|
||||
instance FromJSON DiffTreeEdge where
|
||||
parseJSON = withObject "DiffTreeEdge" $ \obj -> do
|
||||
source <- obj .: "source"
|
||||
target <- obj .: "target"
|
||||
pure $ defMessage & P.source .~ source & P.target .~ target
|
||||
|
||||
instance ToJSON DiffTreeEdge where
|
||||
toJSON x = object [ "source" .= (x^.source), "target" .= (x^.target) ]
|
||||
toEncoding x = pairs $ "source" .= (x^.source) <> "target" .= (x^.target)
|
||||
|
||||
instance FromJSON DiffTreeVertex where
|
||||
parseJSON = withObject "DiffTreeVertex" $ \obj -> do
|
||||
diffVertexId <- obj .: "diffVertexId"
|
||||
diffTerm <- obj .: "diffTerm"
|
||||
pure $ defMessage
|
||||
& P.diffVertexId .~ diffVertexId
|
||||
& P.maybe'diffTerm .~ diffTerm
|
||||
|
||||
instance ToJSON DiffTreeVertex where
|
||||
toJSON x = object
|
||||
[ "diffVertexId" .= (x^.diffVertexId)
|
||||
, "diffTerm" .= (x^.maybe'diffTerm)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"diffVertexId" .= (x^.diffVertexId)
|
||||
<> "diffTerm" .= (x^.maybe'diffTerm)
|
||||
|
||||
instance FromJSON DiffTreeVertex'DiffTerm where
|
||||
parseJSON = withObject "DiffTreeVertexDiffTerm" $ \obj -> msum
|
||||
[
|
||||
DiffTreeVertex'Deleted <$> parseField obj "deleted"
|
||||
, DiffTreeVertex'Inserted <$> parseField obj "inserted"
|
||||
, DiffTreeVertex'Replaced <$> parseField obj "replaced"
|
||||
, DiffTreeVertex'Merged <$> parseField obj "merged"
|
||||
]
|
||||
|
||||
instance ToJSON DiffTreeVertex'DiffTerm where
|
||||
toJSON (DiffTreeVertex'Deleted x) = object [ "deleted" .= x ]
|
||||
toJSON (DiffTreeVertex'Inserted x) = object [ "inserted" .= x ]
|
||||
toJSON (DiffTreeVertex'Replaced x) = object [ "replaced" .= x ]
|
||||
toJSON (DiffTreeVertex'Merged x) = object [ "merged" .= x ]
|
||||
toEncoding (DiffTreeVertex'Deleted x) = pairs $ "deleted" .= x
|
||||
toEncoding (DiffTreeVertex'Inserted x) = pairs $ "inserted" .= x
|
||||
toEncoding (DiffTreeVertex'Replaced x) = pairs $ "replaced" .= x
|
||||
toEncoding (DiffTreeVertex'Merged x) = pairs $ "merged" .= x
|
||||
|
||||
instance FromJSON MergedTerm where
|
||||
parseJSON = withObject "MergedTerm" $ \obj -> do
|
||||
term <- obj .: "term"
|
||||
beforeSpan <- obj .: "beforeSpan"
|
||||
afterSpan <- obj .: "afterSpan"
|
||||
pure $ defMessage
|
||||
& P.term .~ term
|
||||
& P.beforeSpan .~ beforeSpan
|
||||
& P.afterSpan .~ afterSpan
|
||||
|
||||
instance ToJSON MergedTerm where
|
||||
toJSON x = object
|
||||
[ "term" .= (x^.term)
|
||||
, "beforeSpan" .= (x^.beforeSpan)
|
||||
, "afterSpan" .= (x^.afterSpan)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"term" .= (x^.term)
|
||||
<> "beforeSpan" .= (x^.beforeSpan)
|
||||
<> "afterSpan" .= (x^.afterSpan)
|
||||
|
||||
instance FromJSON ReplacedTerm where
|
||||
parseJSON = withObject "ReplacedTerm" $ \obj -> do
|
||||
beforeTerm <- obj .: "beforeTerm"
|
||||
beforeSpan <- obj .: "beforeSpan"
|
||||
afterTerm <- obj .: "afterTerm"
|
||||
afterSpan <- obj .: "afterSpan"
|
||||
pure $ defMessage
|
||||
& P.beforeTerm .~ beforeTerm
|
||||
& P.beforeSpan .~ beforeSpan
|
||||
& P.afterTerm .~ afterTerm
|
||||
& P.afterSpan .~ afterSpan
|
||||
|
||||
instance ToJSON ReplacedTerm where
|
||||
toJSON x = object
|
||||
[ "beforeTerm" .= (x^.beforeTerm)
|
||||
, "beforeSpan" .= (x^.beforeSpan)
|
||||
, "afterTerm" .= (x^.afterTerm)
|
||||
, "afterSpan" .= (x^.afterSpan)
|
||||
]
|
||||
toEncoding x = pairs $
|
||||
"beforeTerm" .= (x^.beforeTerm)
|
||||
<> "beforeSpan" .= (x^.beforeSpan)
|
||||
<> "afterTerm" .= (x^.afterTerm)
|
||||
<> "afterSpan" .= (x^.afterSpan)
|
||||
|
||||
instance FromJSON InsertedTerm where
|
||||
parseJSON = withObject "InsertedTerm" $ \obj -> do
|
||||
term <- obj .: "term"
|
||||
span <- obj .: "span"
|
||||
pure $ defMessage & P.term .~ term & P.span .~ span
|
||||
|
||||
instance ToJSON InsertedTerm where
|
||||
toJSON x = object [ "term" .= (x^.term), "span" .= (x^.span) ]
|
||||
toEncoding x = pairs $ "term" .= (x^.term) <> "span" .= (x^.span)
|
||||
|
||||
instance FromJSON DeletedTerm where
|
||||
parseJSON = withObject "DeletedTerm" $ \obj -> do
|
||||
term <- obj .: "term"
|
||||
span <- obj .: "span"
|
||||
pure $ defMessage & P.term .~ term & P.span .~ span
|
||||
|
||||
instance ToJSON DeletedTerm where
|
||||
toJSON x = object [ "term" .= (x^.term), "span" .= (x^.span) ]
|
||||
toEncoding x = pairs $ "term" .= (x^.term) <> "span" .= (x^.span)
|
||||
|
||||
@ -31,6 +31,7 @@ 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
|
||||
@ -52,7 +53,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.JSONPB
|
||||
parseDiffBuilder DiffJSONGraph = diffGraph >=> serialize Format.JSON
|
||||
parseDiffBuilder DiffSExpression = distributeFoldMap sexpDiff
|
||||
parseDiffBuilder DiffShow = distributeFoldMap showDiff
|
||||
parseDiffBuilder DiffDotGraph = distributeFoldMap dotGraphDiff
|
||||
|
||||
@ -35,6 +35,7 @@ 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
|
||||
@ -87,7 +88,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.JSONPB
|
||||
parseTermBuilder TermJSONGraph = termGraph >=> serialize Format.JSON
|
||||
parseTermBuilder TermSExpression = distributeFoldMap sexpTerm
|
||||
parseTermBuilder TermDotGraph = distributeFoldMap dotGraphTerm
|
||||
parseTermBuilder TermShow = distributeFoldMap showTerm
|
||||
|
||||
@ -32,6 +32,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)
|
||||
@ -92,7 +93,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 JSONPB) (long "toc" <> help "Output JSON table of contents diff summary")
|
||||
<|> flag' (diffSummaryBuilder JSON) (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)
|
||||
@ -119,7 +120,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
|
||||
<|> flag' (parseTermBuilder TermJSONGraph)
|
||||
( long "json-graph"
|
||||
<> help "Output JSON adjacency list")
|
||||
<|> flag' (parseSymbolsBuilder JSONPB)
|
||||
<|> flag' (parseSymbolsBuilder JSON)
|
||||
( long "symbols"
|
||||
<> long "json-symbols"
|
||||
<> help "Output JSON symbol list")
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -15,7 +15,6 @@ import Language.Haskell.HsColour
|
||||
import Language.Haskell.HsColour.Colourise
|
||||
import Prologue
|
||||
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
|
||||
@ -23,7 +22,6 @@ 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
|
||||
@ -36,5 +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 _ JSONPB = fromEncoding . Proto.messageToEncoding
|
||||
runSerialize _ Proto = Proto.buildMessage -- lazyByteString . Proto3.toLazyByteString
|
||||
runSerialize _ Proto = Proto.buildMessage
|
||||
|
||||
@ -147,22 +147,22 @@ spec = do
|
||||
describe "diff with ToCDiffRenderer'" $ do
|
||||
it "produces JSON output" $ do
|
||||
blobs <- blobsForPaths (Both (Path.relFile "ruby/toc/methods.A.rb") (Path.relFile "ruby/toc/methods.B.rb"))
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSONPB [blobs])
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
|
||||
runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb\",\"language\":\"Ruby\",\"changes\":[{\"category\":\"Method\",\"term\":\"self.foo\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"changeType\":\"ADDED\"},{\"category\":\"Method\",\"term\":\"bar\",\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":6,\"column\":4}},\"changeType\":\"MODIFIED\"},{\"category\":\"Method\",\"term\":\"baz\",\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"changeType\":\"REMOVED\"}]}]}\n" :: ByteString)
|
||||
|
||||
it "produces JSON output if there are parse errors" $ do
|
||||
blobs <- blobsForPaths (Both (Path.relFile "ruby/toc/methods.A.rb") (Path.relFile "ruby/toc/methods.X.rb"))
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSONPB [blobs])
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
|
||||
runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\",\"language\":\"Ruby\",\"changes\":[{\"category\":\"Method\",\"term\":\"bar\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"changeType\":\"REMOVED\"},{\"category\":\"Method\",\"term\":\"baz\",\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"changeType\":\"REMOVED\"}],\"errors\":[{\"error\":\"expected end of input nodes, but got ParseError\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":3}}}]}]}\n" :: ByteString)
|
||||
|
||||
it "ignores anonymous functions" $ do
|
||||
blobs <- blobsForPaths (Both (Path.relFile "ruby/toc/lambda.A.rb") (Path.relFile "ruby/toc/lambda.B.rb"))
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSONPB [blobs])
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
|
||||
runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/lambda.A.rb -> test/fixtures/ruby/toc/lambda.B.rb\",\"language\":\"Ruby\"}]}\n" :: ByteString)
|
||||
|
||||
it "summarizes Markdown headings" $ do
|
||||
blobs <- blobsForPaths (Both (Path.relFile "markdown/toc/headings.A.md") (Path.relFile "markdown/toc/headings.B.md"))
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSONPB [blobs])
|
||||
output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
|
||||
runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md\",\"language\":\"Markdown\",\"changes\":[{\"category\":\"Heading 1\",\"term\":\"Introduction\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":3,\"column\":16}},\"changeType\":\"REMOVED\"},{\"category\":\"Heading 2\",\"term\":\"Two\",\"span\":{\"start\":{\"line\":5,\"column\":1},\"end\":{\"line\":7,\"column\":4}},\"changeType\":\"MODIFIED\"},{\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"span\":{\"start\":{\"line\":9,\"column\":1},\"end\":{\"line\":11,\"column\":10}},\"changeType\":\"ADDED\"},{\"category\":\"Heading 1\",\"term\":\"Final\",\"span\":{\"start\":{\"line\":13,\"column\":1},\"end\":{\"line\":14,\"column\":4}},\"changeType\":\"ADDED\"}]}]}\n" :: ByteString)
|
||||
|
||||
|
||||
|
||||
@ -55,7 +55,7 @@ parseFixtures =
|
||||
, ("json", run . parseTermBuilder TermJSONTree, path, prefix </> Path.file "parse-tree.json")
|
||||
, ("json", run . parseTermBuilder TermJSONTree, path', prefix </> Path.file "parse-trees.json")
|
||||
, ("json", run . parseTermBuilder TermJSONTree, [], prefix </> Path.file "parse-tree-empty.json")
|
||||
, ("symbols", run . parseSymbolsBuilder Serializing.Format.JSONPB, path'', prefix </> Path.file "parse-tree.symbols.json")
|
||||
, ("symbols", run . parseSymbolsBuilder Serializing.Format.JSON, path'', prefix </> Path.file "parse-tree.symbols.json")
|
||||
, ("protobuf symbols", run . parseSymbolsBuilder Serializing.Format.Proto, path'', prefix </> Path.file "parse-tree.symbols.protobuf.bin")
|
||||
]
|
||||
where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
|
||||
@ -68,7 +68,7 @@ diffFixtures :: [(String, [BlobPair] -> TaskEff Builder, [Both File], Path.RelFi
|
||||
diffFixtures =
|
||||
[ ("json diff", parseDiffBuilder DiffJSONTree, pathMode, prefix </> Path.file "diff-tree.json")
|
||||
, ("s-expression diff", parseDiffBuilder DiffSExpression, pathMode, Path.relFile "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt")
|
||||
, ("toc summaries diff", diffSummaryBuilder Serializing.Format.JSONPB, pathMode, prefix </> Path.file "diff-tree.toc.json")
|
||||
, ("toc summaries diff", diffSummaryBuilder Serializing.Format.JSON, pathMode, prefix </> Path.file "diff-tree.toc.json")
|
||||
, ("protobuf diff", diffSummaryBuilder Serializing.Format.Proto, pathMode, prefix </> Path.file "diff-tree.toc.protobuf.bin")
|
||||
]
|
||||
where pathMode = [Both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby) (File "test/fixtures/ruby/corpus/method-declaration.B.rb" Ruby)]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user