github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 17:04:47 +03:00
Code Issues Projects Releases Wiki Activity

Linearly operates on terms once more.

Browse Source
This commit is contained in:
Rob Rix 2017-09-22 23:07:41 -04:00
parent 528728d01c
commit dd9b811aeb
2 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Algorithm.hs
View File

@ -4,7 +4,6 @@ module Algorithm where
import Control.Applicative (Alternative(..))
import Control.Monad (guard)
import Control.Monad.Free.Freer
import Data.Align.Generic
import Data.Functor.Classes
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe
@ -20,7 +19,7 @@ data AlgorithmF term1 term2 result partial where
-- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
Diff :: term1 -> term2 -> AlgorithmF term1 term2 result result
-- | Diff two terms recursively in O(n) time, resulting in a single diff node.
Linear :: (GAlign syntax, Show1 syntax, Traversable syntax) => syntax term1 -> syntax term2 -> AlgorithmF term1 term2 result (syntax result)
Linear :: term1 -> term2 -> AlgorithmF term1 term2 result result
-- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
RWS :: [term1] -> [term2] -> AlgorithmF term1 term2 result [result]
-- | Delete a term.
@ -56,7 +55,7 @@ diffMaybe _ (Just b) = Just <$> byInserting b
diffMaybe _ _ = pure Nothing
-- | Diff two terms linearly.
linearly :: (GAlign syntax, Show1 syntax, Traversable syntax) => syntax term1 -> syntax term2 -> Algorithm term1 term2 result (syntax result)
linearly :: term1 -> term2 -> Algorithm term1 term2 result result
linearly f1 f2 = liftF (Linear f1 f2)
-- | Diff two terms using RWS.
@ -79,7 +78,7 @@ byReplacing = (liftF .) . Replace
instance (Show term1, Show term2) => Show1 (AlgorithmF term1 term2 result) where
liftShowsPrec sp _ d algorithm = case algorithm of
Algorithm.Diff t1 t2 -> showsBinaryWith showsPrec showsPrec "Diff" d t1 t2
Linear t1 t2 -> showsBinaryWith (liftShowsPrec showsPrec showList) (liftShowsPrec showsPrec showList) "Linear" d t1 t2
Linear t1 t2 -> showsBinaryWith showsPrec showsPrec "Linear" d t1 t2
RWS as bs -> showsBinaryWith (liftShowsPrec showsPrec showList) (liftShowsPrec showsPrec showList) "RWS" d as bs
Delete t1 -> showsUnaryWith showsPrec "Delete" d t1
Insert t2 -> showsUnaryWith showsPrec "Insert" d t2

2
src/Interpreter.hs
View File

@ -65,7 +65,7 @@ runAlgorithm :: (Diffable syntax, GAlign syntax, Traversable syntax, Alternative
runAlgorithm comparable eqTerms = go
where go = iterFreerA (\ step yield -> case step of
Algorithm.Diff t1 t2 -> (go (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield)
Linear f1 f2 -> galignWith (go . diffThese) f1 f2 >>= yield
Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> galignWith (go . diffThese) f1 f2 >>= yield
RWS as bs -> traverse (go . diffThese) (rws comparable eqTerms as bs) >>= yield
Delete a -> yield (deleting a)
Insert b -> yield (inserting b)