github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-18 04:11:48 +03:00
Code Issues Projects Releases Wiki Activity

Define a ToC rendering function for parse trees.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Renderer.hs
View File

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

14
src/Renderer/TOC.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes, TypeOperators #-}
module Renderer.TOC
( renderToCDiff
, renderToCTerm
, diffTOC
, Summaries(..)
, JSONSummary(..)
@ -194,9 +195,22 @@ renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isV
| before == after -> 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 = 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
toCategoryName :: Declaration -> Text
toCategoryName declaration = case declaration of