e7c9f55e631cd1a194d7b0f3a7046cf4ece94f7f
[darcs-mirrors/transformers.git] / Data / Functor / Sum.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__ >= 702
3 {-# LANGUAGE Safe #-}
4 #endif
5 #if __GLASGOW_HASKELL__ >= 704
6 {-# LANGUAGE PolyKinds #-}
7 #endif
8 #if __GLASGOW_HASKELL__ >= 710
9 {-# LANGUAGE AutoDeriveTypeable #-}
10 #endif
11 -----------------------------------------------------------------------------
12 -- |
13 -- Module : Data.Functor.Sum
14 -- Copyright : (c) Ross Paterson 2014
15 -- License : BSD-style (see the file LICENSE)
16 --
17 -- Maintainer : R.Paterson@city.ac.uk
18 -- Stability : experimental
19 -- Portability : portable
20 --
21 -- Sums, lifted to functors.
22 -----------------------------------------------------------------------------
23
24 module Data.Functor.Sum (
25 Sum(..),
26 ) where
27
28 import Control.Applicative
29 import Data.Foldable (Foldable(foldMap))
30 import Data.Functor.Classes
31 import Data.Monoid (mappend)
32 import Data.Traversable (Traversable(traverse))
33
34 -- | Lifted sum of functors.
35 data Sum f g a = InL (f a) | InR (g a)
36
37 instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where
38 liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2
39 liftEq _ (InL _) (InR _) = False
40 liftEq _ (InR _) (InL _) = False
41 liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2
42
43 instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where
44 liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2
45 liftCompare _ (InL _) (InR _) = LT
46 liftCompare _ (InR _) (InL _) = GT
47 liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2
48
49 instance (Read1 f, Read1 g) => Read1 (Sum f g) where
50 liftReadsPrec rp rl = readsData $
51 readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend`
52 readsUnaryWith (liftReadsPrec rp rl) "InR" InR
53
54 instance (Show1 f, Show1 g) => Show1 (Sum f g) where
55 liftShowsPrec sp sl d (InL x) =
56 showsUnaryWith (liftShowsPrec sp sl) "InL" d x
57 liftShowsPrec sp sl d (InR y) =
58 showsUnaryWith (liftShowsPrec sp sl) "InR" d y
59
60 instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where
61 (==) = eq1
62 instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where
63 compare = compare1
64 instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where
65 readsPrec = readsPrec1
66 instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where
67 showsPrec = showsPrec1
68
69 instance (Functor f, Functor g) => Functor (Sum f g) where
70 fmap f (InL x) = InL (fmap f x)
71 fmap f (InR y) = InR (fmap f y)
72
73 instance (Foldable f, Foldable g) => Foldable (Sum f g) where
74 foldMap f (InL x) = foldMap f x
75 foldMap f (InR y) = foldMap f y
76
77 instance (Traversable f, Traversable g) => Traversable (Sum f g) where
78 traverse f (InL x) = InL <$> traverse f x
79 traverse f (InR y) = InR <$> traverse f y