{-# LANGUAGE RankNTypes #-}
module Data.Functor.Barbie.Layered
( FunctorB (..)
) where
import Barbies (Unit (Unit), Void)
import Data.Data (Proxy (Proxy))
import Data.Functor.Compose (Compose (Compose))
import Data.Functor.Const (Const (Const))
import Data.Functor.Constant (Constant (Constant))
import Data.Functor.Product (Product (Pair))
import Data.Functor.Sum (Sum (InL, InR))
class FunctorB b where
bmap :: forall f g. (Functor f, Functor g) => (forall a. f a -> g a) -> b f -> b g
instance FunctorB Proxy where
bmap :: (forall a. f a -> g a) -> Proxy f -> Proxy g
bmap forall a. f a -> g a
_ Proxy f
_ = Proxy g
forall k (t :: k). Proxy t
Proxy
instance FunctorB Void where
bmap :: (forall a. f a -> g a) -> Void f -> Void g
bmap forall a. f a -> g a
_ Void f
_ = Void g
forall a. HasCallStack => a
undefined
instance FunctorB Unit where
bmap :: (forall a. f a -> g a) -> Unit f -> Unit g
bmap forall a. f a -> g a
_ Unit f
_ = Unit g
forall k (f :: k -> *). Unit f
Unit
instance FunctorB (Constant a) where
bmap :: (forall a. f a -> g a) -> Constant a f -> Constant a g
bmap forall a. f a -> g a
_ (Constant a
a) = a -> Constant a g
forall k a (b :: k). a -> Constant a b
Constant a
a
instance FunctorB (Const a) where
bmap :: (forall a. f a -> g a) -> Const a f -> Const a g
bmap forall a. f a -> g a
_ (Const a
a) = a -> Const a g
forall k a (b :: k). a -> Const a b
Const a
a
instance (FunctorB a, FunctorB b) => FunctorB (Product a b) where
bmap :: (forall a. f a -> g a) -> Product a b f -> Product a b g
bmap forall a. f a -> g a
f (Pair a f
x b f
y) = a g -> b g -> Product a b g
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((forall a. f a -> g a) -> a f -> a g
forall (b :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
(FunctorB b, Functor f, Functor g) =>
(forall a. f a -> g a) -> b f -> b g
bmap forall a. f a -> g a
f a f
x) ((forall a. f a -> g a) -> b f -> b g
forall (b :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
(FunctorB b, Functor f, Functor g) =>
(forall a. f a -> g a) -> b f -> b g
bmap forall a. f a -> g a
f b f
y)
instance (FunctorB a, FunctorB b) => FunctorB (Sum a b) where
bmap :: (forall a. f a -> g a) -> Sum a b f -> Sum a b g
bmap forall a. f a -> g a
f (InL a f
x) = a g -> Sum a b g
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL ((forall a. f a -> g a) -> a f -> a g
forall (b :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
(FunctorB b, Functor f, Functor g) =>
(forall a. f a -> g a) -> b f -> b g
bmap forall a. f a -> g a
f a f
x)
bmap forall a. f a -> g a
f (InR b f
x) = b g -> Sum a b g
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR ((forall a. f a -> g a) -> b f -> b g
forall (b :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
(FunctorB b, Functor f, Functor g) =>
(forall a. f a -> g a) -> b f -> b g
bmap forall a. f a -> g a
f b f
x)
instance (Functor f, FunctorB b) => FunctorB (Compose f b) where
bmap :: (forall a. f a -> g a) -> Compose f b f -> Compose f b g
bmap forall a. f a -> g a
h (Compose f (b f)
x) = f (b g) -> Compose f b g
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((forall a. f a -> g a) -> b f -> b g
forall (b :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
(FunctorB b, Functor f, Functor g) =>
(forall a. f a -> g a) -> b f -> b g
bmap forall a. f a -> g a
h (b f -> b g) -> f (b f) -> f (b g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b f)
x)