ixset-typed 0.1.4 → 0.2
raw patch · 5 files changed
+545/−150 lines, 5 filesdep +HUnitdep +QuickCheckdep +deepseqdep ~basedep ~template-haskell
Dependencies added: HUnit, QuickCheck, deepseq, ixset-typed, tasty, tasty-hunit, tasty-quickcheck
Dependency ranges changed: base, template-haskell
Files
- ixset-typed.cabal +24/−5
- src/Data/IxSet/Typed.hs +219/−145
- src/Data/IxSet/Typed/Ix.hs +4/−0
- tests/Data/IxSet/Typed/Tests.hs +291/−0
- tests/TestIxSetTyped.hs +7/−0
ixset-typed.cabal view
@@ -1,5 +1,5 @@ name: ixset-typed-version: 0.1.4+version: 0.2 synopsis: Efficient relational queries on Haskell sets. description: This Haskell package provides a data structure of sets that are indexed@@ -30,10 +30,11 @@ location: https://github.com/kosmikus/ixset-typed.git library- build-depends: base >= 4.6 && < 5,- syb >= 0.4 && < 1,- containers >= 0.5 && < 1,- safecopy >= 0.8 && < 1,+ build-depends: base >= 4.6 && < 5,+ containers >= 0.5 && < 1,+ deepseq >= 1.3 && < 2,+ safecopy >= 0.8 && < 1,+ syb >= 0.4 && < 1, template-haskell >= 2.8 && < 3 hs-source-dirs: src@@ -43,5 +44,23 @@ ghc-options: -Wall -fno-warn-unused-do-bind ghc-prof-options: -auto-all++ default-language: Haskell2010++test-suite test-ixset-typed+ type: exitcode-stdio-1.0+ build-depends: ixset-typed,+ base >= 4.6 && < 5,+ containers >= 0.5 && < 1,+ HUnit,+ QuickCheck,+ tasty,+ tasty-hunit,+ tasty-quickcheck+ hs-source-dirs: tests+ main-is: TestIxSetTyped.hs+ other-modules: Data.IxSet.Typed.Tests++ ghc-options: -Wall default-language: Haskell2010
src/Data/IxSet/Typed.hs view
@@ -26,7 +26,7 @@ > deriving (Show, Eq, Ord, Data, Typeable) 1. Decide what parts of your type you want indexed and make your type-an instance of 'Indexable'. Use 'ixFun' and 'ixGen' to build indexes:+an instance of 'Indexable'. Use 'ixFun' and 'ixGen' to build indices: > type EntryIxs = '[Author, Id, Updated, Test] > type IxEntry = IxSet EntryIxs Entry@@ -39,7 +39,7 @@ > (ixGen (Proxy :: Proxy Test)) -- bogus index The use of 'ixGen' requires the 'Data' and 'Typeable' instances above.- You can build indexes manually using 'ixFun'. You can also use the+ You can build indices manually using 'ixFun'. You can also use the Template Haskell function 'inferIxSet' to generate an 'Indexable' instance automatically. @@ -187,6 +187,9 @@ import Prelude hiding (null) import Control.Arrow (first, second)+import Control.DeepSeq+import Data.Foldable (Foldable)+import qualified Data.Foldable as Fold import Data.Generics (Data, gmapQ) -- import qualified Data.Generics.SYB.WithClass.Basics as SYBWC import qualified Data.IxSet.Typed.Ix as Ix@@ -203,8 +206,9 @@ import Language.Haskell.TH as TH import GHC.Exts (Constraint) ---- the core datatypes+--------------------------------------------------------------------------+-- The main 'IxSet' datatype.+-------------------------------------------------------------------------- -- | Set with associated indices. --@@ -217,11 +221,26 @@ Nil :: IxList '[] a (:::) :: Ix ix a -> IxList ixs a -> IxList (ix ': ixs) a +infixr 5 :::++-- TODO:+--+-- We cannot currently derive Typeable for 'IxSet':+--+-- * In ghc-7.6, Typeable isn't supported for non-* kinds.+-- * In ghc-7.8, see bug #8950. We can work around this, but I rather+-- would wait for a proper fix.+ -- deriving instance Data (IxSet ixs a) -- deriving instance Typeable IxSet -infixr 5 ::: +--------------------------------------------------------------------------+-- Type-level tools for dealing with indexed sets.+--+-- These are partially internal. TODO: Move to different module?+--------------------------------------------------------------------------+ -- | The constraint @All c xs@ says the @c@ has to hold for all -- elements in the type-level list @xs@. --@@ -237,6 +256,49 @@ type instance All c '[] = () type instance All c (x ': xs) = (c x, All c xs) +-- | Associate indices with a given type. The constraint+-- @'Indexable' ixs a@ says that we know how to build index sets+-- of type @'IxSet' ixs a@.+--+-- In order to use an 'IxSet' on a particular type, you have to+-- make it an instance of 'Indexable' yourself. There are no+-- predefined instances of 'IxSet'.+--+class (All Ord ixs, Ord a) => Indexable ixs a where++ -- | Define what an empty 'IxSet' for this particular type should look+ -- like. It should have all necessary indices.+ --+ -- Use the 'mkEmpty' function to create the set and add indices+ -- with 'ixFun' (or 'ixGen').+ empty :: IxSet ixs a++-- | Constraint for membership in the type-level list. Says that 'ix'+-- is contained in the index list 'ixs'.+class Ord ix => IsIndexOf (ix :: *) (ixs :: [*]) where++ -- | Provide access to the selected index in the list.+ access :: IxList ixs a -> Ix ix a++ -- | Map over the index list, treating the selected different+ -- from the rest.+ mapAt :: (All Ord ixs)+ => (Ix ix a -> Ix ix a)+ -- ^ what to do with the selected index+ -> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)+ -- ^ what to do with the other indices+ -> IxList ixs a -> IxList ixs a++instance Ord ix => IsIndexOf ix (ix ': ixs) where+ access (x ::: _xs) = x+ mapAt fh ft (x ::: xs) = fh x ::: mapIxList ft xs++instance IsIndexOf ix ixs => IsIndexOf ix (ix' ': ixs) where+ access (_x ::: xs) = access xs+ mapAt fh ft (x ::: xs) = ft x ::: mapAt fh ft xs++-- | Return the length of an index list.+-- -- TODO: Could be statically unrolled. lengthIxList :: forall ixs a. IxList ixs a -> Int lengthIxList = go 0@@ -245,41 +307,106 @@ go !acc Nil = acc go !acc (_ ::: xs) = go (acc + 1) xs -ixListToList :: All Ord ixs => (forall ix. Ord ix => Ix ix a -> r) -> IxList ixs a -> [r]+-- | Turn an index list into a normal list, given a function that+-- turns an arbitrary index into an element of a fixed type @r@.+ixListToList :: All Ord ixs+ => (forall ix. Ord ix => Ix ix a -> r)+ -- ^ what to do with each index+ -> IxList ixs a -> [r] ixListToList _ Nil = [] ixListToList f (x ::: xs) = f x : ixListToList f xs -mapIxList :: (All Ord ixs)+-- | Map over an index list.+mapIxList :: All Ord ixs => (forall ix. Ord ix => Ix ix a -> Ix ix a)+ -- ^ what to do with each index -> IxList ixs a -> IxList ixs a mapIxList _ Nil = Nil mapIxList f (x ::: xs) = f x ::: mapIxList f xs -zipWithIxList :: (All Ord ixs)+-- | Zip two index lists of compatible type.+zipWithIxList :: All Ord ixs => (forall ix. Ord ix => Ix ix a -> Ix ix a -> Ix ix a)+ -- ^ how to combine two corresponding indices -> IxList ixs a -> IxList ixs a -> IxList ixs a zipWithIxList _ Nil Nil = Nil zipWithIxList f (x ::: xs) (y ::: ys) = f x y ::: zipWithIxList f xs ys zipWithIxList _ _ _ = error "Data.IxSet.Typed.zipWithIxList: impossible"+ -- the line above is actually impossible by the types; it's just there+ -- to please avoid the warning resulting from the exhaustiveness check --- Constraint for membership in the type-level list. Says that 'ix'--- is contained in the index list 'ixs'.-class Ord ix => IsIndexOf (ix :: *) (ixs :: [*]) where- access :: IxList ixs a -> Ix ix a- mapAt :: (All Ord ixs)- => (Ix ix a -> Ix ix a)- -> (forall ix'. Ord ix' => Ix ix' a -> Ix ix' a)- -> IxList ixs a -> IxList ixs a+--------------------------------------------------------------------------+-- Various instances for 'IxSet'+-------------------------------------------------------------------------- -instance Ord ix => IsIndexOf ix (ix ': ixs) where- access (x ::: _xs) = x- mapAt fh ft (x ::: xs) = fh x ::: mapIxList ft xs+instance Indexable ixs a => Eq (IxSet ixs a) where+ IxSet a _ == IxSet b _ = a == b -instance IsIndexOf ix ixs => IsIndexOf ix (ix' ': ixs) where- access (_x ::: xs) = access xs- mapAt fh ft (x ::: xs) = ft x ::: mapAt fh ft xs+instance Indexable ixs a => Ord (IxSet ixs a) where+ compare (IxSet a _) (IxSet b _) = compare a b --- | Create an 'IxSet' using a set and a number of indexes. If you want to+instance (Indexable ixs a, Show a) => Show (IxSet ixs a) where+ showsPrec prec = showsPrec prec . toSet++instance (Indexable ixs a, Read a) => Read (IxSet ixs a) where+ readsPrec n = map (first fromSet) . readsPrec n++instance (Indexable ixs a, SafeCopy a) => SafeCopy (IxSet ixs a) where+ putCopy = contain . safePut . toList+ getCopy = contain $ fmap fromList safeGet++instance (All NFData ixs, NFData a) => NFData (IxList ixs a) where+ rnf Nil = ()+ rnf (x ::: xs) = rnf x `seq` rnf xs++instance (All NFData ixs, NFData a) => NFData (IxSet ixs a) where+ rnf (IxSet a ixs) = rnf a `seq` rnf ixs++instance Indexable ixs a => Monoid (IxSet ixs a) where+ mempty = empty+ mappend = union++instance Foldable (IxSet ixs) where+ fold = Fold.fold . toSet+ foldMap f = Fold.foldMap f . toSet+ foldr f z = Fold.foldr f z . toSet+ foldl f z = Fold.foldl f z . toSet++-- TODO: Do we need SYBWC?+{-+instance ( SYBWC.Data ctx a+ , SYBWC.Data ctx [a]+ , SYBWC.Sat (ctx (IxSet a))+ , SYBWC.Sat (ctx [a])+ , Indexable a+ , Data a+ , Ord a+ )+ => SYBWC.Data ctx (IxSet a) where+ gfoldl _ f z ixset = z fromList `f` toList ixset+ toConstr _ (IxSet _) = ixSetConstr+ gunfold _ k z c = case SYBWC.constrIndex c of+ 1 -> k (z fromList)+ _ -> error "IxSet.SYBWC.Data.gunfold unexpected match"+ dataTypeOf _ _ = ixSetDataType++ixSetConstr :: SYBWC.Constr+ixSetConstr = SYBWC.mkConstr ixSetDataType "IxSet" [] SYBWC.Prefix+ixSetDataType :: SYBWC.DataType+ixSetDataType = SYBWC.mkDataType "IxSet" [ixSetConstr]+-}++-- TODO: Do we need Default?+{- FIXME+instance (Indexable a, Ord a,Data a, Default a) => Default (IxSet a) where+ defaultValue = empty+-}++--------------------------------------------------------------------------+-- 'IxSet' construction+--------------------------------------------------------------------------++-- | Create an 'IxSet' using a set and a number of indices. If you want to -- use this in the 'Indexable' 'empty' method, better use 'mkEmpty' instead. -- -- Note that this function takes a variable number of arguments.@@ -293,8 +420,8 @@ ixSet :: MkIxSet ixs ixs a r => Set a -> r ixSet s = ixSet' (IxSet s) --- | Create an empty 'IxSet' using a number of indexes. Useful in the 'Indexable'--- 'empty' method. Use 'ixFun' and 'ixGen' for the individual indexes.+-- | Create an empty 'IxSet' using a number of indices. Useful in the 'Indexable'+-- 'empty' method. Use 'ixFun' and 'ixGen' for the individual indices. -- -- Note that this function takes a variable number of arguments. -- Here are some example types at which the function can be used:@@ -328,20 +455,19 @@ ixSet' acc ix = ixSet' (\ x -> acc (ix ::: x)) -- | Create a functional index. Provided function should return a list--- of indexes where the value should be found.+-- of indices where the value should be found. -- -- > getIndexes :: Type -> [IndexType]--- > getIndexes value = [...indexes...]+-- > getIndexes value = [...indices...] -- -- > instance Indexable '[IndexType] Type where -- > empty = mkEmpty (ixFun getIndexes) ----- This is the recommended way to create indexes.+-- This is the recommended way to create indices. -- ixFun :: Ord ix => (a -> [ix]) -> Ix ix a ixFun = Ix Map.empty - -- | 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.@@ -355,70 +481,12 @@ ixGen :: forall proxy a ix. (Ord ix, Data a, Typeable ix) => proxy ix -> Ix ix a ixGen _proxy = ixFun (flatten :: a -> [ix]) -{--showTypeOf :: (Typeable a) => a -> String-showTypeOf x = showsPrec 11 (typeOf x) []--}--instance Indexable ixs a => Eq (IxSet ixs a) where- IxSet a _ == IxSet b _ = a == b--instance Indexable ixs a => Ord (IxSet ixs a) where- compare (IxSet a _) (IxSet b _) = compare a b--{- FIXME-instance Version (IxSet a)-instance (Serialize a, Ord a, Typeable a, Indexable a) => Serialize (IxSet a) where- putCopy = contain . safePut . toList- getCopy = contain $ liftM fromList safeGet--}--instance (Indexable ixs a, SafeCopy a) => SafeCopy (IxSet ixs a) where- putCopy = contain . safePut . toList- getCopy = contain $ fmap fromList safeGet--{--instance ( SYBWC.Data ctx a- , SYBWC.Data ctx [a]- , SYBWC.Sat (ctx (IxSet a))- , SYBWC.Sat (ctx [a])- , Indexable a- , Data a- , Ord a- )- => SYBWC.Data ctx (IxSet a) where- gfoldl _ f z ixset = z fromList `f` toList ixset- toConstr _ (IxSet _) = ixSetConstr- gunfold _ k z c = case SYBWC.constrIndex c of- 1 -> k (z fromList)- _ -> error "IxSet.SYBWC.Data.gunfold unexpected match"- dataTypeOf _ _ = ixSetDataType--ixSetConstr :: SYBWC.Constr-ixSetConstr = SYBWC.mkConstr ixSetDataType "IxSet" [] SYBWC.Prefix-ixSetDataType :: SYBWC.DataType-ixSetDataType = SYBWC.mkDataType "IxSet" [ixSetConstr]--}--{- FIXME-instance (Indexable a, Ord a,Data a, Default a) => Default (IxSet a) where- defaultValue = empty--}-instance (Indexable ixs a, Show a) => Show (IxSet ixs a) where- showsPrec prec = showsPrec prec . toSet--instance (Indexable ixs a, Read a) => Read (IxSet ixs a) where- readsPrec n = map (first fromSet) . readsPrec n---- | Defines objects that can be members of 'IxSet'.-class (All Ord ixs, Ord a) => Indexable ixs a where- -- | Defines what an empty 'IxSet' for this particular type should look- -- like. It should have all necessary indexes. Use the 'mkEmpty'- -- function to create the set and fill it in with 'ixFun' and 'ixGen'.- empty :: IxSet ixs a+--------------------------------------------------------------------------+-- 'IxSet' construction via Template Haskell+-------------------------------------------------------------------------- --- | Function to be used for 'calcs' in 'inferIxSet' when you don't--- want any calculated values.+-- | Function to be used as third argument in 'inferIxSet'+-- when you don't want any calculated values. noCalcs :: t -> () noCalcs _ = () @@ -426,17 +494,24 @@ -- 'Indexable' instance from a data type, e.g. -- -- > data Foo = Foo Int String+-- > deriving (Eq, Ord, Data, Typeable) -- -- and ----- > $(inferIxSet "FooDB" ''Foo 'noCalcs [''Int,''String])+-- > inferIxSet "FooDB" ''Foo 'noCalcs [''Int, ''String] ----- will build a type synonym+-- will define: -- -- > type FooDB = IxSet '[Int, String] Foo+-- > instance Indexable '[Int, String] Foo where+-- > ... ----- with @Int@ and @String@ as indexes.+-- with @Int@ and @String@ as indices defined via --+-- > ixFun (flattenWithCalcs noCalcs)+--+-- each.+-- -- /WARNING/: This function uses 'flattenWithCalcs' for index generation, -- which in turn uses an SYB type-based traversal. It is often more efficient -- (and sometimes more correct) to explicitly define the indices using@@ -490,14 +565,6 @@ tyVarBndrToName (PlainTV nm) = nm tyVarBndrToName (KindedTV nm _) = nm --- modification operations--type SetOp =- forall a. Ord a => a -> Set a -> Set a--type IndexOp =- forall k a. (Ord k,Ord a) => k -> a -> Map k (Set a) -> Map k (Set a)- -- | Generically traverses the argument to find all occurences of -- values of type @b@ and returns them as a list. --@@ -521,11 +588,21 @@ flattenWithCalcs :: (Data c,Typeable a, Data a, Typeable b) => (a -> c) -> a -> [b] flattenWithCalcs calcs x = flatten (x,calcs x) +--------------------------------------------------------------------------+-- Modification of 'IxSet's+--------------------------------------------------------------------------++type SetOp =+ forall a. Ord a => a -> Set a -> Set a++type IndexOp =+ forall k a. (Ord k,Ord a) => k -> a -> Map k (Set a) -> Map k (Set a)+ -- | Higher order operator for modifying 'IxSet's. Use this when your -- final function should have the form @a -> 'IxSet' a -> 'IxSet' a@, -- e.g. 'insert' or 'delete'.-change :: forall ixs a. (Indexable ixs a) =>- SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a+change :: forall ixs a. Indexable ixs a+ => SetOp -> IndexOp -> a -> IxSet ixs a -> IxSet ixs a change opS opI x (IxSet a indexes) = IxSet (opS x a) v where v :: IxList ixs a@@ -541,8 +618,8 @@ index' :: Map ix (Set a) index' = List.foldl' ii index ds -insertList :: forall ixs a. (Indexable ixs a)- => [a] -> IxSet ixs a -> IxSet ixs a+insertList :: forall ixs a. Indexable ixs a+ => [a] -> IxSet ixs a -> IxSet ixs a insertList xs (IxSet a indexes) = IxSet (List.foldl' (\ b x -> Set.insert x b) a xs) v where v :: IxList ixs a@@ -589,7 +666,7 @@ ix :: Map ix (Set a) ix = Ix.insertList dss partialindex - -- Update function for all other indexes.+ -- Update function for all other indices. updatet :: forall ix'. Ord ix' => Ix ix' a -> Ix ix' a updatet (Ix _ f) = Ix ix f where@@ -626,10 +703,12 @@ deleteIx i ixset = maybe ixset (flip delete ixset) $ getOne $ ixset @= i --- conversion operations+--------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------- -- | Converts an 'IxSet' to a 'Set' of its elements.-toSet :: Ord a => IxSet ixs a -> Set a+toSet :: IxSet ixs a -> Set a toSet (IxSet a _) = a -- | Converts a 'Set' to an 'IxSet'.@@ -641,11 +720,11 @@ fromList list = insertList list empty -- | Returns the number of unique items in the 'IxSet'.-size :: Ord a => IxSet ixs a -> Int+size :: IxSet ixs a -> Int size = Set.size . toSet -- | Converts an 'IxSet' to its list of elements.-toList :: Ord a => IxSet ixs a -> [a]+toList :: IxSet ixs a -> [a] toList = Set.toList . toSet -- | Converts an 'IxSet' to its list of elements.@@ -679,7 +758,9 @@ null :: IxSet ixs a -> Bool null (IxSet a _) = Set.null a --- set operations+--------------------------------------------------------------------------+-- Set operations+-------------------------------------------------------------------------- -- | An infix 'intersection' operation. (&&&) :: Indexable ixs a => IxSet ixs a -> IxSet ixs a -> IxSet ixs a@@ -706,7 +787,9 @@ (zipWithIxList (\ (Ix a f) (Ix b _) -> Ix (Ix.intersection a b) f) x1 x2) -- TODO: function is taken from the first --- query operators+--------------------------------------------------------------------------+-- Query operations+-------------------------------------------------------------------------- -- | Infix version of 'getEQ'. (@=) :: (Indexable ixs a, IsIndexOf ix ixs)@@ -733,22 +816,22 @@ => IxSet ixs a -> ix -> IxSet ixs a ix @>= v = getGTE v ix --- | Returns the subset with indexes in the open interval (k,k).+-- | Returns the subset with indices in the open interval (k,k). (@><) :: (Indexable ixs a, IsIndexOf ix ixs) => IxSet ixs a -> (ix, ix) -> IxSet ixs a ix @>< (v1,v2) = getLT v2 $ getGT v1 ix --- | Returns the subset with indexes in [k,k).+-- | Returns the subset with indices in [k,k). (@>=<) :: (Indexable ixs a, IsIndexOf ix ixs) => IxSet ixs a -> (ix, ix) -> IxSet ixs a ix @>=< (v1,v2) = getLT v2 $ getGTE v1 ix --- | Returns the subset with indexes in (k,k].+-- | Returns the subset with indices in (k,k]. (@><=) :: (Indexable ixs a, IsIndexOf ix ixs) => IxSet ixs a -> (ix, ix) -> IxSet ixs a ix @><= (v1,v2) = getLTE v2 $ getGT v1 ix --- | Returns the subset with indexes in [k,k].+-- | Returns the subset with indices in [k,k]. (@>=<=) :: (Indexable ixs a, IsIndexOf ix ixs) => IxSet ixs a -> (ix, ix) -> IxSet ixs a ix @>=<= (v1,v2) = getLTE v2 $ getGTE v1 ix@@ -758,7 +841,7 @@ => IxSet ixs a -> [ix] -> IxSet ixs a ix @+ list = List.foldl' union empty $ map (ix @=) list --- | Creates the subset that matches all the provided indexes.+-- | Creates the subset that matches all the provided indices. (@*) :: (Indexable ixs a, IsIndexOf ix ixs) => IxSet ixs a -> [ix] -> IxSet ixs a ix @* list = List.foldl' intersection ix $ map (ix @=) list@@ -806,7 +889,7 @@ => ix -> ix -> IxSet ixs a -> IxSet ixs a getRange k1 k2 ixset = getGTE k1 (getLT k2 ixset) --- | Returns lists of elements paired with the indexes determined by+-- | Returns lists of elements paired with the indices determined by -- type inference. groupBy :: forall ix ixs a. IsIndexOf ix ixs => IxSet ixs a -> [(ix, [a])] groupBy (IxSet _ indexes) = f (access indexes)@@ -814,7 +897,7 @@ f :: Ix ix a -> [(ix, [a])] f (Ix index _) = map (second Set.toList) (Map.toList index) --- | Returns lists of elements paired with the indexes determined by+-- | Returns lists of elements paired with the indices determined by -- type inference. -- -- The resulting list will be sorted in ascending order by 'ix'.@@ -825,7 +908,7 @@ f :: Ix ix a -> [(ix, [a])] f (Ix index _) = map (second Set.toAscList) (Map.toAscList index) --- | Returns lists of elements paired with the indexes determined by+-- | Returns lists of elements paired with the indices determined by -- type inference. -- -- The resulting list will be sorted in descending order by 'ix'.@@ -840,8 +923,6 @@ f :: Ix ix a -> [(ix, [a])] f (Ix index _) = map (second Set.toAscList) (Map.toDescList index) ---query impl function- -- | A function for building up selectors on 'IxSet's. Used in the -- various get* functions. The set must be indexed over key type, -- doing otherwise results in runtime error.@@ -880,35 +961,28 @@ Just eqset -> Map.insertWith Set.union v eqset ltgt Nothing -> ltgt -{---Optimization todo:--* can we avoid rebuilding the collection every time we query?- does laziness take care of everything?--* nicer operators?--* nice way to do updates that doesn't involve reinserting the entire data--* can we index on xpath rather than just type?----}--instance (Indexable ixs a) => Monoid (IxSet ixs a) where- mempty = empty- mappend = union+-- Optimization todo:+--+-- * can we avoid rebuilding the collection every time we query?+-- does laziness take care of everything?+--+-- * nicer operators?+--+-- * nice way to do updates that doesn't involve reinserting the entire data+--+-- * can we index on xpath rather than just type? -- | Statistics about 'IxSet'. This function returns quadruple -- consisting of -- -- 1. total number of elements in the set--- 2. number of declared indexes--- 3. number of keys in all indexes--- 4. number of values in all keys in all indexes.+-- 2. number of declared indices+-- 3. number of keys in all indices+-- 4. number of values in all keys in all indices. -- -- This can aid you in debugging and optimisation. ---stats :: (Indexable ixs a) => IxSet ixs a -> (Int,Int,Int,Int)+stats :: Indexable ixs a => IxSet ixs a -> (Int,Int,Int,Int) stats (IxSet a ixs) = (no_elements,no_indexes,no_keys,no_values) where no_elements = Set.size a
src/Data/IxSet/Typed/Ix.hs view
@@ -21,6 +21,7 @@ ) where +import Control.DeepSeq -- import Data.Generics hiding (GT) -- import qualified Data.Generics.SYB.WithClass.Basics as SYBWC import qualified Data.List as List@@ -35,6 +36,9 @@ -- values (of type 'a') for that key. data Ix (ix :: *) (a :: *) where Ix :: Map ix (Set a) -> (a -> [ix]) -> Ix ix a++instance (NFData ix, NFData a) => NFData (Ix ix a) where+ rnf (Ix m f) = rnf m `seq` f `seq` () -- deriving instance Typeable (Ix ix a)
+ tests/Data/IxSet/Typed/Tests.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, OverlappingInstances, UndecidableInstances, TemplateHaskell, DataKinds, FlexibleInstances, MultiParamTypeClasses, TypeOperators #-}+{-# OPTIONS_GHC -fdefer-type-errors -fno-warn-orphans #-}++-- TODO (only if SYBWC is added again):+-- Check that the SYBWC Data instance for IxSet works, by testing+-- that going to and from XML works.++module Data.IxSet.Typed.Tests where++import Control.Monad+import Control.Exception+import Data.Data (Data, Typeable)+import Data.IxSet.Typed as IxSet+import Data.Maybe+import qualified Data.Set as Set+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++data Foo+ = Foo String Int+ deriving (Eq, Ord, Show, Data, Typeable)++data FooX+ = Foo1 String Int+ | Foo2 Int+ deriving (Eq, Ord, Show, Data, Typeable)++data NoIdxFoo+ = NoIdxFoo Int+ deriving (Eq, Ord, Show, Data, Typeable)++data BadlyIndexed+ = BadlyIndexed Int+ deriving (Eq, Ord, Show, Data, Typeable)++data MultiIndex+ = MultiIndex String Int Integer (Maybe Int) (Either Bool Char)+ | MultiIndexSubset Int Bool String+ deriving (Eq, Ord, Show, Data, Typeable)++data Triple+ = Triple Int Int Int+ deriving (Eq, Ord, Show, Data, Typeable)++data S+ = S String+ deriving (Eq, Ord, Show, Data, Typeable)++data G a b+ = G a b+ deriving (Eq, Ord, Show, Data, Typeable)++fooCalcs :: Foo -> String+fooCalcs (Foo s _) = s ++ "bar"++inferIxSet "FooXs" ''FooX 'noCalcs [''Int, ''String]+inferIxSet "BadlyIndexeds" ''BadlyIndexed 'noCalcs [''String]+inferIxSet "MultiIndexed" ''MultiIndex 'noCalcs [''String, ''Int, ''Integer, ''Bool, ''Char]+inferIxSet "Triples" ''Triple 'noCalcs [''Int]+inferIxSet "Gs" ''G 'noCalcs [''Int]+inferIxSet "Foos" ''Foo 'fooCalcs [''String, ''Int]++instance Indexable '[Int] S where+ empty = mkEmpty (ixFun (\ (S x) -> [length x]))++ixSetCheckMethodsOnDefault :: TestTree+ixSetCheckMethodsOnDefault =+ testGroup "check methods on default" $+ [ testCase "size is zero" $+ 0 @=? size (IxSet.empty :: Foos)+ , testCase "getOne returns Nothing" $+ Nothing @=? getOne (IxSet.empty :: Foos)+ , testCase "getOneOr returns default" $+ Foo1 "" 44 @=? getOneOr (Foo1 "" 44) (IxSet.empty :: FooXs)+ , testCase "toList returns []" $+ [] @=? toList (IxSet.empty :: Foos)+ ]++foox_a :: FooX+foox_a = Foo1 "abc" 10+foox_b :: FooX+foox_b = Foo1 "abc" 20+foox_c :: FooX+foox_c = Foo2 10+foox_d :: FooX+foox_d = Foo2 20+foox_e :: FooX+foox_e = Foo2 30++foox_set_abc :: FooXs+foox_set_abc = insert foox_a $ insert foox_b $ insert foox_c $ IxSet.empty+foox_set_cde :: FooXs+foox_set_cde = insert foox_e $ insert foox_d $ insert foox_c $ IxSet.empty++ixSetCheckSetMethods :: TestTree+ixSetCheckSetMethods =+ testGroup "check set methods" $+ [ testCase "size abc is 3" $+ 3 @=? size foox_set_abc+ , testCase "size cde is 3" $+ 3 @=? size foox_set_cde+ , testCase "getOne returns Nothing" $+ Nothing @=? getOne foox_set_abc+ , testCase "getOneOr returns default" $+ Foo1 "" 44 @=? getOneOr (Foo1 "" 44) foox_set_abc+ , testCase "toList returns 3 element list" $+ 3 @=? length (toList foox_set_abc)+ ]++isError :: a -> Assertion+isError x = do+ r <- try (return $! x)+ case r of+ Left (ErrorCall _) -> return ()+ Right _ -> assertFailure $ "Exception expected, but call was successful."++badIndexSafeguard :: TestTree+badIndexSafeguard =+ testGroup "bad index safeguard" $+ [ -- TODO: the following is no longer an error. find a replacement test?+ -- testCase "check if there is error when no first index on value" $+ -- isError (size (insert (BadlyIndexed 123) empty :: BadlyIndexeds)) -- TODO: type sig now necessary+ -- TODO / GOOD: this is a type error now+ testCase "check if indexing with missing index" $+ isError (getOne (foox_set_cde @= True)) -- TODO: should actually verify it's a type error+ ]++testTriple :: TestTree+testTriple =+ testGroup "Triple"+ [ testCase "check if we can find element" $+ 1 @=? size ((insert (Triple 1 2 3) empty :: Triples) -- TODO: type sig now necessary+ @= (1::Int) @= (2::Int))+ ]+++instance Arbitrary Foo where+ arbitrary = liftM2 Foo arbitrary arbitrary++instance (Arbitrary a, Indexable (ix ': ixs) a)+ => Arbitrary (IxSet (ix ': ixs) a) where+ arbitrary = liftM fromList arbitrary++prop_sizeEqToListLength :: Foos -> Bool+prop_sizeEqToListLength ixset = size ixset == length (toList ixset)++sizeEqToListLength :: TestTree+sizeEqToListLength =+ testProperty "size === length . toList" $ prop_sizeEqToListLength++prop_union :: Foos -> Foos -> Bool+prop_union ixset1 ixset2 =+ toSet (ixset1 `union` ixset2) == toSet ixset1 `Set.union` toSet ixset2++prop_intersection :: Foos -> Foos -> Bool+prop_intersection ixset1 ixset2 =+ toSet (ixset1 `intersection` ixset2) ==+ toSet ixset1 `Set.intersection` toSet ixset2++prop_any :: Foos -> [Int] -> Bool+prop_any ixset idxs =+ (ixset @+ idxs) == foldr union empty (map ((@=) ixset) idxs)++prop_all :: Foos -> [Int] -> Bool+prop_all ixset idxs =+ (ixset @* idxs) == foldr intersection ixset (map ((@=) ixset) idxs)++setOps :: TestTree+setOps = testGroup "set operations" $+ [ testProperty "distributivity toSet / union" $ prop_union+ , testProperty "distributivity toSet / intersection" $ prop_intersection+ , testProperty "any (@+)" $ prop_any+ , testProperty "all (@*)" $ prop_all+ ]++prop_opers :: Foos -> Int -> Bool+prop_opers ixset intidx =+ and [ (lt `union` eq) == lteq+ , (gt `union` eq) == gteq+ -- this works for Foo as an Int field is in every Foo value+ , (gt `union` eq `union` lt) == ixset+-- , (neq `intersection` eq) == empty+ ]+ where+-- neq = ixset @/= intidx+ eq = ixset @= intidx+ lt = ixset @< intidx+ gt = ixset @> intidx+ lteq = ixset @<= intidx+ gteq = ixset @>= intidx++opers :: TestTree+opers = testProperty "query operators" $ prop_opers++prop_sureelem :: Foos -> Foo -> Bool+prop_sureelem ixset foo@(Foo _string intidx) =+ not (IxSet.null eq ) &&+ not (IxSet.null lteq) &&+ not (IxSet.null gteq)+ where+ ixset' = insert foo ixset+ eq = ixset' @= intidx+ lteq = ixset' @<= intidx+ gteq = ixset' @>= intidx++sureelem :: TestTree+sureelem = testProperty "query / insert interaction" $ prop_sureelem++prop_ranges :: Foos -> Int -> Int -> Bool+prop_ranges ixset intidx1 intidx2 =+ ((ixset @>< (intidx1,intidx2)) == (gt1 &&& lt2)) &&+ ((ixset @>=< (intidx1,intidx2)) == ((gt1 ||| eq1) &&& lt2)) &&+ ((ixset @><= (intidx1,intidx2)) == (gt1 &&& (lt2 ||| eq2))) &&+ ((ixset @>=<= (intidx1,intidx2)) == ((gt1 ||| eq1) &&& (lt2 ||| eq2)))+ where+ eq1 = ixset @= intidx1+ _lt1 = ixset @< intidx1+ gt1 = ixset @> intidx1+ eq2 = ixset @= intidx2+ lt2 = ixset @< intidx2+ _gt2 = ixset @> intidx2++ranges :: TestTree+ranges = testProperty "ranges" $ prop_ranges++funSet :: IxSet '[Int] S+funSet = IxSet.fromList [S "", S "abc", S "def", S "abcde"]++funIndexes :: TestTree+funIndexes =+ testGroup "ixFun indices" $+ [ testCase "has zero length element" $+ 1 @=? size (funSet @= (0 :: Int))+ , testCase "has two lengh 3 elements" $+ 2 @=? size (funSet @= (3 :: Int))+ , testCase "has three lengh [3;7] elements" $+ 3 @=? size (funSet @>=<= (3 :: Int, 7 :: Int))+ ]++bigSet :: Int -> MultiIndexed+bigSet n = fromList $+ [ MultiIndex string int integer maybe_int either_bool_char |+ string <- ["abc", "def", "ghi", "jkl"],+ int <- [1..n],+ integer <- [10000..10010],+ maybe_int <- [Nothing, Just 5, Just 6],+ either_bool_char <- [Left True, Left False, Right 'A', Right 'B']] +++ [ MultiIndexSubset int bool string |+ string <- ["abc", "def", "ghi"],+ int <- [1..n],+ bool <- [True, False]]++findElementX :: MultiIndexed -> Int -> Bool+findElementX set n = isJust $ getOne (set @+ ["abc","def","ghi"]+ @>=<= (10000 :: Integer,10010 :: Integer)+ @= (True :: Bool)+ @= (n `div` n)+ @= "abc"+ @= (10000 :: Integer)+ @= (5 :: Int))++findElement :: Int -> Int -> Bool+findElement n m = all id ([findElementX set k | k <- [1..n]])+ where set = bigSet m++multiIndexed :: TestTree+multiIndexed =+ testGroup "MultiIndexed" $+ [ testCase "find an element" (True @=? findElement 1 1)+ ]++allTests :: TestTree+allTests =+ testGroup "ixset-typed tests" $+ [ testGroup "unit tests" $+ [ ixSetCheckMethodsOnDefault+ , ixSetCheckSetMethods+ , badIndexSafeguard+ , multiIndexed+ , testTriple+ , funIndexes+ ]+ , testGroup "properties" $+ [ sizeEqToListLength+ , setOps+ , opers+ , sureelem+ , ranges+ ]+ ]
+ tests/TestIxSetTyped.hs view
@@ -0,0 +1,7 @@+module Main where++import Test.Tasty+import Data.IxSet.Typed.Tests (allTests)++main :: IO ()+main = defaultMain allTests