1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00
semantic/src/Algorithm.hs

44 lines
1.7 KiB
Haskell
Raw Normal View History

{-# LANGUAGE GADTs, RankNTypes #-}
2015-11-18 03:20:52 +03:00
module Algorithm where
2015-11-18 03:24:01 +03:00
import Control.Applicative.Free
import Prologue hiding (Pure)
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-21 18:38:10 +03:00
-- | Diff two terms recursively in O(n) time, resulting in a single diff node.
Linear :: term -> term -> AlgorithmF term diff diff
2017-02-21 18:38:10 +03:00
-- | Diff two lists of terms by each elements position in O(n³) time, resulting in a list of diffs.
SES :: [term] -> [term] -> AlgorithmF term diff [diff]
2017-02-21 18:38:10 +03:00
-- | Diff two lists of terms by each elements similarity in O(n³ log n), resulting in a list of diffs.
RWS :: [term] -> [term] -> AlgorithmF term diff [diff]
2015-11-18 03:24:01 +03:00
-- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
type Algorithm term diff = Ap (AlgorithmF term diff)
2016-09-25 10:22:14 +03:00
-- | Tear down an Ap by iteration.
2016-09-25 10:21:40 +03:00
iterAp :: Functor g => (g a -> a) -> Ap g a -> a
iterAp algebra = go
where go (Pure a) = a
2016-09-25 11:10:14 +03:00
go (Ap underlying apply) = algebra (go . (apply <*>) . pure <$> underlying)
iterAp' :: (forall x. g x -> (x -> a) -> a) -> Ap g a -> a
iterAp' algebra = go
where go (Pure a) = a
go (Ap underlying apply) = algebra underlying (go . (apply <*>) . pure)
2016-08-04 19:08:34 +03:00
-- DSL
2016-08-04 19:08:18 +03:00
-- | Constructs a 'Recursive' diff of two terms.
linearly :: term -> term -> Algorithm term diff diff
linearly a b = liftAp (Linear a b)
2016-08-04 19:08:18 +03:00
-- | Constructs a 'ByIndex' diff of two lists of terms.
bySES :: [term] -> [term] -> Algorithm term diff [diff]
bySES a b = liftAp (SES a b)
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.
byRWS :: [term] -> [term] -> Algorithm term diff [diff]
byRWS a b = liftAp (RWS a b)