semantic/src/Algorithm.hs

{-# LANGUAGE GADTs #-}
module Algorithm where

import Control.Applicative.Free
import Prologue hiding (Pure)

-- | A single step in a diffing algorithm.
--
-- 'term' is the type of terms.
-- 'diff' is the type of diffs.
-- 'f' represents the continuation after diffing. Often 'Algorithm'.
data AlgorithmF term diff result where
  -- | Recursively diff two terms and pass the result to the continuation.
  Recursive :: term -> term -> AlgorithmF term diff diff
  -- | Diff two lists by each element’s position, and pass the resulting list of diffs to the continuation.
  ByIndex :: [term] -> [term] -> AlgorithmF term diff [diff]
  -- | Diff two lists by each element’s similarity and pass the resulting list of diffs to the continuation.
  BySimilarity :: [term] -> [term] -> AlgorithmF term diff [diff]

-- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
type Algorithm term diff = Ap (AlgorithmF term diff)

-- | Tear down an Ap by iteration.
iterAp :: Functor g => (g a -> a) -> Ap g a -> a
iterAp algebra = go
  where go (Pure a) = a
        go (Ap underlying apply) = algebra (go . (apply <*>) . pure <$> underlying)


-- DSL

-- | Constructs a 'Recursive' diff of two terms.
recursively :: term -> term -> Algorithm term diff diff
recursively a b = liftAp (Recursive a b)

-- | Constructs a 'ByIndex' diff of two lists of terms.
byIndex :: [term] -> [term] -> Algorithm term diff [diff]
byIndex a b = liftAp (ByIndex a b)

-- | Constructs a 'BySimilarity' diff of two lists of terms.
bySimilarity :: [term] -> [term] -> Algorithm term diff [diff]
bySimilarity a b = liftAp (BySimilarity a b)