github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 17:59:10 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #1016 from github/🔥-cost

Browse Source 
🔥 cost
This commit is contained in:
Josh Vera 2017-02-22 16:45:57 -05:00 committed by GitHub
commit 086f55c6dd
18 changed files with 50 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Algorithm.hs
View File

@ -8,8 +8,6 @@ import Prologue hiding (Pure)
data AlgorithmF term diff result where
-- | Diff two terms recursively in O(n) time, resulting in a single diff node.
Linear :: term -> term -> AlgorithmF term diff diff
-- | Diff two lists of terms by each element’s position in O(n³) time, resulting in a list of diffs.
SES :: [term] -> [term] -> AlgorithmF term diff [diff]
-- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
RWS :: [term] -> [term] -> AlgorithmF term diff [diff]
@ -29,10 +27,6 @@ iterAp algebra = go
linearly :: term -> term -> Algorithm term diff diff
linearly a b = liftAp (Linear a b)
-- | Diff two terms using SES.
bySES :: [term] -> [term] -> Algorithm term diff [diff]
bySES a b = liftAp (SES a b)
-- | Diff two terms using RWS.
byRWS :: [term] -> [term] -> Algorithm term diff [diff]
byRWS a b = liftAp (RWS a b)

21
src/Diffing.hs
View File

