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