2015-11-18 03:20:52 +03:00
module Algorithm where
2015-11-18 03:24:01 +03:00
2016-09-25 09:27:59 +03:00
import Control.Applicative.Free
import Prologue hiding ( Pure )
2016-08-04 01:12:31 +03:00
-- | A single step in a diffing algorithm.
2016-08-04 19:31:18 +03:00
--
-- 'term' is the type of terms.
-- 'diff' is the type of diffs.
-- 'f' represents the continuation after diffing. Often 'Algorithm'.
data AlgorithmF term diff f
2016-08-04 01:12:31 +03:00
-- | Recursively diff two terms and pass the result to the continuation.
2016-08-04 01:43:36 +03:00
= Recursive term term ( diff -> f )
2016-08-04 19:07:19 +03:00
-- | Diff two lists by each element’ s position, and pass the resulting list of diffs to the continuation.
2016-08-04 01:43:36 +03:00
| ByIndex [ term ] [ term ] ( [ diff ] -> f )
2016-08-04 19:07:24 +03:00
-- | Diff two lists by each element’ s similarity and pass the resulting list of diffs to the continuation.
2016-08-04 19:06:15 +03:00
| BySimilarity [ term ] [ term ] ( [ diff ] -> f )
2016-08-04 01:12:31 +03:00
deriving Functor
2015-11-18 03:24:01 +03:00
2016-08-04 19:10:19 +03:00
-- | The free monad for 'AlgorithmF'. This enables us to construct diff values using do-notation. We use the Church-encoded free monad 'F' for efficiency.
2016-09-25 09:27:59 +03:00
type Algorithm term diff = Ap ( AlgorithmF term diff )
iter :: Functor g => ( g a -> a ) -> Ap g a -> a
iter algebra = go
where go ( Pure a ) = a
go ( Ap u q ) = algebra ( fmap ( go . ( ` fmap ` q ) . flip ( $ ) ) u )
2016-08-04 01:15:18 +03:00
2016-08-04 19:08:34 +03:00
-- DSL
2016-08-04 19:08:18 +03:00
-- | Constructs a 'Recursive' diff of two terms.
2016-08-04 18:06:19 +03:00
recursively :: term -> term -> Algorithm term diff diff
2016-09-25 09:27:59 +03:00
recursively a b = liftAp ( Recursive a b identity )
2016-08-04 01:38:35 +03:00
2016-08-04 19:08:18 +03:00
-- | Constructs a 'ByIndex' diff of two lists of terms.
2016-08-04 18:06:19 +03:00
byIndex :: [ term ] -> [ term ] -> Algorithm term diff [ diff ]
2016-09-25 09:27:59 +03:00
byIndex a b = liftAp ( ByIndex a b identity )
2016-08-04 01:40:17 +03:00
2016-08-04 19:08:18 +03:00
-- | Constructs a 'BySimilarity' diff of two lists of terms.
2016-08-04 18:06:19 +03:00
bySimilarity :: [ term ] -> [ term ] -> Algorithm term diff [ diff ]
2016-09-25 09:27:59 +03:00
bySimilarity a b = liftAp ( BySimilarity a b identity )