diff --git a/ixset.cabal b/ixset.cabal --- a/ixset.cabal +++ b/ixset.cabal @@ -1,7 +1,7 @@ Name: ixset -Version: 1.0.2 -Synopsis: Efficient relational queries on Haskell sets. -Description: +Version: 1.0.3 +Synopsis: Efficient relational queries on Haskell sets. +Description: Create and query sets that are indexed by multiple indices. License: BSD3 License-file: COPYING @@ -10,7 +10,7 @@ homepage: http://happstack.com Category: Data Structures Build-Type: Simple -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.10 source-repository head type: darcs @@ -20,6 +20,7 @@ flag base4 Library + Default-Language: Haskell2010 if flag(base4) Build-Depends: base >=4 && < 5, syb else @@ -36,15 +37,26 @@ template-haskell hs-source-dirs: src - Exposed-modules: + Exposed-modules: Data.IxSet Data.IxSet.Ix - extensions: DeriveDataTypeable, FlexibleInstances, OverlappingInstances, - TemplateHaskell, UndecidableInstances - if impl(ghc >= 6.12) ghc-options: -Wall -fno-warn-unused-do-bind else ghc-options: -Wall GHC-Prof-Options: -auto-all + +Test-Suite test-ixset + Default-Language: Haskell2010 + type: detailed-0.9 + test-module: Test + other-modules: Data.IxSet.Tests + hs-source-dirs: tests + build-depends: base, + Cabal >= 1.10, + containers, + HUnit, + ixset, + QuickCheck, + random diff --git a/src/Data/IxSet.hs b/src/Data/IxSet.hs --- a/src/Data/IxSet.hs +++ b/src/Data/IxSet.hs @@ -19,7 +19,7 @@ an instance of 'Indexable'. Use 'ixFun' and 'ixGen' to build indexes: > instance Indexable Entry where -> empty = ixSet +> empty = ixSet > [ ixGen (Proxy :: Proxy Author) -- out of order > , ixGen (Proxy :: Proxy Id) > , ixGen (Proxy :: Proxy Updated) @@ -68,7 +68,7 @@ index with this type. Now you can do: > newtype FirstAuthor = FirstAuthor Email -> +> > getFirstAuthor (Entry author _ _ _ _) = [FirstAuthor author] > > instance Indexable Entry where @@ -81,7 +81,7 @@ -} -module Data.IxSet +module Data.IxSet ( -- * Set type IxSet, @@ -92,7 +92,7 @@ ixSet, ixFun, ixGen, - + -- * Changes to set IndexOp, change, @@ -149,7 +149,7 @@ flatten, flattenWithCalcs, - -- * Debugging and optimisation + -- * Debugging and optimization stats ) where @@ -186,11 +186,11 @@ -- the core datatypes --- | Set with associatex indexes. +-- | Set with associated indexes. data IxSet a = IxSet [Ix a] deriving (Data, Typeable) --- | Create an 'IxSet' using a list of indexes. Useful in 'Indexable' +-- | Create an 'IxSet' using a list of indexes. Useful in the 'Indexable' -- 'empty' method. Use 'ixFun' and 'ixGen' as list elements. -- -- > instance Indexable Type where @@ -199,13 +199,13 @@ -- > ixGen (Proxy :: Proxy Index2Type) -- > ] -- --- First index in the list must contain all objects in set, doing --- otherwise result in runtime error. +-- Every value in the 'IxSet' must be reachable by the first index in this +-- list, or you'll get a runtime error. ixSet :: [Ix a] -> IxSet a ixSet = IxSet -- | Create a functional index. Provided function should return a list --- of indexes where value should be found. +-- of indexes where the value should be found. -- -- > getIndexes value = [...indexes...] -- @@ -217,9 +217,9 @@ ixFun f = Ix Map.empty f --- | Create a generic index. Provided example is used only as type --- source so you may use a 'Proxy'. The 'ixGen' uses flatten to --- traverse value using its 'Data' instance. +-- | Create a generic index. Provided example is used only as type source +-- so you may use a 'Proxy'. This uses flatten to traverse values using +-- their 'Data' instances. -- -- > instance Indexable Type where -- > empty = ixSet [ ixGen (Proxy :: Proxy Type) ] @@ -233,7 +233,7 @@ showTypeOf x = showsPrec 11 (typeOf x) [] instance (Eq a,Ord a,Typeable a) => Eq (IxSet a) where - IxSet (Ix a _:_) == IxSet (Ix b _:_) = + IxSet (Ix a _:_) == IxSet (Ix b _:_) = case cast b of Just b' -> a==b' Nothing -> error "trying to compare two sets with different types of first indexes, this is a bug in the library" @@ -277,21 +277,20 @@ instance (Indexable a, Ord a,Data a, Default a) => Default (IxSet a) where defaultValue = empty -} -instance (Ord a,Show a) => Show (IxSet a) where +instance (Ord a,Show a) => Show (IxSet a) where showsPrec prec = showsPrec prec . toSet instance (Ord a,Read a,Typeable a,Indexable a) => Read (IxSet a) where readsPrec n = map (first fromSet) . readsPrec n -{- | 'Indexable' class defines objects that can be members of 'IxSet'. +{- | Defines objects that can be members of 'IxSet'. -} class Indexable a where - -- | Method 'empty' defines what an empty 'IxSet' for this - -- particular type should look like. It should have all necessary - -- indexes. Use 'ixSet' function to create the set and fill it in - -- with 'ixFun' and 'ixGen'. + -- | Defines what an empty 'IxSet' for this particular type should look + -- like. It should have all necessary indexes. Use the 'ixSet' + -- function to create the set and fill it in with 'ixFun' and 'ixGen'. empty :: IxSet a - + -- | Function to be used for 'calcs' in 'inferIxSet' when you don't -- want any calculated values. noCalcs :: t -> () @@ -301,26 +300,26 @@ 'Indexable' instance from a data type, e.g. > data Foo = Foo Int String - + and - + > $(inferIxSet "FooDB" ''Foo 'noCalcs [''Int,''String]) - -will build a type synonym +will build a type synonym + > type FooDB = IxSet Foo - + with @Int@ and @String@ as indexes. -WARNING: The type specified as the first index must be a type which +/WARNING/: The type specified as the first index must be a type which appears in all values in the 'IxSet' or 'toList', 'toSet' and -serialization will not function properly. You will be warned not to do -this by runtime error. You can always use the element type +serialization will not function properly. You will be warned not to do +this with a runtime error. You can always use the element type itself. For example: > $(inferIxSet "FooDB" ''Foo 'noCalcs [''Foo, ''Int, ''String]) --} +-} inferIxSet :: String -> TH.Name -> TH.Name -> [TH.Name] -> Q [Dec] inferIxSet _ _ _ [] = error "inferIxSet needs at least one index" inferIxSet ixset typeName calName entryPoints @@ -353,10 +352,10 @@ getCalType (ForallT _names _ t') = getCalType t' getCalType (AppT (AppT ArrowT _) t') = t' getCalType t' = error ("Unexpected type in getCalType: " ++ pprint t') - mkEntryPoint n = (conE 'Ix) `appE` + mkEntryPoint n = (conE 'Ix) `appE` (sigE (varE 'Map.empty) (forallT binders (return context) $ - appT (appT (conT ''Map) (conT n)) - (appT (conT ''Set) typeCon))) `appE` + appT (appT (conT ''Map) (conT n)) + (appT (conT ''Set) typeCon))) `appE` (varE 'flattenWithCalcs `appE` varE calName) in do i <- instanceD (fullContext) (conT ''Indexable `appT` typeCon) @@ -367,14 +366,14 @@ _ -> error "IxSet.inferIxSet calInfo unexpected match" -- | Version of 'instanceD' that takes in a Q [Dec] instead of a [Q Dec] --- and filters out signatures from the list of declarations +-- and filters out signatures from the list of declarations. instanceD' :: CxtQ -> TypeQ -> Q [Dec] -> DecQ instanceD' ctxt ty decs = do decs' <- decs let decs'' = filter (not . isSigD) decs' instanceD ctxt ty (map return decs'') --- | Returns true if the Dec matches a SigD constructor +-- | Returns true if the Dec matches a SigD constructor. isSigD :: Dec -> Bool isSigD (SigD _ _) = True isSigD _ = False @@ -411,7 +410,7 @@ -- | Generically traverses the argument and calculated values to find -- all occurences of values of type @b@ and returns them as a -- list. Equivalent to: --- +-- -- > flatten (x,calcs x) -- -- This function properly handles 'String' as 'String' not as @['Char']@. @@ -423,7 +422,7 @@ -- e.g. 'insert' or 'delete'. change :: (Typeable a,Indexable a,Ord a) => IndexOp -> a -> IxSet a -> IxSet a -change op x (IxSet indexes) = +change op x (IxSet indexes) = IxSet v where v = zipWith update (True:repeat False) indexes @@ -436,9 +435,9 @@ then error $ "Happstack.Data.IxSet.change: all values must appear in first declared index " ++ showTypeOf key ++ " of " ++ showTypeOf x else List.foldl' ii index ds -- handle multiple values -insertList :: (Typeable a,Indexable a,Ord a) +insertList :: (Typeable a,Indexable a,Ord a) => [a] -> IxSet a -> IxSet a -insertList xs (IxSet indexes) = +insertList xs (IxSet indexes) = IxSet v where v = zipWith update (True:repeat False) indexes @@ -453,9 +452,9 @@ dss = [(k,x) | x <- xs, k <- flattencheck x] index' = Ix.insertList dss index -insertMapOfSets :: (Typeable a, Ord a,Indexable a,Typeable key,Ord key) +insertMapOfSets :: (Typeable a, Ord a,Indexable a,Typeable key,Ord key) => Map key (Set a) -> IxSet a -> IxSet a -insertMapOfSets originalindex (IxSet indexes) = +insertMapOfSets originalindex (IxSet indexes) = IxSet v where v = map update indexes @@ -467,17 +466,17 @@ from original index. We want to reuse it as much as possible. If there was a guarantee that each element is present at at most one index we could reuse originalindex as it is. But there can be more, so we need to - add remaining ones. Anyway we try to reuse old structure and keep + add remaining ones. Anyway we try to reuse old structure and keep new allocations low as much as possible. -} index' = case cast originalindex of - Just originalindex' -> + Just originalindex' -> let dssf = filter (\(k,_v) -> not (Map.member k originalindex')) dss in Ix.insertList dssf originalindex' Nothing -> Ix.insertList dss index -- | Inserts an item into the 'IxSet'. If your data happens to have --- primary key this function might not be what you want. See +-- a primary key this function might not be what you want. See -- 'updateIx'. insert :: (Typeable a, Ord a,Indexable a) => a -> IxSet a -> IxSet a insert = change Ix.insert @@ -549,7 +548,7 @@ [x] -> Just x _ -> Nothing --- | Like 'getOne' with a user provided default. +-- | Like 'getOne' with a user-provided default. getOneOr :: Ord a => a -> IxSet a -> a getOneOr def = fromMaybe def . getOne @@ -576,7 +575,7 @@ union (IxSet x1) (IxSet x2) = IxSet indexes' where indexes' = zipWith union' x1 x2 - union' (Ix a f) (Ix b _) = + union' (Ix a f) (Ix b _) = case cast b of Nothing -> error "IxSet.union: indexes out of order" Just b' -> Ix (Ix.union a b') f @@ -586,7 +585,7 @@ intersection (IxSet x1) (IxSet x2) = IxSet indexes' where indexes' = zipWith intersection' x1 x2 - intersection' (Ix a f) (Ix b _) = + intersection' (Ix a f) (Ix b _) = case cast b of Nothing -> error "IxSet.intersection: indexes out of order" Just b' -> Ix (Ix.intersection a b') f @@ -717,7 +716,7 @@ -- type inference. -- -- The resulting list will be sorted in descending order by 'k'. --- +-- -- NOTE: The values in '[t]' are currently sorted in ascending -- order. But this may change if someone bothers to add -- 'Set.toDescList'. So do not rely on the sort order of '[t]'. @@ -727,7 +726,7 @@ collect [] = [] -- FIXME: should be an error collect (Ix index _:is) = maybe (collect is) f (cast index) f = map (second Set.toAscList) . Map.toDescList - + --query impl function -- | A function for building up selectors on 'IxSet's. Used in the @@ -747,7 +746,7 @@ => Bool -> Bool -> Bool -> k -> IxSet a -> IxSet a getOrd2 inclt inceq incgt v ixset@(IxSet indexes) = collect indexes where - collect [] = error $ "IxSet: there is no index " ++ showTypeOf v ++ + collect [] = error $ "IxSet: there is no index " ++ showTypeOf v ++ " in " ++ showTypeOf ixset collect (Ix index _:is) = maybe (collect is) f $ cast v where @@ -757,11 +756,11 @@ ltgt = Map.unionWith Set.union lt gt result = case eq of Just eqset -> Map.insertWith Set.union v'' eqset ltgt - Nothing -> ltgt - lt = if inclt + Nothing -> ltgt + lt = if inclt then lt' else Map.empty - gt = if incgt + gt = if incgt then gt' else Map.empty eq = if inceq diff --git a/src/Data/IxSet/Ix.hs b/src/Data/IxSet/Ix.hs --- a/src/Data/IxSet/Ix.hs +++ b/src/Data/IxSet/Ix.hs @@ -4,11 +4,11 @@ {- | -This module defines typable indices and convenience functions. Should -be probably considered private to 'Happstack.Data.IxSet'. +This module defines 'Typeable' indexes and convenience functions. Should +probably be considered private to "Data.IxSet". -} -module Data.IxSet.Ix +module Data.IxSet.Ix ( Ix(..) , insert , delete @@ -16,7 +16,7 @@ , deleteList , union , intersection - ) + ) where import Data.Generics hiding (GT) @@ -31,7 +31,7 @@ -- | 'Ix' is a 'Map' from some 'Typeable' key to a 'Set' of values for -- that key. 'Ix' carries type information inside. -data Ix a = forall key . (Typeable key, Ord key) => +data Ix a = forall key . (Typeable key, Ord key) => Ix (Map key (Set a)) (a -> [key]) deriving Typeable @@ -87,14 +87,14 @@ => [(k,a)] -> Map k (Set a) -> Map k (Set a) deleteList xs index = foldl' (\m (k,v) -> delete k v m) index xs --- | Take union of two sets. +-- | Takes the union of two sets. union :: (Ord a, Ord k) => Map k (Set a) -> Map k (Set a) -> Map k (Set a) union index1 index2 = Map.unionWith Set.union index1 index2 --- | Take intersection of two sets +-- | Takes the intersection of two sets. intersection :: (Ord a, Ord k) => Map k (Set a) -> Map k (Set a) -> Map k (Set a) -intersection index1 index2 = Map.filter (not . Set.null) $ +intersection index1 index2 = Map.filter (not . Set.null) $ Map.intersectionWith Set.intersection index1 index2