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