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

Define diffCost as a catamorphism.

Browse Source
This commit is contained in:
Rob Rix 2017-09-09 18:03:07 +01:00
parent 0bfd29fddc
commit 19febc23aa
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Interpreter.hs
View File

@ -11,6 +11,7 @@ import Control.Monad.Free.Freer
import Data.Align.Generic
import Data.Functor.Both
import Data.Functor.Classes (Eq1)
import Data.Functor.Foldable (cata)
import Data.Hashable (Hashable)
import Data.Maybe (isJust)
import Data.Record
@ -124,9 +125,8 @@ defaultM = 10
-- | Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
editDistanceUpTo :: (GAlign f, Foldable f, Functor f) => Integer -> These (Term f (Record fields)) (Term f (Record fields)) -> Int
editDistanceUpTo m = these termSize termSize (\ a b -> diffCost m (approximateDiff a b))
where diffCost m (Diff.Diff diff)
| m <= 0 = 0
| otherwise = case diff of
Copy _ r -> sum (fmap (diffCost (pred m)) r)
Patch patch -> patchSum termSize patch
where diffCost = flip . cata $ \ diff m -> case diff of
_ | m <= 0 -> 0
Copy _ r -> sum (fmap ($ pred m) r)
Patch patch -> patchSum termSize patch
approximateDiff a b = maybe (replacing a b) (copy (both (extract a) (extract b))) (galignWith (these deleting inserting approximateDiff) (unwrap a) (unwrap b))