1
1
mirror of https://github.com/github/semantic.git synced 2024-12-21 05:41:54 +03:00

Update ErrorSummary to use MaybeLanguage

This commit is contained in:
Rick Winfrey 2017-07-18 17:18:09 -07:00
parent c92157b988
commit 9d1f4f19ca

View File

@ -65,7 +65,7 @@ data JSONSummary
, summarySpan :: Span , summarySpan :: Span
, summaryChangeType :: Text , summaryChangeType :: Text
} }
| ErrorSummary { error :: Text, errorSpan :: Span, errorLanguage :: Language } | ErrorSummary { error :: Text, errorSpan :: Span, errorLanguage :: Maybe Language }
deriving (Generic, Eq, Show) deriving (Generic, Eq, Show)
instance ToJSON JSONSummary where instance ToJSON JSONSummary where
@ -172,7 +172,7 @@ dedupe = foldl' go []
similarDeclaration = (==) `on` fmap (toLower . declarationIdentifier) . getDeclaration similarDeclaration = (==) `on` fmap (toLower . declarationIdentifier) . getDeclaration
-- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches. -- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches.
entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Language -> Entry (Record fields) -> Maybe JSONSummary entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Maybe Language -> Entry (Record fields) -> Maybe JSONSummary
entrySummary language entry = case entry of entrySummary language entry = case entry of
Unchanged _ -> Nothing Unchanged _ -> Nothing
Changed a -> recordSummary language a "modified" Changed a -> recordSummary language a "modified"
@ -181,22 +181,21 @@ entrySummary language entry = case entry of
Replaced a -> recordSummary language a "modified" Replaced a -> recordSummary language a "modified"
-- | Construct a 'JSONSummary' from a node annotation and a change type label. -- | Construct a 'JSONSummary' from a node annotation and a change type label.
recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Language -> Record fields -> Text -> Maybe JSONSummary recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Maybe Language -> Record fields -> Text -> Maybe JSONSummary
recordSummary language record = case getDeclaration record of recordSummary language record = case getDeclaration record of
Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record) language) Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record) language)
Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record)
Nothing -> const Nothing Nothing -> const Nothing
renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Both Blob -> Diff f (Record fields) -> Summaries renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Both Blob -> Diff f (Record fields) -> Summaries
renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors) renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC language
where (changes, errors) = List.partition isValidSummary $ diffTOC languages diff where toMap [] = mempty
toMap [] = mempty
toMap as = Map.singleton summaryKey (toJSON <$> as) toMap as = Map.singleton summaryKey (toJSON <$> as)
languages = case runJoin (blobLanguage <$> blobs) of language = case runJoin (blobLanguage <$> blobs) of
(Nothing, Just after) -> after (Nothing, Just after) -> Just after
(Just before, Nothing) -> before (Just before, Nothing) -> Just before
(Nothing, Nothing) -> Undetected (Nothing, Nothing) -> Nothing
(Just before, Just _) -> before (Just before, Just _) -> Just before
summaryKey = toS $ case runJoin (blobPath <$> blobs) of summaryKey = toS $ case runJoin (blobPath <$> blobs) of
(before, after) | null before -> after (before, after) | null before -> after
| null after -> before | null after -> before
@ -204,16 +203,14 @@ renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors)
| otherwise -> before <> " -> " <> after | otherwise -> before <> " -> " <> after
renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Blob -> Term f (Record fields) -> Summaries renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Blob -> Term f (Record fields) -> Summaries
renderToCTerm Blob{..} term = Summaries (toMap changes) (toMap errors) renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC blobLanguage
where (changes, errors) = List.partition isValidSummary $ termToC language term where toMap [] = mempty
language = fromMaybe Undetected blobLanguage
toMap [] = mempty
toMap as = Map.singleton (toS blobPath) (toJSON <$> as) toMap as = Map.singleton (toS blobPath) (toJSON <$> as)
diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Language -> Diff f (Record fields) -> [JSONSummary] diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Maybe Language -> Diff f (Record fields) -> [JSONSummary]
diffTOC language = mapMaybe (entrySummary language) . dedupe . tableOfContentsBy declaration diffTOC language = mapMaybe (entrySummary language) . dedupe . tableOfContentsBy declaration
termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Language -> Term f (Record fields) -> [JSONSummary] termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Maybe Language -> Term f (Record fields) -> [JSONSummary]
termToC language = mapMaybe (flip (recordSummary language) "unchanged") . termTableOfContentsBy declaration termToC language = mapMaybe (flip (recordSummary language) "unchanged") . termTableOfContentsBy declaration
-- The user-facing category name -- The user-facing category name