From 0534c3303d7da97b614f2952d0dfa5d64bc706ce Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 10 May 2017 09:55:05 -0400 Subject: [PATCH] Define a function to compute the table of contents for a diff given some relevance predicate. --- src/Renderer/TOC.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 990942249..671b2acb1 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -1,8 +1,9 @@ +{-# LANGUAGE RankNTypes #-} module Renderer.TOC (toc, diffTOC, JSONSummary(..), Summarizable(..), isErrorSummary) where import Category as C import Data.Aeson -import Data.Align (sequenceL) +import Data.Align (crosswalk, sequenceL) import Data.Functor.Both hiding (fst, snd) import qualified Data.Functor.Both as Both import Data.Text (toLower) @@ -52,6 +53,21 @@ data Summarizable } deriving (Eq, Show) +data Entry a + = Unchanged a + | Changed (Either a (Patch a)) + deriving (Eq, Show) + +tableOfContentsBy :: Traversable f => (forall b. TermF f (Record fields) b -> Bool) -> Diff f (Record fields) -> [Entry (Record fields)] +tableOfContentsBy isRelevant = fromMaybe [] . iter alg . fmap (Just . fmap (Changed . Right) . crosswalk (cata termAlgebra)) + where alg r | isRelevant (first Both.snd r) + , annotation <- Both.snd (headF r) = Just (maybe [Unchanged annotation] (wrapList annotation) (fold r)) + | otherwise = fold r + wrapList a es | null es = [Changed (Left a)] + | otherwise = es + termAlgebra r | isRelevant r = [headF r] + | otherwise = fold r + toc :: HasDefaultFields fields => Both SourceBlob -> Diff (Syntax Text) (Record fields) -> Summaries toc blobs diff = Summaries changes errors where