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

🔥 diffThese.

Browse Source
This commit is contained in:
Rob Rix 2019-10-18 11:20:35 -04:00
parent e8dacbe186
commit a7dc70f474
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 5 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Diffing/Algorithm.hs
View File

@ -5,7 +5,6 @@ module Diffing.Algorithm
, Diffable (..)
, Equivalence (..)
, diff
, diffThese
, diffEdit
, diffMaybe
, linearly
@ -55,10 +54,6 @@ instance Carrier sig m => Carrier sig (Algorithm term1 term2 diff m) where
diff :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> m diff
diff a1 a2 = send (Diff a1 a2 pure)
-- | Diff a These of terms without specifying the algorithm to be used.
diffThese :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => These term1 term2 -> Algorithm term1 term2 diff m diff
diffThese = these byDeleting byInserting diff
-- | Diff an 'Edit' of terms without specifying the algorithm to be used.
diffEdit :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Edit.Edit term1 term2 -> Algorithm term1 term2 diff m diff
diffEdit = Edit.edit byDeleting byInserting diff

10
src/Diffing/Interpreter.hs
View File

@ -9,7 +9,7 @@ import Control.Effect.Carrier
import Control.Effect.Cull
import Control.Effect.NonDet
import qualified Data.Diff as Diff
import Data.Edit (Edit, edit)
import qualified Data.Edit as Edit
import Data.Term
import Diffing.Algorithm
import Diffing.Algorithm.RWS
@ -37,12 +37,12 @@ class Bifoldable (DiffFor term) => DiffTerms term where
-- Note that the dependency means that the diff type is in 1:1 correspondence with the term type. This allows subclasses of 'DiffTerms' to receive e.g. @'DiffFor' term a b@ without incurring ambiguity, since every diff type is unique to its term type.
type DiffFor term = (diff :: * -> * -> *) | diff -> term
-- | Diff an 'Edit' of terms.
diffTermPair :: Edit (term ann1) (term ann2) -> DiffFor term ann1 ann2
-- | Diff an 'Edit.Edit' of terms.
diffTermPair :: Edit.Edit (term ann1) (term ann2) -> DiffFor term ann1 ann2
instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => DiffTerms (Term syntax) where
type DiffFor (Term syntax) = Diff.Diff syntax
diffTermPair = edit Diff.deleting Diff.inserting diffTerms
diffTermPair = Edit.edit Diff.deleting Diff.inserting diffTerms
-- | Run an 'Algorithm' to completion in an 'Alternative' context using the supplied comparability & equivalence relations.
@ -72,7 +72,7 @@ instance ( Alternative m
(DiffC (Term syntax (FeatureVector, ann1)) (Term syntax (FeatureVector, ann2)) (Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2)) m) where
eff (L op) = case op of
Diff t1 t2 k -> runDiff (algorithmForTerms t1 t2) <|> pure (Diff.comparing t1 t2) >>= k
Linear (Term (In ann1 f1)) (Term (In ann2 f2)) k -> Diff.merge (ann1, ann2) <$> tryAlignWith (runDiff . diffThese) f1 f2 >>= k
Linear (Term (In ann1 f1)) (Term (In ann2 f2)) k -> Diff.merge (ann1, ann2) <$> tryAlignWith (runDiff . diffEdit . these Edit.Delete Edit.Insert Edit.Compare) f1 f2 >>= k
RWS as bs k -> traverse (runDiff . diffEdit) (rws comparableTerms equivalentTerms as bs) >>= k
Delete a k -> k (Diff.deleting a)
Insert b k -> k (Diff.inserting b)