Add a second annotation type parameter to Algorithm.

src/Algorithm.hs

@@ -16,36 +16,36 @@ import GHC.Generics
 import Term
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
-data AlgorithmF term diff ann result where
+data AlgorithmF term diff ann1 ann2 result where
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
+  Diff :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
+  Linear :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term ann] -> [term ann] -> AlgorithmF term diff ann [diff ann]
+  RWS :: [term ann] -> [term ann] -> AlgorithmF term diff ann ann [diff ann]
   -- | Delete a term..
-  Delete :: term ann -> AlgorithmF term diff ann (diff ann)
+  Delete :: term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Insert a term.
-  Insert :: term ann -> AlgorithmF term diff ann (diff ann)
+  Insert :: term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Replace one term with another.
-  Replace :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
+  Replace :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
-type Algorithm term diff ann = Freer (AlgorithmF term diff ann)
+type Algorithm term diff ann1 ann2 = Freer (AlgorithmF term diff ann1 ann2)
 
 
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term ann -> term ann -> Algorithm term diff ann (diff ann)
+diff :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
 diff = (liftF .) . Algorithm.Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These (term ann) (term ann) -> Algorithm term diff ann (diff ann)
+diffThese :: These (term ann) (term ann) -> Algorithm term diff ann ann (diff ann)
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term diff ann (Maybe (diff ann))
+diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term diff ann ann (Maybe (diff ann))
 diffMaybe a b = case (a, b) of
   (Just a, Just b) -> Just <$> diff a b
   (Just a, _) -> Just <$> byDeleting a
@@ -53,27 +53,27 @@ diffMaybe a b = case (a, b) of
   _ -> pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term ann -> term ann -> Algorithm term diff ann (diff ann)
+linearly :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
 linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
-byRWS :: [term ann] -> [term ann] -> Algorithm term diff ann [diff ann]
+byRWS :: [term ann] -> [term ann] -> Algorithm term diff ann ann [diff ann]
 byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
-byDeleting :: term ann -> Algorithm term diff ann (diff ann)
+byDeleting :: term ann -> Algorithm term diff ann ann (diff ann)
 byDeleting = liftF . Delete
 
 -- | Insert a term.
-byInserting :: term ann -> Algorithm term diff ann (diff ann)
+byInserting :: term ann -> Algorithm term diff ann ann (diff ann)
 byInserting = liftF . Insert
 
 -- | Replace one term with another.
-byReplacing :: term ann -> term ann -> Algorithm term diff ann (diff ann)
+byReplacing :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
 byReplacing = (liftF .) . Replace
 
 
-instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann) where
+instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann ann) where
   liftShowsPrec _ _ d algorithm = case algorithm of
     Algorithm.Diff t1 t2 -> showsBinaryWith showsTerm showsTerm "Diff" d t1 t2
     Linear t1 t2 -> showsBinaryWith showsTerm showsTerm "Linear" d t1 t2
@@ -87,20 +87,20 @@ instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann) where
 
 -- | Diff two terms based on their generic Diffable instances. If the terms are not diffable
 -- (represented by a Nothing diff returned from algorithmFor) replace one term with another.
-algorithmForTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Algorithm (Term f) (Diff f) a (Diff f a)
+algorithmForTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Algorithm (Term f) (Diff f) a a (Diff f a)
 algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (algorithmForComparableTerms t1 t2)
 
-algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f) a (Diff f a))
+algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f) a a (Diff f a))
 algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merge (ann1, ann2)) <$> algorithmFor f1 f2
 
 
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
-  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
-  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
 genericAlgorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
 
 
@@ -117,7 +117,7 @@ instance Diffable [] where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class Diffable' f where
-  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
 
 -- | Diff two constructors (M1 is the Generic1 newtype for meta-information (possibly related to type constructors, record selectors, and data types))
 instance Diffable' f => Diffable' (M1 i c f) where

src/Data/Syntax.hs

@@ -161,19 +161,19 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 algorithmDeletingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                          => TermF Context a (Term (Union fs) a)
                          -> Term (Union fs) a
-                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (TermF Context a (Diff (Union fs) a)))
+                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a)))
 algorithmDeletingContext (In a1 (Context n1 s1)) s2 = fmap (In a1 . Context (deleting <$> n1)) <$> algorithmForComparableTerms s1 s2
 
 algorithmInsertingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> TermF Context a (Term (Union fs) a)
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (TermF Context a (Diff (Union fs) a)))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a)))
 algorithmInsertingContext s1 (In a2 (Context n2 s2)) = fmap (In a2 . Context (inserting <$> n2)) <$> algorithmForComparableTerms s1 s2
 
 algorithmForContextUnions :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> Term (Union fs) a
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (Diff (Union fs) a))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (Diff (Union fs) a))
 algorithmForContextUnions t1 t2
   | Just algo <- algorithmForComparableTerms t1 t2 = Just algo
   | Just c1@(In _ Context{}) <- prjTermF (unTerm t1) = fmap (deleteF . hoistTermF inj) <$> algorithmDeletingContext c1 t2

src/Interpreter.hs

@@ -41,13 +41,13 @@ decoratingWith getLabel differ t1 t2 = stripDiff (differ (defaultFeatureVectorDe
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
-              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
               -> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
               -> Term f (Record fields) -- ^ A term representing the old state.
               -> Term f (Record fields) -- ^ A term representing the new state.
               -> Diff f (Record fields) -- ^ The resulting diff.
 diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
-  where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) result
+  where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
@@ -68,7 +68,7 @@ getLabel (In h t) = (Info.category h, case t of
 -- | Construct an algorithm to diff a pair of terms.
 algorithmWithTerms :: Term Syntax (Record fields)
                    -> Term Syntax (Record fields)
-                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Diff Syntax (Record fields))
+                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Record fields) (Diff Syntax (Record fields))
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b