1
1
mirror of https://github.com/github/semantic.git synced 2024-12-19 21:01:35 +03:00
This commit is contained in:
Rob Rix 2016-07-08 12:17:38 -04:00
parent 51d8fcd99a
commit 1bf9d63acf

View File

@ -36,7 +36,7 @@ diffTerms construct comparable cost a b = fromMaybe (pure $ Replace a b) $ const
constructAndRun :: (Eq leaf, Hashable leaf, Ord (Record fields), HasField fields Category) => DiffConstructor leaf (Record fields) -> Comparable leaf (Record fields) -> SES.Cost (Diff leaf (Record fields)) -> Term leaf (Record fields) -> Term leaf (Record fields) -> Maybe (Diff leaf (Record fields))
constructAndRun construct comparable cost t1 t2
| not $ comparable t1 t2 = Nothing
| (() <$ t2) == (() <$ t2) = hylo construct runCofree <$> zipTerms t1 t2
| (() <$ t1) == (() <$ t2) = hylo construct runCofree <$> zipTerms t1 t2
| otherwise =
run construct comparable cost $ algorithm a b where
algorithm (Indexed a') (Indexed b') = wrap $! ByIndex a' b' (annotate . Indexed)