{-# LANGUAGE ConstraintKinds, DataKinds, DefaultSignatures, FlexibleContexts,
FlexibleInstances, LambdaCase,
MultiParamTypeClasses, TypeFamilies, TypeOperators #-}
module Data.Profunctor.Product.Default.Class where
import GHC.Exts (Constraint)
import GHC.Generics
import Data.Profunctor (Profunctor, dimap)
import Data.Profunctor.Product.Class
class Default p a b where
def :: p a b
default def :: (Profunctor p, Generic a, Generic b, GDefault p (Rep a) (Rep b)) => p a b
def = forall (p :: * -> * -> *) a b.
(Profunctor p, Generic a, Generic b, GDefault p (Rep a) (Rep b)) =>
p a b
gdef
type DefaultFields p a b = GDefCnstr p (Rep a) (Rep b)
type DefaultFields' p a = DefaultFields p a a
type DefaultPConstraints p a = GDefPCnstr p (Rep a)
type DefaultConstraints p a b = (DefaultPConstraints p a, DefaultFields p a b)
type DefaultConstraints' p a = DefaultConstraints p a a
type family Defaults (as :: [*]) :: Constraint
type instance Defaults '[] = ()
type instance Defaults (p a a' ': as) = (Default p a a', Defaults as)
class GDefault p f g where
type GDefCnstr p f g :: Constraint
gdef1 :: p (f a) (g a)
instance ProductProfunctor p => GDefault p U1 U1 where
type GDefCnstr p U1 U1 = ()
gdef1 :: forall a. p (U1 a) (U1 a)
gdef1 = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (forall a b. a -> b -> a
const ()) (forall a b. a -> b -> a
const forall k (p :: k). U1 p
U1) forall (p :: * -> * -> *). ProductProfunctor p => p () ()
empty
instance (Profunctor p, GDefault p f g) => GDefault p (M1 i c f) (M1 i c g) where
type GDefCnstr p (M1 i c f) (M1 i c g) = GDefCnstr p f g
gdef1 :: forall a. p (M1 i c f a) (M1 i c g a)
gdef1 = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (p :: * -> * -> *) (f :: * -> *) (g :: * -> *) a.
GDefault p f g =>
p (f a) (g a)
gdef1
instance (Profunctor p, Default p c c') => GDefault p (K1 i c) (K1 i c') where
type GDefCnstr p (K1 i c) (K1 i c') = Default p c c'
gdef1 :: forall a. p (K1 i c a) (K1 i c' a)
gdef1 = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall k i c (p :: k). K1 i c p -> c
unK1 forall k i c (p :: k). c -> K1 i c p
K1 forall (p :: * -> * -> *) a b. Default p a b => p a b
def
instance (ProductProfunctor p, GDefault p f f', GDefault p g g') => GDefault p (f :*: g) (f' :*: g') where
type GDefCnstr p (f :*: g) (f' :*: g') = (GDefCnstr p f f', GDefCnstr p g g')
gdef1 :: forall a. p ((:*:) f g a) ((:*:) f' g' a)
gdef1 = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\(f a
x :*: g a
y) -> (f a
x, g a
y)) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)) forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (f :: * -> *) (g :: * -> *) a.
GDefault p f g =>
p (f a) (g a)
gdef1 forall (p :: * -> * -> *) a b a' b'.
ProductProfunctor p =>
p a b -> p a' b' -> p (a, a') (b, b')
***! forall (p :: * -> * -> *) (f :: * -> *) (g :: * -> *) a.
GDefault p f g =>
p (f a) (g a)
gdef1
instance (SumProfunctor p, GDefault p f f', GDefault p g g') => GDefault p (f :+: g) (f' :+: g') where
type GDefCnstr p (f :+: g) (f' :+: g') = (GDefCnstr p f f', GDefCnstr p g g')
gdef1 :: forall a. p ((:+:) f g a) ((:+:) f' g' a)
gdef1 = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall {f :: * -> *} {g :: * -> *} {p}.
(:+:) f g p -> Either (f p) (g p)
sumToEither forall {f :: * -> *} {p} {g :: * -> *}.
Either (f p) (g p) -> (:+:) f g p
eitherToSum forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (f :: * -> *) (g :: * -> *) a.
GDefault p f g =>
p (f a) (g a)
gdef1 forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
+++! forall (p :: * -> * -> *) (f :: * -> *) (g :: * -> *) a.
GDefault p f g =>
p (f a) (g a)
gdef1
where
eitherToSum :: Either (f p) (g p) -> (:+:) f g p
eitherToSum = \case
Left f p
x -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x
Right g p
x -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
x
sumToEither :: (:+:) f g p -> Either (f p) (g p)
sumToEither = \case
L1 f p
x -> forall a b. a -> Either a b
Left f p
x
R1 g p
x -> forall a b. b -> Either a b
Right g p
x
type family GDefPCnstr (p :: * -> * -> *) (f :: * -> *) :: Constraint
type instance GDefPCnstr p U1 = ProductProfunctor p
type instance GDefPCnstr p (M1 i c f) = GDefPCnstr p f
type instance GDefPCnstr p (K1 i c) = Profunctor p
type instance GDefPCnstr p (f :*: g) = ProductProfunctor p
type instance GDefPCnstr p (f :+: g) = (SumProfunctor p, GDefPCnstr p f, GDefPCnstr p g)
gdef :: (Profunctor p, Generic a, Generic b, GDefault p (Rep a) (Rep b)) => p a b
gdef :: forall (p :: * -> * -> *) a b.
(Profunctor p, Generic a, Generic b, GDefault p (Rep a) (Rep b)) =>
p a b
gdef = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall a x. Generic a => a -> Rep a x
from forall a x. Generic a => Rep a x -> a
to forall (p :: * -> * -> *) (f :: * -> *) (g :: * -> *) a.
GDefault p f g =>
p (f a) (g a)
gdef1