{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}
module Control.Categorical.Bifunctor
( PFunctor (first)
, QFunctor (second)
, Bifunctor (bimap)
, dimap
, difirst
) where
import Prelude hiding (id, (.))
import Control.Category
import Control.Category.Dual
class (Category r, Category t) => PFunctor p r t | p r -> t, p t -> r where
first :: r a b -> t (p a c) (p b c)
class (Category s, Category t) => QFunctor q s t | q s -> t, q t -> s where
second :: s a b -> t (q c a) (q c b)
class (PFunctor p r t, QFunctor p s t) => Bifunctor p r s t | p r -> s t, p s -> r t, p t -> r s where
bimap :: r a b -> s c d -> t (p a c) (p b d)
instance PFunctor (,) (->) (->) where first :: (a -> b) -> (a, c) -> (b, c)
first f :: a -> b
f = (a -> b) -> (c -> c) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) (r :: * -> * -> *) (s :: * -> * -> *)
(t :: * -> * -> *) a b c d.
Bifunctor p r s t =>
r a b -> s c d -> t (p a c) (p b d)
bimap a -> b
f c -> c
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance QFunctor (,) (->) (->) where second :: (a -> b) -> (c, a) -> (c, b)
second = (c -> c) -> (a -> b) -> (c, a) -> (c, b)
forall (p :: * -> * -> *) (r :: * -> * -> *) (s :: * -> * -> *)
(t :: * -> * -> *) a b c d.
Bifunctor p r s t =>
r a b -> s c d -> t (p a c) (p b d)
bimap c -> c
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance Bifunctor (,) (->) (->) (->) where
bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
bimap f :: a -> b
f g :: c -> d
g (a :: a
a,b :: c
b)= (a -> b
f a
a, c -> d
g c
b)
instance PFunctor Either (->) (->) where first :: (a -> b) -> Either a c -> Either b c
first f :: a -> b
f = (a -> b) -> (c -> c) -> Either a c -> Either b c
forall (p :: * -> * -> *) (r :: * -> * -> *) (s :: * -> * -> *)
(t :: * -> * -> *) a b c d.
Bifunctor p r s t =>
r a b -> s c d -> t (p a c) (p b d)
bimap a -> b
f c -> c
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance QFunctor Either (->) (->) where second :: (a -> b) -> Either c a -> Either c b
second = (c -> c) -> (a -> b) -> Either c a -> Either c b
forall (p :: * -> * -> *) (r :: * -> * -> *) (s :: * -> * -> *)
(t :: * -> * -> *) a b c d.
Bifunctor p r s t =>
r a b -> s c d -> t (p a c) (p b d)
bimap c -> c
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
instance Bifunctor Either (->) (->) (->) where
bimap :: (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap f :: a -> b
f _ (Left a :: a
a) = b -> Either b d
forall a b. a -> Either a b
Left (a -> b
f a
a)
bimap _ g :: c -> d
g (Right a :: c
a) = d -> Either b d
forall a b. b -> Either a b
Right (c -> d
g c
a)
instance QFunctor (->) (->) (->) where
second :: (a -> b) -> (c -> a) -> c -> b
second = (a -> b) -> (c -> a) -> c -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)
difirst :: PFunctor f (Dual s) t => s b a -> t (f a c) (f b c)
difirst :: s b a -> t (f a c) (f b c)
difirst = Dual s a b -> t (f a c) (f b c)
forall (p :: * -> * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b
c.
PFunctor p r t =>
r a b -> t (p a c) (p b c)
first (Dual s a b -> t (f a c) (f b c))
-> (s b a -> Dual s a b) -> s b a -> t (f a c) (f b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s b a -> Dual s a b
forall (k :: * -> * -> *) a b. k b a -> Dual k a b
Dual
dimap :: Bifunctor f (Dual s) t u => s b a -> t c d -> u (f a c) (f b d)
dimap :: s b a -> t c d -> u (f a c) (f b d)
dimap = Dual s a b -> t c d -> u (f a c) (f b d)
forall (p :: * -> * -> *) (r :: * -> * -> *) (s :: * -> * -> *)
(t :: * -> * -> *) a b c d.
Bifunctor p r s t =>
r a b -> s c d -> t (p a c) (p b d)
bimap (Dual s a b -> t c d -> u (f a c) (f b d))
-> (s b a -> Dual s a b) -> s b a -> t c d -> u (f a c) (f b d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s b a -> Dual s a b
forall (k :: * -> * -> *) a b. k b a -> Dual k a b
Dual