Merge pull request #205 from github/proto-fixes

Revert manual oneof proto edits

Author: robrix

src/Rendering/Graph.hs

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

src/Semantic/Proto/SemanticPB.hs

@@ -1,5 +1,5 @@
 -- 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 #-}
 module Semantic.Proto.SemanticPB where
 
@@ -746,46 +746,32 @@ instance Proto3.Message DiffTreeEdge where
     <*> at decodeMessageField 2
   dotProto = undefined
 
-data DiffTreeVertexDiffTerm = DiffTreeVertexDiffTerm
-  { deleted  :: Maybe DeletedTerm
-  , inserted :: Maybe InsertedTerm
-  , replaced :: Maybe ReplacedTerm
-  , merged   :: Maybe MergedTerm
-  } deriving stock (Eq, Ord, Show, Generic)
-    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)
+data DiffTreeVertexDiffTerm
+  = Deleted (Maybe DeletedTerm)
+  | Inserted (Maybe InsertedTerm)
+  | Replaced (Maybe ReplacedTerm)
+  | Merged (Maybe MergedTerm)
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving anyclass (Proto3.Message, Proto3.Named, NFData)
 
 instance FromJSONPB DiffTreeVertexDiffTerm where
-  parseJSONPB = A.withObject "DiffTreeVertexDiffTerm" $ \obj -> DiffTreeVertexDiffTerm
-    <$> obj .: "deleted"
-    <*> obj .: "inserted"
-    <*> obj .: "replaced"
-    <*> obj .: "merged"
+  parseJSONPB = A.withObject "DiffTreeVertexDiffTerm" $ \obj -> msum
+    [
+      Deleted <$> parseField obj "deleted"
+    , Inserted <$> parseField obj "inserted"
+    , Replaced <$> parseField obj "replaced"
+    , Merged <$> parseField obj "merged"
+    ]
 
 instance ToJSONPB DiffTreeVertexDiffTerm where
-  toJSONPB DiffTreeVertexDiffTerm{..} = object
-    [ "deleted"  .= deleted
-    , "inserted" .= inserted
-    , "replaced" .= replaced
-    , "merged"   .= merged
-    ]
-  toEncodingPB DiffTreeVertexDiffTerm{..} = pairs
-    [ "deleted"  .= deleted
-    , "inserted" .= inserted
-    , "replaced" .= replaced
-    , "merged"   .= merged
-    ]
+  toJSONPB (Deleted x) = object [ "deleted" .= x ]
+  toJSONPB (Inserted x) = object [ "inserted" .= x ]
+  toJSONPB (Replaced x) = object [ "replaced" .= x ]
+  toJSONPB (Merged x) = object [ "merged" .= x ]
+  toEncodingPB (Deleted x) = pairs [ "deleted" .= x ]
+  toEncodingPB (Inserted x) = pairs [ "inserted" .= x ]
+  toEncodingPB (Replaced x) = pairs [ "replaced" .= x ]
+  toEncodingPB (Merged x) = pairs [ "merged" .= x ]
 
 instance FromJSON DiffTreeVertexDiffTerm where
   parseJSON = parseJSONPB
@@ -828,11 +814,23 @@ instance Proto3.Message DiffTreeVertex where
   encodeMessage _ DiffTreeVertex{..} = mconcat
     [
       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
     <$> 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
 
 data DeletedTerm = DeletedTerm