1
1
mirror of https://github.com/github/semantic.git synced 2025-01-07 07:58:12 +03:00

Define a ToC rendering function for parse trees.

This commit is contained in:
Rob Rix 2017-06-16 12:26:14 -04:00
parent 87082918a4
commit a9dd289aae
2 changed files with 15 additions and 0 deletions

View File

@ -8,6 +8,7 @@ module Renderer
, renderJSONDiff , renderJSONDiff
, renderJSONTerm , renderJSONTerm
, renderToCDiff , renderToCDiff
, renderToCTerm
, declarationAlgebra , declarationAlgebra
, markupSectionAlgebra , markupSectionAlgebra
, syntaxDeclarationAlgebra , syntaxDeclarationAlgebra

View File

@ -1,6 +1,7 @@
{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes, TypeOperators #-} {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes, TypeOperators #-}
module Renderer.TOC module Renderer.TOC
( renderToCDiff ( renderToCDiff
, renderToCTerm
, diffTOC , diffTOC
, Summaries(..) , Summaries(..)
, JSONSummary(..) , JSONSummary(..)
@ -194,9 +195,22 @@ renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isV
| before == after -> after | before == after -> after
| otherwise -> before <> " -> " <> after | otherwise -> before <> " -> " <> after
renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => SourceBlob -> Term f (Record fields) -> Summaries
renderToCTerm blob = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC
where toMap [] = mempty
toMap as = Map.singleton (toS (path blob)) (toJSON <$> as)
diffTOC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Diff f (Record fields) -> [JSONSummary] diffTOC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Diff f (Record fields) -> [JSONSummary]
diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration
termToC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Term f (Record fields) -> [JSONSummary]
termToC = mapMaybe recordSummary . termTableOfContentsBy declaration
where recordSummary :: (HasField fields (Maybe Declaration), HasField fields SourceSpan) => Record fields -> Maybe JSONSummary
recordSummary record = case getDeclaration record of
Just (ErrorDeclaration text) -> Just (ErrorSummary text (sourceSpan record))
Just declaration -> Just (JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) "unchanged")
Nothing -> Nothing
-- The user-facing category name -- The user-facing category name
toCategoryName :: Declaration -> Text toCategoryName :: Declaration -> Text
toCategoryName declaration = case declaration of toCategoryName declaration = case declaration of