mirror of
https://github.com/github/semantic.git
synced 2024-12-30 02:14:20 +03:00
29 lines
922 B
Haskell
29 lines
922 B
Haskell
module SES where
|
|
|
|
import Patch
|
|
import Diff
|
|
import Control.Monad.Free
|
|
import Control.Comonad.Cofree
|
|
|
|
type Compare a = Term a Info -> Term a Info -> Maybe (Diff a)
|
|
type Cost a = Diff a -> Integer
|
|
|
|
ses :: Compare a -> Cost a -> [Term a Info] -> [Term a Info] -> [Diff a]
|
|
ses _ _ [] b = (Pure . Insert) <$> b
|
|
ses _ _ a [] = (Pure . Delete) <$> a
|
|
ses recur cost (a : as) (b : bs) = case recur a b of
|
|
Just f | deleteCost < insertCost && deleteCost < copyCost -> delete
|
|
| insertCost < copyCost -> insert
|
|
| otherwise -> copy
|
|
where
|
|
copy = f : ses recur cost as bs
|
|
copyCost = sumCost copy
|
|
Nothing | deleteCost < insertCost -> delete
|
|
| otherwise -> insert
|
|
where
|
|
delete = (Pure . Delete $ a) : ses recur cost as (b : bs)
|
|
insert = (Pure . Insert $ b) : ses recur cost (a : as) bs
|
|
deleteCost = sumCost delete
|
|
insertCost = sumCost insert
|
|
sumCost a = sum $ cost <$> a
|