← Back to branch summary

~ubuntu-branches/ubuntu/wily/agda/wily-proposed

« back to all changes in this revision

Viewing changes to src/compat/Data/Foldable.hs

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2014-08-05 06:38:12 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20140805063812-io8e77niomivhd49
Tags: 2.4.0.2-1
* [6e140ac] Imported Upstream version 2.4.0.2
* [2049fc8] Update Build-Depends to match control
* [93dc4d4] Install the new primitives
* [e48f40f] Fix typo dev→doc

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/compat/Data/Foldable.hs
1
 
{-# OPTIONS_GHC -cpp #-}
2
 
-----------------------------------------------------------------------------
3
 
--
4
 
--
5
 
--
6
 
 
7
 
module Data.Foldable (
8
 
        -- * Folds
9
 
        Foldable(..),
10
 
        -- ** Special biased folds
11
 
        foldr',
12
 
        foldl',
13
 
        foldrM,
14
 
        foldlM,
15
 
        -- ** Folding actions
16
 
        -- *** Applicative actions
17
 
        traverse_,
18
 
        for_,
19
 
        sequenceA_,
20
 
        asum,
21
 
        -- *** Monadic actions
22
 
        mapM_,
23
 
        forM_,
24
 
        sequence_,
25
 
        msum,
26
 
        -- ** Specialized folds
27
 
        toList,
28
 
        concat,
29
 
        concatMap,
30
 
        and,
31
 
        or,
32
 
        any,
33
 
        all,
34
 
        sum,
35
 
        product,
36
 
        maximum,
37
 
        maximumBy,
38
 
        minimum,
39
 
        minimumBy,
40
 
        -- ** Searches
41
 
        elem,
42
 
        notElem,
43
 
        find
44
 
        ) where
45
 
 
46
 
import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,
47
 
                elem, notElem, concat, concatMap, and, or, any, all,
48
 
                sum, product, maximum, minimum)
49
 
import qualified Prelude (foldl, foldr, foldl1, foldr1)
50
 
import Control.Applicative
51
 
import Control.Monad (MonadPlus(..))
52
 
import Data.Maybe (fromMaybe, listToMaybe)
53
 
import Data.Monoid.New
54
 
import Data.Array
55
 
import Data.Map (Map)
56
 
import qualified Data.Map as Map
57
 
import Data.Set (Set)
58
 
import qualified Data.Set as Set
59
 
 
60
 
#ifdef __NHC__
61
 
import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem
62
 
#endif
63
 
 
64
 
#ifdef __GLASGOW_HASKELL__
65
 
import GHC.Exts (build)
66
 
#endif
67
 
 
68
 
--
69
 
--
70
 
--
71
 
--
72
 
--
73
 
--
74
 
--
75
 
class Foldable t where
76
 
        -- | Combine the elements of a structure using a monoid.
77
 
        fold :: Monoid m => t m -> m
78
 
        fold = foldMap id
79
 
 
80
 
        -- | Map each element of the structure to a monoid,
81
 
        -- and combine the results.
82
 
        foldMap :: Monoid m => (a -> m) -> t a -> m
83
 
        foldMap f = foldr (mappend . f) mempty
84
 
 
85
 
        -- | Right-associative fold of a structure.
86
 
        --
87
 
        -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@
88
 
        foldr :: (a -> b -> b) -> b -> t a -> b
89
 
        foldr f z t = appEndo (foldMap (Endo . f) t) z
90
 
 
91
 
        -- | Left-associative fold of a structure.
92
 
        --
93
 
        -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@
94
 
        foldl :: (a -> b -> a) -> a -> t b -> a
95
 
        foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
96
 
 
97
 
        -- | A variant of 'foldr' that has no base case,
98
 
        -- and thus may only be applied to non-empty structures.
99
 
        --
100
 
        -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@
101
 
        foldr1 :: (a -> a -> a) -> t a -> a
102
 
        foldr1 f xs = fromMaybe (error "foldr1: empty structure")
103
 
                        (foldr mf Nothing xs)
104
 
          where mf x Nothing = Just x
105
 
                mf x (Just y) = Just (f x y)
106
 
 
107
 
        -- | A variant of 'foldl' that has no base case,
108
 
        -- and thus may only be applied to non-empty structures.
109
 
        --
110
 
        -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@
111
 
        foldl1 :: (a -> a -> a) -> t a -> a
112
 
        foldl1 f xs = fromMaybe (error "foldl1: empty structure")
113
 
                        (foldl mf Nothing xs)
114
 
          where mf Nothing y = Just y
115
 
                mf (Just x) y = Just (f x y)
116
 
 
117
 
 
118
 
instance Foldable Maybe where
119
 
        foldr f z Nothing = z
120
 
        foldr f z (Just x) = f x z
