From d8ff761f4053e29668c9dc76dca1aef4d24f1ff5 Mon Sep 17 00:00:00 2001 From: joshvera Date: Mon, 8 Aug 2016 14:19:47 -0400 Subject: [PATCH] Add mapPatch --- src/DiffSummary.hs | 8 ++------ src/Patch.hs | 6 ++++++ 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 1b2f67d9d..1393c9cdf 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -44,12 +44,8 @@ diffSummaries sources = para $ \diff -> annotateWithCategory children = maybeToList (prependSummary (Both.snd sources) <$> (afterTerm diff')) <*> (children >>= snd) in case diff of -- Skip comments and leaves since they don't have any changes - Free (_ :< Leaf _) -> [] - Free (_ :< (S.Comment _)) -> [] (Free (_ :< syntax)) -> annotateWithCategory (toList syntax) - (Pure (Insert term)) -> [ DiffSummary (Insert $ termToDiffInfo afterSource term) [] ] - (Pure (Delete term)) -> [ DiffSummary (Delete $ termToDiffInfo beforeSource term) [] ] - (Pure (Replace t1 t2)) -> [ DiffSummary (Replace (termToDiffInfo beforeSource t1) (termToDiffInfo afterSource t2)) [] ] + (Pure patch) -> [ DiffSummary (mapPatch (termToDiffInfo beforeSource) (termToDiffInfo afterSource) patch) [] ] where (beforeSource, afterSource) = runJoin sources @@ -122,7 +118,7 @@ toTermName source term = case unwrap term of maybeParentContext :: [(Category, Text)] -> Doc maybeParentContext annotations = case annotations of [] -> "" - (annotation:xs) -> space <> "in the" <+> (toDoc $ snd annotation) <+> toDoc (toCategoryName $ fst annotation) + (annotation:_) -> space <> "in the" <+> (toDoc $ snd annotation) <+> toDoc (toCategoryName $ fst annotation) toDoc :: Text -> Doc toDoc = string . toS diff --git a/src/Patch.hs b/src/Patch.hs index c4dcc8e69..a156f01f2 100644 --- a/src/Patch.hs +++ b/src/Patch.hs @@ -9,6 +9,7 @@ module Patch , patchSum , maybeFst , maybeSnd +, mapPatch ) where import Data.These @@ -51,6 +52,11 @@ unPatch (Replace a b) = These a b unPatch (Insert b) = That b unPatch (Delete a) = This a +mapPatch :: (a -> b) -> (a -> b) -> Patch a -> Patch b +mapPatch f _ (Delete a ) = Delete (f a) +mapPatch _ g (Insert b) = Insert (g b) +mapPatch f g (Replace a b) = Replace (f a) (g b) + -- | Calculate the cost of the patch given a function to compute the cost of a item. patchSum :: (a -> Integer) -> Patch a -> Integer patchSum termCost patch = maybe 0 termCost (before patch) + maybe 0 termCost (after patch)