github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-05 14:11:33 +03:00
Code Issues Projects Releases Wiki Activity

Define sequenceAlt generically.

Browse Source
This commit is contained in:
Rob Rix 2018-04-09 16:26:49 -04:00
parent 4459b26b0b
commit ebe142e263
1 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Data/Mergeable.hs
View File

@ -27,7 +27,8 @@ class Functor t => Mergeable t where
-- | Sequnce a 'Mergeable' functor by 'merge'ing the 'Alternative' values. -- | Sequnce a 'Mergeable' functor by 'merge'ing the 'Alternative' values.
sequenceAlt :: Alternative f => t (f a) -> f (t a) sequenceAlt :: Alternative f => t (f a) -> f (t a)
sequenceAlt = merge id default sequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a)
sequenceAlt = genericSequenceAlt
-- Instances -- Instances
@ -48,37 +49,50 @@ instance Mergeable Identity where merge f = fmap Identity . f . runIdentity
instance (Apply Functor fs, Apply Mergeable fs) => Mergeable (Union fs) where instance (Apply Functor fs, Apply Mergeable fs) => Mergeable (Union fs) where
merge f = apply' (Proxy :: Proxy Mergeable) (\ reinj g -> reinj <$> merge f g) merge f = apply' (Proxy :: Proxy Mergeable) (\ reinj g -> reinj <$> merge f g)
sequenceAlt = apply' (Proxy :: Proxy Mergeable) (\ inj t -> inj <$> sequenceAlt t)
-- Generics -- Generics
class GMergeable t where class GMergeable t where
gmerge :: Alternative f => (a -> f b) -> t a -> f (t b) gmerge :: Alternative f => (a -> f b) -> t a -> f (t b)
gsequenceAlt :: Alternative f => t (f a) -> f (t a)
genericMerge :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => (a -> f b) -> t a -> f (t b) genericMerge :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => (a -> f b) -> t a -> f (t b)
genericMerge f = fmap to1 . gmerge f . from1 genericMerge f = fmap to1 . gmerge f . from1
genericSequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a)
genericSequenceAlt = fmap to1 . gsequenceAlt . from1
-- Instances -- Instances
instance GMergeable U1 where instance GMergeable U1 where
gmerge _ _ = pure U1 gmerge _ _ = pure U1
gsequenceAlt _ = pure U1
instance GMergeable Par1 where instance GMergeable Par1 where
gmerge f (Par1 a) = Par1 <$> f a gmerge f (Par1 a) = Par1 <$> f a
gsequenceAlt (Par1 a) = Par1 <$> a
instance GMergeable (K1 i c) where instance GMergeable (K1 i c) where
gmerge _ (K1 a) = pure (K1 a) gmerge _ (K1 a) = pure (K1 a)
gsequenceAlt (K1 a) = pure (K1 a)
instance Mergeable f => GMergeable (Rec1 f) where instance Mergeable f => GMergeable (Rec1 f) where
gmerge f (Rec1 a) = Rec1 <$> merge f a gmerge f (Rec1 a) = Rec1 <$> merge f a
gsequenceAlt (Rec1 a) = Rec1 <$> sequenceAlt a
instance GMergeable f => GMergeable (M1 i c f) where instance GMergeable f => GMergeable (M1 i c f) where
gmerge f (M1 a) = M1 <$> gmerge f a gmerge f (M1 a) = M1 <$> gmerge f a
gsequenceAlt (M1 a) = M1 <$> gsequenceAlt a
instance (GMergeable f, GMergeable g) => GMergeable (f :+: g) where instance (GMergeable f, GMergeable g) => GMergeable (f :+: g) where
gmerge f (L1 a) = L1 <$> gmerge f a gmerge f (L1 a) = L1 <$> gmerge f a
gmerge f (R1 b) = R1 <$> gmerge f b gmerge f (R1 b) = R1 <$> gmerge f b
gsequenceAlt (L1 a) = L1 <$> gsequenceAlt a
gsequenceAlt (R1 a) = R1 <$> gsequenceAlt a
instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where
gmerge f (a :*: b) = (:*:) <$> gmerge f a <*> gmerge f b gmerge f (a :*: b) = (:*:) <$> gmerge f a <*> gmerge f b
gsequenceAlt (a :*: b) = (:*:) <$> gsequenceAlt a <*> gsequenceAlt b