github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00
Code Issues Projects Releases Wiki Activity

Loosen the Eq constraint in RWS to an Eq1 constraint.

Browse Source
This commit is contained in:
Rob Rix 2017-02-23 11:03:25 -05:00
parent 361710dd65
commit 6dcfff4716
2 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/RandomWalkSimilarity.hs
View File

@ -21,6 +21,8 @@ import Control.Monad.Random
import Control.Monad.State
import Data.Align.Generic
import Data.Array
import Data.Functor.Classes
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Listable
import Data.Hashable
import qualified Data.IntMap as IntMap
@ -46,7 +48,7 @@ type DiffTerms f fields = Term f (Record fields) -> Term f (Record fields) -> Ma
--
-- This implementation is based on the paper [_RWS-Diff—Flexible and Efficient Change Detection in Hierarchical Data_](https://github.com/github/semantic-diff/files/325837/RWS-Diff.Flexible.and.Efficient.Change.Detection.in.Hierarchical.Data.pdf).
rws :: forall f fields.
(GAlign f, Traversable f, Eq (f (Term f Category)), HasField fields Category, HasField fields (Maybe FeatureVector))
(GAlign f, Traversable f, Eq1 f, HasField fields Category, HasField fields (Maybe FeatureVector))
=> DiffTerms f fields -- ^ A function which compares a pair of terms recursively, returning 'Just' their diffed value if appropriate, or 'Nothing' if they should not be compared.
-> [Term f (Record fields)] -- ^ The list of old terms.
-> [Term f (Record fields)] -- ^ The list of new terms.
@ -149,7 +151,7 @@ rws compare as bs
-- Possibly replace terms in a diff.
replaceIfEqual :: Term f (Record fields) -> Term f (Record fields) -> Maybe (Diff f (Record fields))
replaceIfEqual a b
| (category <$> a) == (category <$> b) = hylo wrap runCofree <$> zipTerms (eraseFeatureVector a) (eraseFeatureVector b)
| gliftEq (==) (category <$> a) (category <$> b) = hylo wrap runCofree <$> zipTerms (eraseFeatureVector a) (eraseFeatureVector b)
| otherwise = Nothing
cost = iter (const 0) . (1 <$)

5
src/Interpreter.hs
View File

@ -3,8 +3,9 @@ module Interpreter (diffTerms) where
import Algorithm
import Data.Align.Generic
import Data.Functor.Foldable
import Data.Functor.Both
import Data.Functor.Classes
import Data.Functor.Foldable
import Data.RandomWalkSimilarity as RWS
import Data.Record
import Data.These
@ -86,7 +87,7 @@ algorithmWithTerms t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ case (unwrap
(Nothing, Nothing) -> Nothing
-- | 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))
runAlgorithm :: (Eq1 f, GAlign f, Traversable f, HasField fields Category, HasField fields (Maybe FeatureVector))
=> (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