{-# 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 :: forall a b c. (a -> b) -> (a, c) -> (b, c)
first 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 :: forall a b c. (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 :: forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
bimap a -> b
f c -> d
g (a
a,c
b)= (a -> b
f a
a, c -> d
g c
b)
instance PFunctor Either (->) (->) where first :: forall a b c. (a -> b) -> Either a c -> Either b c
first 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 :: forall a b c. (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 :: forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap a -> b
f c -> d
_ (Left a
a) = b -> Either b d
forall a b. a -> Either a b
Left (a -> b
f a
a)
bimap a -> b
_ c -> d
g (Right c
a) = d -> Either b d
forall a b. b -> Either a b
Right (c -> d
g c
a)
instance QFunctor (->) (->) (->) where
second :: forall a b c. (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 :: forall (f :: * -> * -> *) (s :: * -> * -> *) (t :: * -> * -> *) b a
c.
PFunctor f (Dual s) t =>
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 :: forall (f :: * -> * -> *) (s :: * -> * -> *) (t :: * -> * -> *)
(u :: * -> * -> *) b a c d.
Bifunctor f (Dual s) t u =>
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