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