Monad (and related) instances for Reverse
[packages/transformers.git] / Data / Functor / Reverse.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__ >= 702
3 {-# LANGUAGE Safe #-}
4 #endif
5 #if __GLASGOW_HASKELL__ >= 706
6 {-# LANGUAGE PolyKinds #-}
7 #endif
8 #if __GLASGOW_HASKELL__ >= 710
9 {-# LANGUAGE AutoDeriveTypeable #-}
10 #endif
11 -----------------------------------------------------------------------------
12 -- |
13 -- Module : Data.Functor.Reverse
14 -- Copyright : (c) Russell O'Connor 2009
15 -- License : BSD-style (see the file LICENSE)
16 --
17 -- Maintainer : R.Paterson@city.ac.uk
18 -- Stability : experimental
19 -- Portability : portable
20 --
21 -- Making functors whose elements are notionally in the reverse order
22 -- from the original functor.
23 -----------------------------------------------------------------------------
24
25 module Data.Functor.Reverse (
26 Reverse(..),
27 ) where
28
29 import Control.Applicative.Backwards
30 import Data.Functor.Classes
31
32 import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
33 import Control.Applicative
34 import Control.Monad
35 #if MIN_VERSION_base(4,9,0)
36 import qualified Control.Monad.Fail as Fail
37 #endif
38 import Data.Foldable
39 import Data.Traversable
40 import Data.Monoid
41
42 -- | The same functor, but with 'Foldable' and 'Traversable' instances
43 -- that process the elements in the reverse order.
44 newtype Reverse f a = Reverse { getReverse :: f a }
45
46 instance (Eq1 f) => Eq1 (Reverse f) where
47 liftEq eq (Reverse x) (Reverse y) = liftEq eq x y
48 {-# INLINE liftEq #-}
49
50 instance (Ord1 f) => Ord1 (Reverse f) where
51 liftCompare comp (Reverse x) (Reverse y) = liftCompare comp x y
52 {-# INLINE liftCompare #-}
53
54 instance (Read1 f) => Read1 (Reverse f) where
55 liftReadsPrec rp rl = readsData $
56 readsUnaryWith (liftReadsPrec rp rl) "Reverse" Reverse
57
58 instance (Show1 f) => Show1 (Reverse f) where
59 liftShowsPrec sp sl d (Reverse x) =
60 showsUnaryWith (liftShowsPrec sp sl) "Reverse" d x
61
62 instance (Eq1 f, Eq a) => Eq (Reverse f a) where (==) = eq1
63 instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare = compare1
64 instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsPrec1
65 instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec = showsPrec1
66
67 -- | Derived instance.
68 instance (Functor f) => Functor (Reverse f) where
69 fmap f (Reverse a) = Reverse (fmap f a)
70 {-# INLINE fmap #-}
71
72 -- | Derived instance.
73 instance (Applicative f) => Applicative (Reverse f) where
74 pure a = Reverse (pure a)
75 {-# INLINE pure #-}
76 Reverse f <*> Reverse a = Reverse (f <*> a)
77 {-# INLINE (<*>) #-}
78
79 -- | Derived instance.
80 instance (Alternative f) => Alternative (Reverse f) where
81 empty = Reverse empty
82 {-# INLINE empty #-}
83 Reverse x <|> Reverse y = Reverse (x <|> y)
84 {-# INLINE (<|>) #-}
85
86 -- | Derived instance.
87 instance (Monad m) => Monad (Reverse m) where
88 return a = Reverse (return a)
89 {-# INLINE return #-}
90 m >>= f = Reverse (getReverse m >>= getReverse . f)
91 {-# INLINE (>>=) #-}
92 fail msg = Reverse (fail msg)
93 {-# INLINE fail #-}
94
95 #if MIN_VERSION_base(4,9,0)
96 instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where
97 fail msg = Reverse (Fail.fail msg)
98 {-# INLINE fail #-}
99 #endif
100
101 -- | Derived instance.
102 instance (MonadPlus m) => MonadPlus (Reverse m) where
103 mzero = Reverse mzero
104 {-# INLINE mzero #-}
105 Reverse x `mplus` Reverse y = Reverse (x `mplus` y)
106 {-# INLINE mplus #-}
107
108 -- | Fold from right to left.
109 instance (Foldable f) => Foldable (Reverse f) where
110 foldMap f (Reverse t) = getDual (foldMap (Dual . f) t)
111 {-# INLINE foldMap #-}
112 foldr f z (Reverse t) = foldl (flip f) z t
113 {-# INLINE foldr #-}
114 foldl f z (Reverse t) = foldr (flip f) z t
115 {-# INLINE foldl #-}
116 foldr1 f (Reverse t) = foldl1 (flip f) t
117 {-# INLINE foldr1 #-}
118 foldl1 f (Reverse t) = foldr1 (flip f) t
119 {-# INLINE foldl1 #-}
120 #if MIN_VERSION_base(4,8,0)
121 null (Reverse t) = null t
122 length (Reverse t) = length t
123 #endif
124
125 -- | Traverse from right to left.
126 instance (Traversable f) => Traversable (Reverse f) where
127 traverse f (Reverse t) =
128 fmap Reverse . forwards $ traverse (Backwards . f) t
129 {-# INLINE traverse #-}