github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

The contrasting function must be polymorphic.

Browse Source
This commit is contained in:
Rob Rix 2016-07-08 14:04:16 -04:00
parent f6ba2f8408
commit 15a0022152
1 changed files with 2 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Term.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE TypeFamilies, TypeSynonymInstances #-}
{-# LANGUAGE RankNTypes, TypeFamilies, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Term where
@ -37,7 +37,7 @@ termSize :: Term a annotation -> Integer
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 :: Functor f => (forall a b. f a -> f b -> Maybe (f (These a b))) -> These (Cofree f a1) (Cofree f a2) -> Free (CofreeF f (These a1 a2)) (These (Cofree f a1) (Cofree f a2))
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