github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00
Code Issues Projects Releases Wiki Activity

Revert manual oneof proto edits

Browse Source
This commit is contained in:
Timothy Clem 2019-07-25 11:28:55 -07:00
parent c3181d1d88
commit 540f0eb76b
2 changed files with 46 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Rendering/Graph.hs
View File

@ -51,10 +51,10 @@ diffStyle name = (defaultStyle (fromString . show . diffVertexId))
{ graphName = fromString (quote name) { graphName = fromString (quote name)
, vertexAttributes = vertexAttributes } , vertexAttributes = vertexAttributes }
where quote a = "\"" <> a <> "\"" where quote a = "\"" <> a <> "\""
vertexAttributes (DiffTreeVertex _ (Just (Deleted DeletedTerm{..}))) = [ "label" := fromString (T.unpack term), "color" := "red" ] vertexAttributes (DiffTreeVertex _ (Just (Deleted (Just DeletedTerm{..})))) = [ "label" := fromString (T.unpack term), "color" := "red" ]
vertexAttributes (DiffTreeVertex _ (Just (Inserted InsertedTerm{..}))) = [ "label" := fromString (T.unpack term), "color" := "green" ] vertexAttributes (DiffTreeVertex _ (Just (Inserted (Just InsertedTerm{..})))) = [ "label" := fromString (T.unpack term), "color" := "green" ]
vertexAttributes (DiffTreeVertex _ (Just (Replaced ReplacedTerm{..}))) = [ "label" := "Replacement", "color" := "orange", "style" := "dashed" ] vertexAttributes (DiffTreeVertex _ (Just (Replaced (Just ReplacedTerm{..})))) = [ "label" := "Replacement", "color" := "orange", "style" := "dashed" ]
vertexAttributes (DiffTreeVertex _ (Just (Merged MergedTerm{..}))) = [ "label" := fromString (T.unpack term) ] vertexAttributes (DiffTreeVertex _ (Just (Merged (Just MergedTerm{..})))) = [ "label" := fromString (T.unpack term) ]
vertexAttributes _ = [] vertexAttributes _ = []
class ToTreeGraph vertex t | t -> vertex where class ToTreeGraph vertex t | t -> vertex where
@ -82,16 +82,16 @@ instance (ConstructorName syntax, Foldable syntax) =>
instance (ConstructorName syntax, Foldable syntax) => instance (ConstructorName syntax, Foldable syntax) =>
ToTreeGraph DiffTreeVertex (DiffF syntax Location Location) where ToTreeGraph DiffTreeVertex (DiffF syntax Location Location) where
toTreeGraph d = case d of toTreeGraph d = case d of
Merge t@(In (a1, a2) syntax) -> diffAlgebra t (Merged (MergedTerm (T.pack (constructorName syntax)) (ann a1) (ann a2))) 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 (DeletedTerm (T.pack (constructorName syntax)) (ann a1))) 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 (InsertedTerm (T.pack (constructorName syntax)) (ann a2))) Patch (Insert t2@(In a2 syntax)) -> diffAlgebra t2 (Inserted (Just (InsertedTerm (T.pack (constructorName syntax)) (ann a2))))
Patch (Replace t1@(In a1 syntax1) t2@(In a2 syntax2)) -> do Patch (Replace t1@(In a1 syntax1) t2@(In a2 syntax2)) -> do
i <- fresh i <- fresh
parent <- ask parent <- ask
let (beforeName, beforeSpan) = (T.pack (constructorName syntax1), ann a1) let (beforeName, beforeSpan) = (T.pack (constructorName syntax1), ann a1)
let (afterName, afterSpan) = (T.pack (constructorName syntax2), ann a2) let (afterName, afterSpan) = (T.pack (constructorName syntax2), ann a2)
let replace = vertex (DiffTreeVertex (fromIntegral i) (Just (Replaced (ReplacedTerm beforeName beforeSpan afterName afterSpan)))) let replace = vertex (DiffTreeVertex (fromIntegral i) (Just (Replaced (Just (ReplacedTerm beforeName beforeSpan afterName afterSpan)))))
graph <- local (const replace) (overlay <$> diffAlgebra t1 (Deleted (DeletedTerm beforeName beforeSpan))) <*> diffAlgebra t2 (Inserted (InsertedTerm afterName afterSpan)) graph <- local (const replace) (overlay <$> diffAlgebra t1 (Deleted (Just (DeletedTerm beforeName beforeSpan))) <*> diffAlgebra t2 (Inserted (Just (InsertedTerm afterName afterSpan))))
pure (parent `connect` replace `overlay` graph) pure (parent `connect` replace `overlay` graph)
where where
ann a = converting #? locationSpan a ann a = converting #? locationSpan a

74
src/Semantic/Proto/SemanticPB.hs
View File

