Better handling of partial errors

src/Semantic/API/Diffs.hs

@@ -75,12 +75,14 @@ diffGraph blobs = distributeFoldMap go (apiBlobPairToBlobPair <$> blobs)
   where
     go :: (DiffEffects sig m) => BlobPair -> m DiffTreeGraphResponse
     go blobPair = doDiff blobPair (const pure) render
+      `catchError` \(SomeException e) ->
+        pure (DiffTreeGraphResponse mempty mempty [ParseError (pathForBlobPair blobPair) (show e)])
 
     render :: (Foldable syntax, Functor syntax, ConstructorName syntax, Applicative m) => BlobPair -> Diff syntax Location Location -> m DiffTreeGraphResponse
     render _ diff =
       let graph = renderTreeGraph diff
           toEdge (Edge (a, b)) = DiffTreeEdge (diffVertexId a) (diffVertexId b)
-      in pure $ DiffTreeGraphResponse (vertexList graph) (fmap toEdge (edgeList graph))
+      in pure $ DiffTreeGraphResponse (vertexList graph) (fmap toEdge (edgeList graph)) mempty
 
 
 sexpDiff :: (DiffEffects sig m) => BlobPair -> m Builder

src/Semantic/API/TOCSummaries.hs

@@ -2,9 +2,13 @@
 module Semantic.API.TOCSummaries (diffSummary, legacyDiffSummary, diffSummaryBuilder) where
 
 import           Analysis.TOCSummary (Declaration, declarationAlgebra)
+import           Control.Effect.Error
+import           Data.Aeson
 import           Data.Blob
 import           Data.ByteString.Builder
 import           Data.Diff
+import qualified Data.Map.Monoidal as Map
+import           Data.Span (emptySpan)
 import qualified Data.Text as T
 import           Rendering.TOC
 import           Semantic.API.Diffs
@@ -24,6 +28,10 @@ legacyDiffSummary = distributeFoldMap go
   where
     go :: (DiffEffects sig m) => BlobPair -> m Summaries
     go blobPair = doDiff blobPair (decorate . declarationAlgebra) render
+      `catchError` \(SomeException e) ->
+        pure $ Summaries mempty (Map.singleton path [toJSON (ErrorSummary (T.pack (show e)) emptySpan lang)])
+      where path = T.pack $ pathKeyForBlobPair blobPair
+            lang = languageForBlobPair blobPair
 
     render :: (Foldable syntax, Functor syntax, Applicative m) => BlobPair -> Diff syntax (Maybe Declaration) (Maybe Declaration) -> m Summaries
     render blobPair = pure . renderToCDiff blobPair
@@ -33,6 +41,10 @@ diffSummary blobs = DiffTreeTOCResponse <$> distributeFor (apiBlobPairToBlobPair
   where
     go :: (DiffEffects sig m) => BlobPair -> m TOCSummaryFile
     go blobPair = doDiff blobPair (decorate . declarationAlgebra) render
+      `catchError` \(SomeException e) ->
+        pure $ TOCSummaryFile path lang mempty [TOCSummaryError (T.pack (show e)) Nothing]
+      where path = T.pack $ pathKeyForBlobPair blobPair
+            lang = 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)
@@ -45,3 +57,8 @@ diffSummary blobs = DiffTreeTOCResponse <$> distributeFor (apiBlobPairToBlobPair
           = TOCSummaryFile path language (TOCSummaryChange summaryCategoryName summaryTermName (spanToSpan summarySpan) (toChangeType summaryChangeType) : changes) errors
         go ErrorSummary{..} TOCSummaryFile{..}
           = TOCSummaryFile path language changes (TOCSummaryError errorText (spanToSpan errorSpan) : errors)
+
+fileError :: BlobPair -> String -> TOCSummaryFile
+fileError blobPair e = TOCSummaryFile path lang mempty [TOCSummaryError (T.pack e) Nothing]
+  where path = T.pack $ pathKeyForBlobPair blobPair
+        lang = languageForBlobPair blobPair

src/Semantic/API/Terms.hs

@@ -46,7 +46,7 @@ termGraph blobs = distributeFoldMap go (fmap apiBlobToBlob blobs)
     go :: ParseEffects sig m => Blob -> m ParseTreeGraphResponse
     go blob = (doParse blob >>= withSomeTerm (pure . render))
       `catchError` \(SomeException e) ->
-        pure (ParseTreeGraphResponse mempty mempty [TermError (blobPath blob) (show e)])
+        pure (ParseTreeGraphResponse mempty mempty [ParseError (blobPath blob) (show e)])
 
     render t = let graph = renderTreeGraph t
                    toEdge (Edge (a, b)) = TermEdge (vertexId a) (vertexId b)

src/Semantic/API/Types.hs

@@ -35,7 +35,7 @@ module Semantic.API.Types
   , ParseTreeGraphResponse(..)
   , TermVertex(..)
   , TermEdge(..)
-  , TermError(..)
+  , ParseError(..)
 
   -- Health Check
   , PingRequest(..)
@@ -139,8 +139,8 @@ data Symbol
 data ParseTreeGraphResponse
   = ParseTreeGraphResponse
   { vertices :: [TermVertex]
-  , edges :: [TermEdge]
-  , errors :: [TermError]
+  , edges    :: [TermEdge]
+  , errors   :: [ParseError]
   }
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Message, Named, ToJSON)
@@ -156,7 +156,11 @@ data TermVertex = TermVertex { vertexId :: Int, term :: String, span :: Maybe Sp
   deriving anyclass (Message, Named, ToJSON)
 instance VertexTag TermVertex where uniqueTag = vertexId
 
-data TermError = TermError { path :: String, error :: String }
+data ParseError
+  = ParseError
+  { path  :: String
+  , error :: String
+  }
   deriving stock (Eq, Ord, Show, Generic)
   deriving anyclass (Message, Named, ToJSON)
 
@@ -226,7 +230,11 @@ data TOCSummaryError = TOCSummaryError
 --
 
 data DiffTreeGraphResponse
-  = DiffTreeGraphResponse { vertices :: [DiffTreeVertex], edges :: [DiffTreeEdge] }
+  = DiffTreeGraphResponse
+  { vertices :: [DiffTreeVertex]
+  , edges    :: [DiffTreeEdge]
+  , errors   :: [ParseError]
+  }
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Message, Named, ToJSON)
   deriving Semigroup via GenericSemigroup DiffTreeGraphResponse
@@ -236,7 +244,7 @@ data DiffTreeEdge = DiffTreeEdge { source :: Int, target :: Int }
   deriving stock (Eq, Ord, Show, Generic)
   deriving anyclass (Message, Named, ToJSON)
 
-data DiffTreeVertex = DiffTreeVertex { diffVertexId :: Int, term :: Maybe DiffTreeTerm }
+data DiffTreeVertex = DiffTreeVertex { diffVertexId :: Int, diffTerm :: Maybe DiffTreeTerm }
   deriving stock (Eq, Ord, Show, Generic)
   deriving anyclass (Message, Named, ToJSON)
 instance VertexTag DiffTreeVertex where uniqueTag = diffVertexId