From 711dcdb2031de32edf3a6f9bc61010c44c2c46a7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sun, 6 Aug 2017 16:35:53 -0400 Subject: [PATCH] Define GAlign over Union non-inductively. --- src/Data/Align/Generic.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs index 67dd2b582..ec484714e 100644 --- a/src/Data/Align/Generic.hs +++ b/src/Data/Align/Generic.hs @@ -4,6 +4,7 @@ module Data.Align.Generic where import Control.Monad import Data.Align import Data.Functor.Identity +import Data.Proxy import Data.These import Data.Union import GHC.Generics @@ -27,11 +28,8 @@ instance GAlign Maybe where instance GAlign Identity where galignWith f (Identity a) (Identity b) = Just (Identity (f (These a b))) -instance (GAlign f, GAlign (Union fs)) => GAlign (Union (f ': fs)) where - galignWith f u1 u2 = case (decompose u1, decompose u2) of - (Left u1', Left u2') -> weaken <$> galignWith f u1' u2' - (Right r1, Right r2) -> inj <$> galignWith f r1 r2 - _ -> Nothing +instance (Apply1 GAlign fs) => GAlign (Union fs) where + galignWith f = (join .) . apply1_2' (Proxy :: Proxy GAlign) (\ inj -> (fmap inj .) . galignWith f) instance GAlign (Union '[]) where galignWith _ _ _ = Nothing