mirror of
https://github.com/github/semantic.git
synced 2024-11-28 10:15:55 +03:00
Merge branch 'master' into dont-log-aws-keys
This commit is contained in:
Rob Rix
commit
98b48a8c8e
@ -64,7 +64,9 @@ splitPatchByLines sources patch = wrapTermInPatch <$> splitAndFoldTerm (unPatch
|
||||
-- | Split a term comprised of an Info & Syntax up into one `outTerm` (abstracted by an alignment function & constructor) per line in `Source`.
|
||||
splitAbstractedTerm :: (Applicative f, Coalescent (f (Line (Maybe (Identity outTerm), Range))), Coalescent (f (Line (Maybe (T.Text, outTerm), Range))), Foldable f, TotalCrosswalk f) => (Info -> Syntax leaf outTerm -> outTerm) -> f (Source Char) -> f Info -> Syntax leaf (Adjoined (f (Line (outTerm, Range)))) -> Adjoined (f (Line (outTerm, Range)))
|
||||
splitAbstractedTerm makeTerm sources infos syntax = case syntax of
|
||||
Leaf a -> tsequenceL (pure mempty) $ fmap <$> ((\ categories -> fmap (\ range -> (makeTerm (Info range categories) (Leaf a), range))) <$> (Info.categories <$> infos)) <*> (linesInRangeOfSource <$> (characterRange <$> infos) <*> sources)
|
||||
Leaf a -> let lineRanges = linesInRangeOfSource <$> (characterRange <$> infos) <*> sources in
|
||||
tsequenceL (pure mempty)
|
||||
$ fmap <$> ((\ info -> fmap (\ range -> (makeTerm info { characterRange = range } (Leaf a), range))) <$> infos) <*> lineRanges
|
||||
Indexed children -> adjoinChildren sources infos (constructor (Indexed . fmap runIdentity)) (Identity <$> children)
|
||||
Fixed children -> adjoinChildren sources infos (constructor (Fixed . fmap runIdentity)) (Identity <$> children)
|
||||
Keyed children -> adjoinChildren sources infos (constructor (Keyed . Map.fromList)) (Map.toList children)
|
||||
@ -76,10 +78,11 @@ adjoinChildren sources infos constructor children = wrap <$> leadingContext <> l
|
||||
where (lines, next) = foldr (childLines sources) (mempty, end <$> ranges) children
|
||||
ranges = characterRange <$> infos
|
||||
categories = Info.categories <$> infos
|
||||
sizes = size <$> infos
|
||||
leadingContext = tsequenceL (pure mempty) $ makeContextLines <$> (linesInRangeOfSource <$> (Range <$> (start <$> ranges) <*> next) <*> sources)
|
||||
wrap = (wrapLineContents <$> (makeBranchTerm constructor <$> categories <*> next) <*>)
|
||||
makeBranchTerm constructor categories next children = let range = unionRangesFrom (rangeAt next) $ Prelude.snd <$> children in
|
||||
(constructor (Info range categories) . catMaybes . toList $ Prelude.fst <$> children, range)
|
||||
wrap = (wrapLineContents <$> (makeBranchTerm constructor <$> categories <*> sizes <*> next) <*>)
|
||||
makeBranchTerm constructor categories size next children = let range = unionRangesFrom (rangeAt next) $ Prelude.snd <$> children in
|
||||
(constructor (Info range categories size) . catMaybes . toList $ Prelude.fst <$> children, range)
|
||||
|
||||
-- | Accumulate the lines of and between a branch term’s children.
|
||||
childLines :: (Copointed c, Functor c, Applicative f, Coalescent (f (Line (Maybe (c a), Range))), Foldable f, TotalCrosswalk f) => f (Source Char) -> c (Adjoined (f (Line (a, Range)))) -> (Adjoined (f (Line (Maybe (c a), Range))), f Int) -> (Adjoined (f (Line (Maybe (c a), Range))), f Int)
|
||||
|
||||
@ -17,7 +17,6 @@ type Diff a annotation = Free (Annotated a (Both annotation)) (Patch (Term a ann
|
||||
diffSum :: (Patch (Term a annotation) -> Integer) -> Diff a annotation -> Integer
|
||||
diffSum patchCost diff = sum $ fmap patchCost diff
|
||||
|
||||
-- | The total cost of the diff.
|
||||
-- | This is the number of all leaves in all terms in all patches of the diff.
|
||||
-- | The sum of the node count of the diff’s patches.
|
||||
diffCost :: Diff a annotation -> Integer
|
||||
diffCost = diffSum $ patchSum termSize
|
||||
|
||||
@ -12,7 +12,6 @@ import Source
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import qualified System.IO as IO
|
||||
import Data.String
|
||||
import Data.Text hiding (split)
|
||||
|
||||
-- | Returns a rendered diff given a parser, diff arguments and two source blobs.
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
module Diffing where
|
||||
|
||||
import Diff
|
||||
import Info
|
||||
import Interpreter
|
||||
import Language
|
||||
@ -12,10 +13,13 @@ import Term
|
||||
import TreeSitter
|
||||
import Text.Parser.TreeSitter.Language
|
||||
|
||||
import Control.Monad.Free
|
||||
import Control.Comonad.Cofree
|
||||
import Data.Copointed
|
||||
import Data.Functor.Both
|
||||
import qualified Data.ByteString.Char8 as B1
|
||||
import Data.Foldable
|
||||
import Data.Monoid
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.ICU.Detect as Detect
|
||||
import qualified Data.Text.ICU.Convert as Convert
|
||||
@ -31,12 +35,12 @@ parserForType mediaType = case languageForType mediaType of
|
||||
|
||||
-- | A fallback parser that treats a file simply as rows of strings.
|
||||
lineByLineParser :: Parser
|
||||
lineByLineParser input = return . root . Indexed $ case foldl' annotateLeaves ([], 0) lines of
|
||||
lineByLineParser input = return . root $ case foldl' annotateLeaves ([], 0) lines of
|
||||
(leaves, _) -> leaves
|
||||
where
|
||||
lines = actualLines input
|
||||
root syntax = Info (Range 0 $ length input) mempty :< syntax
|
||||
leaf charIndex line = Info (Range charIndex $ charIndex + T.length line) mempty :< Leaf line
|
||||
root children = Info (Range 0 $ length input) mempty (1 + fromIntegral (length children)) :< Indexed children
|
||||
leaf charIndex line = Info (Range charIndex $ charIndex + T.length line) mempty 1 :< Leaf line
|
||||
annotateLeaves (accum, charIndex) line =
|
||||
(accum ++ [ leaf charIndex (toText line) ]
|
||||
, charIndex + length line)
|
||||
@ -50,10 +54,14 @@ parserForFilepath = parserForType . T.pack . takeExtension
|
||||
breakDownLeavesByWord :: Source Char -> Term T.Text Info -> Term T.Text Info
|
||||
breakDownLeavesByWord source = cata replaceIn
|
||||
where
|
||||
replaceIn info@(Info range categories) (Leaf _) | ranges <- rangesAndWordsInSource range, length ranges > 1 = info :< Indexed (makeLeaf categories <$> ranges)
|
||||
replaceIn info syntax = info :< syntax
|
||||
replaceIn (Info range categories _) (Leaf _)
|
||||
| ranges <- rangesAndWordsInSource range
|
||||
, length ranges > 1
|
||||
= Info range categories (1 + fromIntegral (length ranges)) :< Indexed (makeLeaf categories <$> ranges)
|
||||
replaceIn info@(Info range categories _) syntax
|
||||
= Info range categories (1 + sum (size . copoint <$> syntax)) :< syntax
|
||||
rangesAndWordsInSource range = rangesAndWordsFrom (start range) (toString $ slice range source)
|
||||
makeLeaf categories (range, substring) = Info range categories :< Leaf (T.pack substring)
|
||||
makeLeaf categories (range, substring) = Info range categories 1 :< Leaf (T.pack substring)
|
||||
|
||||
-- | Transcode a file to a unicode source.
|
||||
transcode :: B1.ByteString -> IO (Source Char)
|
||||
@ -77,4 +85,13 @@ diffFiles parser renderer sourceBlobs = do
|
||||
let sources = source <$> sourceBlobs
|
||||
terms <- sequence $ parser <$> sources
|
||||
let replaceLeaves = breakDownLeavesByWord <$> sources
|
||||
return $! renderer (runBothWith diffTerms $ replaceLeaves <*> terms) sourceBlobs
|
||||
return $! renderer (runBothWith (diffTerms diffCostWithAbsoluteDifferenceOfCachedDiffSizes) $ replaceLeaves <*> terms) sourceBlobs
|
||||
|
||||
-- | The sum of the node count of the diff’s patches.
|
||||
diffCostWithCachedTermSizes :: Diff a Info -> Integer
|
||||
diffCostWithCachedTermSizes = diffSum (getSum . foldMap (Sum . size . copoint))
|
||||
|
||||
-- | The absolute difference between the node counts of a diff.
|
||||
diffCostWithAbsoluteDifferenceOfCachedDiffSizes :: Diff a Info -> Integer
|
||||
diffCostWithAbsoluteDifferenceOfCachedDiffSizes (Free (Annotated (Both (before, after)) _)) = abs $ size before - size after
|
||||
diffCostWithAbsoluteDifferenceOfCachedDiffSizes (Pure patch) = sum $ size . copoint <$> patch
|
||||
|
||||
@ -6,7 +6,7 @@ import Range
|
||||
|
||||
-- | An annotation for a source file, including the source range and semantic
|
||||
-- | categories.
|
||||
data Info = Info { characterRange :: !Range, categories :: !(Set Category) }
|
||||
data Info = Info { characterRange :: !Range, categories :: !(Set Category), size :: !Integer }
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Categorizable Info where
|
||||
|
||||
@ -23,13 +23,13 @@ import Term
|
||||
-- | Returns whether two terms are comparable
|
||||
type Comparable a annotation = Term a annotation -> Term a annotation -> Bool
|
||||
|
||||
-- | Diff two terms, given the default Categorizable.comparable function.
|
||||
diffTerms :: (Eq a, Eq annotation, Categorizable annotation) => Term a annotation -> Term a annotation -> Diff a annotation
|
||||
diffTerms = interpret comparable
|
||||
-- | Diff two terms, given the default Categorizable.comparable function and a function computing the cost of a given diff.
|
||||
diffTerms :: (Eq a, Eq annotation, Categorizable annotation) => Cost a annotation -> Term a annotation -> Term a annotation -> Diff a annotation
|
||||
diffTerms cost = interpret comparable cost
|
||||
|
||||
-- | Diff two terms, given a function that determines whether two terms can be compared.
|
||||
interpret :: (Eq a, Eq annotation) => Comparable a annotation -> Term a annotation -> Term a annotation -> Diff a annotation
|
||||
interpret comparable a b = fromMaybe (Pure $ Replace a b) $ constructAndRun comparable a b
|
||||
interpret :: (Eq a, Eq annotation) => Comparable a annotation -> Cost a annotation -> Term a annotation -> Term a annotation -> Diff a annotation
|
||||
interpret comparable cost a b = fromMaybe (Pure $ Replace a b) $ constructAndRun comparable cost a b
|
||||
|
||||
-- | A hylomorphism. Given an `a`, unfold and then refold into a `b`.
|
||||
hylo :: Functor f => (t -> f b -> b) -> (a -> (t, f a)) -> a -> b
|
||||
@ -37,13 +37,13 @@ hylo down up a = down annotation $ hylo down up <$> syntax where
|
||||
(annotation, syntax) = up a
|
||||
|
||||
-- | Constructs an algorithm and runs it
|
||||
constructAndRun :: (Eq a, Eq annotation) => Comparable a annotation -> Term a annotation -> Term a annotation -> Maybe (Diff a annotation)
|
||||
constructAndRun _ a b | a == b = hylo (curry $ Free . uncurry Annotated) (copoint &&& unwrap) <$> zipTerms a b where
|
||||
constructAndRun :: (Eq a, Eq annotation) => Comparable a annotation -> Cost a annotation -> Term a annotation -> Term a annotation -> Maybe (Diff a annotation)
|
||||
constructAndRun _ _ a b | a == b = hylo (curry $ Free . uncurry Annotated) (copoint &&& unwrap) <$> zipTerms a b where
|
||||
|
||||
constructAndRun comparable a b | not $ comparable a b = Nothing
|
||||
constructAndRun comparable _ a b | not $ comparable a b = Nothing
|
||||
|
||||
constructAndRun comparable (annotation1 :< a) (annotation2 :< b) =
|
||||
run comparable $ algorithm a b where
|
||||
constructAndRun comparable cost (annotation1 :< a) (annotation2 :< b) =
|
||||
run comparable cost $ algorithm a b where
|
||||
algorithm (Indexed a') (Indexed b') = Free $ ByIndex a' b' (annotate . Indexed)
|
||||
algorithm (Keyed a') (Keyed b') = Free $ ByKey a' b' (annotate . Keyed)
|
||||
algorithm (Leaf a') (Leaf b') | a' == b' = annotate $ Leaf b'
|
||||
@ -51,29 +51,29 @@ constructAndRun comparable (annotation1 :< a) (annotation2 :< b) =
|
||||
annotate = Pure . Free . Annotated (Both (annotation1, annotation2))
|
||||
|
||||
-- | Runs the diff algorithm
|
||||
run :: (Eq a, Eq annotation) => Comparable a annotation -> Algorithm a annotation (Diff a annotation) -> Maybe (Diff a annotation)
|
||||
run _ (Pure diff) = Just diff
|
||||
run :: (Eq a, Eq annotation) => Comparable a annotation -> Cost a annotation -> Algorithm a annotation (Diff a annotation) -> Maybe (Diff a annotation)
|
||||
run _ _ (Pure diff) = Just diff
|
||||
|
||||
run comparable (Free (Recursive (annotation1 :< a) (annotation2 :< b) f)) = run comparable . f $ recur a b where
|
||||
recur (Indexed a') (Indexed b') | length a' == length b' = annotate . Indexed $ zipWith (interpret comparable) a' b'
|
||||
recur (Fixed a') (Fixed b') | length a' == length b' = annotate . Fixed $ zipWith (interpret comparable) a' b'
|
||||
run comparable cost (Free (Recursive (annotation1 :< a) (annotation2 :< b) f)) = run comparable cost . f $ recur a b where
|
||||
recur (Indexed a') (Indexed b') | length a' == length b' = annotate . Indexed $ zipWith (interpret comparable cost) a' b'
|
||||
recur (Fixed a') (Fixed b') | length a' == length b' = annotate . Fixed $ zipWith (interpret comparable cost) a' b'
|
||||
recur (Keyed a') (Keyed b') | Map.keys a' == bKeys = annotate . Keyed . Map.fromList . fmap repack $ bKeys
|
||||
where
|
||||
bKeys = Map.keys b'
|
||||
repack key = (key, interpretInBoth key a' b')
|
||||
interpretInBoth key x y = interpret comparable (x ! key) (y ! key)
|
||||
interpretInBoth key x y = interpret comparable cost (x ! key) (y ! key)
|
||||
recur _ _ = Pure $ Replace (annotation1 :< a) (annotation2 :< b)
|
||||
|
||||
annotate = Free . Annotated (Both (annotation1, annotation2))
|
||||
|
||||
run comparable (Free (ByKey a b f)) = run comparable $ f byKey where
|
||||
run comparable cost (Free (ByKey a b f)) = run comparable cost $ f byKey where
|
||||
byKey = Map.fromList $ toKeyValue <$> List.union aKeys bKeys
|
||||
toKeyValue key | List.elem key deleted = (key, Pure . Delete $ a ! key)
|
||||
toKeyValue key | List.elem key inserted = (key, Pure . Insert $ b ! key)
|
||||
toKeyValue key = (key, interpret comparable (a ! key) (b ! key))
|
||||
toKeyValue key = (key, interpret comparable cost (a ! key) (b ! key))
|
||||
aKeys = Map.keys a
|
||||
bKeys = Map.keys b
|
||||
deleted = aKeys \\ bKeys
|
||||
inserted = bKeys \\ aKeys
|
||||
|
||||
run comparable (Free (ByIndex a b f)) = run comparable . f $ ses (constructAndRun comparable) diffCost a b
|
||||
run comparable cost (Free (ByIndex a b f)) = run comparable cost . f $ ses (constructAndRun comparable cost) cost a b
|
||||
|
||||
@ -6,6 +6,7 @@ import Range
|
||||
import Syntax
|
||||
import Term
|
||||
import Control.Comonad.Cofree
|
||||
import Data.Copointed
|
||||
import qualified Data.OrderedMap as Map
|
||||
import qualified Data.Set as Set
|
||||
import Source
|
||||
@ -39,13 +40,13 @@ isFixed = not . Set.null . Set.intersection fixedCategories
|
||||
-- | Given a function that maps production names to sets of categories, produce
|
||||
-- | a Constructor.
|
||||
termConstructor :: (String -> Set.Set Category) -> Constructor
|
||||
termConstructor mapping source range name = (Info range categories :<) . construct
|
||||
termConstructor mapping source range name children = Info range categories (1 + sum (size . copoint <$> children)) :< construct children
|
||||
where
|
||||
categories = mapping name
|
||||
construct [] = Leaf . pack . toString $ slice range source
|
||||
construct children | isFixed categories = Fixed children
|
||||
construct children | isKeyed categories = Keyed . Map.fromList $ assignKey <$> children
|
||||
construct children = Indexed children
|
||||
assignKey node@(Info _ categories :< Fixed (key : _)) | Set.member Pair categories = (getSubstring key, node)
|
||||
assignKey node@(Info _ categories _ :< Fixed (key : _)) | Set.member Pair categories = (getSubstring key, node)
|
||||
assignKey node = (getSubstring node, node)
|
||||
getSubstring (Info range _ :< _) = pack . toString $ slice range source
|
||||
getSubstring (Info range _ _ :< _) = pack . toString $ slice range source
|
||||
|
||||
@ -7,7 +7,7 @@ data Patch a =
|
||||
Replace a a
|
||||
| Insert a
|
||||
| Delete a
|
||||
deriving (Functor, Show, Eq)
|
||||
deriving (Foldable, Functor, Show, Eq)
|
||||
|
||||
-- | Return the item from the after side of the patch.
|
||||
after :: Patch a -> Maybe a
|
||||
|
||||
@ -10,6 +10,8 @@ import Data.Text
|
||||
type Renderer a = Diff a Info -> Both SourceBlob -> Text
|
||||
|
||||
data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath }
|
||||
deriving (Show)
|
||||
|
||||
-- | The available types of diff rendering.
|
||||
data Format = Split | Patch | JSON
|
||||
deriving (Show)
|
||||
|
||||
@ -12,7 +12,6 @@ import Data.Aeson hiding (json)
|
||||
import Data.Aeson.Encode
|
||||
import Data.Functor.Both
|
||||
import Data.OrderedMap hiding (fromList)
|
||||
import Data.Text
|
||||
import Data.Text.Lazy (toStrict)
|
||||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import qualified Data.Text as T
|
||||
@ -67,7 +66,7 @@ lineFields n line | isEmpty line = []
|
||||
]
|
||||
|
||||
termFields :: (ToJSON recur, KeyValue kv) => Info -> Syntax leaf recur -> [kv]
|
||||
termFields (Info range categories) syntax = "range" .= range : "categories" .= categories : case syntax of
|
||||
termFields (Info range categories _) syntax = "range" .= range : "categories" .= categories : case syntax of
|
||||
Leaf _ -> []
|
||||
Indexed c -> childrenFields c
|
||||
Fixed c -> childrenFields c
|
||||
|
||||
@ -25,7 +25,7 @@ import Data.Text (pack, Text)
|
||||
|
||||
-- | Render a timed out file as a truncated diff.
|
||||
truncatePatch :: DiffArguments -> Both SourceBlob -> Text
|
||||
truncatePatch arguments blobs = pack $ header blobs ++ "#timed_out\nTruncating diff: timeout reached.\n"
|
||||
truncatePatch _ blobs = pack $ header blobs ++ "#timed_out\nTruncating diff: timeout reached.\n"
|
||||
|
||||
-- | Render a diff in the traditional patch format.
|
||||
patch :: Renderer a
|
||||
@ -85,8 +85,8 @@ showLine source line | isEmpty line = Nothing
|
||||
|
||||
-- | Return the range from a split diff.
|
||||
getRange :: SplitDiff leaf Info -> Range
|
||||
getRange (Free (Annotated (Info range _) _)) = range
|
||||
getRange (Pure patch) = let Info range _ :< _ = getSplitTerm patch in range
|
||||
getRange (Free (Annotated (Info range _ _) _)) = range
|
||||
getRange (Pure patch) = let Info range _ _ :< _ = getSplitTerm patch in range
|
||||
|
||||
-- | Returns the header given two source blobs and a hunk.
|
||||
header :: Both SourceBlob -> String
|
||||
|
||||
@ -8,7 +8,6 @@ import Control.Monad.Free
|
||||
import Data.Foldable
|
||||
import Data.Functor.Both
|
||||
import Data.Monoid
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Diff
|
||||
import Info
|
||||
@ -86,7 +85,7 @@ 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 range categories, syntax)) = classifyMarkup categories $ case syntax of
|
||||
toMarkup (Renderable (source, Info range categories size, syntax)) = (! A.data_ (stringValue (show size))) . classifyMarkup categories $ case syntax of
|
||||
Leaf _ -> span . string . toString $ slice range source
|
||||
Indexed children -> ul . mconcat $ wrapIn li <$> contentElements children
|
||||
Fixed children -> ul . mconcat $ wrapIn li <$> contentElements children
|
||||
@ -104,12 +103,12 @@ instance ToMarkup f => ToMarkup (Renderable (Source Char, Info, Syntax a (f, Ran
|
||||
elements ++ [ string . toString $ slice (Range previous $ end range) source ]
|
||||
|
||||
instance ToMarkup (Renderable (Source Char, Term a Info)) where
|
||||
toMarkup (Renderable (source, term)) = Prelude.fst $ cata (\ info@(Info range _) syntax -> (toMarkup $ Renderable (source, info, syntax), range)) term
|
||||
toMarkup (Renderable (source, term)) = Prelude.fst $ cata (\ info@(Info range _ _) syntax -> (toMarkup $ Renderable (source, info, syntax), range)) term
|
||||
|
||||
instance ToMarkup (Renderable (Source Char, SplitDiff a Info)) where
|
||||
toMarkup (Renderable (source, diff)) = Prelude.fst $ iter (\ (Annotated info@(Info range _) syntax) -> (toMarkup $ Renderable (source, info, syntax), range)) $ toMarkupAndRange <$> diff
|
||||
toMarkup (Renderable (source, diff)) = Prelude.fst $ iter (\ (Annotated info@(Info range _ _) syntax) -> (toMarkup $ Renderable (source, info, syntax), range)) $ toMarkupAndRange <$> diff
|
||||
where toMarkupAndRange :: SplitPatch (Term a Info) -> (Markup, Range)
|
||||
toMarkupAndRange patch = let term@(Info range _ :< _) = getSplitTerm patch in
|
||||
toMarkupAndRange patch = let term@(Info range _ _ :< _) = getSplitTerm patch in
|
||||
((div ! A.class_ (splitPatchToClassName patch) ! A.data_ (stringValue . show $ termSize term)) . toMarkup $ Renderable (source, term), range)
|
||||
|
||||
|
||||
|
||||
@ -26,10 +26,7 @@ zipTerms (annotation1 :< a) (annotation2 :< b) = annotate $ zipUnwrap a b
|
||||
cata :: (annotation -> Syntax a b -> b) -> Term a annotation -> b
|
||||
cata f (annotation :< syntax) = f annotation $ cata f <$> syntax
|
||||
|
||||
-- | Return the number of leaves in the node.
|
||||
-- | Return the node count of a term.
|
||||
termSize :: Term a annotation -> Integer
|
||||
termSize = cata size where
|
||||
size _ (Leaf _) = 1
|
||||
size _ (Indexed i) = sum i
|
||||
size _ (Fixed f) = sum f
|
||||
size _ (Keyed k) = sum k
|
||||
size _ syntax = 1 + sum syntax
|
||||
|
||||
@ -32,36 +32,36 @@ spec = parallel $ do
|
||||
describe "splitDiffByLines" $ do
|
||||
prop "preserves line counts in equal sources" $
|
||||
\ source ->
|
||||
length (splitDiffByLines (pure source) (Free $ Annotated (pure $ Info (totalRange source) mempty) (Indexed . Prelude.fst $ foldl combineIntoLeaves ([], 0) source))) `shouldBe` length (filter (== '\n') $ toString source) + 1
|
||||
length (splitDiffByLines (pure source) (Free $ Annotated (pure $ Info (totalRange source) mempty 1) (Indexed . Prelude.fst $ foldl combineIntoLeaves ([], 0) source))) `shouldBe` length (filter (== '\n') $ toString source) + 1
|
||||
|
||||
prop "produces the maximum line count in inequal sources" $
|
||||
\ sources ->
|
||||
length (splitDiffByLines sources (Free $ Annotated ((`Info` mempty) . totalRange <$> sources) (Indexed $ leafWithRangesInSources sources <$> runBothWith (zipWith both) (actualLineRanges <$> (totalRange <$> sources) <*> sources)))) `shouldBe` runBothWith max ((+ 1) . length . filter (== '\n') . toString <$> sources)
|
||||
\ sources -> let ranges = actualLineRanges <$> (totalRange <$> sources) <*> sources in
|
||||
length (splitDiffByLines sources (Free $ Annotated ((\ s -> Info (totalRange s) mempty 0) <$> sources) (Indexed $ leafWithRangesInSources sources <$> runBothWith (zipWith both) ranges))) `shouldBe` runBothWith max ((+ 1) . length . filter (== '\n') . toString <$> sources)
|
||||
|
||||
describe "splitAbstractedTerm" $ do
|
||||
prop "preserves line count" $
|
||||
\ source -> let range = totalRange source in
|
||||
splitAbstractedTerm (:<) (Identity source) (Identity (Info range mempty)) (Leaf source) `shouldBe` (Identity . lineMap (fmap (((:< Leaf source) . (`Info` mempty) &&& id))) <$> linesInRangeOfSource range source)
|
||||
splitAbstractedTerm (:<) (Identity source) (Identity (Info range mempty 0)) (Leaf source) `shouldBe` (Identity . lineMap (fmap (((:< Leaf source) . (\ r -> Info r mempty 0) &&& id))) <$> linesInRangeOfSource range source)
|
||||
|
||||
let makeTerm = ((Free .) . Annotated) :: Info -> Syntax (Source Char) (SplitDiff (Source Char) Info) -> SplitDiff (Source Char) Info
|
||||
prop "outputs one row for single-line unchanged leaves" $
|
||||
forAll (arbitraryLeaf `suchThat` isOnSingleLine) $
|
||||
\ (source, info@(Info range categories), syntax) -> splitAbstractedTerm makeTerm (pure source) (pure $ Info range categories) syntax `shouldBe` fromList [
|
||||
both (pure (makeTerm info $ Leaf source, Range 0 (length source))) (pure (makeTerm info $ Leaf source, Range 0 (length source))) ]
|
||||
\ (source, (Info range categories _), syntax) -> splitAbstractedTerm makeTerm (pure source) (pure $ Info range categories 0) syntax `shouldBe` fromList [
|
||||
both (pure (makeTerm (Info range categories 0) $ Leaf source, Range 0 (length source))) (pure (makeTerm (Info range categories 0) $ Leaf source, Range 0 (length source))) ]
|
||||
|
||||
prop "outputs one row for single-line empty unchanged indexed nodes" $
|
||||
forAll (arbitrary `suchThat` (\ a -> filter (/= '\n') (toString a) == toString a)) $
|
||||
\ source -> splitAbstractedTerm makeTerm (pure source) (pure $ Info (totalRange source) mempty) (Indexed []) `shouldBe` fromList [
|
||||
both (pure (makeTerm (Info (totalRange source) mempty) $ Indexed [], Range 0 (length source))) (pure (makeTerm (Info (totalRange source) mempty) $ Indexed [], Range 0 (length source))) ]
|
||||
\ source -> splitAbstractedTerm makeTerm (pure source) (pure $ Info (totalRange source) mempty 0) (Indexed []) `shouldBe` fromList [
|
||||
both (pure (makeTerm (Info (totalRange source) mempty 0) $ Indexed [], Range 0 (length source))) (pure (makeTerm (Info (totalRange source) mempty 0) $ Indexed [], Range 0 (length source))) ]
|
||||
|
||||
where
|
||||
isOnSingleLine (a, _, _) = filter (/= '\n') (toString a) == toString a
|
||||
|
||||
combineIntoLeaves (leaves, start) char = (leaves ++ [ Free $ Annotated (Info <$> pure (Range start $ start + 1) <*> mempty) (Leaf [ char ]) ], start + 1)
|
||||
combineIntoLeaves (leaves, start) char = (leaves ++ [ Free $ Annotated (Info <$> pure (Range start $ start + 1) <*> mempty <*> pure 1) (Leaf [ char ]) ], start + 1)
|
||||
|
||||
leafWithRangesInSources sources ranges = Free $ Annotated (Info <$> ranges <*> pure mempty) (Leaf $ runBothWith (++) (toString <$> sources))
|
||||
leafWithRangesInSources sources ranges = Free $ Annotated (Info <$> ranges <*> pure mempty <*> pure 1) (Leaf $ runBothWith (++) (toString <$> sources))
|
||||
|
||||
leafWithRangeInSource source range = Info range mempty :< Leaf source
|
||||
leafWithRangeInSource source range = Info range mempty 1 :< Leaf source
|
||||
|
||||
patchWithBoth (Insert ()) = Insert . snd
|
||||
patchWithBoth (Delete ()) = Delete . fst
|
||||
|
||||
@ -74,4 +74,4 @@ instance Arbitrary a => Arbitrary (Source a) where
|
||||
|
||||
arbitraryLeaf :: Gen (Source Char, Info, Syntax (Source Char) f)
|
||||
arbitraryLeaf = toTuple <$> arbitrary
|
||||
where toTuple string = (string, Info (Range 0 $ length string) mempty, Leaf string)
|
||||
where toTuple string = (string, Info (Range 0 $ length string) mempty 1, Leaf string)
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
module InterpreterSpec where
|
||||
|
||||
import Diff
|
||||
import qualified Interpreter as I
|
||||
import Range
|
||||
import Syntax
|
||||
@ -14,8 +15,8 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "interpret" $ do
|
||||
it "returns a replacement when comparing two unicode equivalent terms" $
|
||||
I.interpret comparable (Info range mempty :< Leaf "t\776") (Info range2 mempty :< Leaf "\7831") `shouldBe`
|
||||
Pure (Replace (Info range mempty :< Leaf "t\776") (Info range2 mempty :< Leaf "\7831"))
|
||||
I.interpret comparable diffCost (Info range mempty 0 :< Leaf "t\776") (Info range2 mempty 0 :< Leaf "\7831") `shouldBe`
|
||||
Pure (Replace (Info range mempty 0 :< Leaf "t\776") (Info range2 mempty 0 :< Leaf "\7831"))
|
||||
|
||||
where
|
||||
range = Range 0 2
|
||||
|
||||
@ -14,4 +14,4 @@ spec :: Spec
|
||||
spec = parallel $
|
||||
describe "hunks" $
|
||||
it "empty diffs have empty hunks" $
|
||||
hunks (Free . Annotated (pure (Info (Range 0 0) mempty)) $ Leaf "") (Both (SourceBlob (fromList "") "abcde" "path2.txt" (Just defaultPlainBlob), SourceBlob (fromList "") "xyz" "path2.txt" (Just defaultPlainBlob))) `shouldBe` [Hunk {offset = Both (0, 0), changes = [], trailingContext = []}]
|
||||
hunks (Free . Annotated (pure (Info (Range 0 0) mempty 1)) $ Leaf "") (Both (SourceBlob (fromList "") "abcde" "path2.txt" (Just defaultPlainBlob), SourceBlob (fromList "") "xyz" "path2.txt" (Just defaultPlainBlob))) `shouldBe` [Hunk {offset = Both (0, 0), changes = [], trailingContext = []}]
|
||||
|
||||
@ -17,9 +17,9 @@ spec = parallel $ do
|
||||
|
||||
describe "Diff" $ do
|
||||
prop "equality is reflexive" $
|
||||
\ a b -> let diff = interpret comparable (unTerm a) (unTerm (b :: ArbitraryTerm String CategorySet)) in
|
||||
\ a b -> let diff = interpret comparable diffCost (unTerm a) (unTerm (b :: ArbitraryTerm String CategorySet)) in
|
||||
diff == diff
|
||||
|
||||
prop "equal terms produce identity diffs" $
|
||||
\ a -> let term = unTerm (a :: ArbitraryTerm String CategorySet) in
|
||||
diffCost (interpret comparable term term) == 0
|
||||
diffCost (interpret comparable diffCost term term) == 0
|
||||
|
||||
@ -1,25 +1,25 @@
|
||||
<!DOCTYPE HTML>
|
||||
<html><head><link rel="stylesheet" href="style.css"></head><body><table class="diff"><colgroup><col width="40"><col><col width="40"><col></colgroup><tr><td class="blob-num">1</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary">{
|
||||
<html><head><link rel="stylesheet" href="style.css"></head><body><table class="diff"><colgroup><col width="40"><col><col width="40"><col></colgroup><tr><td class="blob-num">1</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13">{
|
||||
</dl></li></ul></li></ul></td>
|
||||
<td class="blob-num">1</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary">{
|
||||
<td class="blob-num">1</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13">{
|
||||
</dl></li></ul></li></ul></td>
|
||||
|
||||
</tr><tr><td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary"> <dd><ul class="category-pair"><li><ul class="category-string"><li><span class="category-string">"</span></li><li><span class="category-string">b</span></li><li><span class="category-string">"</span></li></ul></li>: <li><div class="patch replace" data="1"><span class="category-number">4</span></div></li></ul></dd>,
|
||||
</tr><tr><td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13"> <dd><ul class="category-pair" data="6"><li><ul class="category-string" data="4"><li><span class="category-string" data="1">"</span></li><li><span class="category-string" data="1">b</span></li><li><span class="category-string" data="1">"</span></li></ul></li>: <li><div class="patch replace" data="1"><span class="category-number" data="1">4</span></div></li></ul></dd>,
|
||||
</dl></li></ul></li></ul></td>
|
||||
<td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary"> <dd><ul class="category-pair"><li><ul class="category-string"><li><span class="category-string">"</span></li><li><span class="category-string">b</span></li><li><span class="category-string">"</span></li></ul></li>: <li><div class="patch replace" data="1"><span class="category-number">5</span></div></li></ul></dd>,
|
||||
<td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13"> <dd><ul class="category-pair" data="6"><li><ul class="category-string" data="4"><li><span class="category-string" data="1">"</span></li><li><span class="category-string" data="1">b</span></li><li><span class="category-string" data="1">"</span></li></ul></li>: <li><div class="patch replace" data="1"><span class="category-number" data="1">5</span></div></li></ul></dd>,
|
||||
</dl></li></ul></li></ul></td>
|
||||
|
||||
</tr><tr><td class="blob-num">3</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary"> <dd><ul class="category-pair"><li><ul class="category-string"><li><span class="category-string">"</span></li><li><span class="category-string">a</span></li><li><span class="category-string">"</span></li></ul></li>: <li><span class="category-number">5</span></li></ul></dd>
|
||||
</tr><tr><td class="blob-num">3</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13"> <dd><ul class="category-pair" data="6"><li><ul class="category-string" data="4"><li><span class="category-string" data="1">"</span></li><li><span class="category-string" data="1">a</span></li><li><span class="category-string" data="1">"</span></li></ul></li>: <li><span class="category-number" data="1">5</span></li></ul></dd>
|
||||
</dl></li></ul></li></ul></td>
|
||||
<td class="blob-num">3</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary"> <dd><ul class="category-pair"><li><ul class="category-string"><li><span class="category-string">"</span></li><li><span class="category-string">a</span></li><li><span class="category-string">"</span></li></ul></li>: <li><span class="category-number">5</span></li></ul></dd>
|
||||
<td class="blob-num">3</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13"> <dd><ul class="category-pair" data="6"><li><ul class="category-string" data="4"><li><span class="category-string" data="1">"</span></li><li><span class="category-string" data="1">a</span></li><li><span class="category-string" data="1">"</span></li></ul></li>: <li><span class="category-number" data="1">5</span></li></ul></dd>
|
||||
</dl></li></ul></li></ul></td>
|
||||
|
||||
</tr><tr><td class="blob-num">4</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary">}</dl></li>
|
||||
</tr><tr><td class="blob-num">4</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13">}</dl></li>
|
||||
</ul></li></ul></td>
|
||||
<td class="blob-num">4</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"><li><dl class="category-dictionary">}</dl></li>
|
||||
<td class="blob-num">4</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"><li><dl class="category-dictionary" data="13">}</dl></li>
|
||||
</ul></li></ul></td>
|
||||
|
||||
</tr><tr><td class="blob-num">5</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"></ul></li></ul></td>
|
||||
<td class="blob-num">5</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statement"></ul></li></ul></td>
|
||||
</tr><tr><td class="blob-num">5</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"></ul></li></ul></td>
|
||||
<td class="blob-num">5</td><td class="blob-code"><ul class="category-program" data="15"><li><ul class="category-expression_statement" data="14"></ul></li></ul></td>
|
||||
|
||||
</tr></table></body></html>
|
||||
Loading…
Reference in New Issue
Block a user