github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 04:51:57 +03:00
Code Issues Projects Releases Wiki Activity

Replace the old iterAp with the one taking a continuation.

Browse Source
This commit is contained in:
Rob Rix 2017-02-21 10:53:20 -05:00
parent b5d6b4dbce
commit 9b3d8a4949
2 changed files with 3 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Algorithm.hs
View File

@ -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)

2
src/Interpreter.hs
View File

@ -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