@ -1,5 +1,5 @@
-- Code generated by protoc-gen-haskell 0.1.0, DO NOT EDIT. -- Code generated by protoc-gen-haskell 0.1.0, DO NOT EDIT.
{-# LANGUAGE DerivingVia, DeriveAnyClass, DuplicateRecordFields, PatternSynonyms #-} {-# LANGUAGE DerivingVia, DeriveAnyClass, DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-missing-export-lists #-} {-# OPTIONS_GHC -Wno-unused-imports -Wno-missing-export-lists #-}
module Semantic.Proto.SemanticPB where module Semantic.Proto.SemanticPB where
@ -746,46 +746,32 @@ instance Proto3.Message DiffTreeEdge where
<*> at decodeMessageField 2 <*> at decodeMessageField 2
dotProto = undefined dotProto = undefined
data DiffTreeVertexDiffTerm = DiffTreeVertexDiffTerm data DiffTreeVertexDiffTerm
{ deleted :: Maybe DeletedTerm = Deleted (Maybe DeletedTerm)
, inserted :: Maybe InsertedTerm | Inserted (Maybe InsertedTerm)
, replaced :: Maybe ReplacedTerm | Replaced (Maybe ReplacedTerm)
, merged :: Maybe MergedTerm | Merged (Maybe MergedTerm)
} deriving stock (Eq, Ord, Show, Generic) deriving stock (Eq, Ord, Show, Generic)
deriving anyclass (Proto3.Message, Proto3.Named, NFData) deriving anyclass (Proto3.Message, Proto3.Named, NFData)
pattern Deleted :: DeletedTerm -> DiffTreeVertexDiffTerm
pattern Deleted a = DiffTreeVertexDiffTerm (Just a) Nothing Nothing Nothing
pattern Inserted :: InsertedTerm -> DiffTreeVertexDiffTerm
pattern Inserted a = DiffTreeVertexDiffTerm Nothing (Just a) Nothing Nothing
pattern Replaced :: ReplacedTerm -> DiffTreeVertexDiffTerm
pattern Replaced a = DiffTreeVertexDiffTerm Nothing Nothing (Just a) Nothing
pattern Merged :: MergedTerm -> DiffTreeVertexDiffTerm
pattern Merged a = DiffTreeVertexDiffTerm Nothing Nothing Nothing (Just a)
instance FromJSONPB DiffTreeVertexDiffTerm where instance FromJSONPB DiffTreeVertexDiffTerm where
parseJSONPB = A.withObject "DiffTreeVertexDiffTerm" $ \obj -> DiffTreeVertexDiffTerm parseJSONPB = A.withObject "DiffTreeVertexDiffTerm" $ \obj -> msum
<$> obj .: "deleted" [
<*> obj .: "inserted" Deleted <$> parseField obj "deleted"
<*> obj .: "replaced" , Inserted <$> parseField obj "inserted"
<*> obj .: "merged" , Replaced <$> parseField obj "replaced"
, Merged <$> parseField obj "merged"
]
instance ToJSONPB DiffTreeVertexDiffTerm where instance ToJSONPB DiffTreeVertexDiffTerm where
toJSONPB DiffTreeVertexDiffTerm{..} = object toJSONPB (Deleted x) = object [ "deleted" .= x ]
[ "deleted" .= deleted toJSONPB (Inserted x) = object [ "inserted" .= x ]
, "inserted" .= inserted toJSONPB (Replaced x) = object [ "replaced" .= x ]
, "replaced" .= replaced toJSONPB (Merged x) = object [ "merged" .= x ]
, "merged" .= merged toEncodingPB (Deleted x) = pairs [ "deleted" .= x ]
] toEncodingPB (Inserted x) = pairs [ "inserted" .= x ]
toEncodingPB DiffTreeVertexDiffTerm{..} = pairs toEncodingPB (Replaced x) = pairs [ "replaced" .= x ]
[ "deleted" .= deleted toEncodingPB (Merged x) = pairs [ "merged" .= x ]
, "inserted" .= inserted
, "replaced" .= replaced
, "merged" .= merged
]
instance FromJSON DiffTreeVertexDiffTerm where instance FromJSON DiffTreeVertexDiffTerm where
parseJSON = parseJSONPB parseJSON = parseJSONPB
@ -828,11 +814,23 @@ instance Proto3.Message DiffTreeVertex where
encodeMessage _ DiffTreeVertex{..} = mconcat encodeMessage _ DiffTreeVertex{..} = mconcat
[ [
encodeMessageField 1 diffVertexId encodeMessageField 1 diffVertexId
, encodeMessageField 2 (Proto3.Nested diffTerm) , case diffTerm of
Nothing -> mempty
Just (Deleted deleted) -> encodeMessageField 2 deleted
Just (Inserted inserted) -> encodeMessageField 3 inserted
Just (Replaced replaced) -> encodeMessageField 4 replaced
Just (Merged merged) -> encodeMessageField 5 merged
] ]
decodeMessage _ = DiffTreeVertex decodeMessage _ = DiffTreeVertex
<$> at decodeMessageField 1 <$> at decodeMessageField 1
<*> at decodeMessageField 2 <*> oneof
Nothing
[
(2, Just . Deleted <$> decodeMessageField)
, (3, Just . Inserted <$> decodeMessageField)
, (4, Just . Replaced <$> decodeMessageField)
, (5, Just . Merged <$> decodeMessageField)
]
dotProto = undefined dotProto = undefined
data DeletedTerm = DeletedTerm data DeletedTerm = DeletedTerm