1{-# LANGUAGE CPP, NoImplicitPrelude #-}
2{-# LANGUAGE BangPatterns #-}
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
5#endif
6module Data.List.Compat (
7  module Base
8#if !(MIN_VERSION_base(4,11,0))
9, iterate'
10#endif
11
12#if !(MIN_VERSION_base(4,8,0))
13, all
14, and
15, any
16, concat
17, concatMap
18, elem
19, find
20, foldl
21, foldl'
22, foldl1
23, foldr
24, foldr1
25, length
26, maximum
27, maximumBy
28, minimum
29, minimumBy
30, notElem
31, nub
32, nubBy
33, null
34, or
35, product
36, sum
37, union
38, unionBy
39, mapAccumL
40, mapAccumR
41
42, isSubsequenceOf
43, sortOn
44, uncons
45, scanl'
46#endif
47
48#if !(MIN_VERSION_base(4,5,0))
49, dropWhileEnd
50#endif
51) where
52
53#if MIN_VERSION_base(4,8,0)
54import Data.List as Base
55#else
56import Data.List as Base hiding (
57    all
58  , and
59  , any
60  , concat
61  , concatMap
62  , elem
63  , find
64  , foldl
65  , foldl'
66  , foldl1
67  , foldr
68  , foldr1
69  , length
70  , maximum
71  , maximumBy
72  , minimum
73  , minimumBy
74  , notElem
75  , nub
76  , nubBy
77  , null
78  , or
79  , product
80  , sum
81  , union
82  , unionBy
83  , mapAccumL
84  , mapAccumR
85  )
86import Data.Foldable.Compat
87import Data.Traversable
88import Data.Ord (comparing)
89#endif
90
91#if !(MIN_VERSION_base(4,11,0))
92import GHC.Exts (build)
93import Prelude.Compat hiding (foldr, null)
94#endif
95
96#if !(MIN_VERSION_base(4,5,0))
97-- | The 'dropWhileEnd' function drops the largest suffix of a list
98-- in which the given predicate holds for all elements.  For example:
99--
100-- > dropWhileEnd isSpace "foo\n" == "foo"
101-- > dropWhileEnd isSpace "foo bar" == "foo bar"
102-- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined
103--
104-- /Since: 4.5.0.0/
105dropWhileEnd :: (a -> Bool) -> [a] -> [a]
106dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
107
108#endif
109
110#if !(MIN_VERSION_base(4,8,0))
111-- | The 'isSubsequenceOf' function takes two lists and returns 'True' if the
112-- first list is a subsequence of the second list.
113--
114-- @'isSubsequenceOf' x y@ is equivalent to @'elem' x ('subsequences' y)@.
115--
116-- /Since: 4.8.0.0/
117--
118-- ==== __Examples__
119--
120-- >>> isSubsequenceOf "GHC" "The Glorious Haskell Compiler"
121-- True
122-- >>> isSubsequenceOf ['a','d'..'z'] ['a'..'z']
123-- True
124-- >>> isSubsequenceOf [1..10] [10,9..0]
125-- False
126isSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool
127isSubsequenceOf []    _                    = True
128isSubsequenceOf _     []                   = False
129isSubsequenceOf a@(x:a') (y:b) | x == y    = isSubsequenceOf a' b
130                               | otherwise = isSubsequenceOf a b
131
132-- | Sort a list by comparing the results of a key function applied to each
133-- element.  @sortOn f@ is equivalent to @sortBy . comparing f@, but has the
134-- performance advantage of only evaluating @f@ once for each element in the
135-- input list.  This is called the decorate-sort-undecorate paradigm, or
136-- Schwartzian transform.
137--
138-- /Since: 4.8.0.0/
139sortOn :: Ord b => (a -> b) -> [a] -> [a]
140sortOn f =
141  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
142
143-- | Decompose a list into its head and tail. If the list is empty,
144-- returns 'Nothing'. If the list is non-empty, returns @'Just' (x, xs)@,
145-- where @x@ is the head of the list and @xs@ its tail.
146--
147-- /Since: 4.8.0.0/
148uncons                  :: [a] -> Maybe (a, [a])
149uncons []               = Nothing
150uncons (x:xs)           = Just (x, xs)
151
152-- | A strictly accumulating version of 'scanl'
153{-# NOINLINE [1] scanl' #-}
154scanl'           :: (b -> a -> b) -> b -> [a] -> [b]
155-- This peculiar form is needed to prevent scanl' from being rewritten
156-- in its own right hand side.
157scanl' = scanlGo'
158  where
159    scanlGo'           :: (b -> a -> b) -> b -> [a] -> [b]
160    scanlGo' f !q ls    = q : (case ls of
161                            []   -> []
162                            x:xs -> scanlGo' f (f q x) xs)
163
164-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.
165-- In particular, it keeps only the first occurrence of each element.
166-- (The name 'nub' means \`essence\'.)
167-- It is a special case of 'nubBy', which allows the programmer to supply
168-- their own equality test.
169nub                     :: (Eq a) => [a] -> [a]
170nub                     =  nubBy (==)
171
172
173-- | The 'nubBy' function behaves just like 'nub', except it uses a
174-- user-supplied equality predicate instead of the overloaded '=='
175-- function.
176nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
177-- stolen from HBC
178nubBy eq l              = nubBy' l []
179  where
180    nubBy' [] _         = []
181    nubBy' (y:ys) xs
182       | elem_by eq y xs = nubBy' ys xs
183       | otherwise       = y : nubBy' ys (y:xs)
184
185-- Not exported:
186-- Note that we keep the call to `eq` with arguments in the
187-- same order as in the reference (prelude) implementation,
188-- and that this order is different from how `elem` calls (==).
189-- See #2528, #3280 and #7913.
190-- 'xs' is the list of things we've seen so far,
191-- 'y' is the potential new element
192elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
193elem_by _  _ []         =  False
194elem_by eq y (x:xs)     =  x `eq` y || elem_by eq y xs
195
196-- | The 'union' function returns the list union of the two lists.
197-- For example,
198--
199-- > "dog" `union` "cow" == "dogcw"
200--
201-- Duplicates, and elements of the first list, are removed from the
202-- the second list, but if the first list contains duplicates, so will
203-- the result.
204-- It is a special case of 'unionBy', which allows the programmer to supply
205-- their own equality test.
206
207union                   :: (Eq a) => [a] -> [a] -> [a]
208union                   = unionBy (==)
209
210-- | The 'unionBy' function is the non-overloaded version of 'union'.
211unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
212unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
213#endif
214
215#if !(MIN_VERSION_base(4,11,0))
216-- | 'iterate\'' is the strict version of 'iterate'.
217--
218-- It ensures that the result of each application of force to weak head normal
219-- form before proceeding.
220{-# NOINLINE [1] iterate' #-}
221iterate' :: (a -> a) -> a -> [a]
222iterate' f x =
223    let x' = f x
224    in x' `seq` (x : iterate' f x')
225
226{-# INLINE [0] iterate'FB #-} -- See Note [Inline FB functions]
227iterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b
228iterate'FB c f x0 = go x0
229  where go x =
230            let x' = f x
231            in x' `seq` (x `c` go x')
232
233{-# RULES
234"iterate'"    [~1] forall f x.   iterate' f x = build (\c _n -> iterate'FB c f x)
235"iterate'FB"  [1]                iterate'FB (:) = iterate'
236 #-}
237#endif
238