{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | -- Module : Data.Functor.Contravariant.Compose -- Copyright : (c) Edward Kmett 2010 -- License : BSD3 -- -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : portable -- -- Composition of contravariant functors. module Data.Functor.Contravariant.Compose ( Compose(..) , ComposeFC(..) , ComposeCF(..) ) where import Control.Arrow #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Data.Functor.Contravariant import Data.Functor.Contravariant.Divisible -- | Composition of two contravariant functors newtype Compose f g a = Compose { Compose f g a -> f (g a) getCompose :: f (g a) } instance (Contravariant f, Contravariant g) => Functor (Compose f g) where fmap :: (a -> b) -> Compose f g a -> Compose f g b fmap a -> b f (Compose f (g a) x) = f (g b) -> Compose f g b forall (f :: * -> *) (g :: * -> *) a. f (g a) -> Compose f g a Compose ((g b -> g a) -> f (g a) -> f (g b) forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a contramap ((a -> b) -> g b -> g a forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a contramap a -> b f) f (g a) x) -- | Composition of covariant and contravariant functors newtype ComposeFC f g a = ComposeFC { ComposeFC f g a -> f (g a) getComposeFC :: f (g a) } instance (Functor f, Contravariant g) => Contravariant (ComposeFC f g) where contramap :: (a -> b) -> ComposeFC f g b -> ComposeFC f g a contramap a -> b f (ComposeFC f (g b) x) = f (g a) -> ComposeFC f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeFC f g a ComposeFC ((g b -> g a) -> f (g b) -> f (g a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> b) -> g b -> g a forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a contramap a -> b f) f (g b) x) instance (Functor f, Functor g) => Functor (ComposeFC f g) where fmap :: (a -> b) -> ComposeFC f g a -> ComposeFC f g b fmap a -> b f (ComposeFC f (g a) x) = f (g b) -> ComposeFC f g b forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeFC f g a ComposeFC ((g a -> g b) -> f (g a) -> f (g b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> b) -> g a -> g b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f) f (g a) x) instance (Applicative f, Divisible g) => Divisible (ComposeFC f g) where conquer :: ComposeFC f g a conquer = f (g a) -> ComposeFC f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeFC f g a ComposeFC (f (g a) -> ComposeFC f g a) -> f (g a) -> ComposeFC f g a forall a b. (a -> b) -> a -> b $ g a -> f (g a) forall (f :: * -> *) a. Applicative f => a -> f a pure g a forall (f :: * -> *) a. Divisible f => f a conquer divide :: (a -> (b, c)) -> ComposeFC f g b -> ComposeFC f g c -> ComposeFC f g a divide a -> (b, c) abc (ComposeFC f (g b) fb) (ComposeFC f (g c) fc) = f (g a) -> ComposeFC f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeFC f g a ComposeFC (f (g a) -> ComposeFC f g a) -> f (g a) -> ComposeFC f g a forall a b. (a -> b) -> a -> b $ (a -> (b, c)) -> g b -> g c -> g a forall (f :: * -> *) a b c. Divisible f => (a -> (b, c)) -> f b -> f c -> f a divide a -> (b, c) abc (g b -> g c -> g a) -> f (g b) -> f (g c -> g a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (g b) fb f (g c -> g a) -> f (g c) -> f (g a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f (g c) fc instance (Applicative f, Decidable g) => Decidable (ComposeFC f g) where lose :: (a -> Void) -> ComposeFC f g a lose a -> Void f = f (g a) -> ComposeFC f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeFC f g a ComposeFC (f (g a) -> ComposeFC f g a) -> f (g a) -> ComposeFC f g a forall a b. (a -> b) -> a -> b $ g a -> f (g a) forall (f :: * -> *) a. Applicative f => a -> f a pure ((a -> Void) -> g a forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose a -> Void f) choose :: (a -> Either b c) -> ComposeFC f g b -> ComposeFC f g c -> ComposeFC f g a choose a -> Either b c abc (ComposeFC f (g b) fb) (ComposeFC f (g c) fc) = f (g a) -> ComposeFC f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeFC f g a ComposeFC (f (g a) -> ComposeFC f g a) -> f (g a) -> ComposeFC f g a forall a b. (a -> b) -> a -> b $ (a -> Either b c) -> g b -> g c -> g a forall (f :: * -> *) a b c. Decidable f => (a -> Either b c) -> f b -> f c -> f a choose a -> Either b c abc (g b -> g c -> g a) -> f (g b) -> f (g c -> g a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (g b) fb f (g c -> g a) -> f (g c) -> f (g a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f (g c) fc -- | Composition of contravariant and covariant functors newtype ComposeCF f g a = ComposeCF { ComposeCF f g a -> f (g a) getComposeCF :: f (g a) } instance (Contravariant f, Functor g) => Contravariant (ComposeCF f g) where contramap :: (a -> b) -> ComposeCF f g b -> ComposeCF f g a contramap a -> b f (ComposeCF f (g b) x) = f (g a) -> ComposeCF f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeCF f g a ComposeCF ((g a -> g b) -> f (g b) -> f (g a) forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a contramap ((a -> b) -> g a -> g b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f) f (g b) x) instance (Functor f, Functor g) => Functor (ComposeCF f g) where fmap :: (a -> b) -> ComposeCF f g a -> ComposeCF f g b fmap a -> b f (ComposeCF f (g a) x) = f (g b) -> ComposeCF f g b forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeCF f g a ComposeCF ((g a -> g b) -> f (g a) -> f (g b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> b) -> g a -> g b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f) f (g a) x) instance (Divisible f, Applicative g) => Divisible (ComposeCF f g) where conquer :: ComposeCF f g a conquer = f (g a) -> ComposeCF f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeCF f g a ComposeCF f (g a) forall (f :: * -> *) a. Divisible f => f a conquer divide :: (a -> (b, c)) -> ComposeCF f g b -> ComposeCF f g c -> ComposeCF f g a divide a -> (b, c) abc (ComposeCF f (g b) fb) (ComposeCF f (g c) fc) = f (g a) -> ComposeCF f g a forall (f :: * -> *) (g :: * -> *) a. f (g a) -> ComposeCF f g a ComposeCF (f (g a) -> ComposeCF f g a) -> f (g a) -> ComposeCF f g a forall a b. (a -> b) -> a -> b $ (g a -> (g b, g c)) -> f (g b) -> f (g c) -> f (g a) forall (f :: * -> *) a b c. Divisible f => (a -> (b, c)) -> f b -> f c -> f a divide (g (b, c) -> (g b, g c) forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b) funzip (g (b, c) -> (g b, g c)) -> (g a -> g (b, c)) -> g a -> (g b, g c) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (b, c)) -> g a -> g (b, c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> (b, c) abc) f (g b) fb f (g c) fc funzip :: Functor f => f (a, b) -> (f a, f b) funzip :: f (a, b) -> (f a, f b) funzip = ((a, b) -> a) -> f (a, b) -> f a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a, b) -> a forall a b. (a, b) -> a fst (f (a, b) -> f a) -> (f (a, b) -> f b) -> f (a, b) -> (f a, f b) forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& ((a, b) -> b) -> f (a, b) -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a, b) -> b forall a b. (a, b) -> b snd