1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00

Merge remote-tracking branch 'origin/master' into syntax-redux

This commit is contained in:
joshvera 2016-06-21 17:08:40 -04:00
commit 0a574871c9
14 changed files with 143 additions and 51 deletions

View File

@ -19,6 +19,7 @@ library
, Data.Bifunctor.Join.Arbitrary
, Data.Functor.Both
, Data.OrderedMap
, Data.Record
, Data.These.Arbitrary
, Diff
, Diff.Arbitrary

View File

@ -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)

52
src/Data/Record.hs Normal file
View File

@ -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 Levins [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 isnt. 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

View File

@ -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 diffs 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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)) =

View File

@ -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)

View File

@ -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

View File

@ -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))

View File

@ -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")) ])

View File

@ -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

View File

@ -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 = []}]