collections-base-instances (empty) → 1.0.0.0
raw patch · 6 files changed
+582/−0 lines, 6 filesdep +arraydep +basedep +bytestringsetup-changed
Dependencies added: array, base, bytestring, collections-api, containers
Files
- Data/Collections/BaseInstances.hs +356/−0
- Data/Map/List.hs +88/−0
- Data/Set/List.hs +73/−0
- LICENSE +31/−0
- Setup.hs +3/−0
- collections-base-instances.cabal +31/−0
+ Data/Collections/BaseInstances.hs view
@@ -0,0 +1,356 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS -XMultiParamTypeClasses -XTypeSynonymInstances #-}++module Data.Collections.BaseInstances (+-- * Concrete collection types+ Seq.Seq, + IntMap.IntMap, IntSet.IntSet,+ StdSet, StdMap) where++import Prelude hiding (sum,concat,lookup,map,filter,foldr,foldr1,foldl,null,reverse,(++),minimum,maximum,all,elem,concatMap,drop,head,tail,init)++import Control.Monad+import Data.Monoid+import Data.Collections+import Data.Collections.Foldable++import Data.Sequence (ViewL(..), ViewR(..))+import qualified Data.Sequence as Seq+import qualified Data.Foldable as AltFoldable++import qualified Data.Array as Array+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.List as List+import qualified Data.Map as Map+import qualified Data.Maybe as Maybe+import qualified Data.Set as Set+import qualified Data.ByteString as BS+--import qualified Data.ByteString.Char8 as BSC +-- Char8 version cannot be made as long as all bytestrings use the same type.+import qualified Data.ByteString.Lazy as BSL+import Data.Word (Word8)+-- import Data.Int (Int64)+-- import Control.Monad.Identity++type StdSet = Set.Set+type StdMap = Map.Map++-----------------------------------------------------------------------------+-- Instances+-----------------------------------------------------------------------------+++-- We follow with (sample) instances of the classes.++-----------------------------------------------------------------------------+-- Data.List++instance Unfoldable [a] a where+ empty = []+ singleton = return+ insert = (:)++instance Collection [a] a where+ filter = List.filter++instance Sequence [a] a where+ take = List.take+ drop = List.drop+ splitAt = List.splitAt+ reverse = List.reverse+ front (x:xs) = return (x,xs)+ front [] = fail "front: empty sequence"+ back s = return swap `ap` front (reverse s)+ where swap (x,s) = (reverse s,x)+ cons = (:)+ snoc xs x = xs List.++ [x]+ isPrefix = List.isPrefixOf++instance Indexed [a] Int a where+ index = flip (List.!!)+ adjust f k l = left >< (f x:right)+ where (left,x:right) = List.splitAt k l+ inDomain k l = k >= 0 && k < List.length l+ +--------------------------------------+-- Data.Sequence++instance Unfoldable (Seq.Seq a) a where+ empty = Seq.empty+ singleton = return+ insert = (<|)++instance Foldable (Seq.Seq a) a where+ foldr = AltFoldable.foldr+ foldl = AltFoldable.foldl+ foldr1 = AltFoldable.foldr1+ foldl1 = AltFoldable.foldl1+ foldMap = AltFoldable.foldMap+ null = Seq.null++instance Collection (Seq.Seq a) a where+ filter f = fromList . filter f . fromFoldable ++instance Sequence (Seq.Seq a) a where+ take = Seq.take+ drop = Seq.drop+ splitAt = Seq.splitAt+ reverse = Seq.reverse+ front s = case Seq.viewl s of+ EmptyL -> fail "front: empty sequence"+ a :< s -> return (a,s)+ back s = case Seq.viewr s of+ EmptyR -> fail "back: empty sequence"+ s :> a -> return (s,a)+ cons = (Seq.<|)+ snoc = (Seq.|>)++instance Indexed (Seq.Seq a) Int a where+ index = flip Seq.index+ adjust = Seq.adjust+ inDomain k l = k >= 0 && k < Seq.length l++------------------------+-- Data.ByteString++instance Foldable BS.ByteString Word8 where+ fold = foldr (+) 0+ foldr = BS.foldr+ foldl = BS.foldl+ foldr1 = BS.foldr1+ foldl1 = BS.foldl1+ null = BS.null+ size = BS.length++instance Unfoldable BS.ByteString Word8 where+ empty = BS.empty+ singleton = BS.singleton+ insert = BS.cons ++instance Collection BS.ByteString Word8 where+ filter = BS.filter++instance Sequence BS.ByteString Word8 where+ take = BS.take+ drop = BS.drop+ splitAt = BS.splitAt+ reverse = BS.reverse+ front s = if BS.null s then fail "front: empty ByteString" else return (BS.head s,BS.tail s)+ back s = if BS.null s + then fail "back: empty sequence" + else let (s',x) = BS.splitAt (BS.length s - 1) s in return (s', BS.head x)+ cons = BS.cons+ snoc = BS.snoc++instance Indexed BS.ByteString Int Word8 where+ index = flip BS.index+ adjust = error "Indexed.ajust: not supported by ByteString"+ inDomain k l = k >= 0 && k < BS.length l++------------------------+-- Data.ByteString.Lazy++instance Foldable BSL.ByteString Word8 where+ fold = foldr (+) 0+ foldr = BSL.foldr+ foldl = BSL.foldl+ foldr1 = BSL.foldr1+ foldl1 = BSL.foldl1+ null = BSL.null+ size = fromIntegral . BSL.length++instance Unfoldable BSL.ByteString Word8 where+ empty = BSL.empty+ singleton = BSL.singleton+ insert = BSL.cons+ +instance Collection BSL.ByteString Word8 where+ filter = BSL.filter++instance Sequence BSL.ByteString Word8 where+ take = BSL.take . fromIntegral+ drop = BSL.drop . fromIntegral+ splitAt = BSL.splitAt . fromIntegral+ reverse = BSL.reverse+ front s = if BSL.null s then fail "front: empty ByteString" else return (BSL.head s,BSL.tail s)+ back s = if BSL.null s + then fail "back: empty sequence" + else let (s',x) = BSL.splitAt (BSL.length s - 1) s in return (s', BSL.head x)+ cons = BSL.cons+ snoc = BSL.snoc++instance Indexed BSL.ByteString Int Word8 where+ index = flip BSL.index . fromIntegral+ adjust = error "Indexed.ajust: not supported by ByteString.Lazy yet"+ inDomain k l = k >= 0 && k < size l++--------------------------------------+-- Data.Array++instance Array.Ix i => Indexed (Array.Array i e) i e where+ index = flip (Array.!)+ adjust f k a = a Array.// [(k,f (a ! k))]+ inDomain k a = Array.inRange (Array.bounds a) k+ (//) a l = (Array.//) a (toList l)++instance Array.Ix i => Array (Array.Array i e) i e where+ array b l = Array.array b (toList l)+ bounds = Array.bounds++-----------------------------------------------------------------------------+-- Data.Map++-- TODO: write the instance based on foldMap+instance Foldable (Map.Map k a) (k,a) where+ foldr f i m = Map.foldWithKey (curry f) i m+ null = Map.null++instance Ord k => Unfoldable (Map.Map k a) (k,a) where+ insert = uncurry Map.insert+ singleton (k,a) = Map.singleton k a+ empty = Map.empty++instance Ord k => Collection (Map.Map k a) (k,a) where+ filter f = Map.filterWithKey (curry f)++instance Ord k => Indexed (Map.Map k a) k a where+ index = flip (Map.!)+ adjust = Map.adjust+ inDomain = member++instance Ord k => Map (Map.Map k a) k a where + isSubmapBy = Map.isSubmapOfBy+ isSubset = Map.isSubmapOfBy (\_ _->True)+ member = Map.member+ union = Map.union+ difference = Map.difference+ delete = Map.delete+ intersection = Map.intersection+ lookup = Map.lookup+ alter = Map.alter+ insertWith = Map.insertWith+ unionWith = Map.unionWith+ intersectionWith = Map.intersectionWith+ differenceWith = Map.differenceWith+ mapWithKey = Map.mapWithKey++instance Ord k => SortingCollection (Map.Map k a) (k,a) where+ minView = Map.minViewWithKey++-----------------------------------------------------------------------------+-- Data.IntMap+instance Foldable (IntMap.IntMap a) (Int,a) where+ null = IntMap.null+ size = IntMap.size+ foldr f i m = IntMap.foldWithKey (curry f) i m++instance Unfoldable (IntMap.IntMap a) (Int,a) where+ insert = uncurry IntMap.insert+ singleton (k,a) = IntMap.singleton k a+ empty = IntMap.empty++instance Collection (IntMap.IntMap a) (Int,a) where+ filter f = IntMap.filterWithKey (curry f)++instance Indexed (IntMap.IntMap a) Int a where+ index = flip (IntMap.!)+ adjust = IntMap.adjust+ inDomain = member++instance Map (IntMap.IntMap a) Int a where+ isSubmapBy = IntMap.isSubmapOfBy+ isSubset = IntMap.isSubmapOfBy (\_ _->True)+ member = IntMap.member+ union = IntMap.union+ difference = IntMap.difference+ delete = IntMap.delete+ intersection = IntMap.intersection+ lookup = IntMap.lookup+ alter = IntMap.alter+ insertWith = IntMap.insertWith+ unionWith = IntMap.unionWith+ intersectionWith = IntMap.intersectionWith+ differenceWith = IntMap.differenceWith+ mapWithKey = IntMap.mapWithKey++-----------------------------------------------------------------------------+-- Data.Set++instance Foldable (Set.Set a) a where+ foldr f i s = Set.fold f i s+ null = Set.null+ size = Set.size++instance Ord a => Unfoldable (Set.Set a) a where+ insert = Set.insert+ singleton = Set.singleton+ empty = Set.empty+ +instance Ord a => Collection (Set.Set a) a where+ filter = Set.filter++instance Ord a => Set (Set.Set a) a where+ haddock_candy = haddock_candy++instance Ord a => Map (Set.Set a) a () where+ isSubset = Set.isSubsetOf+ isSubmapBy f x y = isSubset x y && (f () () || null (intersection x y))+ member = Set.member+ union = Set.union+ difference = Set.difference+ intersection = Set.intersection+ delete = Set.delete+ insertWith _f k () = insert k+ unionWith _f = union+ intersectionWith _f = intersection+ differenceWith f s1 s2 = if f () () == Nothing then difference s1 s2 else s1+ lookup k l = if member k l then return () else fail "element not found"+ alter f k m = case f (lookup k m) of+ Just _ -> insert k m+ Nothing -> delete k m+ mapWithKey _f = id +++instance Ord a => SortingCollection (Set.Set a) a where+ minView c = if null c then fail "Data.Set.minView: empty set" else return (Set.findMin c, Set.deleteMin c)+ -- FIXME: add support for this in Data.Set++-----------------------------------------------------------------------------+-- Data.IntSet++instance Foldable IntSet.IntSet Int where+ foldr f i s = IntSet.fold f i s+ fold = foldl (+) 0+ null = IntSet.null+ size = IntSet.size++instance Unfoldable IntSet.IntSet Int where+ insert = IntSet.insert+ singleton = IntSet.singleton+ empty = IntSet.empty++instance Collection IntSet.IntSet Int where+ filter = IntSet.filter++instance Set IntSet.IntSet Int where+ haddock_candy = haddock_candy++instance Map IntSet.IntSet Int () where+ isSubmapBy f x y = isSubset x y && (f () () || null (intersection x y))+ isSubset = IntSet.isSubsetOf+ member = IntSet.member+ union = IntSet.union+ difference = IntSet.difference+ intersection = IntSet.intersection+ delete = IntSet.delete+ insertWith _f k () = insert k+ unionWith _f = union+ intersectionWith _f = intersection+ differenceWith f s1 s2 = if f () () == Nothing then difference s1 s2 else s1+ lookup k l = if member k l then return () else fail "element not found" + alter f k m = case f (lookup k m) of+ Just _ -> insert k m+ Nothing -> delete k m+ mapWithKey _f = id+
+ Data/Map/List.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances -fno-warn-name-shadowing #-}++module Data.Map.List (AssocList(..)) where++import Data.Monoid+import qualified Data.Maybe as Maybe+import qualified Data.List as List+import Prelude hiding (sum,concat,lookup,map,filter,foldr,foldr1,foldl,null,reverse,(++),minimum,maximum,all,elem,concatMap,head)+import Data.Collections+import Data.Collections.BaseInstances ()+import Data.Typeable+import Data.Ord (comparing)+++-- | View a list (actually any 'Sequence') of @(key,value)@ pairs as a 'Map' collection.+--+-- This allows to feed sequences into algorithms that require a map without building a full-fledged map.+-- Most of the time this will be used only when the parameter list is known to be very small, such that+-- conversion to a Map would be to costly.+--++newtype AssocList s k v = AssocList s++-- FIXME: GHC 6.4 cannot see that Sequence c (k,v) implies the FD: c -> k v+-- Hence it requires two extra parameters to AssocList. Drop them as possible.++#include "Typeable.h"+INSTANCE_TYPEABLE3(AssocList,theTc,"Data.Map.List.AssocList")++instance (Eq c, Eq k, Eq v, Foldable c (k,v)) => Eq (AssocList c k v) where+ (AssocList l1) == (AssocList l2) = l1 == l2 || + (size l1 == size l2 && all (`elem` l1) l2)+ ++instance Show l => Show (AssocList l k v) where+ show (AssocList l) = "AssocList " >< show l++instance Sequence c (k,v) => Foldable (AssocList c k v) (k,v) where+ foldr f z (AssocList l) = foldr f z l+ null (AssocList l) = null l++instance (Ord k, Sequence c (k,v)) => Collection (AssocList c k v) (k,v) where+ filter f (AssocList l) = AssocList $ filter f l++instance (Ord k, Sequence c (k,v)) => Unfoldable (AssocList c k v) (k,v) where+ empty = AssocList empty+ insert (k,v) m = insertWith const k v m+ +instance (Ord k, Sequence c (k,v)) => Indexed (AssocList c k v) k v where+ index k c = Maybe.fromJust $ lookup k c+ adjust f k c = alter (fmap f) k c+ inDomain = member++instance (Ord k, Sequence c (k,v)) => Monoid (AssocList c k v) where+ mempty = empty+ mappend = union++instance (Ord k, Sequence c (k,v), Monoid (AssocList c k v)) => Map (AssocList c k v) k v where+ isSubmapBy f c1 c2 = all (\(k,v) -> case lookup k c2 of+ Nothing -> False+ Just v' -> f v v') c1+ c1 `isSubset` c2 = all (`member` c2) (KeysView c1) + lookup k (AssocList l) = maybe (fail "Key not found") (return . snd) (find ((k ==) . fst) l)+ intersectionWith f (AssocList m1) m2 + = AssocList $ fromList + [(k,f x y) | (k,x) <- toList m1, + y <- Maybe.maybeToList $ lookup k m2]++ unionWith f (AssocList m1) (AssocList m2) = AssocList $ fromList $ List.map unionOne $+ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) $ toList (m1 >< m2)+ where unionOne list = (fst (head list), foldr1 f (List.map snd list))+ differenceWith f (AssocList m1) m2 = AssocList $ fromList $ Maybe.catMaybes + [newEl k x (lookup k m2) | (k,x) <- toList m1]+ where newEl k x Nothing = Just (k,x)+ newEl k x (Just y) = fmap (\x->(k,x)) (f x y)+ alter f k m@(AssocList l) = AssocList $ foldr construct + (if member k m then empty else maybe empty (\x -> singleton (k,x)) (f Nothing)) l+ where construct :: (k,v) -> c -> c+ construct a@(k',x) l+ | k'== k = case f (Just x) of + Nothing -> l+ Just x -> (k', x) <| l+ | otherwise = a <| l+ mapWithKey f (AssocList l) = AssocList (smap l)+ where smap = foldr (\(k,x) s -> (k,f k x) <| s) mempty++on :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)+on op f x y = op (f x) (f y)
+ Data/Set/List.hs view
@@ -0,0 +1,73 @@+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}++module Data.Set.List (SetList(..)) where+++import Data.Monoid+import qualified Data.List as List+import Prelude hiding (sum,concat,lookup,map,filter,foldr,foldr1,foldl,null,reverse,(++),minimum,maximum,all,elem,concatMap)+import Data.Collections+import Data.Collections.BaseInstances ()+import Data.Typeable++-- | View a list of as a 'Set' collection.+--+-- This allows to feed sequences into algorithms that require a Set without building a full-fledged Set.+-- Most of the time this will be used only when the parameter list is known to be very small, such that+-- conversion to a Set would be to costly.++--FIXME: Generalize to sequences.+newtype SetList s = SetList {fromSetList :: s}++instance (Eq s, Eq a, Foldable s a) => Eq (SetList s) where+ (SetList l1) == (SetList l2) = l1 == l2 || + (size l1 == size l2 && all (`elem` l1) l2)+++#include "Typeable.h"+INSTANCE_TYPEABLE1(SetList,theTc,"Data.Set.List.SetList")++instance Show l => Show (SetList l) where+ show (SetList l) = "SetList " >< show l++instance Foldable (SetList [a]) a where+ foldr f z (SetList l) = foldr f z l+ null (SetList l) = null l++instance Eq a => Set (SetList [a]) a where+ haddock_candy = haddock_candy++instance Eq a => Monoid (SetList [a]) where+ mempty = empty+ mappend = union++instance Eq a => Unfoldable (SetList [a]) a where+ empty = SetList empty+ insert x (SetList l) = SetList $ if x `elem` l then l else insert x l+ +instance Eq a => Collection (SetList [a]) a where+ filter f (SetList l) = SetList $ filter f l++instance Eq a => Map (SetList [a]) a () where+ isSubmapBy f x y = isSubset x y && (f () () || null (intersection x y))+ insertWith _f k () = insert k+ unionWith _f = union+ intersectionWith _f = intersection+ mapWithKey _f = id+ differenceWith f s1 s2 = if f () () == Nothing then difference s1 s2 else s1+ lookup k l = if member k l then return () else fail "element not found"++ (SetList l1) `isSubset` (SetList l2) = all (`elem` l2) l1+ difference (SetList l1) (SetList l2) = SetList $ (List.\\) l1 l2+ delete k (SetList l) = SetList $ filter (not . (k ==)) l+ member k (SetList l) = List.elem k l+ union (SetList l1) (SetList l2) = SetList $ List.union l1 l2+ intersection (SetList l1) (SetList l2) = SetList $ List.intersect l1 l2+ alter f k l = let lk = lookup k l in+ case lk of+ Nothing -> case f lk of+ Nothing -> l+ Just _ -> insert k l+ Just _ -> case f lk of+ Nothing -> delete k l+ Just _ -> l
+ 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-base-instances.cabal view
@@ -0,0 +1,31 @@+name: collections-base-instances+version: 1.0.0.0+category: Data Structures+description:+ This package provides a common API, through a consistent set of classes, to the container types in the @containers@ package.+ list, array, set, map, bytestring, etc. are supported.+license: BSD3+license-file: LICENSE+author: Jean-Philippe Bernardy+maintainer: jeanphilippe.bernardy (google mail)++stability: Stable+category: Data Structures+synopsis: Useful standard collections types and related functions.+description:+ This package provides a common API, through a consistent set of classes, to the various standard container types.+ list, array, set, map, bytestring, etc. are supported.+homepage: http://code.haskell.org/collections/+cabal-version: >= 1.6++build-type: Simple+tested-with: GHC==6.8.2++exposed-modules:+ Data.Collections.BaseInstances,+ Data.Map.List,+ Data.Set.List++build-depends: base >= 3.0 && < 5, array, containers, bytestring, collections-api == 1.0.*+extensions: CPP+ghc-options: -Wall