{-# LANGUAGE ScopedTypeVariables ,MultiParamTypeClasses ,FunctionalDependencies ,FlexibleInstances ,BangPatterns ,FlexibleContexts ,CPP #-} {- Copyright (C) 2007 John Goerzen <jgoerzen@complete.org> All rights reserved. For license and copyright information, see the file COPYRIGHT -} {- | Module : Data.ListLike.Base Copyright : Copyright (C) 2007 John Goerzen License : BSD3 Maintainer : John Lato <jwlato@gmail.com> Stability : provisional Portability: portable Generic operations over list-like structures Written by John Goerzen, jgoerzen\@complete.org -} module Data.ListLike.Base ( ListLike(..), InfiniteListLike(..), zip, zipWith, sequence_ ) where import Prelude hiding (length, uncons, head, last, null, tail, map, filter, concat, any, lookup, init, all, foldl, foldr, foldl1, foldr1, maximum, minimum, iterate, span, break, takeWhile, dropWhile, dropWhileEnd, reverse, zip, zipWith, sequence, sequence_, mapM, mapM_, concatMap, and, or, sum, product, repeat, replicate, cycle, take, drop, splitAt, elem, notElem, unzip, lines, words, unlines, unwords, foldMap) import qualified Data.List as L import Data.ListLike.FoldableLL import qualified Control.Monad as M import Data.Monoid import Data.Maybe {- | The class implementing list-like functions. It is worth noting that types such as 'Data.Map.Map' can be instances of 'ListLike'. Due to their specific ways of operating, they may not behave in the expected way in some cases. For instance, 'cons' may not increase the size of a map if the key you have given is already in the map; it will just replace the value already there. Implementators must define at least: * singleton * head * tail * null or genericLength -} class (FoldableLL full item, Monoid full) => ListLike full item | full -> item where ------------------------------ Creation {- | The empty list -} empty :: full empty = mempty {- | Creates a single-element list out of an element -} singleton :: item -> full ------------------------------ Basic Functions {- | Like (:) for lists: adds an element to the beginning of a list -} cons :: item -> full -> full cons item l = append (singleton item) l {- | Adds an element to the *end* of a 'ListLike'. -} snoc :: full -> item -> full snoc l item = append l (singleton item) {- | Combines two lists. Like (++). -} append :: full -> full -> full append = mappend {- | Extracts the first element of a 'ListLike'. -} head :: full -> item head = maybe (error "head") fst . uncons {- | Extract head and tail, return Nothing if empty -} uncons :: full -> Maybe (item, full) uncons x = if null x then Nothing else Just (head x, tail x) -- please don't {- | Extracts the last element of a 'ListLike'. -} last :: full -> item last l = case genericLength l of (0::Integer) -> error "Called last on empty list" 1 -> head l _ -> last (tail l) {- | Gives all elements after the head. -} tail :: full -> full tail = maybe (error "tail") snd . uncons {- | All elements of the list except the last one. See also 'inits'. -} init :: full -> full init l | null l = error "init: empty list" | null xs = empty | otherwise = cons (head l) (init xs) where xs = tail l {- | Tests whether the list is empty. -} null :: full -> Bool null x = genericLength x == (0::Integer) {- | Length of the list. See also 'genericLength'. -} length :: full -> Int length = genericLength ------------------------------ List Transformations {- | Apply a function to each element, returning any other valid 'ListLike'. 'rigidMap' will always be at least as fast, if not faster, than this function and is recommended if it will work for your purposes. See also 'mapM'. -} map :: ListLike full' item' => (item -> item') -> full -> full' map func inp | null inp = empty | otherwise = cons (func (head inp)) (map func (tail inp)) {- | Like 'map', but without the possibility of changing the type of the item. This can have performance benefits for things such as ByteStrings, since it will let the ByteString use its native low-level map implementation. -} rigidMap :: (item -> item) -> full -> full rigidMap = map {- | Reverse the elements in a list. -} reverse :: full -> full reverse l = rev l empty where rev rl a | null rl = a | otherwise = rev (tail rl) (cons (head rl) a) {- | Add an item between each element in the structure -} intersperse :: item -> full -> full intersperse sep l | null l = empty | null xs = singleton x | otherwise = cons x (cons sep (intersperse sep xs)) where x = head l xs = tail l ------------------------------ Reducing Lists (folds) -- See also functions in FoldableLLL ------------------------------ Special folds {- | Flatten the structure. -} concat :: (ListLike full' full, Monoid full) => full' -> full concat = fold {- | Map a function over the items and concatenate the results. See also 'rigidConcatMap'.-} concatMap :: (ListLike full' item') => (item -> full') -> full -> full' concatMap = foldMap {- | Like 'concatMap', but without the possibility of changing the type of the item. This can have performance benefits for some things such as ByteString. -} rigidConcatMap :: (item -> full) -> full -> full rigidConcatMap = concatMap {- | True if any items satisfy the function -} any :: (item -> Bool) -> full -> Bool any p = getAny . foldMap (Any . p) {- | True if all items satisfy the function -} all :: (item -> Bool) -> full -> Bool all p = getAll . foldMap (All . p) {- | The maximum value of the list -} maximum :: Ord item => full -> item maximum = foldr1 max {- | The minimum value of the list -} minimum :: Ord item => full -> item minimum = foldr1 min ------------------------------ Infinite lists {- | Generate a structure with the specified length with every element set to the item passed in. See also 'genericReplicate' -} replicate :: Int -> item -> full replicate = genericReplicate ------------------------------ Sublists {- | Takes the first n elements of the list. See also 'genericTake'. -} take :: Int -> full -> full take = genericTake {- | Drops the first n elements of the list. See also 'genericDrop' -} drop :: Int -> full -> full drop = genericDrop {- | Equivalent to @('take' n xs, 'drop' n xs)@. See also 'genericSplitAt'. -} splitAt :: Int -> full -> (full, full) splitAt = genericSplitAt {- | Returns all elements at start of list that satisfy the function. -} takeWhile :: (item -> Bool) -> full -> full takeWhile func l | null l = empty | func x = cons x (takeWhile func (tail l)) | otherwise = empty where x = head l {- | Drops all elements from the start of the list that satisfy the function. -} dropWhile :: (item -> Bool) -> full -> full dropWhile func l | null l = empty | func (head l) = dropWhile func (tail l) | otherwise = l {- | Drops all elements from the end of the list that satisfy the function. -} dropWhileEnd :: (item -> Bool) -> full -> full dropWhileEnd func = foldr (\x xs -> if func x && null xs then empty else cons x xs) empty {- | The equivalent of @('takeWhile' f xs, 'dropWhile' f xs)@ -} span :: (item -> Bool) -> full -> (full, full) span func l | null l = (empty, empty) | func x = (cons x ys, zs) | otherwise = (empty, l) where (ys, zs) = span func (tail l) x = head l {- | The equivalent of @'span' ('not' . f)@ -} break :: (item -> Bool) -> full -> (full, full) break p = span (not . p) {- | Split a list into sublists, each which contains equal arguments. For order-preserving types, concatenating these sublists will produce the original list. See also 'groupBy'. -} group :: (ListLike full' full, Eq item) => full -> full' group = groupBy (==) {- | All initial segments of the list, shortest first -} inits :: (ListLike full' full) => full -> full' inits l | null l = singleton empty | otherwise = append (singleton empty) (map (cons (head l)) theinits) where theinits = asTypeOf (inits (tail l)) [l] {- | All final segnemts, longest first -} tails :: ListLike full' full => full -> full' tails l | null l = singleton empty | otherwise = cons l (tails (tail l)) ------------------------------ Predicates {- | True when the first list is at the beginning of the second. -} isPrefixOf :: Eq item => full -> full -> Bool isPrefixOf needle haystack | null needle = True | null haystack = False | otherwise = (head needle) == (head haystack) && isPrefixOf (tail needle) (tail haystack) {- | True when the first list is at the beginning of the second. -} isSuffixOf :: Eq item => full -> full -> Bool isSuffixOf needle haystack = isPrefixOf (reverse needle) (reverse haystack) {- | True when the first list is wholly containted within the second -} isInfixOf :: Eq item => full -> full -> Bool isInfixOf needle haystack = any (isPrefixOf needle) thetails where thetails = asTypeOf (tails haystack) [haystack] ------------------------------ Conditionally modify based on predicates {- | Remove a prefix from a listlike if possible -} stripPrefix :: Eq item => full -> full -> Maybe full stripPrefix xs ys = if xs `isPrefixOf` ys then Just $ drop (length xs) ys else Nothing {- | Remove a suffix from a listlike if possible -} stripSuffix :: Eq item => full -> full -> Maybe full stripSuffix xs ys = if xs `isSuffixOf` ys then Just $ take (length ys - length xs) ys else Nothing ------------------------------ Searching {- | True if the item occurs in the list -} elem :: Eq item => item -> full -> Bool elem i = any (== i) {- | True if the item does not occur in the list -} notElem :: Eq item => item -> full -> Bool notElem i = all (/= i) {- | Take a function and return the first matching element, or Nothing if there is no such element. -} find :: (item -> Bool) -> full -> Maybe item find f l = case findIndex f l of Nothing -> Nothing Just x -> Just (index l x) {- | Returns only the elements that satisfy the function. -} filter :: (item -> Bool) -> full -> full filter func l | null l = empty | func (head l) = cons (head l) (filter func (tail l)) | otherwise = filter func (tail l) {- | Returns the lists that do and do not satisfy the function. Same as @('filter' p xs, 'filter' ('not' . p) xs)@ -} partition :: (item -> Bool) -> full -> (full, full) partition p xs = (filter p xs, filter (not . p) xs) ------------------------------ Indexing {- | The element at 0-based index i. Raises an exception if i is out of bounds. Like (!!) for lists. -} index :: full -> Int -> item index l i | null l = error "index: index not found" | i < 0 = error "index: index must be >= 0" | i == 0 = head l | otherwise = index (tail l) (i - 1) {- | Returns the index of the element, if it exists. -} elemIndex :: Eq item => item -> full -> Maybe Int elemIndex e l = findIndex (== e) l {- | Returns the indices of the matching elements. See also 'findIndices' -} elemIndices :: (Eq item, ListLike result Int) => item -> full -> result elemIndices i l = findIndices (== i) l {- | Take a function and return the index of the first matching element, or Nothing if no element matches -} findIndex :: (item -> Bool) -> full -> Maybe Int findIndex f = listToMaybe . findIndices f {- | Returns the indices of all elements satisfying the function -} findIndices :: (ListLike result Int) => (item -> Bool) -> full -> result findIndices p xs = map snd $ filter (p . fst) $ thezips where thezips = asTypeOf (zip xs [0..]) [(head xs, 0::Int)] ------------------------------ Monadic operations {- | Evaluate each action in the sequence and collect the results -} sequence :: (Monad m, ListLike fullinp (m item)) => fullinp -> m full sequence l = foldr func (return empty) l where func litem results = do x <- litem xs <- results return (cons x xs) {- | A map in monad space. Same as @'sequence' . 'map'@ See also 'rigidMapM' -} mapM :: (Monad m, ListLike full' item') => (item -> m item') -> full -> m full' mapM func l = sequence mapresult where mapresult = asTypeOf (map func l) [] {- | Like 'mapM', but without the possibility of changing the type of the item. This can have performance benefits with some types. -} rigidMapM :: Monad m => (item -> m item) -> full -> m full rigidMapM = mapM ------------------------------ "Set" operations {- | Removes duplicate elements from the list. See also 'nubBy' -} nub :: Eq item => full -> full nub = nubBy (==) {- | Removes the first instance of the element from the list. See also 'deleteBy' -} delete :: Eq item => item -> full -> full delete = deleteBy (==) {- | List difference. Removes from the first list the first instance of each element of the second list. See '(\\)' and 'deleteFirstsBy' -} deleteFirsts :: Eq item => full -> full -> full deleteFirsts = foldl (flip delete) {- | List union: the set of elements that occur in either list. Duplicate elements in the first list will remain duplicate. See also 'unionBy'. -} union :: Eq item => full -> full -> full union = unionBy (==) {- | List intersection: the set of elements that occur in both lists. See also 'intersectBy' -} intersect :: Eq item => full -> full -> full intersect = intersectBy (==) ------------------------------ Ordered lists {- | Sorts the list. On data types that do not preserve ordering, or enforce their own ordering, the result may not be what you expect. See also 'sortBy'. -} sort :: Ord item => full -> full sort = sortBy compare {- | Inserts the element at the last place where it is still less than or equal to the next element. On data types that do not preserve ordering, or enforce their own ordering, the result may not be what you expect. On types such as maps, this may result in changing an existing item. See also 'insertBy'. -} insert :: Ord item => item -> full -> full insert = insertBy compare ------------------------------ Conversions {- | Converts the structure to a list. This is logically equivolent to 'fromListLike', but may have a more optimized implementation. -} toList :: full -> [item] toList = fromListLike {- | Generates the structure from a list. -} fromList :: [item] -> full fromList [] = empty fromList (x:xs) = cons x (fromList xs) {- | Converts one ListLike to another. See also 'toList'. Default implementation is @fromListLike = map id@ -} fromListLike :: ListLike full' item => full -> full' fromListLike = map id {-# INLINE fromListLike #-} ------------------------------ Generalized functions {- | Generic version of 'nub' -} nubBy :: (item -> item -> Bool) -> full -> full nubBy f l = nubBy' l (empty :: full) where nubBy' ys xs | null ys = empty | any (f (head ys)) xs = nubBy' (tail ys) xs | otherwise = let y = head ys in cons y (nubBy' (tail ys) (cons y xs)) {- nubBy f l | null l = empty | otherwise = cons (head l) (nubBy f (filter (\y -> not (f (head l) y)) (tail l))) -} {- | Generic version of 'deleteBy' -} deleteBy :: (item -> item -> Bool) -> item -> full -> full deleteBy func i l | null l = empty | otherwise = if func i (head l) then tail l else cons (head l) (deleteBy func i (tail l)) {- | Generic version of 'deleteFirsts' -} deleteFirstsBy :: (item -> item -> Bool) -> full -> full -> full deleteFirstsBy func = foldl (flip (deleteBy func)) {- | Generic version of 'union' -} unionBy :: (item -> item -> Bool) -> full -> full -> full unionBy func x y = append x $ foldl (flip (deleteBy func)) (nubBy func y) x {- | Generic version of 'intersect' -} intersectBy :: (item -> item -> Bool) -> full -> full -> full intersectBy func xs ys = filter (\x -> any (func x) ys) xs {- | Generic version of 'group'. -} groupBy :: (ListLike full' full, Eq item) => (item -> item -> Bool) -> full -> full' groupBy eq l | null l = empty | otherwise = cons (cons x ys) (groupBy eq zs) where (ys, zs) = span (eq x) xs x = head l xs = tail l {- | Sort function taking a custom comparison function -} sortBy :: (item -> item -> Ordering) -> full -> full sortBy cmp = foldr (insertBy cmp) empty {- | Like 'insert', but with a custom comparison function -} insertBy :: (item -> item -> Ordering) -> item -> full -> full insertBy cmp x ys | null ys = singleton x | otherwise = case cmp x (head ys) of GT -> cons (head ys) (insertBy cmp x (tail ys)) _ -> cons x ys ------------------------------ Generic Operations {- | Length of the list -} genericLength :: Num a => full -> a genericLength l = calclen 0 l where calclen !accum cl = if null cl then accum else calclen (accum + 1) (tail cl) {- | Generic version of 'take' -} genericTake :: Integral a => a -> full -> full genericTake n l | n <= 0 = empty | null l = empty | otherwise = cons (head l) (genericTake (n - 1) (tail l)) {- | Generic version of 'drop' -} genericDrop :: Integral a => a -> full -> full genericDrop n l | n <= 0 = l | null l = l | otherwise = genericDrop (n - 1) (tail l) {- | Generic version of 'splitAt' -} genericSplitAt :: Integral a => a -> full -> (full, full) genericSplitAt n l = (genericTake n l, genericDrop n l) {- | Generic version of 'replicate' -} genericReplicate :: Integral a => a -> item -> full genericReplicate count x | count <= 0 = empty | otherwise = map (\_ -> x) [1..count] #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL (singleton, uncons, null) | (singleton, uncons, genericLength) | (singleton, head, tail, null) | (singleton, head, tail, genericLength) #-} #endif {- instance (ListLike full item) => Monad full where m >>= k = foldr (append . k) empty m m >> k = foldr (append . (\_ -> k)) empty m return x = singleton x fail _ = empty instance (ListLike full item) => M.MonadPlus full where mzero = empty mplus = append -} {- | An extension to 'ListLike' for those data types that are capable of dealing with infinite lists. Some 'ListLike' functions are capable of working with finite or infinite lists. The functions here require infinite list capability in order to work at all. -} class (ListLike full item) => InfiniteListLike full item | full -> item where {- | An infinite list of repeated calls of the function to args -} iterate :: (item -> item) -> item -> full iterate f x = cons x (iterate f (f x)) {- | An infinite list where each element is the same -} repeat :: item -> full repeat x = xs where xs = cons x xs {- | Converts a finite list into a circular one -} cycle :: full -> full cycle xs | null xs = error "ListLike.cycle: empty list" | otherwise = xs' where xs' = append xs xs' -------------------------------------------------- -- This instance is here due to some default class functions instance ListLike [a] a where empty = [] singleton x = [x] cons x l = x : l snoc l x = l ++ [x] append = (++) head = L.head last = L.last tail = L.tail init = L.init null = L.null length = L.length map f = fromList . L.map f rigidMap = L.map reverse = L.reverse intersperse = L.intersperse toList = id fromList = id -- fromListLike = toList concat = L.concat . toList -- concatMap func = fromList . L.concatMap func rigidConcatMap = L.concatMap any = L.any all = L.all maximum = L.maximum minimum = L.minimum -- fold -- foldMap replicate = L.replicate take = L.take drop = L.drop splitAt = L.splitAt takeWhile = L.takeWhile dropWhile = L.dropWhile span = L.span break = L.break group = fromList . L.group inits = fromList . L.inits tails = fromList . L.tails isPrefixOf = L.isPrefixOf isSuffixOf = L.isSuffixOf isInfixOf = L.isInfixOf stripPrefix = L.stripPrefix elem = L.elem notElem = L.notElem find = L.find filter = L.filter partition = L.partition index = (L.!!) elemIndex = L.elemIndex elemIndices item = fromList . L.elemIndices item findIndex = L.findIndex sequence = M.sequence . toList -- mapM = M.mapM nub = L.nub delete = L.delete deleteFirsts = (L.\\) union = L.union intersect = L.intersect sort = L.sort groupBy func = fromList . L.groupBy func unionBy = L.unionBy intersectBy = L.intersectBy sortBy = L.sortBy insert = L.insert genericLength = L.genericLength -------------------------------------------------- -- These utils are here instead of in Utils.hs because they are needed -- by default class functions {- | Takes two lists and returns a list of corresponding pairs. -} zip :: (ListLike full item, ListLike fullb itemb, ListLike result (item, itemb)) => full -> fullb -> result zip = zipWith (\a b -> (a, b)) {- | Takes two lists and combines them with a custom combining function -} zipWith :: (ListLike full item, ListLike fullb itemb, ListLike result resultitem) => (item -> itemb -> resultitem) -> full -> fullb -> result zipWith f a b | null a = empty | null b = empty | otherwise = cons (f (head a) (head b)) (zipWith f (tail a) (tail b))