{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Distributive.Generic
( GDistributive(..)
, genericCollect
, genericDistribute
) where
import Data.Distributive
import GHC.Generics
import Data.Coerce
genericCollect :: (Functor f, Generic1 g, GDistributive (Rep1 g))
=> (a -> g b) -> f a -> g (f b)
genericCollect f = to1 . gcollect (from1 . f)
genericDistribute :: (Functor f, Generic1 g, GDistributive (Rep1 g)) => f (g a) -> g (f a)
genericDistribute = to1 . gdistribute . fmap from1
class GDistributive g where
gcollect :: Functor f => (a -> g b) -> f a -> g (f b)
gdistribute :: (GDistributive g, Functor f) => f (g b) -> g (f b)
gdistribute = gcollect id
{-# INLINE gdistribute #-}
instance GDistributive U1 where
gcollect _ _ = U1
{-# INLINE gcollect #-}
instance (GDistributive a, GDistributive b) => GDistributive (a :*: b) where
gcollect f x = gcollect fstP x' :*: gcollect sndP x' where
x' = fmap f x
fstP (l :*: _) = l
sndP (_ :*: r) = r
{-# INLINE gcollect #-}
instance (Distributive a, GDistributive b) => GDistributive (a :.: b) where
gcollect f = Comp1 . fmap gdistribute . collect (coerce f)
{-# INLINE gcollect #-}
instance GDistributive Par1 where
gcollect = coerce (fmap :: (a -> b) -> f a -> f b)
:: forall f a b . Functor f => (a -> Par1 b) -> f a -> Par1 (f b)
{-# INLINE gcollect #-}
instance Distributive f => GDistributive (Rec1 f) where
gcollect = coerce (collect :: (a -> f b) -> g a -> f (g b))
:: forall g a b . Functor g
=> (a -> Rec1 f b) -> g a -> Rec1 f (g b)
{-# INLINE gcollect #-}
instance GDistributive f => GDistributive (M1 i c f) where
gcollect = coerce (gcollect :: (a -> f b) -> g a -> f (g b))
:: forall g a b . Functor g
=> (a -> M1 i c f b) -> g a -> M1 i c f (g b)
{-# INLINE gcollect #-}