github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-19 21:01:35 +03:00
Code Issues Projects Releases Wiki Activity

Don’t attempt to align non-overlapping terms.

Browse Source
This commit is contained in:
Rob Rix 2016-07-08 14:00:07 -04:00
parent 032dcb047b
commit 59bc42b731
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Term.hs
View File

@ -37,7 +37,7 @@ termSize = cata size where
size (_ :< syntax) = 1 + sum syntax
alignCofreeWith :: Functor f => (f (Cofree f a1) -> f (Cofree f a2) -> Maybe (f (These (Cofree f a1) (Cofree f a2)))) -> These (Cofree f a1) (Cofree f a2) -> Free (CofreeF f (These a1 a2)) (These (Cofree f a1) (Cofree f a2))
alignCofreeWith contrast terms = case terms of
This t1 -> let (a1 :< s1) = runCofree t1 in wrap $! This a1 :< (alignCofreeWith contrast . This <$> s1)
That t2 -> let (a2 :< s2) = runCofree t2 in wrap $! That a2 :< (alignCofreeWith contrast . That <$> s2)
These t1 t2 -> let (a1 :< s1, a2 :< s2) = (runCofree t1, runCofree t2) in maybe (pure terms) (wrap . (These a1 a2 :<) . fmap (alignCofreeWith contrast)) (contrast s1 s2)
alignCofreeWith contrast terms = fromMaybe (pure terms) $ case terms of
These t1 t2 -> let (a1 :< s1, a2 :< s2) = (runCofree t1, runCofree t2) in
wrap . (These a1 a2 :<) . fmap (alignCofreeWith contrast) <$> contrast s1 s2
_ -> Nothing