collections-api (empty) → 1.0.0.0
raw patch · 6 files changed
+1650/−0 lines, 6 filesdep +QuickCheckdep +arraydep +basesetup-changed
Dependencies added: QuickCheck, array, base
Files
- Data/Collections.hs +594/−0
- Data/Collections/Foldable.hs +313/−0
- Data/Collections/Properties.hs +682/−0
- LICENSE +31/−0
- Setup.hs +3/−0
- collections-api.cabal +27/−0
+ Data/Collections.hs view
@@ -0,0 +1,594 @@+{-# 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+++
+ Data/Collections/Foldable.hs view
@@ -0,0 +1,313 @@+{-# OPTIONS -fglasgow-exts -cpp -fno-warn-name-shadowing #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Collections.Foldable+-- Copyright : Ross Paterson 2005, adaptation to MPTC+FD by Jean-Philippe Bernardy+-- License : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer : jeanphilippe.bernardy (google mail address)+-- Stability : experimental+-- Portability : MPTC+FD+--+-- Class of data structures that can be folded to a summary value.++module Data.Collections.Foldable (+ -- * Folds+ Foldable(..),+ -- ** Special biased folds+ foldr',+ foldl',+ foldrM,+ foldlM,+ -- ** Folding actions+ -- *** Applicative actions+ traverse_,+ for_,+ sequenceA_,+ asum,+ -- *** Monadic actions+ mapM_,+ forM_,+ sequence_,+ msum,+ -- ** Specialized folds+ toList,+ --More general versions exist in Data.Collections+ --concat,+ --concatMap,+ and,+ or,+ any,+ all,+ sum,+ product,+ maximum,+ maximumBy,+ minimum,+ minimumBy,+ -- ** Searches+ elem,+ notElem,+ find+ ) where++import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,+ elem, notElem, concat, concatMap, and, or, any, all,+ sum, product, maximum, minimum)+import qualified Prelude (foldl, foldr, foldl1, foldr1)+import Control.Applicative+import Control.Monad (MonadPlus(..))+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Monoid+import Data.Array++#ifdef __NHC__+import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem+#endif++#ifdef __GLASGOW_HASKELL__+import GHC.Exts (build)+#endif++-- | Data structures that can be folded.+--+-- Minimal complete definition: 'foldMap' or 'foldr'.+--+-- For example, given a data type+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be+--+-- > instance Foldable Tree+-- > foldMap f Empty = mempty+-- > foldMap f (Leaf x) = f x+-- > foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r+--+-- This is suitable even for abstract types, as the monoid is assumed+-- to satisfy the monoid laws.+--+class Foldable t a | t -> a where+ -- | Combine the elements of a structure using a monoid.+ fold :: Monoid a => t -> a+ fold = foldMap id++ -- | Map each element of the structure to a monoid,+ -- and combine the results.+ foldMap :: Monoid m => (a -> m) -> t -> m+ foldMap f = foldr (mappend . f) mempty++ -- | Right-associative fold of a structure.+ --+ -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@+ foldr :: (a -> b -> b) -> b -> t -> b+ foldr f z t = appEndo (foldMap (Endo . f) t) z++ -- | Left-associative fold of a structure.+ --+ -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@+ foldl :: (b -> a -> b) -> b -> t -> b+ foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z++ -- | A variant of 'foldr' that has no base case,+ -- and thus may only be applied to non-empty structures.+ --+ -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@+ foldr1 :: (a -> a -> a) -> t -> a+ foldr1 f xs = fromMaybe (error "foldr1: empty structure")+ (foldr mf Nothing xs)+ where mf x Nothing = Just x+ mf x (Just y) = Just (f x y)++ -- | A variant of 'foldl' that has no base case,+ -- and thus may only be applied to non-empty structures.+ --+ -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@+ foldl1 :: (a -> a -> a) -> t -> a+ foldl1 f xs = fromMaybe (error "foldl1: empty structure")+ (foldl mf Nothing xs)+ where mf Nothing y = Just y+ mf (Just x) y = Just (f x y)+ + -- | Tells whether the structure is empty.+ null :: t -> Bool + null = all (const False) ++ -- | Returns the size of the structure.+ size :: t -> Int + size = foldr (const (+1)) 0++ -- | Tells whether the structure contains a single element.+ isSingleton :: t -> Bool + isSingleton = (1 ==) . size -- FIXME: more efficient default.++-- instances for Prelude types++instance Foldable (Maybe a) a where+ foldr _ z Nothing = z+ foldr f z (Just x) = f x z++ foldl _ z Nothing = z+ foldl f z (Just x) = f z x++instance Foldable [a] a where+ null = Prelude.null+ size = Prelude.length+ foldr = Prelude.foldr+ foldl = Prelude.foldl+ foldr1 = Prelude.foldr1+ foldl1 = Prelude.foldl1++instance Ix i => Foldable (Array i a) (i,a) where+ foldr f z = Prelude.foldr f z . assocs++-- | Fold over the elements of a structure,+-- associating to the right, but strictly.+foldr' :: Foldable t a => (a -> b -> b) -> b -> t -> b+foldr' f z xs = foldl f' id xs z+ where f' k x z = k $! f x z++-- | Monadic fold over the elements of a structure,+-- associating to the right, i.e. from right to left.+foldrM :: (Foldable t a, Monad m) => (a -> b -> m b) -> b -> t -> m b+foldrM f z xs = foldl f' return xs z+ where f' k x z = f x z >>= k++-- | Fold over the elements of a structure,+-- associating to the left, but strictly.+foldl' :: Foldable t b => (a -> b -> a) -> a -> t -> a+foldl' f z xs = foldr f' id xs z+ where f' x k z = k $! f z x++-- | Monadic fold over the elements of a structure,+-- associating to the left, i.e. from left to right.+foldlM :: (Foldable t b, Monad m) => (a -> b -> m a) -> a -> t -> m a+foldlM f z xs = foldr f' return xs z+ where f' x k z = f z x >>= k++-- | Map each element of a structure to an action, evaluate+-- these actions from left to right, and ignore the results.+traverse_ :: (Foldable t a, Applicative f) => (a -> f b) -> t -> f ()+traverse_ f = foldr ((*>) . f) (pure ())++-- | 'for_' is 'traverse_' with its arguments flipped.+for_ :: (Foldable t a, Applicative f) => t -> (a -> f b) -> f ()+{-# INLINE for_ #-}+for_ = flip traverse_++-- | Map each element of a structure to a monadic action, evaluate+-- these actions from left to right, and ignore the results.+mapM_ :: (Foldable t a, Monad m) => (a -> m b) -> t -> m ()+mapM_ f = foldr ((>>) . f) (return ())++-- | 'forM_' is 'mapM_' with its arguments flipped.+forM_ :: (Foldable t a, Monad m) => t -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ = flip mapM_++-- | Evaluate each action in the structure from left to right,+-- and ignore the results.+sequenceA_ :: forall f a t. (Foldable t (f a), Applicative f) => t -> f ()+sequenceA_ = foldr (*>) (pure ())++-- | Evaluate each monadic action in the structure from left to right,+-- and ignore the results.+sequence_ :: forall m a t. (Foldable t (m a), Monad m) => t -> m ()+sequence_ = foldr (>>) (return ())++-- | The sum of a collection of actions, generalizing 'concat'.+asum :: (Foldable t (f a), Alternative f) => t -> f a+{-# INLINE asum #-}+asum = foldr (<|>) empty++-- | The sum of a collection of actions, generalizing 'concat'.+msum :: (Foldable t (m a), MonadPlus m) => t -> m a+{-# INLINE msum #-}+msum = foldr mplus mzero++-- These use foldr rather than foldMap to avoid repeated concatenation.++-- | List of elements of a structure.+toList :: Foldable t a => t -> [a]+#ifdef __GLASGOW_HASKELL__+toList t = build (\ c n -> foldr c n t)+#else+toList = foldr (:) []+#endif++{- Not used or exported+-- | The concatenation of all the elements of a container of lists.+concat :: Foldable t [a] => t -> [a]+concat = fold+-}++-- | Map a function over all the elements of a container and concatenate+-- the resulting lists.+concatMap :: Foldable t a => (a -> [b]) -> t -> [b]+concatMap = foldMap++-- | 'and' returns the conjunction of a container of Bools. For the+-- result to be 'True', the container must be finite; 'False', however,+-- results from a 'False' value finitely far from the left end.+and :: Foldable t Bool => t -> Bool+and = getAll . foldMap All++-- | 'or' returns the disjunction of a container of Bools. For the+-- result to be 'False', the container must be finite; 'True', however,+-- results from a 'True' value finitely far from the left end.+or :: Foldable t Bool => t -> Bool+or = getAny . foldMap Any++-- | Determines whether any element of the structure satisfies the predicate.+any :: Foldable t a => (a -> Bool) -> t -> Bool+any p = getAny . foldMap (Any . p)++-- | Determines whether all elements of the structure satisfy the predicate.+all :: Foldable t a => (a -> Bool) -> t -> Bool+all p = getAll . foldMap (All . p)++-- | The 'sum' function computes the sum of the numbers of a structure.+sum :: (Foldable t a, Num a) => t -> a+sum = getSum . foldMap Sum++-- | The 'product' function computes the product of the numbers of a structure.+product :: (Foldable t a, Num a) => t -> a+product = getProduct . foldMap Product++-- | The largest element of the structure.+maximum :: (Foldable t a, Ord a) => t -> a+maximum = foldr1 max++-- | The largest element of a non-empty structure with respect to the+-- given comparison function.+maximumBy :: Foldable t a => (a -> a -> Ordering) -> t -> a+maximumBy cmp = foldr1 max'+ where max' x y = case cmp x y of+ GT -> x+ _ -> y++-- | The least element of a non-null structure.+minimum :: (Foldable t a, Ord a) => t -> a+minimum = foldr1 min++-- | The least element of a non-empty structure with respect to the+-- given comparison function.+minimumBy :: Foldable t a => (a -> a -> Ordering) -> t -> a+minimumBy cmp = foldr1 min'+ where min' x y = case cmp x y of+ GT -> y+ _ -> x++-- | Does the element occur in the structure?+elem :: (Foldable t a, Eq a) => a -> t -> Bool+elem = any . (==)++-- | 'notElem' is the negation of 'elem'.+notElem :: (Foldable t a, Eq a) => a -> t -> Bool+notElem x = not . elem x++-- | The 'find' function takes a predicate and a structure and returns+-- the leftmost element of the structure matching the predicate, or+-- 'Nothing' if there is no such element.+find :: Foldable t a => (a -> Bool) -> t -> Maybe a+find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])
+ Data/Collections/Properties.hs view
@@ -0,0 +1,682 @@+{-# OPTIONS_GHC -fglasgow-exts -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+-- Portability : MPTC, FD, undecidable instances+--+-- The purpose of this module is twofold:+-- +-- (1) Check instances of the classes in the collection framework.+--+-- (2) Give those classes more formal semantics.+--+-- Therefore, this acts as a contract between the collections users and implementers.+--+-- Each function in this module returns a list of @(property_name, propterty)@+-- for a given class (or set of classes). Each function is parameterized on the +-- type of+-- the collection to check, so a value witnessing the type must be passed. This+-- value is guaranteed not to be evaluated, so it can always be 'undefined'.+--+-- These properties allow to verify, with a high degree of confidence, that+-- instances of the classes defined in 'Data.Collections' satisfy +-- the prescribed properties.+--+-- You will note that properties depend on the 'Eq' class. This means that+--+-- * properties are verified up to 'Eq' equivalence.+--+-- * Infinite structures and other @bottom@s are not testable with this module.+--+++module Data.Collections.Properties + (+ unfoldable_properties,+ foldable_properties,+ collection_properties,+ map_properties,+ map_unfold_properties,+ set_unfold_properties,+ map_fold_properties,+ set_fold_properties,+ indexed_map_properties,+ sequence_properties,+ indexed_properties, + indexed_sequence_properties+ ) where++--+-- The documentation in this module is mostly generated from the function definitions,+-- see tools/AnnotateProps.hs.+-- TODO:+-- +-- + interactions with other classes (mainly Functor)+-- + see if prop_foldable could be defined better.+-- + array+++import Prelude hiding (null, foldr, lookup, concatMap, concat, and, drop, take, reverse, elem, notElem, all, any, filter)++import Control.Monad++import Data.Collections++import Data.Collections.Foldable as Foldable++import Data.Maybe++import Data.Monoid++import qualified Data.List as List++import Test.QuickCheck hiding ((><))++import qualified Data.Collections as C++infix 1 <==>++infix 1 <==++instance Show (a->b) where+ show _ = "<func>"++-- | Logic equivalence++(<==>) :: Bool -> Bool -> Bool+(<==>) x y = x == y ++(<==) = flip (==>)++-- | foldable_properties returns the following properties: +--+-- [/size/]+--+-- > size c == foldr (const (+1)) 0 c+--+-- [/null/]+--+-- > null c <==> all (const False) c+--+-- [/isSingleton/]+--+-- > isSingleton c <==> size c == 1+--+-- [/eq_elem/]+--+-- > c1 == c2 ==> elem x c1 == elem x c2 -- note that the order of folding is not enforced, and that the converse is not true++foldable_properties :: forall c a. (Arbitrary c, Arbitrary a,+ Show a, Show c,+ Eq c, Eq a,+ Foldable c a) => c -> [(Property,String)]+foldable_properties _ = [(property prop_size,"size"), (property prop_null,"null"), (property prop_isSingleton,"isSingleton"), (property prop_eq_elem,"eq_elem")]+ where size = C.size :: c -> Int+ null = C.null :: c -> Bool+ foldr = C.foldr :: (a -> b -> b) -> b -> c -> b+ toList = C.toList :: c -> [a]+ elem = C.elem :: a -> c -> Bool+ prop_size c = size c == foldr (const (+1)) 0 c+ prop_null c = null c <==> all (const False) c+ prop_isSingleton c = isSingleton c <==> size c == 1+ prop_eq_elem c1 c2 x = c1 == c2 ==> elem x c1 == elem x c2 -- note that the order of folding is not enforced, and that the converse is not true++-- | unfoldable_properties returns the following properties: +--+-- [/singleton/]+--+-- > singleton a == insert a empty+--+-- [/insertMany/]+--+-- > insertMany l c == Foldable.foldr insert c l+--+-- [/insertManySorted/]+--+-- > insertManySorted l c == Foldable.foldr insert c l+-- > where l = List.sort l0++unfoldable_properties :: forall c a. (Arbitrary c, Arbitrary a,+ Ord a, Show a, Show c,+ Eq c, Eq a,+ Unfoldable c a) => c -> [(Property,String)]+unfoldable_properties _ = [(property prop_singleton,"singleton"), (property prop_insertMany,"insertMany"), (property prop_insertManySorted,"insertManySorted")]+ where empty = C.empty :: c+ insert = C.insert :: a -> c -> c+ singleton = C.singleton :: a -> c+ prop_singleton a = singleton a == insert a empty+ prop_insertMany c (l::[a]) = insertMany l c == Foldable.foldr insert c l+ prop_insertManySorted c (l0::[a]) = insertManySorted l c == Foldable.foldr insert c l+ where l = List.sort l0++-- | collection_properties returns the following properties: +--+-- [/collection/]+--+-- > foldr insert empty c == c+--+-- [/empty/]+--+-- > null empty+--+-- [/insert1/]+--+-- > a `elem` (insert a c) -- insert puts the element in the collection+--+-- [/insert2/]+--+-- > a /= a' ==> (a' `elem` c <== a' `elem` (insert a c)) -- insert does not insert other elements+--+-- [/insert3/]+--+-- > let c' = insert a c in x `elem` c && y `elem` c ==> x `elem` c' || y `elem` c' -- insert alters at most one element+--+-- [/filter/]+--+-- > (a `elem` filter f c) <==> ((a `elem` c) && f a)++collection_properties :: forall c i. (CoArbitrary i, Arbitrary c, Arbitrary i,+ Show i, Show c,+ Eq c, Eq i,+ Collection c i) => c -> [(Property,String)]+collection_properties _ = [(property prop_collection,"collection"), (property prop_empty,"empty"), (property prop_insert1,"insert1"), (property prop_insert2,"insert2"), (property prop_insert3,"insert3"), (property prop_filter,"filter")]+ where empty = C.empty :: c+ foldr = C.foldr :: (i -> b -> b) -> b -> c -> b+ filter = C.filter :: (i -> Bool) -> c -> c+ insert = C.insert :: i -> c -> c++ prop_collection c = foldr insert empty c == c+ prop_empty = null empty++ prop_insert1 a c = a `elem` (insert a c) -- insert puts the element in the collection+ prop_insert2 a a' c = a /= a' ==> (a' `elem` c <== a' `elem` (insert a c)) -- insert does not insert other elements+ prop_insert3 a x y c = let c' = insert a c in x `elem` c && y `elem` c ==> x `elem` c' || y `elem` c' -- insert alters at most one element+ --NOTE: This leaves the door open to insert actually 'removing' an element.+ + prop_filter f c a = (a `elem` filter f c) <==> ((a `elem` c) && f a)++-- | map_properties returns the following properties: +--+-- [/alter/]+--+-- > lookup k (alter f k m) == f (lookup k m)+--+-- [/mapWithKey/]+--+-- > lookup k (mapWithKey f m) == fmap (f k) (lookup k m)+--+-- [/unionWith/]+--+-- > lookup k (unionWith f m1 m2) == case (lookup k m1, lookup k m2) of+-- > (Nothing,Nothing) -> Nothing+-- > (Just x, Nothing) -> Just x+-- > (Nothing,Just x) -> Just x+-- > (Just x, Just y) -> Just (f x y)+--+-- [/intersectionWith/]+--+-- > lookup k (intersectionWith f m1 m2) == case (lookup k m1, lookup k m2) of+-- > (Just x, Just y) -> Just (f x y)+-- > _ -> Nothing+--+-- [/differenceWith/]+--+-- > lookup k (differenceWith f m1 m2) == case (lookup k m1, lookup k m2) of+-- > (Just x, Nothing) -> Just x+-- > (Just x, Just y) -> f x y+-- > (Nothing, _) -> Nothing+--+-- [/isSubmapBy/]+--+-- > isSubmapBy f m1 m2 <==> differenceWith (\x y->if f x y then Nothing else Just v) m1 m2 == mempty+--+-- [/isProperSubmapBy/]+--+-- > isProperSubmapBy f m1 m2 <==> isSubmapBy f m1 m2 && m1 /= m2+--+-- [/insertWith/]+--+-- > insertWith f k a m == alter (\x -> Just $ case x of {Nothing->a;Just a' -> f a a'}) k m+--+-- [/fromFoldableWith/]+--+-- > fromFoldableWith f l == foldr (uncurry (insertWith f)) mempty l+--+-- [/delete/]+--+-- > delete k m == alter (const Nothing) k m+--+-- [/member/]+--+-- > member k m <==> isJust (lookup k m)+--+-- [/union/]+--+-- > union m1 m2 == unionWith const m1 m2+--+-- [/intersection/]+--+-- > intersection m1 m2 == intersectionWith const m1 m2 +--+-- [/difference/]+--+-- > difference m1 m2 == differenceWith (\_ _ -> Nothing) m1 m2+--+-- [/subset/]+--+-- > isSubset m1 m2 <==> isSubmapBy (\_ _ -> True) m1 m2+--+-- [/properSubset/]+--+-- > isProperSubset m1 m2 <==> isProperSubmapBy (\_ _ -> True) m1 m2+--+-- [/mempty/]+--+-- > lookup k mempty == Nothing+--+-- [/mappend/]+--+-- > mappend m1 m2 == union m1 m2+--+-- [/eq_lookup/]+--+-- > c1 == c2 ==> lookup x c1 == lookup x c2 -- should really be: c1 == c2 <==> forall x. lookup x c1 == lookup x c2++map_properties :: forall m k v. (CoArbitrary v, CoArbitrary k, Arbitrary m, Arbitrary k, Arbitrary v, + Show k, Show v, Show m,+ Eq m, Eq v,+ Map m k v+ ) => m -> [(Property,String)]+map_properties _ = [(property prop_alter,"alter"), (property prop_mapWithKey,"mapWithKey"), (property prop_unionWith,"unionWith"), (property prop_intersectionWith,"intersectionWith"), (property prop_differenceWith,"differenceWith"), (property prop_isSubmapBy,"isSubmapBy"), (property prop_isProperSubmapBy,"isProperSubmapBy"), (property prop_insertWith,"insertWith"), (property prop_fromFoldableWith,"fromFoldableWith"), (property prop_delete,"delete"), (property prop_member,"member"), (property prop_union,"union"), (property prop_intersection,"intersection"), (property prop_difference,"difference"), (property prop_subset,"subset"), (property prop_properSubset,"properSubset"), (property prop_mempty,"mempty"), (property prop_mappend,"mappend"), (property prop_eq_lookup,"eq_lookup")]+ where +-- empty = C.empty :: m+-- singleton = C.singleton :: i -> m+-- size = C.size :: m -> Int+ alter = C.alter :: (Maybe v -> Maybe v) -> k -> m -> m+ lookup = C.lookup :: k -> m -> Maybe v+ isSubset = C.isSubset :: m -> m -> Bool+ isProperSubset = C.isProperSubset :: m -> m -> Bool+ isSubmapBy = C.isSubmapBy :: (v -> v -> Bool) -> m -> m -> Bool+ unionWith = C.unionWith :: (v -> v -> v) -> m -> m -> m+ union = C.union :: m -> m -> m+ intersectionWith = C.intersectionWith :: (v -> v -> v) -> m -> m -> m+ differenceWith = C.differenceWith :: (v -> v -> Maybe v) -> m -> m -> m+ fromFoldableWith = C.fromFoldableWith :: (v -> v -> v) -> [(k,v)] -> m++ prop_alter f k m = lookup k (alter f k m) == f (lookup k m)++ prop_mapWithKey f k m = lookup k (mapWithKey f m) == fmap (f k) (lookup k m)++ prop_unionWith f k m1 m2 = lookup k (unionWith f m1 m2) == case (lookup k m1, lookup k m2) of+ (Nothing,Nothing) -> Nothing+ (Just x, Nothing) -> Just x+ (Nothing,Just x) -> Just x+ (Just x, Just y) -> Just (f x y)++ prop_intersectionWith f k m1 m2 = lookup k (intersectionWith f m1 m2) == case (lookup k m1, lookup k m2) of+ (Just x, Just y) -> Just (f x y)+ _ -> Nothing++ prop_differenceWith f k m1 m2 = lookup k (differenceWith f m1 m2) == case (lookup k m1, lookup k m2) of+ (Just x, Nothing) -> Just x+ (Just x, Just y) -> f x y+ (Nothing, _) -> Nothing++ prop_isSubmapBy f m1 m2 v = isSubmapBy f m1 m2 <==> differenceWith (\x y->if f x y then Nothing else Just v) m1 m2 == mempty+ prop_isProperSubmapBy f m1 m2 = isProperSubmapBy f m1 m2 <==> isSubmapBy f m1 m2 && m1 /= m2++ prop_insertWith f k a m = insertWith f k a m == alter (\x -> Just $ case x of {Nothing->a;Just a' -> f a a'}) k m+ prop_fromFoldableWith f l = fromFoldableWith f l == foldr (uncurry (insertWith f)) mempty l+ prop_delete k m = delete k m == alter (const Nothing) k m+ prop_member k m = member k m <==> isJust (lookup k m)+ prop_union m1 m2 = union m1 m2 == unionWith const m1 m2+ prop_intersection m1 m2 = intersection m1 m2 == intersectionWith const m1 m2 + prop_difference m1 m2 = difference m1 m2 == differenceWith (\_ _ -> Nothing) m1 m2+ prop_subset m1 m2 = isSubset m1 m2 <==> isSubmapBy (\_ _ -> True) m1 m2+ prop_properSubset m1 m2 = isProperSubset m1 m2 <==> isProperSubmapBy (\_ _ -> True) m1 m2++ prop_mempty k = lookup k mempty == Nothing+ prop_mappend m1 m2 = mappend m1 m2 == union m1 m2+ prop_eq_lookup x c1 c2 = c1 == c2 ==> lookup x c1 == lookup x c2 -- should really be: c1 == c2 <==> forall x. lookup x c1 == lookup x c2++ --prop_eq' c1 c2 = c1 == c2 <==> forAll (\x -> lookup x c1 == lookup x c2)++count :: Foldable f a => (a -> Bool) -> f -> Int+count p = getSum . foldMap (\x->Sum $ if p x then 1 else 0) ++-- | map_unfold_properties returns the following properties: +--+-- [/mempty/]+--+-- > mempty == empty+--+-- [/insert/]+--+-- > insert (k,v) m == insertWith (\x _ -> x) k v m++map_unfold_properties :: forall m k v. (Arbitrary m, Arbitrary k, Arbitrary v, + Show k, Show v, Show m,+ Eq m, Eq v, Eq k,+ Map m k v,+ Collection m (k,v)+ ) => m -> [(Property,String)]+map_unfold_properties _ = [(property prop_mempty,"mempty"), (property prop_insert,"insert")]+ where + empty = C.empty :: m+-- singleton = C.singleton :: i -> m+-- size = C.size :: m -> Int+ alter = C.alter :: (Maybe v -> Maybe v) -> k -> m -> m+ lookup = C.lookup :: k -> m -> Maybe v+ insertWith = C.insertWith :: (v -> v -> v) -> k -> v -> m -> m+ toList = C.toList :: m -> [(k,v)]++ prop_mempty = mempty == empty+ prop_insert k v m = insert (k,v) m == insertWith (\x _ -> x) k v m++-- | map_fold_properties returns the following properties: +--+-- [/foldable/]+--+-- > maybeToList (lookup k m) == map snd (List.filter ((== k) . fst) (toList m))+--+-- [/size/]+--+-- > sizeExcept (alter f k m) == sizeExcept m+-- > where sizeExcept m = size m - maybe 0 (const 1) (lookup k m)++map_fold_properties :: forall m k v. (CoArbitrary v, Arbitrary m, Arbitrary k, Arbitrary v, + Show k, Show v, Show m,+ Eq m, Eq v, Eq k,+ Map m k v,+ Collection m (k,v)+ ) => m -> [(Property,String)]+map_fold_properties _ = [(property prop_foldable,"foldable"), (property prop_size,"size")]+ where + empty = C.empty :: m+-- singleton = C.singleton :: i -> m+-- size = C.size :: m -> Int+ alter = C.alter :: (Maybe v -> Maybe v) -> k -> m -> m+ lookup = C.lookup :: k -> m -> Maybe v+ insertWith = C.insertWith :: (v -> v -> v) -> k -> v -> m -> m+ toList = C.toList :: m -> [(k,v)]++ prop_foldable k m = maybeToList (lookup k m) == map snd (List.filter ((== k) . fst) (toList m))+ prop_size f k m = sizeExcept (alter f k m) == sizeExcept m+ where sizeExcept m = size m - maybe 0 (const 1) (lookup k m)++-- | set_unfold_properties returns the following properties: +--+-- [/mempty/]+--+-- > mempty == empty+--+-- [/insert/]+--+-- > insert k m == insertWith (\x _->x) k () m++set_unfold_properties :: forall m k. (Arbitrary m, Arbitrary k, + Show k, Show m,+ Eq m, Eq k,+ Map m k (),+ Unfoldable m k+ ) => m -> [(Property,String)]+set_unfold_properties _ = [(property prop_mempty,"mempty"), (property prop_insert,"insert")]+ where + empty = C.empty :: m+ insertWith = C.insertWith :: (() -> () -> ()) -> k -> () -> m -> m+ + prop_mempty = mempty == empty+ prop_insert k m = insert k m == insertWith (\x _->x) k () m++-- | set_fold_properties returns the following properties: +--+-- [/foldable/]+--+-- > maybeToList (lookup k m) == map (const ()) (List.filter (== k) (toList m))+--+-- [/size/]+--+-- > sizeExcept (alter f k m) == sizeExcept m+-- > where sizeExcept m = size m - maybe 0 (const 1) (lookup k m)++set_fold_properties :: forall m k. (Arbitrary m, Arbitrary k, + Show k, Show m,+ Eq m, Eq k,+ Map m k (),+ Foldable m k+ ) => m -> [(Property,String)]+set_fold_properties _ = [(property prop_foldable,"foldable"), (property prop_size,"size")]+ where +-- singleton = C.singleton :: i -> m+-- size = C.size :: m -> Int+ alter = C.alter :: (Maybe () -> Maybe ()) -> k -> m -> m+ member = C.member :: k -> m -> Bool+ lookup = C.lookup :: k -> m -> Maybe ()+ + prop_foldable k m = maybeToList (lookup k m) == map (const ()) (List.filter (== k) (toList m))+ prop_size f k m = sizeExcept (alter f k m) == sizeExcept m+ where sizeExcept m = size m - maybe 0 (const 1) (lookup k m)++-- | indexed_properties returns the following properties: +--+-- [/adjust/]+--+-- > k `inDomain` m ==> index k (adjust f k m) == f (index k m)++indexed_properties :: forall m k v. (CoArbitrary v, Arbitrary m, Arbitrary k, Arbitrary v, + Show k, Show v, Show m,+ Eq m, Eq v,+ Indexed m k v+ ) => m -> [(Property,String)]+indexed_properties _ = [(property prop_adjust,"adjust")]+ where adjust = C.adjust :: (v -> v) -> k -> m -> m+ + prop_adjust f k m = k `inDomain` m ==> index k (adjust f k m) == f (index k m)++-- | sequence_properties returns the following properties: +--+-- [/fold0/]+--+-- > foldMap f empty == mempty+--+-- [/fold1/]+--+-- > foldMap f (x <| s) == f x `mappend` foldMap f s+--+-- [/fold2/]+--+-- > foldMap f (s |> x) == foldMap f s `mappend` f x+--+-- [/fold3/]+--+-- > foldMap f (s >< t) == foldMap f s `mappend` foldMap f t+--+-- [/front0/]+--+-- > front empty == Nothing+--+-- [/front1/]+--+-- > front (x <| s) == Just (x,s)+--+-- [/front2/]+--+-- > front (s |> x) == case front s of {Nothing -> Just (x, empty); Just (x',s') -> Just (x', s' |> x)}+--+-- [/front3/]+--+-- > front (s >< t) == case front s of {Nothing -> front t; Just (x',s') -> Just (x', s' >< t)}+--+-- [/back0/]+--+-- > back empty == Nothing+--+-- [/back1/]+--+-- > back (s |> x) == Just (s,x)+--+-- [/back2/]+--+-- > back (x <| s) == case back s of {Nothing -> Just (empty, x); Just (s',x') -> Just (x <| s', x')}+--+-- [/back3/]+--+-- > back (t >< s) == case back s of {Nothing -> back t; Just (s',x') -> Just (t >< s', x')}+--+-- [/drop1/]+--+-- > drop 0 s == s+--+-- [/drop2/]+--+-- > n>0 ==> drop (n+1) s == case front (drop n s) of Nothing -> empty; Just (_,s') -> s'+--+-- [/take1/]+--+-- > take 0 s == empty+--+-- [/take2/]+--+-- > n>0 ==> take (n+1) s == case front s of Nothing -> empty; Just (x,s') -> x <| take n s'+--+-- [/reverse/]+--+-- > foldMap f (reverse s) == getDual (foldMap (Dual . f) s)+--+-- [/mempty/]+--+-- > mempty == empty+--+-- [/eq_fold/]+--+-- > s1 == s2 ==> foldMap f s1 == foldMap f s2++sequence_properties :: forall s a . (Arbitrary s, Arbitrary a,+ Show s, Show a,+ Eq s, Eq a,+ Sequence s a+ ) => s -> [(Property,String)]+sequence_properties _ = [(property prop_fold0,"fold0"), (property prop_fold1,"fold1"), (property prop_fold2,"fold2"), (property prop_fold3,"fold3"), (property prop_front0,"front0"), (property prop_front1,"front1"), (property prop_front2,"front2"), (property prop_front3,"front3"), (property prop_back0,"back0"), (property prop_back1,"back1"), (property prop_back2,"back2"), (property prop_back3,"back3"), (property prop_drop1,"drop1"), (property prop_drop2,"drop2"), (property prop_take1,"take1"), (property prop_take2,"take2"), (property prop_reverse,"reverse"), (property prop_mempty,"mempty"), (property prop_eq_fold,"eq_fold")]+ where + empty = C.empty :: s+ front = C.front :: s -> Maybe (a,s)+ back = C.back :: s -> Maybe (s,a)+-- size = C.size :: s -> Int+ drop = C.drop :: Int -> s -> s+ take = C.take :: Int -> s -> s+ reverse = C.reverse :: s -> s+ foldMap :: forall m. Monoid m => (a -> m) -> s -> m+ foldMap = C.foldMap ++ f :: a -> [a] -- testing this single function ensure that fold properties are ok for all monoids and functions + -- (because mappend is associative)+ f x = [x]++ prop_fold0 = foldMap f empty == mempty+ prop_fold1 s x = foldMap f (x <| s) == f x `mappend` foldMap f s+ prop_fold2 s x = foldMap f (s |> x) == foldMap f s `mappend` f x+ prop_fold3 s t = foldMap f (s >< t) == foldMap f s `mappend` foldMap f t++ prop_front0 = front empty == Nothing+ prop_front1 s x = front (x <| s) == Just (x,s)+ prop_front2 s x = front (s |> x) == case front s of {Nothing -> Just (x, empty); Just (x',s') -> Just (x', s' |> x)}+ prop_front3 s t = front (s >< t) == case front s of {Nothing -> front t; Just (x',s') -> Just (x', s' >< t)}++ prop_back0 = back empty == Nothing+ prop_back1 s x = back (s |> x) == Just (s,x)+ prop_back2 s x = back (x <| s) == case back s of {Nothing -> Just (empty, x); Just (s',x') -> Just (x <| s', x')}+ prop_back3 s t = back (t >< s) == case back s of {Nothing -> back t; Just (s',x') -> Just (t >< s', x')}++ prop_drop1 s = drop 0 s == s+ prop_drop2 s n = n>0 ==> drop (n+1) s == case front (drop n s) of Nothing -> empty; Just (_,s') -> s'++ prop_take1 s = take 0 s == empty+ prop_take2 s n = n>0 ==> take (n+1) s == case front s of Nothing -> empty; Just (x,s') -> x <| take n s'++ prop_reverse s = foldMap f (reverse s) == getDual (foldMap (Dual . f) s)++ prop_mempty = mempty == empty++ prop_eq_fold s1 s2 = s1 == s2 ==> foldMap f s1 == foldMap f s2++-- | indexed_sequence_properties returns the following properties: +--+-- [/domain/]+--+-- > k `inDomain` s <==> k >= 0 && k < size s+--+-- [/left1/]+--+-- > k `inDomain` s ==> index (k+1) (x <| s) == index k s+--+-- [/left2/]+--+-- > index 0 (x <| s) == x+--+-- [/right1/]+--+-- > k `inDomain` s ==> index k (s |> x) == index k s+--+-- [/right2/]+--+-- > index (size s) (s |> x) == x+--+-- [/append1/]+--+-- > k `inDomain` t ==> index (k+size s) (s >< t) == index k t+--+-- [/append2/]+--+-- > k `inDomain` s ==> index k (s >< t) == index k s++indexed_sequence_properties :: forall s a . (Arbitrary s, Arbitrary a,+ Show s, Show a,+ Eq s, Eq a,+ Sequence s a,+ Indexed s Int a+ ) => s -> [(Property,String)]+indexed_sequence_properties _ = [(property prop_domain,"domain"), (property prop_left1,"left1"), (property prop_left2,"left2"), (property prop_right1,"right1"), (property prop_right2,"right2"), (property prop_append1,"append1"), (property prop_append2,"append2")]+ where + index = C.index :: Int -> s -> a+ (<|) = (C.<|) :: a -> s -> s+ (|>) = (C.|>) :: s -> a -> s+ (><) = (C.><) :: s -> s -> s+ inDomain = C.inDomain :: Int -> s -> Bool++ prop_domain k s = k `inDomain` s <==> k >= 0 && k < size s++ prop_left1 k s x = k `inDomain` s ==> index (k+1) (x <| s) == index k s+ prop_left2 s x = index 0 (x <| s) == x+ prop_right1 k s x = k `inDomain` s ==> index k (s |> x) == index k s+ prop_right2 s x = index (size s) (s |> x) == x+ prop_append1 k s t = k `inDomain` t ==> index (k+size s) (s >< t) == index k t+ prop_append2 k s t = k `inDomain` s ==> index k (s >< t) == index k s++-- | indexed_map_properties returns the following properties: +--+-- [/domain/]+--+-- > k `inDomain` m <==> k `member` m+--+-- [/index/]+--+-- > case lookup k m of {Just x -> x == index k m; _ -> True}++indexed_map_properties :: forall m k v. (Arbitrary m, Arbitrary k, Arbitrary v, + Show k, Show v, Show m,+ Eq m, Eq v,+ Map m k v,+ Indexed m k v+ ) => m -> [(Property,String)]+indexed_map_properties _ = [(property prop_domain,"domain"), (property prop_index,"index")]+ where+ index = C.index :: k -> m -> v+ inDomain = C.inDomain :: k -> m -> Bool+ prop_domain k m = k `inDomain` m <==> k `member` m+ prop_index k m = case lookup k m of {Just x -> x == index k m; _ -> True}+
+ LICENSE view
@@ -0,0 +1,31 @@+See the AUTHORS file for a list of copyright holders.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holders nor the names of+ other contributors may be used to endorse or promote products+ derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/runhaskell+import Distribution.Simple+main = defaultMain
+ collections-api.cabal view
@@ -0,0 +1,27 @@+name: collections-api+build-type: Simple+version: 1.0.0.0+category: Data Structures++license: BSD3+license-file: LICENSE++author: Jean-Philippe Bernardy+maintainer: jeanphilippe.bernardy (google mail)++synopsis: API for collection data structures.+description: This package provides classes for a consistent API to data+ structures. The behaviour of the interface is specified by QuickCheck properties. + It is intended as an evolution of the API of the data structures in the @containers@ package.+homepage: http://code.haskell.org/collections/+cabal-version: >= 1.6++tested-with: GHC==6.12.1++exposed-modules:+ Data.Collections,+ Data.Collections.Foldable,+ Data.Collections.Properties+build-depends: base >= 3 && < 5, QuickCheck == 2.*, array+extensions: CPP, MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances+ghc-options: -Wall