1{-# LANGUAGE CPP #-} 2-- | 3-- Module : Data.Functor.Contravariant.Compose 4-- Copyright : (c) Edward Kmett 2010 5-- License : BSD3 6-- 7-- Maintainer : ekmett@gmail.com 8-- Stability : experimental 9-- Portability : portable 10-- 11-- Composition of contravariant functors. 12 13module Data.Functor.Contravariant.Compose 14 ( Compose(..) 15 , ComposeFC(..) 16 , ComposeCF(..) 17 ) where 18 19import Control.Arrow 20 21#if __GLASGOW_HASKELL__ < 710 22import Control.Applicative 23#endif 24 25import Data.Functor.Contravariant 26import Data.Functor.Contravariant.Divisible 27 28-- | Composition of two contravariant functors 29newtype Compose f g a = Compose { getCompose :: f (g a) } 30 31instance (Contravariant f, Contravariant g) => Functor (Compose f g) where 32 fmap f (Compose x) = Compose (contramap (contramap f) x) 33 34-- | Composition of covariant and contravariant functors 35newtype ComposeFC f g a = ComposeFC { getComposeFC :: f (g a) } 36 37instance (Functor f, Contravariant g) => Contravariant (ComposeFC f g) where 38 contramap f (ComposeFC x) = ComposeFC (fmap (contramap f) x) 39 40instance (Functor f, Functor g) => Functor (ComposeFC f g) where 41 fmap f (ComposeFC x) = ComposeFC (fmap (fmap f) x) 42 43instance (Applicative f, Divisible g) => Divisible (ComposeFC f g) where 44 conquer = ComposeFC $ pure conquer 45 divide abc (ComposeFC fb) (ComposeFC fc) = ComposeFC $ divide abc <$> fb <*> fc 46 47instance (Applicative f, Decidable g) => Decidable (ComposeFC f g) where 48 lose f = ComposeFC $ pure (lose f) 49 choose abc (ComposeFC fb) (ComposeFC fc) = ComposeFC $ choose abc <$> fb <*> fc 50 51-- | Composition of contravariant and covariant functors 52newtype ComposeCF f g a = ComposeCF { getComposeCF :: f (g a) } 53 54instance (Contravariant f, Functor g) => Contravariant (ComposeCF f g) where 55 contramap f (ComposeCF x) = ComposeCF (contramap (fmap f) x) 56 57instance (Functor f, Functor g) => Functor (ComposeCF f g) where 58 fmap f (ComposeCF x) = ComposeCF (fmap (fmap f) x) 59 60instance (Divisible f, Applicative g) => Divisible (ComposeCF f g) where 61 conquer = ComposeCF conquer 62 divide abc (ComposeCF fb) (ComposeCF fc) = ComposeCF $ divide (funzip . fmap abc) fb fc 63 64funzip :: Functor f => f (a, b) -> (f a, f b) 65funzip = fmap fst &&& fmap snd 66