mirror of
https://github.com/github/semantic.git
synced 2024-12-22 22:31:36 +03:00
Merge branch '🔥-cost' into interpreter-decomposition
This commit is contained in:
Rob Rix
commit
e7cc5a9c6e
@ -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]
|
||||
-- | Delete a term..
|
||||
@ -35,10 +33,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)
|
||||
|
||||
@ -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
18
src/Info.hs
@ -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
|
||||
|
||||
@ -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 (Patch, inserting, deleting, replacing)
|
||||
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,16 +87,13 @@ 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)
|
||||
Delete a -> cont (deleting a)
|
||||
Insert b -> cont (inserting b)
|
||||
|
||||
11
src/Parse.hs
11
src/Parse.hs
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 "")
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"))) ])
|
||||
|
||||
@ -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,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">"b"</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">"b"</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">"b"</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">"b"</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">"a"</span></li>: <li><span class="category-number">5</span></li></ul></li>
|
||||
|
||||
@ -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">'world'</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">'world'</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>
|
||||
|
||||
@ -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">'cruel'</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">'cruel'</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">'world'</span></li>)</ul></li>;</ul></li>
|
||||
|
||||
@ -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">'world'</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">'world'</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>
|
||||
|
||||
@ -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">"insertion"</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">"insertion"</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>
|
||||
|
||||
@ -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">"insertion"</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">"insertion"</span></li>)</ul></li>;</ul></div></li></ul></td>
|
||||
|
||||
</tr></table></body></html>
|
||||
Loading…
Reference in New Issue
Block a user