@ -7,8 +7,6 @@ import Data.Functor.Both
import Data.RandomWalkSimilarity (defaultFeatureVectorDecorator, stripDiff)
import Data.Record
import qualified Data.Text.IO as TextIO
import Data.These
import Diff
import Info
import Interpreter
import Patch
@ -34,7 +32,7 @@ import Data.Aeson.Encoding (encodingToLazyByteString)
-- | result.
-- | Returns the rendered result strictly, so it's always fully evaluated
-- | with respect to other IO actions.
diffFiles :: (HasField fields Category, HasField fields Cost)
diffFiles :: HasField fields Category
=> Parser (Syntax Text) (Record fields)
-> Renderer (Record fields)
-> Both SourceBlob
@ -48,14 +46,9 @@ diffFiles parse render sourceBlobs = do
(True, False) -> pure $ Insert (snd terms)
(False, True) -> pure $ Delete (fst terms)
(_, _) ->
runBothWith (diffTerms construct compareCategoryEq diffCostWithCachedTermCosts) terms
runBothWith diffTerms terms
areNullOids a b = (hasNullOid a, hasNullOid b)
hasNullOid blob = oid blob == nullOid || Source.null (source blob)
construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax))
sumCost = fmap getSum . foldMap (fmap Sum . getCost)
getCost diff = case runFree diff of
Free (info :< _) -> cost <$> info
Pure patch -> uncurry both (fromThese 0 0 (unPatch (cost . extract <$> patch)))
getLabel :: HasField fields Category => CofreeF (Syntax leaf) (Record fields) b -> (Category, Maybe leaf)
getLabel (h :< t) = (category h, case t of
@ -66,14 +59,8 @@ getLabel (h :< t) = (category h, case t of
compareCategoryEq :: Functor f => HasField fields Category => Term f (Record fields) -> Term f (Record fields) -> Bool
compareCategoryEq = (==) `on` category . extract
-- | The sum of the node count of the diff’s patches.
diffCostWithCachedTermCosts :: Functor f => HasField fields Cost => Diff f (Record fields) -> Int
diffCostWithCachedTermCosts diff = unCost $ case runFree diff of
Free (info :< _) -> sum (cost <$> info)
Pure patch -> sum (cost . extract <$> patch)
-- | Returns a rendered diff given a parser, diff arguments and two source blobs.
textDiff :: (ToJSON (Record fields), DefaultFields fields, HasField fields Cost) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO Output
textDiff :: (ToJSON (Record fields), DefaultFields fields) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO Output
textDiff parser arguments = diffFiles parser $ case format arguments of
Split -> split
Patch -> patch
@ -93,7 +80,7 @@ truncatedDiff arguments sources = pure $ case format arguments of
TOC -> TOCOutput mempty
-- | Prints a rendered diff to stdio or a filepath given a parser, diff arguments and two source blobs.
printDiff :: (ToJSON (Record fields), DefaultFields fields, HasField fields Cost) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO ()
printDiff :: (ToJSON (Record fields), DefaultFields fields) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO ()
printDiff parser arguments sources = do
rendered <- textDiff parser arguments sources
writeToOutput (output arguments) $

18
src/Info.hs
View File

@ -6,9 +6,6 @@ module Info
, Category(..)
, category
, setCategory
, Cost(..)
, cost
, setCost
, SourceSpan(..)
, SourcePos(..)
, SourceSpans(..)
@ -18,7 +15,6 @@ module Info
, sourceText
) where
import Data.Functor.Listable
import Data.Record
import Prologue
import Category
@ -26,9 +22,6 @@ import Range
import SourceSpan
import Data.Aeson
newtype Cost = Cost { unCost :: Int }
deriving (Eq, Num, Ord, Show, ToJSON)
newtype SourceText = SourceText { unText :: Text }
deriving (Show, ToJSON)
@ -44,12 +37,6 @@ category = getField
setCategory :: HasField fields Category => Record fields -> Category -> Record fields
setCategory = setField
cost :: HasField fields Cost => Record fields -> Cost
cost = getField
setCost :: HasField fields Cost => Record fields -> Cost -> Record fields
setCost = setField
sourceText :: HasField fields SourceText => Record fields -> SourceText
sourceText = getField
@ -58,8 +45,3 @@ sourceSpan = getField
setSourceSpan :: HasField fields SourceSpan => Record fields -> SourceSpan -> Record fields
setSourceSpan = setField
-- Instances
instance Listable Cost where
tiers = cons1 Cost

46
src/Interpreter.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE GADTs, RankNTypes #-}
module Interpreter (Comparable, DiffConstructor, diffTerms) where
module Interpreter (diffTerms) where
import Algorithm
import Data.Align.Generic
@ -12,47 +12,34 @@ import Diff
import Info
import Patch
import Prologue hiding (lookup)
import SES
import Syntax as S
import Term
-- | Returns whether two terms are comparable
type Comparable f annotation = Term f annotation -> Term f annotation -> Bool
-- | Constructs a diff from the CofreeF containing its annotation and syntax. This function has the opportunity to, for example, cache properties in the annotation.
type DiffConstructor f annotation = TermF f (Both annotation) (Diff f annotation) -> Diff f annotation
-- | Diff two terms recursively, given functions characterizing the diffing.
diffTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
=> DiffConstructor (Syntax leaf) (Record fields) -- ^ A function to wrap up & possibly annotate every produced diff.
-> Comparable (Syntax leaf) (Record fields) -- ^ A function to determine whether or not two terms should even be compared.
-> SES.Cost (SyntaxDiff leaf fields) -- ^ A function to compute the cost of a given diff node.
-> SyntaxTerm leaf fields -- ^ A term representing the old state.
=> SyntaxTerm leaf fields -- ^ A term representing the old state.
-> SyntaxTerm leaf fields -- ^ A term representing the new state.
-> SyntaxDiff leaf fields
diffTerms construct comparable cost a b = fromMaybe (replacing a b) $ diffComparableTerms construct comparable cost a b
diffTerms a b = fromMaybe (replacing a b) $ diffComparableTerms a b
-- | Diff two terms recursively, given functions characterizing the diffing. If the terms are incomparable, returns 'Nothing'.
diffComparableTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
=> DiffConstructor (Syntax leaf) (Record fields)
-> Comparable (Syntax leaf) (Record fields)
-> SES.Cost (SyntaxDiff leaf fields)
-> SyntaxTerm leaf fields
=> SyntaxTerm leaf fields
-> SyntaxTerm leaf fields
-> Maybe (SyntaxDiff leaf fields)
diffComparableTerms construct comparable cost = recur
diffComparableTerms = recur
where recur a b
| (category <$> a) == (category <$> b) = hylo construct runCofree <$> zipTerms a b
| comparable a b = runAlgorithm construct recur cost (Just <$> algorithmWithTerms construct a b)
| (category <$> a) == (category <$> b) = hylo wrap runCofree <$> zipTerms a b
| comparable a b = runAlgorithm recur (Just <$> algorithmWithTerms a b)
| otherwise = Nothing
comparable = (==) `on` category . extract
-- | Construct an algorithm to diff a pair of terms.
algorithmWithTerms :: Applicative diff
=> (TermF (Syntax leaf) (Both a) (diff (Patch (Term (Syntax leaf) a))) -> diff (Patch (Term (Syntax leaf) a)))
-> Term (Syntax leaf) a
algorithmWithTerms :: MonadFree (TermF (Syntax leaf) (Both a)) diff
=> Term (Syntax leaf) a
-> Term (Syntax leaf) a
-> Algorithm (Term (Syntax leaf) a) (diff (Patch (Term (Syntax leaf) a))) (diff (Patch (Term (Syntax leaf) a)))
algorithmWithTerms construct t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ case (unwrap t1, unwrap t2) of
algorithmWithTerms t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ case (unwrap t1, unwrap t2) of
(Indexed a, Indexed b) ->
Just $ Indexed <$> byRWS a b
(S.Module idA a, S.Module idB b) ->
@ -89,7 +76,7 @@ algorithmWithTerms construct t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ ca
<*> byRWS bodyA bodyB
_ -> Nothing
where
annotate = construct . (both (extract t1) (extract t2) :<)
annotate = wrap . (both (extract t1) (extract t2) :<)
maybeLinearly :: Applicative f => Maybe a -> Maybe a -> Algorithm a (f (Patch a)) (Maybe (f (Patch a)))
maybeLinearly a b = sequenceA $ case (a, b) of
@ -100,14 +87,11 @@ algorithmWithTerms construct t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ ca
-- | Run an algorithm, given functions characterizing the evaluation.
runAlgorithm :: (GAlign f, HasField fields Category, Eq (f (Cofree f Category)), Traversable f, HasField fields (Maybe FeatureVector))
=> (CofreeF f (Both (Record fields)) (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) -> Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) -- ^ A function to wrap up & possibly annotate every produced diff.
-> (Cofree f (Record fields) -> Cofree f (Record fields) -> Maybe (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields))))) -- ^ A function to diff two subterms recursively, if they are comparable, or else return 'Nothing'.
-> SES.Cost (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) -- ^ A function to compute the cost of a given diff node.
=> (Cofree f (Record fields) -> Cofree f (Record fields) -> Maybe (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields))))) -- ^ A function to diff two subterms recursively, if they are comparable, or else return 'Nothing'.
-> Algorithm (Cofree f (Record fields)) (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) a -- ^ The algorithm to run.
-> a
runAlgorithm construct recur cost = iterAp $ \ r cont -> case r of
Linear a b -> cont . maybe (replacing a b) (construct . (both (extract a) (extract b) :<)) $ do
runAlgorithm recur = iterAp $ \ r cont -> case r of
Linear a b -> cont . maybe (replacing a b) (wrap . (both (extract a) (extract b) :<)) $ do
aligned <- galign (unwrap a) (unwrap b)
traverse (these (Just . deleting) (Just . inserting) recur) aligned
SES as bs -> cont (ses recur cost as bs)
RWS as bs -> cont (rws recur as bs)

