1{-# LANGUAGE ScopedTypeVariables
2            ,TypeFamilies
3            ,MultiParamTypeClasses
4            ,FunctionalDependencies
5            ,FlexibleInstances
6            ,BangPatterns
7            ,FlexibleContexts
8            ,ConstraintKinds
9            ,CPP #-}
10
11{-
12Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>
13
14All rights reserved.
15
16For license and copyright information, see the file COPYRIGHT
17
18-}
19
20{- |
21   Module     : Data.ListLike.Base
22   Copyright  : Copyright (C) 2007 John Goerzen
23   License    : BSD3
24
25   Maintainer : John Lato <jwlato@gmail.com>
26   Stability  : provisional
27   Portability: portable
28
29Generic operations over list-like structures
30
31Written by John Goerzen, jgoerzen\@complete.org
32-}
33
34module Data.ListLike.Base
35    (
36    ListLike(..), ListOps,
37    toList, fromList,
38    InfiniteListLike(..),
39    zip, zipWith, sequence_
40    ) where
41import Prelude hiding (length, {-uncons,-} head, last, null, tail, map, filter, concat,
42                       any, lookup, init, all, foldl, foldr, foldl1, foldr1,
43                       maximum, minimum, iterate, span, break, takeWhile,
44                       dropWhile, {-dropWhileEnd,-} reverse, zip, zipWith, sequence,
45                       sequence_, mapM, mapM_, concatMap, and, or, sum,
46                       product, repeat, replicate, cycle, take, drop,
47                       splitAt, elem, notElem, unzip, lines, words,
48                       unlines, unwords, foldMap)
49import qualified Data.List as L
50import Data.ListLike.FoldableLL
51import qualified Control.Monad as M
52import Data.Monoid
53import Data.Maybe
54import GHC.Exts (IsList(Item, fromList, {-fromListN,-} toList))
55
56{- | The class implementing list-like functions.
57
58It is worth noting that types such as 'Data.Map.Map' can be instances of
59'ListLike'.  Due to their specific ways of operating, they may not behave
60in the expected way in some cases.  For instance, 'cons' may not increase
61the size of a map if the key you have given is already in the map; it will
62just replace the value already there.
63
64Implementators must define at least:
65
66* singleton
67
68* head
69
70* tail
71
72* null or genericLength
73-}
74class (IsList full, item ~ Item full, FoldableLL full item, Monoid full) =>
75    ListLike full item | full -> item where
76
77    ------------------------------ Creation
78    {- | The empty list -}
79    empty :: full
80    empty = mempty
81
82    {- | Creates a single-element list out of an element -}
83    singleton :: item -> full
84
85    ------------------------------ Basic Functions
86
87    {- | Like (:) for lists: adds an element to the beginning of a list -}
88    cons :: item -> full -> full
89    cons item l = append (singleton item) l
90
91    {- | Adds an element to the *end* of a 'ListLike'. -}
92    snoc :: full -> item -> full
93    snoc l item = append l (singleton item)
94
95    {- | Combines two lists.  Like (++). -}
96    append :: full -> full -> full
97    append = mappend
98
99    {- | Extracts the first element of a 'ListLike'. -}
100    head :: full -> item
101    head = maybe (error "head") fst . uncons
102
103    {- | Extract head and tail, return Nothing if empty -}
104    uncons :: full -> Maybe (item, full)
105    uncons x = if null x then Nothing else Just (head x, tail x) -- please don't
106
107    {- | Extracts the last element of a 'ListLike'. -}
108    last :: full -> item
109    last l = case genericLength l of
110                  (0::Integer) -> error "Called last on empty list"
111                  1 -> head l
112                  _ -> last (tail l)
113
114    {- | Gives all elements after the head. -}
115    tail :: full -> full
116    tail = maybe (error "tail") snd . uncons
117
118    {- | All elements of the list except the last one.  See also 'inits'. -}
119    init :: full -> full
120    init l
121        | null l = error "init: empty list"
122        | null xs = empty
123        | otherwise = cons (head l) (init xs)
124        where xs = tail l
125
126    {- | Tests whether the list is empty. -}
127    null :: full -> Bool
128    null x = genericLength x == (0::Integer)
129
130    {- | Length of the list.  See also 'genericLength'. -}
131    length :: full -> Int
132    length = genericLength
133
134    ------------------------------ List Transformations
135
136    {- | Apply a function to each element, returning any other
137         valid 'ListLike'.  'rigidMap' will always be at least
138         as fast, if not faster, than this function and is recommended
139         if it will work for your purposes.  See also 'mapM'. -}
140    map :: ListLike full' item' => (item -> item') -> full -> full'
141    map func inp
142        | null inp = empty
143        | otherwise = cons (func (head inp)) (map func (tail inp))
144
145    {- | Like 'map', but without the possibility of changing the type of
146       the item.  This can have performance benefits for things such as
147       ByteStrings, since it will let the ByteString use its native
148       low-level map implementation. -}
149    rigidMap :: (item -> item) -> full -> full
150    rigidMap = map
151
152    {- | Reverse the elements in a list. -}
153    reverse :: full -> full
154    reverse l = rev l empty
155        where rev rl a
156                | null rl = a
157                | otherwise = rev (tail rl) (cons (head rl) a)
158    {- | Add an item between each element in the structure -}
159    intersperse :: item -> full -> full
160    intersperse sep l
161        | null l = empty
162        | null xs = singleton x
163        | otherwise = cons x (cons sep (intersperse sep xs))
164        where x = head l
165              xs = tail l
166
167    ------------------------------ Reducing Lists (folds)
168    -- See also functions in FoldableLLL
169
170    ------------------------------ Special folds
171    {- | Flatten the structure. -}
172    concat :: (ListLike full' full{-, Monoid full-}) => full' -> full
173    concat = fold
174
175    {- | Map a function over the items and concatenate the results.
176         See also 'rigidConcatMap'.-}
177    concatMap :: (ListLike full' item') =>
178                 (item -> full') -> full -> full'
179    concatMap = foldMap
180
181    {- | Like 'concatMap', but without the possibility of changing
182         the type of the item.  This can have performance benefits
183         for some things such as ByteString. -}
184    rigidConcatMap :: (item -> full) -> full -> full
185    rigidConcatMap = concatMap
186
187    {- | True if any items satisfy the function -}
188    any :: (item -> Bool) -> full -> Bool
189    any p = getAny . foldMap (Any . p)
190
191    {- | True if all items satisfy the function -}
192    all :: (item -> Bool) -> full -> Bool
193    all p = getAll . foldMap (All . p)
194
195    {- | The maximum value of the list -}
196    maximum :: Ord item => full -> item
197    maximum = foldr1 max
198
199    {- | The minimum value of the list -}
200    minimum :: Ord item => full -> item
201    minimum = foldr1 min
202
203    ------------------------------ Infinite lists
204    {- | Generate a structure with the specified length with every element
205    set to the item passed in.  See also 'genericReplicate' -}
206    replicate :: Int -> item -> full
207    replicate = genericReplicate
208
209    ------------------------------ Sublists
210    {- | Takes the first n elements of the list.  See also 'genericTake'. -}
211    take :: Int -> full -> full
212    take = genericTake
213
214    {- | Drops the first n elements of the list.  See also 'genericDrop' -}
215    drop :: Int -> full -> full
216    drop = genericDrop
217
218    {- | Equivalent to @('take' n xs, 'drop' n xs)@.  See also 'genericSplitAt'. -}
219    splitAt :: Int -> full -> (full, full)
220    splitAt = genericSplitAt
221
222    {- | Returns all elements at start of list that satisfy the function. -}
223    takeWhile :: (item -> Bool) -> full -> full
224    takeWhile func l
225        | null l = empty
226        | func x = cons x (takeWhile func (tail l))
227        | otherwise = empty
228        where x = head l
229
230    {- | Drops all elements from the start of the list that satisfy the
231       function. -}
232    dropWhile :: (item -> Bool) -> full -> full
233    dropWhile func l
234        | null l = empty
235        | func (head l) = dropWhile func (tail l)
236        | otherwise = l
237
238    {- | Drops all elements from the end of the list that satisfy the
239       function. -}
240    dropWhileEnd :: (item -> Bool) -> full -> full
241    dropWhileEnd func = foldr (\x xs -> if func x && null xs then empty else cons x xs) empty
242
243    {- | The equivalent of @('takeWhile' f xs, 'dropWhile' f xs)@ -}
244    span :: (item -> Bool) -> full -> (full, full)
245    span func l
246        | null l = (empty, empty)
247        | func x = (cons x ys, zs)
248        | otherwise = (empty, l)
249       where (ys, zs) = span func (tail l)
250             x = head l
251    {- | The equivalent of @'span' ('not' . f)@ -}
252    break :: (item -> Bool) -> full -> (full, full)
253    break p = span (not . p)
254
255    {- | Split a list into sublists, each which contains equal arguments.
256       For order-preserving types, concatenating these sublists will produce
257       the original list. See also 'groupBy'. -}
258    group :: (ListLike full' full, Eq item) => full -> full'
259    group = groupBy (==)
260
261    {- | All initial segments of the list, shortest first -}
262    inits :: (ListLike full' full) => full -> full'
263    inits l
264        | null l = singleton empty
265        | otherwise =
266            append (singleton empty)
267                   (map (cons (head l)) theinits)
268            where theinits = asTypeOf (inits (tail l)) [l]
269
270    {- | All final segnemts, longest first -}
271    tails :: ListLike full' full => full -> full'
272    tails l
273        | null l = singleton empty
274        | otherwise = cons l (tails (tail l))
275
276    ------------------------------ Predicates
277    {- | True when the first list is at the beginning of the second. -}
278    isPrefixOf :: Eq item => full -> full -> Bool
279    isPrefixOf needle haystack
280        | null needle = True
281        | null haystack = False
282        | otherwise = (head needle) == (head haystack) &&
283                      isPrefixOf (tail needle) (tail haystack)
284
285    {- | True when the first list is at the beginning of the second. -}
286    isSuffixOf :: Eq item => full -> full -> Bool
287    isSuffixOf needle haystack = isPrefixOf (reverse needle) (reverse haystack)
288
289    {- | True when the first list is wholly containted within the second -}
290    isInfixOf :: Eq item => full -> full -> Bool
291    isInfixOf needle haystack =
292        any (isPrefixOf needle) thetails
293        where thetails = asTypeOf (tails haystack) [haystack]
294
295    ------------------------------ Conditionally modify based on predicates
296    {- | Remove a prefix from a listlike if possible -}
297    stripPrefix :: Eq item => full -> full -> Maybe full
298    stripPrefix xs ys = if xs `isPrefixOf` ys
299                            then Just $ drop (length xs) ys
300                            else Nothing
301
302    {- | Remove a suffix from a listlike if possible -}
303    stripSuffix :: Eq item => full -> full -> Maybe full
304    stripSuffix xs ys = if xs `isSuffixOf` ys
305                            then Just $ take (length ys - length xs) ys
306                            else Nothing
307
308    ------------------------------ Searching
309    {- | True if the item occurs in the list -}
310    elem :: Eq item => item -> full -> Bool
311    elem i = any (== i)
312
313    {- | True if the item does not occur in the list -}
314    notElem :: Eq item => item -> full -> Bool
315    notElem i = all (/= i)
316
317    {- | Take a function and return the first matching element, or Nothing
318       if there is no such element. -}
319    find :: (item -> Bool) -> full -> Maybe item
320    find f l = case findIndex f l of
321                    Nothing -> Nothing
322                    Just x -> Just (index l x)
323
324    {- | Returns only the elements that satisfy the function. -}
325    filter :: (item -> Bool) -> full -> full
326    filter func l
327        | null l = empty
328        | func (head l) = cons (head l) (filter func (tail l))
329        | otherwise = filter func (tail l)
330
331    {- | Returns the lists that do and do not satisfy the function.
332       Same as @('filter' p xs, 'filter' ('not' . p) xs)@ -}
333    partition :: (item -> Bool) -> full -> (full, full)
334    partition p xs = (filter p xs, filter (not . p) xs)
335
336    ------------------------------ Indexing
337    {- | The element at 0-based index i.  Raises an exception if i is out
338         of bounds.  Like (!!) for lists. -}
339    index :: full -> Int -> item
340    index l i
341        | null l = error "index: index not found"
342        | i < 0 = error "index: index must be >= 0"
343        | i == 0 = head l
344        | otherwise = index (tail l) (i - 1)
345
346    {- | Returns the index of the element, if it exists. -}
347    elemIndex :: Eq item => item -> full -> Maybe Int
348    elemIndex e l = findIndex (== e) l
349
350    {- | Returns the indices of the matching elements.  See also
351       'findIndices' -}
352    elemIndices :: (Eq item, ListLike result Int) => item -> full -> result
353    elemIndices i l = findIndices (== i) l
354
355    {- | Take a function and return the index of the first matching element,
356         or Nothing if no element matches -}
357    findIndex :: (item -> Bool) -> full -> Maybe Int
358    findIndex f = listToMaybe . findIndices f
359
360    {- | Returns the indices of all elements satisfying the function -}
361    findIndices :: (ListLike result Int) => (item -> Bool) -> full -> result
362    findIndices p xs = map snd $ filter (p . fst) $ thezips
363        where thezips = asTypeOf (zip xs [0..]) [(head xs, 0::Int)]
364
365    ------------------------------ Monadic operations
366    {- | Evaluate each action in the sequence and collect the results -}
367    sequence :: (Monad m, ListLike fullinp (m item)) =>
368                fullinp -> m full
369    sequence l = foldr func (return empty) l
370        where func litem results =
371                do x <- litem
372                   xs <- results
373                   return (cons x xs)
374
375    {- | A map in monad space.  Same as @'sequence' . 'map'@
376
377         See also 'rigidMapM' -}
378    mapM :: (Monad m, ListLike full' item') =>
379            (item -> m item') -> full -> m full'
380    mapM func l = sequence mapresult
381            where mapresult = asTypeOf (map func l) []
382
383    {- | Like 'mapM', but without the possibility of changing the type
384         of the item.  This can have performance benefits with some types. -}
385    rigidMapM :: Monad m => (item -> m item) -> full -> m full
386    rigidMapM = mapM
387
388
389    ------------------------------ "Set" operations
390    {- | Removes duplicate elements from the list.  See also 'nubBy' -}
391    nub :: Eq item => full -> full
392    nub = nubBy (==)
393
394    {- | Removes the first instance of the element from the list.
395       See also 'deleteBy' -}
396    delete :: Eq item => item -> full -> full
397    delete = deleteBy (==)
398
399    {- | List difference.  Removes from the first list the first instance
400       of each element of the second list.  See '(\\)' and 'deleteFirstsBy' -}
401    deleteFirsts :: Eq item => full -> full -> full
402    deleteFirsts = foldl (flip delete)
403
404    {- | List union: the set of elements that occur in either list.
405         Duplicate elements in the first list will remain duplicate.
406         See also 'unionBy'. -}
407    union :: Eq item => full -> full -> full
408    union = unionBy (==)
409
410    {- | List intersection: the set of elements that occur in both lists.
411         See also 'intersectBy' -}
412    intersect :: Eq item => full -> full -> full
413    intersect = intersectBy (==)
414
415    ------------------------------ Ordered lists
416    {- | Sorts the list.  On data types that do not preserve ordering,
417         or enforce their own ordering, the result may not be what
418         you expect.  See also 'sortBy'. -}
419    sort :: Ord item => full -> full
420    sort = sortBy compare
421
422    {- | Inserts the element at the last place where it is still less than or
423         equal to the next element.  On data types that do not preserve
424         ordering, or enforce their own ordering, the result may not
425         be what you expect.  On types such as maps, this may result in
426         changing an existing item.  See also 'insertBy'. -}
427    insert :: Ord item => item -> full -> full
428    insert = insertBy compare
429
430    ------------------------------ Conversions
431
432    {- | Converts the structure to a list.  This is logically equivolent
433         to 'fromListLike', but may have a more optimized implementation.
434         These two functions are now retired in favor of the methods of
435         IsList, but they are retained here because some instances still
436         use this implementation. -}
437    toList' :: full -> [item]
438    toList' = fromListLike
439
440    {- | Generates the structure from a list. -}
441    fromList' :: [item] -> full
442    fromList' [] = empty
443    fromList' (x:xs) = cons x (fromList xs)
444
445    {- | Converts one ListLike to another.  See also 'toList''.
446         Default implementation is @fromListLike = map id@ -}
447    fromListLike :: ListLike full' item => full -> full'
448    fromListLike = map id
449    {-# INLINE fromListLike #-}
450
451    ------------------------------ Generalized functions
452    {- | Generic version of 'nub' -}
453    -- This code is adapted from Data.List in base.
454    nubBy :: (item -> item -> Bool) -> full -> full
455    nubBy eq l = nubBy' l mempty
456      where
457        nubBy' ys xs =
458          case uncons ys of
459            Nothing -> mempty
460            Just (y, ys')
461              | elem_by y xs -> nubBy' ys' xs
462              | otherwise -> cons y (nubBy' ys' (cons y xs))
463        elem_by :: item -> full -> Bool
464        elem_by y xs =
465          case uncons xs of
466            Nothing -> False
467            Just (x, xs') -> x `eq` y || elem_by y xs'
468{-
469    nubBy f l
470        | null l = empty
471        | otherwise =
472            cons (head l) (nubBy f (filter (\y -> not (f (head l) y)) (tail l)))
473-}
474
475    {- | Generic version of 'deleteBy' -}
476    deleteBy :: (item -> item -> Bool) -> item -> full -> full
477    deleteBy func i l
478        | null l = empty
479        | otherwise =
480            if func i (head l)
481               then tail l
482               else cons (head l) (deleteBy func i (tail l))
483
484    {- | Generic version of 'deleteFirsts' -}
485    deleteFirstsBy :: (item -> item -> Bool) -> full -> full -> full
486    deleteFirstsBy func = foldl (flip (deleteBy func))
487
488    {- | Generic version of 'union' -}
489    unionBy :: (item -> item -> Bool) -> full -> full -> full
490    unionBy func x y =
491        append x $ foldl (flip (deleteBy func)) (nubBy func y) x
492
493    {- | Generic version of 'intersect' -}
494    intersectBy :: (item -> item -> Bool) -> full -> full -> full
495    intersectBy func xs ys = filter (\x -> any (func x) ys) xs
496
497    {- | Generic version of 'group'. -}
498    groupBy :: (ListLike full' full, Eq item) =>
499                (item -> item -> Bool) -> full -> full'
500    groupBy eq l
501        | null l = empty
502        | otherwise = cons (cons x ys) (groupBy eq zs)
503                      where (ys, zs) = span (eq x) xs
504                            x = head l
505                            xs = tail l
506
507    {- | Sort function taking a custom comparison function -}
508    sortBy :: (item -> item -> Ordering) -> full -> full
509    sortBy cmp = foldr (insertBy cmp) empty
510
511    {- | Like 'insert', but with a custom comparison function -}
512    insertBy :: (item -> item -> Ordering) -> item ->
513                full -> full
514    insertBy cmp x ys
515        | null ys = singleton x
516        | otherwise = case cmp x (head ys) of
517                        GT -> cons (head ys) (insertBy cmp x (tail ys))
518                        _ ->  cons x ys
519
520    ------------------------------ Generic Operations
521    {- | Length of the list -}
522    genericLength :: Num a => full -> a
523    genericLength l = calclen 0 l
524        where calclen !accum cl =
525                  if null cl
526                     then accum
527                     else calclen (accum + 1) (tail cl)
528
529    {- | Generic version of 'take' -}
530    genericTake :: Integral a => a -> full -> full
531    genericTake n l
532        | n <= 0 = empty
533        | null l = empty
534        | otherwise = cons (head l) (genericTake (n - 1) (tail l))
535
536    {- | Generic version of 'drop' -}
537    genericDrop :: Integral a => a -> full -> full
538    genericDrop n l
539        | n <= 0 = l
540        | null l = l
541        | otherwise = genericDrop (n - 1) (tail l)
542
543    {- | Generic version of 'splitAt' -}
544    genericSplitAt :: Integral a => a -> full -> (full, full)
545    genericSplitAt n l = (genericTake n l, genericDrop n l)
546
547    {- | Generic version of 'replicate' -}
548    genericReplicate :: Integral a => a -> item -> full
549    genericReplicate count x
550        | count <= 0 = empty
551        | otherwise = map (\_ -> x) [1..count]
552
553#if __GLASGOW_HASKELL__ >= 708
554    {-# MINIMAL (singleton, uncons, null) |
555                (singleton, uncons, genericLength) |
556                (singleton, head, tail, null) |
557                (singleton, head, tail, genericLength) #-}
558#endif
559
560-- | A version of 'ListLike' with a single type parameter, the item
561-- type is obtained using the 'Item' type function from 'IsList'.
562type ListOps full = (ListLike full (Item full))
563
564{-
565instance (ListLike full item) => Monad full where
566    m >>= k = foldr (append . k) empty m
567    m >> k = foldr (append . (\_ -> k)) empty m
568    return x = singleton x
569    fail _ = empty
570
571instance (ListLike full item) => M.MonadPlus full where
572    mzero = empty
573    mplus = append
574-}
575
576{- | An extension to 'ListLike' for those data types that are capable
577of dealing with infinite lists.  Some 'ListLike' functions are capable
578of working with finite or infinite lists.  The functions here require
579infinite list capability in order to work at all. -}
580class (ListLike full item) => InfiniteListLike full item | full -> item where
581    {- | An infinite list of repeated calls of the function to args -}
582    iterate :: (item -> item) -> item -> full
583    iterate f x = cons x (iterate f (f x))
584
585    {- | An infinite list where each element is the same -}
586    repeat :: item -> full
587    repeat x = xs
588        where xs = cons x xs
589
590    {- | Converts a finite list into a circular one -}
591    cycle :: full -> full
592    cycle xs
593        | null xs = error "ListLike.cycle: empty list"
594        | otherwise = xs' where xs' = append xs xs'
595
596--------------------------------------------------
597-- This instance is here due to some default class functions
598
599instance ListLike [a] a where
600    empty = []
601    singleton x = [x]
602    cons x l = x : l
603    snoc l x = l ++ [x]
604    append = (++)
605    head = L.head
606    last = L.last
607    tail = L.tail
608    init = L.init
609    null = L.null
610    length = L.length
611    map f = fromList . L.map f
612    rigidMap = L.map
613    reverse = L.reverse
614    intersperse = L.intersperse
615    -- fromListLike = toList
616    concat = L.concat . toList
617    -- concatMap func = fromList . L.concatMap func
618    rigidConcatMap = L.concatMap
619    any = L.any
620    all = L.all
621    maximum = L.maximum
622    minimum = L.minimum
623    -- fold
624    -- foldMap
625    replicate = L.replicate
626    take = L.take
627    drop = L.drop
628    splitAt = L.splitAt
629    takeWhile = L.takeWhile
630    dropWhile = L.dropWhile
631    span = L.span
632    break = L.break
633    group = fromList . L.group
634    inits = fromList . L.inits
635    tails = fromList . L.tails
636    isPrefixOf = L.isPrefixOf
637    isSuffixOf = L.isSuffixOf
638    isInfixOf = L.isInfixOf
639    stripPrefix = L.stripPrefix
640    elem = L.elem
641    notElem = L.notElem
642    find = L.find
643    filter = L.filter
644    partition = L.partition
645    index = (L.!!)
646    elemIndex = L.elemIndex
647    elemIndices item = fromList . L.elemIndices item
648    findIndex = L.findIndex
649    sequence = M.sequence . toList
650    -- mapM = M.mapM
651    nub = L.nub
652    delete = L.delete
653    deleteFirsts = (L.\\)
654    union = L.union
655    intersect = L.intersect
656    sort = L.sort
657    groupBy func = fromList . L.groupBy func
658    unionBy = L.unionBy
659    intersectBy = L.intersectBy
660    sortBy = L.sortBy
661    insert = L.insert
662    genericLength = L.genericLength
663
664
665--------------------------------------------------
666-- These utils are here instead of in Utils.hs because they are needed
667-- by default class functions
668
669{- | Takes two lists and returns a list of corresponding pairs. -}
670zip :: (ListLike full item,
671          ListLike fullb itemb,
672          ListLike result (item, itemb)) =>
673          full -> fullb -> result
674zip = zipWith (\a b -> (a, b))
675
676{- | Takes two lists and combines them with a custom combining function -}
677zipWith :: (ListLike full item,
678            ListLike fullb itemb,
679            ListLike result resultitem) =>
680            (item -> itemb -> resultitem) -> full -> fullb -> result
681zipWith f a b
682    | null a = empty
683    | null b = empty
684    | otherwise = cons (f (head a) (head b)) (zipWith f (tail a) (tail b))
685