{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-name-shadowing -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Collections
-- Copyright : (c) Jean-Philippe Bernardy, 2006
-- License : BSD3
-- Maintainer : jeanphilippe.bernardy; google mail.
-- Stability : experimental
--
-- This module defines a class framework for collection types. It provides:
--
-- * Classes for the most common type of collections
--
-- * /View/ types to change the type of a collection, so it implements other classes.
-- This allows to use types for purposes that they are not originally designed for. (eg. 'ElemsView')
--
-- * A few generic functions for handling collections.
--
-- * Infix (operator) version of common functions.
--
-- Should you need a more precise documentation, "Data.Collections.Properties" lists laws that
-- implementations are entitled to assume.
--
-- The classes defined in this module are intended to give hints about performance.
-- eg. if a function has a @'Map' c k v@ context, this indicates that the function
-- will perform better if @c@ has an efficitent lookup function.
--
-- This class framework is based on ideas found in Simon Peyton Jones, \"/Bulk types with class/\".
-- <http://research.microsoft.com/Users/simonpj/Papers/collections.ps.gz>
--
-- Another inspiration source are the examples of MPTC and fuctional dependencies in Oleg Kiselyov's
-- many articles posted to the haskell mailing list.
--
--
-- This module name-clashes with a lot of Prelude functions, subsuming those.
-- The user is encouraged to import Prelude hiding the clashing functions.
-- Alternatively, it can be imported @qualified@.
--
{-
Selling points:
* Unification of Map and Set (required by the below)
* inclusion of Arrays
* Good integration with existing base libraries
* Relative simplicity: few classes, not too many methods, very little redundancy.
* Reuses the same identifiers as other standard hierarchy modules.
Conversion from the module-based API to this class-based one should be easy.
* Comprehensive set of properties that define the behaviour of the classes.
* Compatibility with GHC and Hugs.
Bad points
* Extra complexity due to heavy usage of MTPC (although imho it's a matter of getting used to it)
TODO:
* test with nhc98/hugs
* add missing functions (partition, ..., ?)
* optimizations (rules pragmas)
* see how multimap/multiset fits this scheme.
* Think about class Map' :: (* -> *) -> * -> $
* Fix infelicity about null map test; (== mempty).
-}
module Data.Collections
(
-- * Classes
-- ** Unfoldable
Unfoldable(..),
-- ** Collection
Collection(..),
SortingCollection(..),
-- ** Map
Map(..),
lookupWithDefault,
unionsWith,
intersectionWith',
differenceWith',
mapWithKey',
(!),
-- ** Set
Set(..),
unions,
notMember,
(\\),
-- ** Sequence
Sequence(..),
head,
tail,
append,
concat,
concatMap,
-- length,
(<|),
(|>),
(><),
-- ** Others
Array(..),
Indexed(..),
-- * Conversions
fromFoldable,
fromAscFoldable,
fromList,
fromListWith,
fromAscList,
-- * Views
KeysView(..), ElemsView(..),
withKeys, withElems,
-- * Foldable
module Data.Collections.Foldable,
) where
-- import Prelude (Bool(..), Int, Maybe(..),
-- (==), (.), (+), ($), (-), (&&), (||),
-- Eq, Ord,
-- error, const, not, fst, snd, maybe, head, otherwise, curry, uncurry, flip,
-- min, max, Show)
import Prelude hiding (sum,concat,lookup,map,filter,foldr,foldr1,foldl,null,reverse,(++),minimum,maximum,all,elem,concatMap,drop,head,tail,init)
import Data.Monoid
import Data.Collections.Foldable
import qualified Data.Array as Array
import qualified Data.List as List
import qualified Data.Maybe as Maybe
infixl 9 !
infixl 9 \\ --
infixr 5 ><
infixr 5 <|
infixl 5 |>
------------------------------------------------------------------------
-- * Type classes
-- | Class of collection types.
class (Foldable c a, Unfoldable c a) => Collection c a | c -> a where
-- | @filter f c@ returns the collection of those elements that satisfy the predicate @f@.
filter :: (a -> Bool) -> c -> c
-- | Class of collection with unobservable elements. It is the dual of the 'Foldable' class.
class Unfoldable c i | c -> i where
-- | \'natural\' insertion of an element into a collection.
insert :: i -> c -> c
--insert i c = cofold (\Right c -> Right c; Left (i,c) -> Left (i,Right c)) (Left (i,c))
-- | The empty collection.
empty :: c
empty = unfold (const Nothing) undefined
-- | Creates a collection with a single element.
singleton :: i -> c
singleton i = insert i empty
-- | Insert all the elements of a foldable.
insertMany :: Foldable c' i => c' -> c -> c
insertMany c' c = foldr insert c c'
-- At first sight, it looks like the above could just use List instead of any Foldable.
-- However, it would then be more difficult to ensure that the conversion could be made
-- very efficient between certain types.
-- | Same as insertMany, but with the unchecked precondition that the input 'Foldable' is sorted.
insertManySorted :: Foldable c' i => c' -> c -> c
insertManySorted = insertMany
unfold :: Unfoldable c a => (b -> Maybe (a, b)) -> b -> c
unfold f b = insertMany (List.unfoldr f b) empty
class Collection c o => SortingCollection c o where
minView :: c -> Maybe (o,c)
-- isSorted :: (Ord a, Foldable c a) => c -> Bool
-- isSorted = fst . foldr cmp (True, Nothing)
-- where curr `cmp` (acc, prev) = (acc && maybe True (curr <=) prev, Just curr)
-- | Conversion from a Foldable to a Collection.
fromFoldable :: (Foldable f a, Collection c' a) => f -> c'
fromFoldable = flip insertMany empty
-- TODO: Should be specialized (RULE pragmas) so it's efficient when converting from/to set/maps
-- | Conversion from a Foldable to a Collection, with the /unchecked/ precondition that the input is sorted
fromAscFoldable :: (Foldable f a, Collection c' a) => f -> c'
fromAscFoldable = flip insertManySorted empty
-- | Converts a list into a collection.
fromList :: Collection c a => [a] -> c
fromList = fromFoldable
-- | Converts a list into a collection, with the precondition that the input is sorted.
fromAscList :: Collection c a => [a] -> c
fromAscList = fromAscFoldable
-- | Class of sequential-access types.
-- In addition of the 'Collection' services, it provides deconstruction and concatenation.
class (Monoid c, Collection c a) => Sequence c a where
-- | The first @i@ elements of a sequence.
take :: Int -> c -> c
-- | Elements of a sequence after the first @i@.
drop :: Int -> c -> c
-- | Split a sequence at a given index.
splitAt :: Int -> c -> (c,c)
-- | Reverse a sequence.
reverse :: c -> c
-- | Analyse the left end of a sequence.
front :: c -> Maybe (a,c)
-- | Analyse the right end of a sequence.
back :: c -> Maybe (c,a)
-- | Add an element to the left end of a sequence.
cons :: a -> c -> c
-- | Add an element to the right end of a sequence.
snoc :: c -> a -> c
-- | The 'isPrefix' function takes two seqences and returns True iff
-- the first is a prefix of the second.
isPrefix :: Eq a => c -> c -> Bool
cons = insert
isPrefix s1 s2
= case front s1 of
Nothing -> True
Just (x,xs) ->
case front s2 of
Nothing -> False
Just (y,ys) -> x == y && isPrefix xs ys
-- -- | Length of a sequence
-- length :: Sequence c i o => c -> Int
-- length = size
-- | Concatenate two sequences.
append :: Sequence c a => c -> c -> c
append = mappend
-- TODO: span ?
-- | Infix version of 'cons': add an element to the left end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(<|) :: Sequence c i => i -> c -> c
(<|) = cons
-- | Infix version of 'snoc': add an element to the right end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(|>) :: Sequence c i => c -> i -> c
(|>) = snoc
-- | Infix verion of 'append'. Concatenate two sequences.
(><) :: Sequence c a => c -> c -> c
(><) = append
-- | The concatenation of all the elements of a container of sequences.
concat :: (Sequence s a, Foldable t s) => t -> s
concat = fold
-- | Map a function over all the elements of a container and concatenate
-- the resulting sequences.
concatMap :: (Sequence s b, Foldable t a) => (a -> s) -> t -> s
concatMap = foldMap
head :: Sequence s a => s -> a
head = fst . Maybe.fromJust . front
tail :: Sequence s a => s -> s
tail = drop 1
-- | Class of indexed types.
-- The collection is 'dense': there is no way to /remove/ an element nor for lookup
-- to return "not found".
--
-- In practice however, most shallow collection types will instanciate this
-- class in addition of 'Map', and leave the responsibility of failure to the caller.
class Indexed c k v | c -> k v where
-- | @index c k@ returns element associated to @k@
index :: k -> c -> v
-- | @adjust f k c@ applies @f@ to element associated to @k@ and returns the resulting collection.
adjust :: (v -> v) -> k -> c -> c
-- | if @inDomain k c@, then @index c k@ is guaranteed not to fail.
inDomain :: k -> c -> Bool
-- | Constructs a collection identical to the first argument except that it has
-- been updated by the associations in the right argument.
-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then
--
-- > m//[((i,i), 0) | i <- [1..n]]
--
-- is the same matrix, except with the diagonal zeroed.
(//) :: Foldable l (k,v) => c -> l -> c
(//) = foldr replace
where replace (k,v) = adjust (const v) k
-- | @'accum' f@ takes an array and an association list and accumulates
-- pairs from the list into the array with the accumulating function @f@.
-- Thus 'accumArray' can be defined using 'accum':
accum :: Foldable l (k,v') => (v -> v' -> v) -> c -> l -> c
accum f = foldr adjust'
where adjust' (k,v') = adjust (\v->f v v') k
-- | Infix version of 'index', with arguments swapped.
(!) :: Indexed c k v => c -> k -> v
(!) = flip index
class (Array.Ix k, Foldable c (k,v), Indexed c k v) => Array c k v | c -> k v where
-- | if @(l,r) = bounds c@, then @inDomain k c <==> l <= k <= r@
bounds :: c -> (k,k)
-- | Construct an array with the specified bounds and containing values
-- for given indices within these bounds.
--
-- The array is undefined (i.e. bottom) if any index in the list is
-- out of bounds. The Haskell 98 Report further specifies that if any
-- two associations in the list have the same index, the value at that
-- index is undefined (i.e. bottom). However in GHC's implementation,
-- the value at such an index is the value part of the last association
-- with that index in the list.
--
-- Because the indices must be checked for these errors, 'array' is
-- strict in the bounds argument and in the indices of the association
-- list, but nonstrict in the values. Thus, recurrences such as the
-- following are possible:
--
-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])
--
-- Not every index within the bounds of the array need appear in the
-- association list, but the values associated with indices that do not
-- appear will be undefined (i.e. bottom).
--
-- If, in any dimension, the lower bound is greater than the upper bound,
-- then the array is legal, but empty. Indexing an empty array always
-- gives an array-bounds error, but 'bounds' still yields the bounds
-- with which the array was constructed.
array :: Foldable l (k,v) => (k,k) -> l -> c
-- | Class of map-like types. (aka. for sparse associative types).
--
-- In opposition of Indexed, Map supports unexisting value for some indices.
class Monoid c => Map c k a | c -> k a where
-- | Remove a key from the keySet (and therefore the associated value in the Map).
delete :: k -> c -> c
delete = alter (const Nothing)
-- | Tells whether an key is member of the keySet.
member :: k -> c -> Bool
member k = Maybe.isJust . lookup k
-- | Union of two keySets.
-- When duplicates are encountered, the keys may come from any of the two input sets.
-- Values come from the map given as first arguement.
union :: c -> c -> c
union = unionWith const
-- | Intersection of two keySets.
--
-- When duplicates are encountered, the keys may come from any of the two input sets.
-- Values come from the map given as first arguement.
intersection :: c -> c -> c
intersection = intersectionWith const
-- | Difference of two keySets.
-- Difference is to be read infix: @a `difference` b@ returns a set containing the
-- elements of @a@ that are also absent from @b@.
difference :: c -> c -> c
difference = differenceWith (\_ _-> Nothing)
-- | @s1 `isSubset` s2@ returns True iff. the keys in s1 form a subset of the keys in s2.
isSubset :: c -> c -> Bool
isSubset = isSubmapBy (\_ _->True)
-- | @s1 `isProperSubset` s2@ returns True iff. @s1 `isProperSubset` s2@ and @s1 /= s2@
isProperSubset :: c -> c -> Bool
isProperSubset = isProperSubmapBy (\_ _->True)
-- Follows functions for fully-fledged maps.
-- | Lookup the value at a given key.
lookup :: k -> c -> Maybe a
-- | Change the value associated to a given key. 'Nothing' represents no associated value.
alter :: (Maybe a -> Maybe a) -> k -> c -> c
alter f k m = case lookup k m of
j@(Just _) -> case f j of
Just a' -> insertWith (\a _ -> a) k a' m
Nothing -> delete k m
Nothing -> case f Nothing of
Just a' -> insertWith (\a _ -> a) k a' m
Nothing -> m
-- | Insert with a combining function.
--
-- @insertWith f key value m@
-- will insert the pair @(key, value)@ into @m@ if @key@ does
-- not exist in the map. If the key does exist, the function will
-- insert the pair @(key, f new_value old_value)@.
insertWith :: (a -> a -> a) -> k -> a -> c -> c
insertWith f k a c = alter (\x -> Just $ case x of {Nothing->a;Just a' -> f a a'}) k c
-- | Convert a 'Foldable' to a 'Map', with a combining function.
-- Note the applications of the combining function:
-- @fromFoldableWith (+) [(k,x1), (k,x2), ..., (k,xn)] = fromFoldable [(k, xn + (... + (x2 + x1)))]@
-- or more generally @fromFoldableWith f [(k,x) | x <- l] = fromFoldable [(k,foldl1 (flip f) l)]@
-- 'foldGroups' is probably less surprising, so use it.
fromFoldableWith :: Foldable l (k,a) => (a -> a -> a) -> l -> c
fromFoldableWith f = foldr (uncurry (insertWith f)) mempty
-- | Convert a 'Foldable' to a 'Map', with a combining function.
-- @foldGroups f a l = let mkGroup g = (fst $ head g, foldr f a (map snd g)) in fromList . map mkGroup . groupBy ((==) `on` fst)) . toList@
foldGroups :: Foldable l (k,b) => (b -> a -> a) -> a -> l -> c
foldGroups f a = foldr' (\(k,b) c -> (alter (\x -> Just $ case x of {Nothing->f b a;Just a' -> f b a'}) k c)) mempty
-- | Apply a function over all values in the map.
mapWithKey :: (k -> a -> a) -> c -> c
-- | Union with a combining function.
unionWith :: (a -> a -> a) -> c -> c -> c
-- | Intersection with a combining function.
intersectionWith :: (a -> a -> a) -> c -> c -> c
-- | Difference with a combining function.
differenceWith :: (a -> a -> Maybe a) -> c -> c -> c
-- | isSubmapBy
isSubmapBy :: (a -> a -> Bool) -> c -> c -> Bool
-- | isProperSubmapBy
isProperSubmapBy :: (a -> a -> Bool) -> c -> c -> Bool
-- isProperSubmapBy f m1 m2 = isSubmapBy f m1 m2 && not (isEmpty (differenceWith (\_ _->Nothing) m1 m2))
-- | Tells whether a key is not a member of the keySet.
notMember :: (Map c k a) => k -> c -> Bool
notMember k s = not $ member k s
-- | The expression @('lookupWithDefault' def k map)@ returns
-- the value at key @k@ or returns @def@ when the key is not in the map.
lookupWithDefault :: (Map c k a) => a -> k -> c -> a
lookupWithDefault a k c = Maybe.fromMaybe a (lookup k c)
-- | Specialized version of fromFoldableWith for lists.
fromListWith :: (Map c k a) => (a -> a -> a) -> [(k,a)] -> c
fromListWith = fromFoldableWith
data O a b c = L !a | R !b | O !c
-- | Same as 'intersectionWith', but with a more general type.
intersectionWith' :: (Functor m, Map (m (O a b c)) k (O a b c)) =>
(a->b->c) -> m a -> m b -> m c
intersectionWith' f m1 m2 = fmap extract (intersectionWith combine (fmap L m1) (fmap R m2))
where combine (L l) (R r) = O (f l r)
extract (O a) = a
-- | Same as 'differenceWith', but with a more general type.
differenceWith' :: (Functor m, Map (m (O a b c)) k (O a b c)) =>
(a->b->Maybe c) -> m a -> m b -> m c
differenceWith' f m1 m2 = fmap extract (differenceWith combine (fmap L m1) (fmap R m2))
where combine (L l) (R r) = fmap O (f l r)
extract (O a) = a
mapWithKey' :: (Functor m, Map (m (Either a b)) k (Either a b)) =>
(k -> a -> b) -> m a -> m b
mapWithKey' f = fmap (either (error "mapWithKey': bug.") id) . mapWithKey f' . fmap Left
where f' k (Left x) = Right (f k x)
-- | Class for set-like collection types. A set is really a map
-- with no value associated to the keys,
-- so Set just states so.
-- Note that this should be a class alias, if it existed.
-- See: http://repetae.net/john/recent/out/classalias.html
class Map c k () => Set c k | c -> k where
-- | Dummy method for haddock to accept the class.
haddock_candy :: c -> k
-- | Infix version of 'difference'. Difference of two (key) sets.
(\\) :: Map c k a => c -> c -> c
(\\) = difference
-- NOTE: the following two are only tentative, and thus not exported.
-- | Infix version of 'union'. Union of two (key) sets.
(\/) :: Map c k a => c -> c -> c
(\/) = union
-- | Infix version of 'intersection'. Intersection of two (key) sets.
(/\) :: Map c k a => c -> c -> c
(/\) = intersection
{-
Maybe it would be a good idea to bite the bullet and use a Lattice class for intersection and union.
Maybe leave it unrelated to the Map class. In a separate module/package? Something like:
class Lattice a where
(/\) :: a -> a -> a
(\/) :: a -> a -> a
instance Lattice () where
_ /\ _ = ()
_ \/ _ = ()
instance Lattice Bool where
(/\) = (&&)
(\/) = (||)
instance (Lattice a, Map c k a) => Lattice c where
(/\) = intersectionWith (/\)
(\/) = unionWith (\/)
-}
-- | Union of many (key) sets.
unions :: (Unfoldable s i, Map s k a, Foldable cs s) => cs -> s
unions sets = foldl' union empty sets
-- | Union of many (key) sets, with combining function
unionsWith :: (Unfoldable s i, Map s k a, Foldable cs s) => (a->a->a) -> cs -> s
unionsWith f sets = foldl' (unionWith f) empty sets
------------------------------------------------------------------------
-- Trickier stuff for alternate dictionnary usages
-- | "View" to the keys of a dictionnary
newtype KeysView m k v = KeysView {fromKeysView :: m}
-- | "View" to the elements of a dictionnary
newtype ElemsView m k v = ElemsView {fromElemsView :: m}
-- The following requires undecidable instances. An alternative
-- implementation is to define these instances directly on the
-- concrete map types and drop the requirement for the aforementioned
-- extension.
type T a = a->a
withKeys :: Collection m (k,v) => T (KeysView m k v) -> T m
withKeys f c = fromKeysView $ f (KeysView c)
withElems :: Collection m (k,v) => T (ElemsView m k v) -> T m
withElems f c = fromElemsView $ f (ElemsView c)
instance Foldable m (k,v) => Foldable (KeysView m k v) k where
foldr f i (KeysView c) = foldr (f . fst) i c
null (KeysView c) = null c
instance Unfoldable m (k,v) => Unfoldable (KeysView m k v) (k,v) where
empty = KeysView empty
insert x (KeysView m) = KeysView $ insert x m
singleton x = KeysView (singleton x)
instance Foldable m (k,v) => Foldable (ElemsView m k v) v where
foldr f i (ElemsView c) = foldr (f . snd) i c
null (ElemsView c) = null c
instance Unfoldable m (k,v) => Unfoldable (ElemsView m k v) (k,v) where
empty = ElemsView empty
insert x (ElemsView m) = ElemsView $ insert x m
singleton x = ElemsView (singleton x)
instance (Monoid m, Map m k v) => Monoid (KeysView m k v) where
mempty = KeysView mempty
mappend = union
instance Map m k v => Map (KeysView m k v) k v where
isSubmapBy f (KeysView m) (KeysView m') = isSubmapBy f m m'
isProperSubmapBy f (KeysView m) (KeysView m') = isProperSubmapBy f m m'
member k (KeysView m) = Maybe.isJust $ lookup k m
union (KeysView m) (KeysView m') = KeysView $ union m m'
difference (KeysView m) (KeysView m') = KeysView $ difference m m'
intersection (KeysView m) (KeysView m') = KeysView $ intersection m m'
delete k (KeysView m) = KeysView $ delete k m
insertWith f k a (KeysView m) = KeysView $ insertWith f k a m
lookup k (KeysView m) = lookup k m
alter f k (KeysView m) = KeysView $ alter f k m
unionWith f (KeysView m) (KeysView m') = KeysView $ unionWith f m m'
differenceWith f (KeysView m) (KeysView m') = KeysView $ differenceWith f m m'
intersectionWith f (KeysView m) (KeysView m') = KeysView $ intersectionWith f m m'
mapWithKey f (KeysView m) = KeysView $ mapWithKey f m