121
 
 
122
 
        foldl f z Nothing = z
123
 
        foldl f z (Just x) = f z x
124
 
 
125
 
instance Foldable [] where
126
 
        foldr = Prelude.foldr
127
 
        foldl = Prelude.foldl
128
 
        foldr1 = Prelude.foldr1
129
 
        foldl1 = Prelude.foldl1
130
 
 
131
 
instance Ix i => Foldable (Array i) where
132
 
        foldr f z = Prelude.foldr f z . elems
133
 
 
134
 
instance Ord k => Foldable (Map k) where
135
 
    foldr f z = foldr f z . Map.elems
136
 
 
137
 
instance Foldable Set where
138
 
    foldr f z = foldr f z . Set.toList
139
 
 
140
 
foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b
141
 
foldr' f z xs = foldl f' id xs z
142
 
  where f' k x z = k $! f x z
143
 
 
144
 
foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
145
 
foldrM f z xs = foldl f' return xs z
146
 
  where f' k x z = f x z >>= k
147
 
 
148
 
foldl' :: Foldable t => (a -> b -> a) -> a -> t b -> a
149
 
foldl' f z xs = foldr f' id xs z
150
 
  where f' x k z = k $! f z x
151
 
 
152
 
foldlM :: (Foldable t, Monad m) => (a -> b -> m a) -> a -> t b -> m a
153
 
foldlM f z xs = foldr f' return xs z
154
 
  where f' x k z = f z x >>= k
155
 
 
156
 
traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
157
 
traverse_ f = foldr ((*>) . f) (pure ())
158
 
 
159
 
for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
160
 
{-# INLINE for_ #-}
161
 
for_ = flip traverse_
162
 
 
163
 
mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
164
 
mapM_ f = foldr ((>>) . f) (return ())
165
 
 
166
 
forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()
167
 
{-# INLINE forM_ #-}
168
 
forM_ = flip mapM_
169
 
 
170
 
sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()
171
 
sequenceA_ = foldr (*>) (pure ())
172
 
 
173
 
sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()
174
 
sequence_ = foldr (>>) (return ())
175
 
 
176
 
asum :: (Foldable t, Alternative f) => t (f a) -> f a
177
 
{-# INLINE asum #-}
178
 
asum = foldr (<|>) empty
179
 
 
180
 
msum :: (Foldable t, MonadPlus m) => t (m a) -> m a
181
 
{-# INLINE msum #-}
182
 
msum = foldr mplus mzero
183
 
 
184
 
 
185
 
toList :: Foldable t => t a -> [a]
186
 
#ifdef __GLASGOW_HASKELL__
187
 
toList t = build (\ c n -> foldr c n t)
188
 
#else
189
 
toList = foldr (:) []
190
 
#endif
191
 
 
192
 
concat :: Foldable t => t [a] -> [a]
193
 
concat = fold
194
 
 
195
 
concatMap :: Foldable t => (a -> [b]) -> t a -> [b]
196
 
concatMap = foldMap
197
 
 
198
 
and :: Foldable t => t Bool -> Bool
199
 
and = getAll . foldMap All
200
 
 
201
 
or :: Foldable t => t Bool -> Bool
202
 
or = getAny . foldMap Any
203
 
 
204
 
any :: Foldable t => (a -> Bool) -> t a -> Bool
205
 
any p = getAny . foldMap (Any . p)
206
 
 
207
 
all :: Foldable t => (a -> Bool) -> t a -> Bool
208
 
all p = getAll . foldMap (All . p)
209
 
 
210
 
sum :: (Foldable t, Num a) => t a -> a
211
 
sum = getSum . foldMap Sum
212
 
 
213
 
product :: (Foldable t, Num a) => t a -> a
214
 
product = getProduct . foldMap Product
215
 
 
216
 
maximum :: (Foldable t, Ord a) => t a -> a
217
 
maximum = foldr1 max
218
 
 
219
 
maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
220
 
maximumBy cmp = foldr1 max'
221
 
  where max' x y = case cmp x y of
222
 
                        GT -> x
223
 
                        _  -> y
224
 
 
225
 
minimum :: (Foldable t, Ord a) => t a -> a
226
 
minimum = foldr1 min
227
 
 
228
 
minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
229
 
minimumBy cmp = foldr1 min'
230
 
  where min' x y = case cmp x y of
231
 
                        GT -> y
232
 
                        _  -> x
233
 
 
234
 
elem :: (Foldable t, Eq a) => a -> t a -> Bool
235
 
elem = any . (==)
236
 
 
237
 
notElem :: (Foldable t, Eq a) => a -> t a -> Bool
238
 
notElem x = not . elem x
239
 
 
240
 
find :: Foldable t => (a -> Bool) -> t a -> Maybe a
241
 
find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])