Merge branch 'master' into break-hearts-not-builds

Author: robrix

.ghci

@@ -2,16 +2,9 @@
 :set -package pretty-show -package hscolour
 
 -- See docs/💡ProTip!.md
-:undef pretty
-:def pretty \ _ -> return ":set -interactive-print Semantic.Util.Pretty.prettyShow"
-
--- See docs/💡ProTip!.md
-:undef no-pretty
-:def no-pretty \_ -> return ":set -interactive-print System.IO.print"
-
--- See docs/💡ProTip!.md
-:undef r
-:def r \_ -> return (unlines [":reload", ":pretty"])
+:def! pretty \ _ -> return ":set -interactive-print Semantic.Util.Pretty.prettyShow"
+:def! no-pretty \_ -> return ":set -interactive-print System.IO.print"
+:def! r \_ -> return (unlines [":reload", ":pretty"])
 
 -- See docs/💡ProTip!.md for documentation & examples.
 :{
@@ -29,8 +22,7 @@ assignmentExample lang = case lang of
   _ -> mk "" ""
   where mk fileExtension parser = putStrLn ("example: fmap (() <$) . runTask . parse " ++ parser ++ "Parser =<< Semantic.Util.blob \"example." ++ fileExtension ++ "\"") >> return ("import Parsing.Parser\nimport Semantic.Task\nimport Semantic.Util")
 :}
-:undef assignment
-:def assignment assignmentExample
+:def! assignment assignmentExample
 
 -- Enable breaking on errors for code written in the repl.
 :seti -fbreak-on-error

src/Data/Abstract/Address/Monovariant.hs

@@ -9,7 +9,7 @@ import Data.Abstract.Name
 import qualified Data.Set as Set
 import Prologue
 
--- | 'Monovariant' models using one address for a particular name. It trackes the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new.
+-- | 'Monovariant' models using one address for a particular name. It tracks the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new.
 newtype Monovariant = Monovariant { unMonovariant :: Name }
   deriving (Eq, Ord)
 

src/Data/Abstract/ScopeGraph.hs

@@ -76,7 +76,7 @@ instance Ord AccessControl where
   (<=) Private _           = True
   (<=) _       Private     = False
 
-  -- | Protected AccessControl is inbetween Private and Public in the order specification.
+  -- | Protected AccessControl is in between Private and Public in the order specification.
   -- Protected AccessControl "on the left" has access to Protected or Public AccessControls "on the right".
   (<=) Protected Public    = True
   (<=) Protected Protected = True

src/Language/Go/Assignment.hs

@@ -661,6 +661,6 @@ manyTermsTill step end = manyTill (step <|> comment) end
 manyTerm :: Assignment Term -> Assignment [Term]
 manyTerm = many . term
 
--- | Match a term and contextualize any comments preceeding or proceeding the term.
+-- | Match a term and contextualize any comments preceding or proceeding the term.
 term :: Assignment Term -> Assignment Term
 term term' = contextualize comment term' <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm)

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/Rendering/TOC.hs

@@ -96,7 +96,7 @@ newtype DedupeKey = DedupeKey (T.Text, T.Text) deriving (Eq, Ord)
 -- different behaviors:
 -- 1. Identical entries are in the list.
 --    Action: take the first one, drop all subsequent.
--- 2. Two similar entries (defined by a case insensitive comparision of their
+-- 2. Two similar entries (defined by a case insensitive comparison of their
 --    identifiers) are in the list.
 --    Action: Combine them into a single Replaced entry.
 dedupe :: [Entry Declaration] -> [Entry Declaration]

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