11
src/Parse.hs
View File

@ -64,9 +64,6 @@ run Arguments{..} = do
Nothing -> for_ text putStrLn
Just path -> for_ text (T.writeFile path)
-- | Return a parser that decorates with the cost of a term and its children.
parserWithCost :: FilePath -> Parser (Syntax Text) (Record '[Cost, Range, Category, SourceSpan])
parserWithCost path blob = decorateTerm termCostDecorator <$> parserForType (toS (takeExtension path)) blob
-- | Return a parser that decorates with the source text.
parserWithSource :: FilePath -> Parser (Syntax Text) (Record '[SourceText, Range, Category, SourceSpan])
@ -89,10 +86,6 @@ decorateTerm decorator = cata $ \ term -> cofree ((decorator (extract <$> term)
-- | A function computing a value to decorate terms with. This can be used to cache synthesized attributes on terms.
type TermDecorator f fields field = TermF f (Record fields) (Record (field ': fields)) -> field
-- | Term decorator computing the cost of an unpacked term.
termCostDecorator :: (Foldable f, Functor f) => TermDecorator f a Cost
termCostDecorator c = 1 + sum (cost <$> tailF c)
-- | Term decorator extracting the source text for a term.
termSourceDecorator :: (HasField fields Range) => Source -> TermDecorator f fields SourceText
termSourceDecorator source c = SourceText . toText $ Source.slice range' source
@ -111,8 +104,8 @@ lineByLineParser SourceBlob{..} = pure . cofree . root $ case foldl' annotateLea
(accum <> [ leaf charIndex (Source.toText line) ] , charIndex + Source.length line)
-- | Return the parser that should be used for a given path.
parserForFilepath :: FilePath -> Parser (Syntax Text) (Record '[Cost, Range, Category, SourceSpan])
parserForFilepath path blob = decorateTerm termCostDecorator <$> parserForType (toS (takeExtension path)) blob
parserForFilepath :: FilePath -> Parser (Syntax Text) (Record '[Range, Category, SourceSpan])
parserForFilepath = parserForType . toS . takeExtension
-- | Read the file and convert it to Unicode.
readAndTranscodeFile :: FilePath -> IO Source

8
src/Renderer/Split.hs
View File

@ -158,7 +158,7 @@ splitPatchToClassName patch = stringValue $ "patch " <> case patch of
SplitReplace _ -> "replace"
-- | Render a diff as an HTML split diff.
split :: (HasField fields Category, HasField fields Cost, HasField fields Range) => Renderer (Record fields)
split :: (HasField fields Category, HasField fields Range) => Renderer (Record fields)
split blobs diff = SplitOutput . TL.toStrict . renderHtml
. docTypeHtml
. ((head $ link ! A.rel "stylesheet" ! A.href "style.css") <>)
@ -220,13 +220,11 @@ instance (ToMarkup f, HasField fields Category, HasField fields Range) => ToMark
instance (HasField fields Category, HasField fields Range) => ToMarkup (Renderable (SyntaxTerm leaf fields)) where
toMarkup (Renderable source term) = Prologue.fst $ cata (\ t -> (toMarkup $ Renderable source t, byteRange (headF t))) term
instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SplitSyntaxDiff leaf fields)) where
instance (HasField fields Category, HasField fields Range) => ToMarkup (Renderable (SplitSyntaxDiff leaf fields)) where
toMarkup (Renderable source diff) = Prologue.fst . iter (\ t -> (toMarkup $ Renderable source t, byteRange (headF t))) $ toMarkupAndRange <$> diff
where toMarkupAndRange patch = let term@(info :< _) = runCofree $ getSplitTerm patch in
((div ! patchAttribute patch `withCostAttribute` cost info) . toMarkup $ Renderable source (cofree term), byteRange info)
((div ! patchAttribute patch) . toMarkup $ Renderable source (cofree term), byteRange info)
patchAttribute patch = A.class_ (splitPatchToClassName patch)
withCostAttribute a (Cost c) | c > 0 = a ! A.data_ (stringValue (show c))
| otherwise = identity
instance ToMarkup a => ToMarkup (Cell a) where
toMarkup (Cell hasChanges num line)

4
src/SemanticDiff.hs
View File

@ -88,7 +88,7 @@ diffPaths :: Arguments -> Both FilePath -> IO ()
diffPaths args@Arguments{..} paths = do
sources <- sequence $ readAndTranscodeFile <$> paths
let sourceBlobs = Source.SourceBlob <$> sources <*> pure mempty <*> paths <*> pure (Just Source.defaultPlainBlob)
D.printDiff (parserWithCost (fst paths)) (diffArgs args) sourceBlobs
D.printDiff (parserForFilepath (fst paths)) (diffArgs args) sourceBlobs
where
diffArgs Arguments{..} = R.DiffArguments { format = format, output = output }
@ -113,7 +113,7 @@ fetchDiff' Arguments{..} filepath = do
let sources = fromMaybe (Source.emptySourceBlob filepath) <$> sourcesAndOids
let sourceBlobs = Source.idOrEmptySourceBlob <$> sources
let textDiff = D.textDiff (parserWithCost filepath) diffArguments sourceBlobs
let textDiff = D.textDiff (parserForFilepath filepath) diffArguments sourceBlobs
text <- fetchText textDiff
truncatedPatch <- liftIO $ D.truncatedDiff diffArguments sourceBlobs

4
test/CorpusSpec.hs
View File

@ -75,7 +75,7 @@ normalizeName path = addExtension (dropExtension $ dropExtension path) (takeExte
-- | Given file paths for A, B, and, optionally, a diff, return whether diffing
-- | the files will produce the diff. If no diff is provided, then the result
-- | is true, but the diff will still be calculated.
testDiff :: Renderer (Record '[Cost, Range, Category, SourceSpan]) -> Both (Maybe FilePath) -> Maybe FilePath -> (Maybe Verbatim -> Maybe Verbatim -> Expectation) -> Expectation
testDiff :: Renderer (Record '[Range, Category, SourceSpan]) -> Both (Maybe FilePath) -> Maybe FilePath -> (Maybe Verbatim -> Maybe Verbatim -> Expectation) -> Expectation
testDiff renderer paths diff matcher = do
sources <- traverse (traverse readAndTranscodeFile) paths
actual <- fmap Verbatim <$> traverse ((pure . concatOutputs . pure) <=< diffFiles' sources) parser
@ -85,7 +85,7 @@ testDiff renderer paths diff matcher = do
expected <- Verbatim <$> readFile file
matcher actual (Just expected)
where diffFiles' sources parser = diffFiles parser renderer (sourceBlobs sources paths)
parser = parserWithCost <$> runBothWith (<|>) paths
parser = parserForFilepath <$> runBothWith (<|>) paths
sourceBlobs :: Both (Maybe (S.Source)) -> Both (Maybe FilePath) -> Both S.SourceBlob
sourceBlobs sources paths = case runJoin paths of
(Nothing, Nothing) -> Join (S.emptySourceBlob "", S.emptySourceBlob "")

6
test/Diff/Spec.hs
View File

@ -24,16 +24,16 @@ spec = parallel $ do
prop "equal terms produce identity diffs" $
\ a -> let term = decorate (unListableF a :: SyntaxTerm String '[Category]) in
diffCost (diffTerms wrap (==) diffCost term term) `shouldBe` 0
diffCost (diffTerms term term) `shouldBe` 0
describe "beforeTerm" $ do
prop "recovers the before term" $
\ a b -> let diff = stripDiff $ diffTerms wrap (==) diffCost (decorate (unListableF a)) (decorate (unListableF b :: SyntaxTerm String '[Category])) in
\ a b -> let diff = stripDiff $ diffTerms (decorate (unListableF a)) (decorate (unListableF b :: SyntaxTerm String '[Category])) in
beforeTerm diff `shouldBe` Just (unListableF a)
describe "afterTerm" $ do
prop "recovers the after term" $
\ a b -> let diff = stripDiff $ diffTerms wrap (==) diffCost (decorate (unListableF a)) (decorate (unListableF b :: SyntaxTerm String '[Category])) in
\ a b -> let diff = stripDiff $ diffTerms (decorate (unListableF a)) (decorate (unListableF b :: SyntaxTerm String '[Category])) in
afterTerm diff `shouldBe` Just (unListableF b)
unListableDiff :: Functor f => ListableF (Free (TermF f (ListableF (Join (,)) annotation))) (Patch (ListableF (Term f) annotation)) -> Diff f annotation

4
test/DiffSummarySpec.hs
View File

@ -51,12 +51,12 @@ spec = parallel $ do
prop "equal terms produce identity diffs" $
\ a -> let term = defaultFeatureVectorDecorator (category . headF) (unListableF a :: SyntaxTerm String '[Category, Range, SourceSpan]) in
diffSummaries blobs (diffTerms wrap (==) diffCost term term) `shouldBe` []
diffSummaries blobs (diffTerms term term) `shouldBe` []
describe "DiffInfo" $ do
prop "patches in summaries match the patches in diffs" $
\a -> let
diff = unListableDiff a :: SyntaxDiff String '[Category, Cost, Range, SourceSpan]
diff = unListableDiff a :: SyntaxDiff String '[Category, Range, SourceSpan]
summaries = diffToDiffSummaries (source <$> blobs) diff
patches = toList diff
in

9
test/InterpreterSpec.hs
View File

@ -23,22 +23,21 @@ spec :: Spec
spec = parallel $ do
describe "interpret" $ do
let decorate = defaultFeatureVectorDecorator (category . headF)
let compare = (==) `on` category . extract
it "returns a replacement when comparing two unicode equivalent terms" $
let termA = cofree $ (StringLiteral :. Nil) :< Leaf ("t\776" :: String)
termB = cofree $ (StringLiteral :. Nil) :< Leaf "\7831" in
stripDiff (diffTerms wrap compare diffCost (decorate termA) (decorate termB)) `shouldBe` replacing termA termB
stripDiff (diffTerms (decorate termA) (decorate termB)) `shouldBe` replacing termA termB
prop "produces correct diffs" $
\ a b -> let diff = stripDiff $ diffTerms wrap compare diffCost (decorate (unListableF a)) (decorate (unListableF b :: SyntaxTerm String '[Category])) in
\ a b -> let diff = stripDiff $ diffTerms (decorate (unListableF a)) (decorate (unListableF b :: SyntaxTerm String '[Category])) in
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (unListableF a), Just (unListableF b))
prop "constructs zero-cost diffs of equal terms" $
\ a -> let term = decorate (unListableF a :: SyntaxTerm String '[Category])
diff = diffTerms wrap compare diffCost term term in
diff = diffTerms term term in
diffCost diff `shouldBe` 0
it "produces unbiased insertions within branches" $
let term s = decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf s) ]))
root = cofree . ((Just (listArray (0, defaultD) (repeat 0)) :. Program :. Nil) :<) . Indexed in
stripDiff (diffTerms wrap compare diffCost (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` wrap (pure (Program :. Nil) :< Indexed [ inserting (stripTerm (term "a")), cata wrap (fmap pure (stripTerm (term "b"))) ])
stripDiff (diffTerms (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` wrap (pure (Program :. Nil) :< Indexed [ inserting (stripTerm (term "a")), cata wrap (fmap pure (stripTerm (term "b"))) ])

14
test/TOCSpec.hs
View File

@ -6,7 +6,6 @@ import Data.Functor.Both
import Data.Functor.Listable
import Data.RandomWalkSimilarity
import Data.Record
import Data.These
import Data.String
import Diff
import Diffing
@ -95,7 +94,7 @@ spec = parallel $ do
prop "equal terms produce identity diffs" $
\a -> let term = defaultFeatureVectorDecorator (Info.category . headF) (unListableF a :: Term') in
diffTOC blankDiffBlobs (diffTerms wrap (==) diffCost term term) `shouldBe` []
diffTOC blankDiffBlobs (diffTerms term term) `shouldBe` []
type Diff' = SyntaxDiff String '[Range, Category, SourceSpan]
type Term' = SyntaxTerm String '[Range, Category, SourceSpan]
@ -157,23 +156,18 @@ isMethodOrFunction a = case runCofree (unListableF a) of
(_ :< S.Function{}) -> True
_ -> False
testDiff :: Both SourceBlob -> IO (Diff (Syntax Text) (Record '[Cost, Range, Category, SourceSpan]))
testDiff :: Both SourceBlob -> IO (Diff (Syntax Text) (Record '[Range, Category, SourceSpan]))
testDiff sourceBlobs = do
terms <- traverse (fmap (defaultFeatureVectorDecorator getLabel) . parser) sourceBlobs
pure $! stripDiff (diffTerms' terms sourceBlobs)
where
parser = parserWithCost (path . fst $ sourceBlobs)
parser = parserForFilepath (path . fst $ sourceBlobs)
diffTerms' terms blobs = case runBothWith areNullOids blobs of
(True, False) -> pure $ Insert (snd terms)
(False, True) -> pure $ Delete (fst terms)
(_, _) -> runBothWith (diffTerms construct compareCategoryEq diffCostWithCachedTermCosts) terms
(_, _) -> runBothWith diffTerms terms
areNullOids a b = (hasNullOid a, hasNullOid b)
hasNullOid blob = oid blob == nullOid || Source.null (source blob)
construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax))
sumCost = fmap getSum . foldMap (fmap Sum . getCost)
getCost diff = case runFree diff of
Free (info :< _) -> cost <$> info
Pure patch -> uncurry both (fromThese 0 0 (unPatch (cost . extract <$> patch)))
blobsForPaths :: Both FilePath -> IO (Both SourceBlob)
blobsForPaths paths = do

4
test/diffs/dictionary.split.js
View File

@ -4,9 +4,9 @@
<td class="blob-num">1</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statements"><li><ul class="category-object">{
</ul></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_statements"><li><ul class="category-object"> <li><ul class="category-pair"><li><span class="category-string">&quot;b&quot;</span></li>: <li><div class="patch replace" data="1"><span class="category-number">4</span></div></li></ul></li>,
</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_statements"><li><ul class="category-object"> <li><ul class="category-pair"><li><span class="category-string">&quot;b&quot;</span></li>: <li><div class="patch replace"><span class="category-number">4</span></div></li></ul></li>,
</ul></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_statements"><li><ul class="category-object"> <li><ul class="category-pair"><li><span class="category-string">&quot;b&quot;</span></li>: <li><div class="patch replace" data="1"><span class="category-number">5</span></div></li></ul></li>,
<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_statements"><li><ul class="category-object"> <li><ul class="category-pair"><li><span class="category-string">&quot;b&quot;</span></li>: <li><div class="patch replace"><span class="category-number">5</span></div></li></ul></li>,
</ul></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_statements"><li><ul class="category-object"> <li><ul class="category-pair"><li><span class="category-string">&quot;a&quot;</span></li>: <li><span class="category-number">5</span></li></ul></li>

2
test/diffs/insert.split.js
View File

@ -5,7 +5,7 @@
</ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>
<td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert" data="5"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&#39;world&#39;</span></li>)</ul></li>;</ul></div></li>
<td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&#39;world&#39;</span></li>)</ul></li>;</ul></div></li>
</ul></td>
</tr><tr><td class="blob-num">2</td><td class="blob-code"><ul class="category-program"></ul></td>

6
test/diffs/multiline-insert.split.js
View File

@ -5,15 +5,15 @@
</ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>
<td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert" data="8"><ul class="category-if_statement">if (<li><span class="category-boolean">true</span></li>) <li><ul class="category-expression_statements">{
<td class="blob-num blob-num-replacement">2</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert"><ul class="category-if_statement">if (<li><span class="category-boolean">true</span></li>) <li><ul class="category-expression_statements">{
</ul></li></ul></div></li></ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert" data="8"><ul class="category-if_statement"><li><ul class="category-expression_statements"> <li><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&#39;cruel&#39;</span></li>)</ul></li>;</ul></li>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert"><ul class="category-if_statement"><li><ul class="category-expression_statements"> <li><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&#39;cruel&#39;</span></li>)</ul></li>;</ul></li>
</ul></li></ul></div></li></ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>
<td class="blob-num blob-num-replacement">4</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert" data="8"><ul class="category-if_statement"><li><ul class="category-expression_statements">}</ul></li></ul></div></li>
<td class="blob-num blob-num-replacement">4</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert"><ul class="category-if_statement"><li><ul class="category-expression_statements">}</ul></li></ul></div></li>
</ul></td>
</tr><tr><td class="blob-num">2</td><td class="blob-code"><ul class="category-program"><li><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&#39;world&#39;</span></li>)</ul></li>;</ul></li>

2
test/diffs/nested-insert.split.js
View File

@ -10,7 +10,7 @@
</ul></li></ul></li></ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><ul class="category-if_statement"><li><ul class="category-expression_statements"> <li><div class="patch insert" data="5"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&#39;world&#39;</span></li>)</ul></li>;</ul></div></li>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><ul class="category-if_statement"><li><ul class="category-expression_statements"> <li><div class="patch insert"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&#39;world&#39;</span></li>)</ul></li>;</ul></div></li>
</ul></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-if_statement"><li><ul class="category-expression_statements">}</ul></li></ul></li>

2
test/diffs/newline-at-eof.split.js
View File

@ -9,7 +9,7 @@
</ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert" data="5"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&quot;insertion&quot;</span></li>)</ul></li>;</ul></div></li>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&quot;insertion&quot;</span></li>)</ul></li>;</ul></div></li>
</ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>

2
test/diffs/no-newline-at-eof.split.js
View File

@ -8,6 +8,6 @@
</ul></td>
</tr><tr><td class="blob-num blob-num-empty empty-cell"></td><td class="blob-code blob-code-empty empty-cell"></td>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert" data="5"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&quot;insertion&quot;</span></li>)</ul></li>;</ul></div></li></ul></td>
<td class="blob-num blob-num-replacement">3</td><td class="blob-code blob-code-replacement"><ul class="category-program"><li><div class="patch insert"><ul class="category-expression_statements"><li><ul class="category-function_call"><li><span class="category-identifier">console</span></li>.<li><span class="category-identifier">log</span></li>(<li><span class="category-string">&quot;insertion&quot;</span></li>)</ul></li>;</ul></div></li></ul></td>
</tr></table></body></html>