diff --git a/semantic-diff.cabal b/semantic-diff.cabal index bf3836460..cf225d84e 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -19,6 +19,7 @@ library , Data.Bifunctor.Join.Arbitrary , Data.Functor.Both , Data.OrderedMap + , Data.Record , Data.These.Arbitrary , Diff , Diff.Arbitrary diff --git a/src/Alignment.hs b/src/Alignment.hs index 72c13c843..59ecab355 100644 --- a/src/Alignment.hs +++ b/src/Alignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables #-} module Alignment ( hasChanges , numberedRows @@ -18,6 +18,7 @@ import Data.Functor.Foldable (hylo) import Data.List (partition) import Data.Maybe (fromJust) import qualified Data.OrderedMap as Map +import Data.Record import Data.These import Diff import Info @@ -39,15 +40,15 @@ numberedRows = countUp (both 1 1) nextLineNumbers from row = modifyJoin (fromThese identity identity) (succ <$ row) <*> from -- | Determine whether a line contains any patches. -hasChanges :: SplitDiff leaf Info -> Bool +hasChanges :: SplitDiff leaf annotation -> Bool hasChanges = or . (True <$) -- | Align a Diff into a list of Join These SplitDiffs representing the (possibly blank) lines on either side. -alignDiff :: Show leaf => Both (Source Char) -> Diff leaf Info -> [Join These (SplitDiff leaf Info)] +alignDiff :: (Show leaf, Show (Record fields), HasField fields Range) => Both (Source Char) -> Diff leaf (Record fields) -> [Join These (SplitDiff leaf (Record fields))] alignDiff sources diff = iter (alignSyntax (runBothWith ((Join .) . These)) (free . Free) getRange sources) (alignPatch sources <$> diff) -- | Align the contents of a patch into a list of lines on the corresponding side(s) of the diff. -alignPatch :: forall leaf. Show leaf => Both (Source Char) -> Patch (Term leaf Info) -> [Join These (SplitDiff leaf Info)] +alignPatch :: forall fields leaf. (Show leaf, Show (Record fields), HasField fields Range) => Both (Source Char) -> Patch (Term leaf (Record fields)) -> [Join These (SplitDiff leaf (Record fields))] alignPatch sources patch = case patch of Delete term -> fmap (pure . SplitDelete) <$> alignSyntax' this (fst sources) term Insert term -> fmap (pure . SplitInsert) <$> alignSyntax' that (snd sources) term @@ -55,13 +56,13 @@ alignPatch sources patch = case patch of (alignSyntax' this (fst sources) term1) (alignSyntax' that (snd sources) term2) where getRange = characterRange . extract - alignSyntax' :: (forall a. Identity a -> Join These a) -> Source Char -> Term leaf Info -> [Join These (Term leaf Info)] + alignSyntax' :: (forall a. Identity a -> Join These a) -> Source Char -> Term leaf (Record fields) -> [Join These (Term leaf (Record fields))] alignSyntax' side source term = hylo (alignSyntax side cofree getRange (Identity source)) runCofree (Identity <$> term) this = Join . This . runIdentity that = Join . That . runIdentity -- | The Applicative instance f is either Identity or Both. Identity is for Terms in Patches, Both is for Diffs in unchanged portions of the diff. -alignSyntax :: (Applicative f, Show term) => (forall a. f a -> Join These a) -> (CofreeF (Syntax leaf) Info term -> term) -> (term -> Range) -> f (Source Char) -> CofreeF (Syntax leaf) (f Info) [Join These term] -> [Join These term] +alignSyntax :: (Applicative f, Show term, HasField fields Range) => (forall a. f a -> Join These a) -> (CofreeF (Syntax leaf) (Record fields) term -> term) -> (term -> Range) -> f (Source Char) -> CofreeF (Syntax leaf) (f (Record fields)) [Join These term] -> [Join These term] alignSyntax toJoinThese toNode getRange sources (infos :< syntax) = case syntax of Leaf s -> catMaybes $ wrapInBranch (const (Leaf s)) . fmap (flip (,) []) <$> sequenceL lineRanges Indexed children -> catMaybes $ wrapInBranch Indexed <$> alignBranch getRange (join children) bothRanges @@ -88,7 +89,7 @@ alignSyntax toJoinThese toNode getRange sources (infos :< syntax) = case syntax Keyed children -> catMaybes $ wrapInBranch (Keyed . Map.fromList) <$> alignBranch (getRange . Prologue.snd) (Map.toList children >>= pairWithKey) bothRanges where bothRanges = modifyJoin (fromThese [] []) lineRanges lineRanges = toJoinThese $ actualLineRanges <$> (characterRange <$> infos) <*> sources - wrapInBranch constructor = applyThese $ toJoinThese ((\ info (range, children) -> toNode (info { characterRange = range } :< constructor children)) <$> infos) + wrapInBranch constructor = applyThese $ toJoinThese ((\ info (range, children) -> toNode (setCharacterRange info range :< constructor children)) <$> infos) pairWithKey (key, values) = fmap ((,) key) <$> values -- | Given a function to get the range, a list of already-aligned children, and the lists of ranges spanned by a branch, return the aligned lines. @@ -105,7 +106,7 @@ alignBranch getRange children ranges = case intersectingChildren of _ -> case intersectionsWithHeadRanges <$> listToMaybe symmetricalChildren of -- At least one child intersects on both sides, so align symmetrically. Just (True, True) -> let (line, remaining) = lineAndRemaining intersectingChildren (Just headRanges) in - line $ alignBranch getRange (remaining ++ nonIntersectingChildren) (drop 1 <$> ranges) + line $ alignBranch getRange (remaining <> nonIntersectingChildren) (drop 1 <$> ranges) -- A symmetrical child intersects on the right, so align asymmetrically on the left. Just (False, True) -> alignAsymmetrically leftRange first -- A symmetrical child intersects on the left, so align asymmetrically on the right. @@ -120,7 +121,7 @@ alignBranch getRange children ranges = case intersectingChildren of Just headRanges = sequenceL (listToMaybe <$> Join (runBothWith These ranges)) (leftRange, rightRange) = splitThese headRanges alignAsymmetrically range advanceBy = let (line, remaining) = lineAndRemaining asymmetricalChildren range in - line $ alignBranch getRange (remaining ++ symmetricalChildren ++ nonIntersectingChildren) (modifyJoin (advanceBy (drop 1)) ranges) + line $ alignBranch getRange (remaining <> symmetricalChildren <> nonIntersectingChildren) (modifyJoin (advanceBy (drop 1)) ranges) lineAndRemaining _ Nothing = (identity, []) lineAndRemaining children (Just ranges) = let (intersections, remaining) = alignChildren getRange children ranges in ((:) $ (,) <$> ranges `applyToBoth` (sortBy (compare `on` getRange) <$> intersections), remaining) diff --git a/src/Data/Record.hs b/src/Data/Record.hs new file mode 100644 index 000000000..03127f39a --- /dev/null +++ b/src/Data/Record.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DataKinds, FlexibleContexts, GADTs, KindSignatures, MultiParamTypeClasses, TypeOperators #-} +module Data.Record where + +import Prologue + +-- | A type-safe, extensible record structure. +-- | +-- | This is heavily inspired by Aaron Levin’s [Extensible Effects in the van Laarhoven Free Monad](http://aaronlevin.ca/post/136494428283/extensible-effects-in-the-van-laarhoven-free-monad). +data Record :: [*] -> * where + RNil :: Record '[] + RCons :: h -> Record t -> Record (h ': t) + +infixr 0 .: + +-- | Infix synonym for `RCons`: `a .: b .: RNil == RCons a (RCons b RNil)`. +(.:) :: h -> Record t -> Record (h ': t) +(.:) = RCons + + +-- Classes + +-- | HasField enables indexing a Record by (phantom) type tags. +class HasField (fields :: [*]) (field :: *) where + getField :: Record fields -> field + setField :: Record fields -> field -> Record fields + + +-- Instances + +-- OVERLAPPABLE is required for the HasField instances so that we can handle the two cases: either the head of the non-empty h-list is the requested field, or it isn’t. The third possible case (the h-list is empty) is rejected at compile-time. + +instance {-# OVERLAPPABLE #-} HasField fields field => HasField (notIt ': fields) field where + getField (RCons _ t) = getField t + setField (RCons h t) f = RCons h (setField t f) + +instance {-# OVERLAPPABLE #-} HasField (field ': fields) field where + getField (RCons h _) = h + setField (RCons _ t) f = RCons f t + + +instance (Show h, Show (Record t)) => Show (Record (h ': t)) where + showsPrec n (RCons h t) = showsPrec n h . (" : " <>) . showsPrec n t + +instance Show (Record '[]) where + showsPrec _ RNil = ("'[]" <>) + + +instance (Eq h, Eq (Record t)) => Eq (Record (h ': t)) where + RCons h1 t1 == RCons h2 t2 = h1 == h2 && t1 == t2 + +instance Eq (Record '[]) where + _ == _ = True diff --git a/src/Diffing.hs b/src/Diffing.hs index c3d2b1a96..299dc76d6 100644 --- a/src/Diffing.hs +++ b/src/Diffing.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE FlexibleContexts #-} module Diffing where import Prologue hiding (fst, snd) import qualified Data.ByteString.Char8 as B1 import Data.Functor.Both import Data.Functor.Foldable +import Data.Record import qualified Data.Text as T import qualified Data.Text.ICU.Detect as Detect import qualified Data.Text.ICU.Convert as Convert @@ -39,8 +41,8 @@ lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([], where lines = actualLines input root children = let size = 1 + fromIntegral (length children) in - Info (Range 0 $ length input) (Other "program") size size :< Indexed children - leaf charIndex line = Info (Range charIndex $ charIndex + T.length line) (Other "program") 1 1 :< Leaf line + ((Range 0 $ length input) .: Other "program" .: size .: Cost (unSize size) .: RNil) :< Indexed children + leaf charIndex line = ((Range charIndex $ charIndex + T.length line) .: Other "program" .: 1 .: 1 .: RNil) :< Leaf line annotateLeaves (accum, charIndex) line = (accum ++ [ leaf charIndex (toText line) ] , charIndex + length line) @@ -55,13 +57,13 @@ breakDownLeavesByWord :: Source Char -> Term T.Text Info -> Term T.Text Info breakDownLeavesByWord source = cata replaceIn where replaceIn :: TermF T.Text Info (Term T.Text Info) -> Term T.Text Info - replaceIn (info :< syntax) = let size' = 1 + sum (size . extract <$> syntax') in cofree $ info { size = size', cost = size' } :< syntax' + replaceIn (info :< syntax) = let size' = 1 + sum (size . extract <$> syntax') in cofree $ setCost (setSize info size') (Cost (unSize size')) :< syntax' where syntax' = case (ranges, syntax) of (_:_:_, Leaf _) -> Indexed (makeLeaf info <$> ranges) _ -> syntax ranges = rangesAndWordsInSource (characterRange info) rangesAndWordsInSource range = rangesAndWordsFrom (start range) (toString $ slice range source) - makeLeaf info (range, substring) = cofree $ info { characterRange = range } :< Leaf (T.pack substring) + makeLeaf info (range, substring) = cofree $ setCharacterRange info range :< Leaf (T.pack substring) -- | Transcode a file to a unicode source. transcode :: B1.ByteString -> IO (Source Char) @@ -95,7 +97,6 @@ diffFiles parser renderer sourceBlobs = do pure $! renderer textDiff sourceBlobs where construct :: CofreeF (Syntax Text) (Both Info) (Diff Text Info) -> Diff Text Info construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax)) - setCost info cost = info { cost = cost } sumCost = fmap getSum . foldMap (fmap Sum . getCost) getCost diff = case runFree diff of Free (info :< _) -> cost <$> info @@ -104,6 +105,6 @@ diffFiles parser renderer sourceBlobs = do -- | The sum of the node count of the diff’s patches. diffCostWithCachedTermSizes :: Diff a Info -> Integer -diffCostWithCachedTermSizes diff = case runFree diff of +diffCostWithCachedTermSizes diff = unCost $ case runFree diff of Free (info :< _) -> sum (cost <$> info) Pure patch -> sum (cost . extract <$> patch) diff --git a/src/Info.hs b/src/Info.hs index 1d79e0245..7c459f18a 100644 --- a/src/Info.hs +++ b/src/Info.hs @@ -1,10 +1,40 @@ +{-# LANGUAGE DataKinds, FlexibleContexts, GeneralizedNewtypeDeriving #-} module Info where +import Data.Record import Prologue import Category import Range --- | An annotation for a source file, including the source range and semantic --- | categories. -data Info = Info { characterRange :: !Range, category :: !Category, size :: !Integer, cost :: !Integer } - deriving (Eq, Show) +newtype Size = Size { unSize :: Integer } + deriving (Eq, Num, Show) +newtype Cost = Cost { unCost :: Integer } + deriving (Eq, Num, Show) + +type InfoFields = '[ Range, Category, Size, Cost ] + +type Info = Record InfoFields + +characterRange :: HasField fields Range => Record fields -> Range +characterRange = getField + +setCharacterRange :: HasField fields Range => Record fields -> Range -> Record fields +setCharacterRange = setField + +category :: HasField fields Category => Record fields -> Category +category = getField + +setCategory :: HasField fields Category => Record fields -> Category -> Record fields +setCategory = setField + +size :: HasField fields Size => Record fields -> Size +size = getField + +setSize :: HasField fields Size => Record fields -> Size -> Record fields +setSize = setField + +cost :: HasField fields Cost => Record fields -> Cost +cost = getField + +setCost :: HasField fields Cost => Record fields -> Cost -> Record fields +setCost = setField diff --git a/src/Parser.hs b/src/Parser.hs index 567957065..97bc0f6be 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} module Parser where import Prologue hiding (Constructor) @@ -62,7 +63,7 @@ termConstructor source info = cofree . construct x -> error $ "Expected a function declaration but got: " <> show x construct children | FunctionCall == category info = case runCofree <$> children of - [ (_ :< S.MemberAccess{..}), params@(_ :< S.Args{}) ] -> info { category = MethodCall } :< S.MethodCall memberId property (cofree params) + [ (_ :< S.MemberAccess{..}), params@(_ :< S.Args{}) ] -> setCategory info MethodCall :< S.MethodCall memberId property (cofree params) (x:xs) -> withDefaultInfo $ S.FunctionCall (cofree x) (cofree <$> xs) construct children | Ternary == category info = case children of @@ -74,7 +75,7 @@ termConstructor source info = cofree . construct construct children | VarDecl == category info = withDefaultInfo . S.Indexed $ toVarDecl <$> children where toVarDecl :: Term Text Info -> Term Text Info - toVarDecl child = cofree $ ((extract child) { category = VarDecl } :< S.VarDecl child) + toVarDecl child = cofree $ (setCategory (extract child) VarDecl :< S.VarDecl child) construct children | Switch == category info , (expr:_) <- children = withDefaultInfo $ S.Switch expr children diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index f88e87fbc..b46db0556 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -66,7 +66,7 @@ lineFields n term range = [ "number" .= n ] termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv] -termFields Info{..} syntax = "range" .= characterRange : "category" .= category : case syntax of +termFields info syntax = "range" .= characterRange info : "category" .= category info : case syntax of Leaf _ -> [] Indexed c -> childrenFields c Fixed c -> childrenFields c diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index 3bc604585..db482d253 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -108,27 +108,28 @@ split diff blobs = TL.toStrict . renderHtml newtype Renderable a = Renderable a instance ToMarkup f => ToMarkup (Renderable (Source Char, Info, Syntax a (f, Range))) where - toMarkup (Renderable (source, Info {..}, syntax)) = (! A.data_ (textValue (show size))) . classifyMarkup category $ case syntax of - Leaf _ -> span . text . toText $ slice characterRange source - Indexed children -> ul . mconcat $ wrapIn li <$> contentElements source characterRange children - Fixed children -> ul . mconcat $ wrapIn li <$> contentElements source characterRange children - Keyed children -> dl . mconcat $ wrapIn dd <$> contentElements source characterRange children - Syntax.FunctionCall identifier children -> dl . mconcat $ (wrapIn dt <$> (contentElements source characterRange [identifier])) <> (wrapIn dd <$> contentElements source characterRange children) + toMarkup (Renderable (source, info, syntax)) = (! A.data_ (textValue (show . unSize $ size info))) . classifyMarkup (category info) $ case syntax of + Leaf _ -> span . text . toText $ slice (characterRange info) source + Indexed children -> ul . mconcat $ wrapIn li <$> contentElements source (characterRange info) children + Fixed children -> ul . mconcat $ wrapIn li <$> contentElements source (characterRange info) children + Keyed children -> dl . mconcat $ wrapIn dd <$> contentElements source (characterRange info) children + Syntax.FunctionCall identifier children -> dl . mconcat $ (wrapIn dt <$> (contentElements source (characterRange info) [identifier])) <> (wrapIn dd <$> contentElements source (characterRange info) children) Syntax.Function identifier params expressions -> ul . mconcat $ wrapIn li <$> - contentElements source characterRange (catMaybes [identifier, params, Just expressions]) + contentElements source (characterRange info) (catMaybes [identifier, params, Just expressions]) Syntax.MethodCall targetId methodId methodParams -> ul . mconcat $ wrapIn li <$> - contentElements source characterRange [targetId, methodId, methodParams] + contentElements source (characterRange info) [targetId, methodId, methodParams] Syntax.Args children -> ul . mconcat $ wrapIn li <$> - contentElements source characterRange children + contentElements source (characterRange info) children Syntax.MemberAccess memberId property -> ul . mconcat $ wrapIn li <$> - contentElements source characterRange [memberId, property] + contentElements source (characterRange info) [memberId, property] Syntax.Assignment memberId value -> ul . mconcat $ wrapIn li <$> - contentElements source characterRange [memberId, value] - Syntax.VarDecl decl -> ul . mconcat $ wrapIn li <$> contentElements source characterRange [decl] + contentElements source (characterRange info) [memberId, value] + Syntax.VarDecl decl -> ul . mconcat $ wrapIn li <$> contentElements source (characterRange info) [decl] Syntax.VarAssignment varId value -> - dl . mconcat $ (wrapIn dt <$> (contentElements source characterRange [varId])) <> (wrapIn dd <$> contentElements source characterRange [value]) - Syntax.Switch expr cases -> ul . mconcat $ wrapIn li <$> contentElements source characterRange (expr : cases) - Syntax.Case expr body -> ul . mconcat $ wrapIn li <$> contentElements source characterRange [expr, body] + dl . mconcat $ (wrapIn dt <$> (contentElements source (characterRange info) [varId])) <> (wrapIn dd <$> contentElements source (characterRange info) [value]) + Syntax.Switch expr cases -> ul . mconcat $ wrapIn li <$> contentElements source (characterRange info) (expr : cases) + Syntax.Case expr body -> ul . mconcat $ wrapIn li <$> contentElements source (characterRange info) [expr, body] + contentElements :: (Foldable t, ToMarkup f) => Source Char -> Range -> t (f, Range) -> [Markup] contentElements source range children = let (elements, next) = foldr' (markupForContextAndChild source) ([], end range) children in text (toText (slice (Range (start range) (max next (start range))) source)) : elements @@ -144,13 +145,13 @@ wrapIn _ l@Blaze.Comment{} = l wrapIn f p = f p instance ToMarkup (Renderable (Source Char, Term a Info)) where - toMarkup (Renderable (source, term)) = Prologue.fst $ cata (\ (info@(Info{..}) :< syntax) -> (toMarkup $ Renderable (source, info, syntax), characterRange)) term + toMarkup (Renderable (source, term)) = Prologue.fst $ cata (\ (info :< syntax) -> (toMarkup $ Renderable (source, info, syntax), characterRange info)) term instance ToMarkup (Renderable (Source Char, SplitDiff a Info)) where - toMarkup (Renderable (source, diff)) = Prologue.fst $ iter (\ (info@(Info{..}) :< syntax) -> (toMarkup $ Renderable (source, info, syntax), characterRange)) $ toMarkupAndRange <$> diff + toMarkup (Renderable (source, diff)) = Prologue.fst $ iter (\ (info :< syntax) -> (toMarkup $ Renderable (source, info, syntax), characterRange info)) $ toMarkupAndRange <$> diff where toMarkupAndRange :: SplitPatch (Term a Info) -> (Markup, Range) - toMarkupAndRange patch = let term@(Info{..} :< _) = runCofree $ getSplitTerm patch in - ((div ! A.class_ (splitPatchToClassName patch) ! A.data_ (stringValue (show size))) . toMarkup $ Renderable (source, cofree term), characterRange) + toMarkupAndRange patch = let term@(info :< _) = runCofree $ getSplitTerm patch in + ((div ! A.class_ (splitPatchToClassName patch) ! A.data_ (stringValue (show (unSize (size info))))) . toMarkup $ Renderable (source, cofree term), characterRange info) instance ToMarkup a => ToMarkup (Renderable (Bool, Int, a)) where toMarkup (Renderable (hasChanges, num, line)) = diff --git a/src/SplitDiff.hs b/src/SplitDiff.hs index 2076b883f..30011fde6 100644 --- a/src/SplitDiff.hs +++ b/src/SplitDiff.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE FlexibleContexts #-} module SplitDiff where +import Data.Record import Info import Range import Prologue @@ -17,7 +19,7 @@ getSplitTerm (SplitDelete a) = a getSplitTerm (SplitReplace a) = a -- | Get the range of a SplitDiff. -getRange :: SplitDiff leaf Info -> Range +getRange :: HasField fields Range => SplitDiff leaf (Record fields) -> Range getRange diff = characterRange $ case runFree diff of Free annotated -> headF annotated Pure patch -> extract (getSplitTerm patch) diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs index 19c454aec..be90a8cfd 100644 --- a/src/TreeSitter.hs +++ b/src/TreeSitter.hs @@ -1,7 +1,7 @@ module TreeSitter where import Prologue hiding (Constructor) -import Data.Text (pack) +import Data.Record import Category import Info import Language @@ -88,7 +88,7 @@ documentToTerm language document contents = alloca $ \ root -> do range <- pure $! Range { start = fromIntegral $ ts_node_p_start_char node, end = fromIntegral $ ts_node_p_end_char node } let size' = 1 + sum (size . extract <$> children) - let info = Info range (categoriesForLanguage language (pack name)) size' size' + let info = range .: (categoriesForLanguage language (toS name)) .: size' .: Cost (unSize size') .: RNil pure $! termConstructor contents info children getChild node n out = do _ <- ts_node_p_named_child node n out diff --git a/test/AlignmentSpec.hs b/test/AlignmentSpec.hs index 4f51ea2e7..1c8757f0e 100644 --- a/test/AlignmentSpec.hs +++ b/test/AlignmentSpec.hs @@ -11,6 +11,7 @@ import Data.Bifunctor.Join.Arbitrary () import Data.Functor.Both as Both import Data.List (nub) import Data.Monoid +import Data.Record import Data.String import Data.Text.Arbitrary () import Data.These @@ -258,7 +259,7 @@ align :: Both (Source.Source Char) -> ConstructibleFree (Patch (Term String Info align sources = PrettyDiff sources . fmap (fmap (getRange &&& identity)) . alignDiff sources . deconstruct info :: Int -> Int -> Info -info start end = Info (Range start end) StringLiteral 0 0 +info start end = Range start end .: StringLiteral .: 0 .: 0 .: RNil prettyDiff :: Both (Source.Source Char) -> [Join These (ConstructibleFree (SplitPatch (Term String Info)) Info)] -> PrettyDiff (SplitDiff String Info) prettyDiff sources = PrettyDiff sources . fmap (fmap ((getRange &&& identity) . deconstruct)) diff --git a/test/DiffSummarySpec.hs b/test/DiffSummarySpec.hs index fcef6c9c0..f7db5b1eb 100644 --- a/test/DiffSummarySpec.hs +++ b/test/DiffSummarySpec.hs @@ -1,6 +1,7 @@ module DiffSummarySpec where import Prologue +import Data.Record import Test.Hspec import Diff import Info @@ -11,10 +12,10 @@ import Category import DiffSummary arrayInfo :: Info -arrayInfo = Info (rangeAt 0) ArrayLiteral 2 0 +arrayInfo = rangeAt 0 .: ArrayLiteral .: 2 .: 0 .: RNil literalInfo :: Info -literalInfo = Info (rangeAt 1) StringLiteral 1 0 +literalInfo = rangeAt 1 .: StringLiteral .: 1 .: 0 .: RNil testDiff :: Diff Text Info testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "a")) ]) diff --git a/test/InterpreterSpec.hs b/test/InterpreterSpec.hs index 054ea511c..fb8422cee 100644 --- a/test/InterpreterSpec.hs +++ b/test/InterpreterSpec.hs @@ -2,6 +2,7 @@ module InterpreterSpec where import Prologue import Diff +import Data.Record import qualified Interpreter as I import Range import Syntax @@ -14,8 +15,8 @@ spec :: Spec spec = parallel $ describe "interpret" $ it "returns a replacement when comparing two unicode equivalent terms" $ - I.diffTerms (free . Free) ((==) `on` extract) diffCost (cofree (Info range StringLiteral 0 0 :< Leaf "t\776")) (cofree (Info range2 StringLiteral 0 0 :< Leaf "\7831")) `shouldBe` - free (Pure (Replace (cofree (Info range StringLiteral 0 0 :< Leaf "t\776")) (cofree (Info range2 StringLiteral 0 0 :< Leaf "\7831")))) + I.diffTerms (free . Free) ((==) `on` extract) diffCost (cofree ((range .: StringLiteral .: 0 .: 0 .: RNil) :< Leaf "t\776")) (cofree ((range2 .: StringLiteral .: 0 .: 0 .: RNil) :< Leaf "\7831")) `shouldBe` + free (Pure (Replace (cofree ((range .: StringLiteral .: 0 .: 0 .: RNil) :< Leaf "t\776")) (cofree ((range2 .: StringLiteral .: 0 .: 0 .: RNil) :< Leaf "\7831")))) where range = Range 0 2 diff --git a/test/PatchOutputSpec.hs b/test/PatchOutputSpec.hs index 612c49bd4..429d18e70 100644 --- a/test/PatchOutputSpec.hs +++ b/test/PatchOutputSpec.hs @@ -2,7 +2,7 @@ module PatchOutputSpec where import Prologue import Data.Functor.Both -import Info +import Data.Record import Range import Renderer.Patch import Source @@ -14,4 +14,4 @@ spec :: Spec spec = parallel $ describe "hunks" $ it "empty diffs have empty hunks" $ - hunks (free . Free $ pure (Info (Range 0 0) StringLiteral 1 0) :< Leaf "") (both (SourceBlob (fromList "") "abcde" "path2.txt" (Just defaultPlainBlob)) (SourceBlob (fromList "") "xyz" "path2.txt" (Just defaultPlainBlob))) `shouldBe` [Hunk {offset = pure 0, changes = [], trailingContext = []}] + hunks (free . Free $ pure (Range 0 0 .: StringLiteral .: 1 .: 0 .: RNil) :< Leaf "") (both (SourceBlob (fromList "") "abcde" "path2.txt" (Just defaultPlainBlob)) (SourceBlob (fromList "") "xyz" "path2.txt" (Just defaultPlainBlob))) `shouldBe` [Hunk {offset = pure 0, changes = [], trailingContext = []}]