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