2017-02-21 18:44:48 +03:00
|
|
|
|
{-# LANGUAGE GADTs, RankNTypes #-}
|
2015-11-18 03:20:52 +03:00
|
|
|
|
module Algorithm where
|
2015-11-18 03:24:01 +03:00
|
|
|
|
|
2017-02-24 21:28:44 +03:00
|
|
|
|
import Control.Monad.Free.Freer
|
2017-02-23 20:25:45 +03:00
|
|
|
|
import Data.These
|
2017-02-24 21:28:44 +03:00
|
|
|
|
import Prologue hiding (liftF)
|
2016-08-04 01:12:31 +03:00
|
|
|
|
|
2017-02-21 18:26:27 +03:00
|
|
|
|
-- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
|
2017-02-21 18:25:25 +03:00
|
|
|
|
data AlgorithmF term diff result where
|
2017-02-23 20:24:31 +03:00
|
|
|
|
-- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
|
|
|
|
|
Diff :: term -> term -> AlgorithmF term diff diff
|
2017-02-21 18:38:10 +03:00
|
|
|
|
-- | Diff two terms recursively in O(n) time, resulting in a single diff node.
|
2017-02-21 18:46:19 +03:00
|
|
|
|
Linear :: term -> term -> AlgorithmF term diff diff
|
2017-02-21 18:38:10 +03:00
|
|
|
|
-- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
|
2017-02-21 18:46:19 +03:00
|
|
|
|
RWS :: [term] -> [term] -> AlgorithmF term diff [diff]
|
2017-02-21 19:40:13 +03:00
|
|
|
|
-- | Delete a term..
|
|
|
|
|
Delete :: term -> AlgorithmF term diff diff
|
|
|
|
|
-- | Insert a term.
|
|
|
|
|
Insert :: term -> AlgorithmF term diff diff
|
|
|
|
|
-- | Replace one term with another.
|
|
|
|
|
Replace :: term -> term -> AlgorithmF term diff diff
|
2015-11-18 03:24:01 +03:00
|
|
|
|
|
2016-09-25 09:50:49 +03:00
|
|
|
|
-- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
|
2017-02-24 21:28:44 +03:00
|
|
|
|
type Algorithm term diff = Freer (AlgorithmF term diff)
|
2017-02-21 18:44:48 +03:00
|
|
|
|
|
2016-08-04 19:08:34 +03:00
|
|
|
|
|
|
|
|
|
-- DSL
|
|
|
|
|
|
2017-02-23 20:24:31 +03:00
|
|
|
|
-- | Diff two terms without specifying the algorithm to be used.
|
|
|
|
|
diff :: term -> term -> Algorithm term diff diff
|
2017-02-24 21:28:44 +03:00
|
|
|
|
diff = (liftF .) . Diff
|
2017-02-23 20:24:31 +03:00
|
|
|
|
|
2017-02-23 20:30:26 +03:00
|
|
|
|
-- | Diff a These of terms without specifying the algorithm to be used.
|
2017-02-23 20:25:45 +03:00
|
|
|
|
diffThese :: These term term -> Algorithm term diff diff
|
|
|
|
|
diffThese = these byDeleting byInserting diff
|
|
|
|
|
|
2017-02-21 19:39:41 +03:00
|
|
|
|
-- | Diff two terms linearly.
|
2017-02-21 18:46:19 +03:00
|
|
|
|
linearly :: term -> term -> Algorithm term diff diff
|
2017-02-24 21:28:44 +03:00
|
|
|
|
linearly a b = liftF (Linear a b)
|
2016-08-04 01:38:35 +03:00
|
|
|
|
|
2017-02-21 19:39:41 +03:00
|
|
|
|
-- | Diff two terms using RWS.
|
2017-02-21 18:46:19 +03:00
|
|
|
|
byRWS :: [term] -> [term] -> Algorithm term diff [diff]
|
2017-02-24 21:28:44 +03:00
|
|
|
|
byRWS a b = liftF (RWS a b)
|
2017-02-21 19:40:13 +03:00
|
|
|
|
|
|
|
|
|
-- | Delete a term.
|
|
|
|
|
byDeleting :: term -> Algorithm term diff diff
|
2017-02-24 21:28:44 +03:00
|
|
|
|
byDeleting = liftF . Delete
|
2017-02-21 19:40:13 +03:00
|
|
|
|
|
|
|
|
|
-- | Insert a term.
|
|
|
|
|
byInserting :: term -> Algorithm term diff diff
|
2017-02-24 21:28:44 +03:00
|
|
|
|
byInserting = liftF . Insert
|
2017-02-21 19:40:13 +03:00
|
|
|
|
|
|
|
|
|
-- | Replace one term with another.
|
|
|
|
|
byReplacing :: term -> term -> Algorithm term diff diff
|
2017-02-24 21:28:44 +03:00
|
|
|
|
byReplacing = (liftF .) . Replace
|