dcb62901287593b4254977a8b567e89b2987e405
[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 #if MIN_VERSION_base(4,12,0)
32 import Data.Functor.Contravariant
33 #endif
34
35 import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
36 import Control.Applicative
37 import Control.Monad
38 #if MIN_VERSION_base(4,9,0)
39 import qualified Control.Monad.Fail as Fail
40 #endif
41 import Data.Foldable
42 import Data.Traversable
43 import Data.Monoid
44
45 -- | The same functor, but with 'Foldable' and 'Traversable' instances
46 -- that process the elements in the reverse order.
47 newtype Reverse f a = Reverse { getReverse :: f a }
48
49 instance (Eq1 f) => Eq1 (Reverse f) where
50 liftEq eq (Reverse x) (Reverse y) = liftEq eq x y
51 {-# INLINE liftEq #-}
52
53 instance (Ord1 f) => Ord1 (Reverse f) where
54 liftCompare comp (Reverse x) (Reverse y) = liftCompare comp x y
55 {-# INLINE liftCompare #-}
56
57 instance (Read1 f) => Read1 (Reverse f) where
58 liftReadsPrec rp rl = readsData $
59 readsUnaryWith (liftReadsPrec rp rl) "Reverse" Reverse
60
61 instance (Show1 f) => Show1 (Reverse f) where
62 liftShowsPrec sp sl d (Reverse x) =
63 showsUnaryWith (liftShowsPrec sp sl) "Reverse" d x
64
65 instance (Eq1 f, Eq a) => Eq (Reverse f a) where (==) = eq1
66 instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare = compare1
67 instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsPrec1
68 instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec = showsPrec1
69
70 -- | Derived instance.
71 instance (Functor f) => Functor (Reverse f) where
72 fmap f (Reverse a) = Reverse (fmap f a)
73 {-# INLINE fmap #-}
74
75 -- | Derived instance.
76 instance (Applicative f) => Applicative (Reverse f) where
77 pure a = Reverse (pure a)
78 {-# INLINE pure #-}
79 Reverse f <*> Reverse a = Reverse (f <*> a)
80 {-# INLINE (<*>) #-}
81
82 -- | Derived instance.
83 instance (Alternative f) => Alternative (Reverse f) where
84 empty = Reverse empty
85 {-# INLINE empty #-}
86 Reverse x <|> Reverse y = Reverse (x <|> y)
87 {-# INLINE (<|>) #-}
88
89 -- | Derived instance.
90 instance (Monad m) => Monad (Reverse m) where
91 #if !(MIN_VERSION_base(4,8,0))
92 return a = Reverse (return a)
93 {-# INLINE return #-}
94 #endif
95 m >>= f = Reverse (getReverse m >>= getReverse . f)
96 {-# INLINE (>>=) #-}
97 fail msg = Reverse (fail msg)
98 {-# INLINE fail #-}
99
100 #if MIN_VERSION_base(4,9,0)
101 instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where
102 fail msg = Reverse (Fail.fail msg)
103 {-# INLINE fail #-}
104 #endif
105
106 -- | Derived instance.
107 instance (MonadPlus m) => MonadPlus (Reverse m) where
108 mzero = Reverse mzero
109 {-# INLINE mzero #-}
110 Reverse x `mplus` Reverse y = Reverse (x `mplus` y)
111 {-# INLINE mplus #-}
112
113 -- | Fold from right to left.
114 instance (Foldable f) => Foldable (Reverse f) where
115 foldMap f (Reverse t) = getDual (foldMap (Dual . f) t)
116 {-# INLINE foldMap #-}
117 foldr f z (Reverse t) = foldl (flip f) z t
118 {-# INLINE foldr #-}
119 foldl f z (Reverse t) = foldr (flip f) z t
120 {-# INLINE foldl #-}
121 foldr1 f (Reverse t) = foldl1 (flip f) t
122 {-# INLINE foldr1 #-}
123 foldl1 f (Reverse t) = foldr1 (flip f) t
124 {-# INLINE foldl1 #-}
125 #if MIN_VERSION_base(4,8,0)
126 null (Reverse t) = null t
127 length (Reverse t) = length t
128 #endif
129
130 -- | Traverse from right to left.
131 instance (Traversable f) => Traversable (Reverse f) where
132 traverse f (Reverse t) =
133 fmap Reverse . forwards $ traverse (Backwards . f) t
134 {-# INLINE traverse #-}
135
136 #if MIN_VERSION_base(4,12,0)
137 -- | Derived instance.
138 instance Contravariant f => Contravariant (Reverse f) where
139 contramap f = Reverse . contramap f . getReverse
140 {-# INLINE contramap #-}
141 #endif