diff --git a/src/Algorithm.hs b/src/Algorithm.hs index 9762bba08..43ff67114 100644 --- a/src/Algorithm.hs +++ b/src/Algorithm.hs @@ -16,15 +16,9 @@ data AlgorithmF term diff result where -- | 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) - -- | Tear down an Ap by iteration, given a continuation. -iterAp' :: (forall x. g x -> (x -> a) -> a) -> Ap g a -> a -iterAp' algebra = go +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) diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 1d184e4bf..0196d3137 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -105,7 +105,7 @@ runAlgorithm :: (GAlign f, HasField fields Category, Eq (f (Cofree f Category)), -> SES.Cost (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) -- ^ A function to compute the cost of a given diff node. -> Algorithm (Cofree f (Record fields)) (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) a -- ^ The algorithm to run. -> a -runAlgorithm construct recur cost = iterAp' $ \ r cont -> case r of +runAlgorithm construct recur cost = iterAp $ \ r cont -> case r of Linear a b -> cont . maybe (replacing a b) (construct . (both (extract a) (extract b) :<)) $ do aligned <- galign (unwrap a) (unwrap b) traverse (these (Just . deleting) (Just . inserting) recur) aligned