diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,61 @@ +0.3 (2014-07-23) +================ + +* `IxSet` internals are now more strict + +* The `empty` method of `Indexable` is now called `indices` and has a slightly + different path; to migrate your code, if you were using Template Haskell, + you probably do not have to change anything. Otherwise, wherever you have + an instance of `Indexable` that looks like this + + instance Indexable MyIndexSet MyType where -- OLD + empty = mkEmpty ... + + change it to + + instance Indexable MyIndexSet MyType where -- NEW + indices = ixList ... + + +0.2 (2014-04-06) +================ + +* Add testsuite (which is a port of the ixset testsuite). + +* Cleaning up and documentation. + +* Add 'Foldable' and 'NFData' instances. + + +0.1.4 (2014-04-03) +================== + +* Documentation. + + +0.1.3 (2014-04-02) +================== + +* Export `IsIndexOf` class. + + +0.1.2 (2014-04-02) +================== + +* Clean up export list. + +* Documentation. + + +0.1.1 (2014-04-02) +================== + +* Clean up export list. + +* Documentation. + + +0.1.0.0 (2014-03-31) +==================== + +* Initial release. diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,30 @@ +Copyright (c) 2014, Well-Typed LLP +Copyright (c) 2006, HAppS.org +All rights reserved. + +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 HAppS.org; nor the names of its 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. diff --git a/ixset-typed.cabal b/ixset-typed.cabal --- a/ixset-typed.cabal +++ b/ixset-typed.cabal @@ -1,5 +1,5 @@ name: ixset-typed -version: 0.2 +version: 0.3 synopsis: Efficient relational queries on Haskell sets. description: This Haskell package provides a data structure of sets that are indexed @@ -19,15 +19,17 @@ of the more precise types, a few manual tweaks are necessary when switching from one to the other, but the interface is mostly the same. license: BSD3 +license-file: COPYING author: Andres Löh, Happstack team, HAppS LLC maintainer: Andres Löh category: Data Structures build-type: Simple cabal-version: >= 1.10 +extra-source-files: CHANGELOG.md source-repository head type: git - location: https://github.com/kosmikus/ixset-typed.git + location: https://github.com/well-typed/ixset-typed.git library build-depends: base >= 4.6 && < 5, diff --git a/src/Data/IxSet/Typed.hs b/src/Data/IxSet/Typed.hs --- a/src/Data/IxSet/Typed.hs +++ b/src/Data/IxSet/Typed.hs @@ -32,11 +32,11 @@ > type IxEntry = IxSet EntryIxs Entry > > instance Indexable EntryIxs Entry where - > empty = mkEmpty - > (ixGen (Proxy :: Proxy Author)) -- out of order - > (ixGen (Proxy :: Proxy Id)) - > (ixGen (Proxy :: Proxy Updated)) - > (ixGen (Proxy :: Proxy Test)) -- bogus index + > indices = ixList + > (ixGen (Proxy :: Proxy Author)) -- out of order + > (ixGen (Proxy :: Proxy Id)) + > (ixGen (Proxy :: Proxy Updated)) + > (ixGen (Proxy :: Proxy Test)) -- bogus index The use of 'ixGen' requires the 'Data' and 'Typeable' instances above. You can build indices manually using 'ixFun'. You can also use the @@ -70,9 +70,9 @@ > > type EntryIxs = '[..., Word] > instance Indexable EntryIxs Entry where - > empty = mkEmpty - > ... - > (ixFun getWords) + > indices = ixList + > ... + > (ixFun getWords) Now you can do this query to find entries with any of the words: @@ -95,9 +95,9 @@ > > type EntryIxs = '[..., FirstAuthor] > instance Indexable EntryIxs Entry where - > empty = mkEmpty - > ... - > (ixFun getFirstAuthor) + > indices = ixList + > ... + > (ixFun getFirstAuthor) > entries @= (FirstAuthor "john@doe.com") -- guess what this does @@ -107,14 +107,14 @@ ( -- * Set type IxSet(), + IxList(), Indexable(..), IsIndexOf(), All, -- ** Declaring indices Ix(), - ixSet, - mkEmpty, - MkIxSet(), + ixList, + MkIxList(), ixFun, ixGen, -- ** TH derivation of indices @@ -132,6 +132,7 @@ deleteIx, -- * Creation + empty, fromSet, fromList, @@ -214,8 +215,16 @@ -- -- The type-level list 'ixs' contains all types that are valid index keys. -- The type 'a' is the type of elements in the indexed set. +-- +-- On strictness: An 'IxSet' is "mostly" spine-strict. It is generally +-- spine-strict in the set itself. All operations on 'IxSet' with the +-- exception of queries are spine-strict in the indices as well. Query +-- operations, however, are lazy in the indices, so querying a number of +-- times and subsequently selecting the result will not unnecessarily +-- rebuild all indices. +-- data IxSet (ixs :: [*]) (a :: *) where - IxSet :: Set a -> IxList ixs a -> IxSet ixs a + IxSet :: !(Set a) -> !(IxList ixs a) -> IxSet ixs a data IxList (ixs :: [*]) (a :: *) where Nil :: IxList '[] a @@ -223,6 +232,12 @@ infixr 5 ::: +-- | A strict variant of ':::'. +(!:::) :: Ix ix a -> IxList ixs a -> IxList (ix ': ixs) a +(!:::) !ix !ixs = ix ::: ixs + +infixr 5 !::: + -- TODO: -- -- We cannot currently derive Typeable for 'IxSet': @@ -266,12 +281,11 @@ -- 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. + -- | Define how the indices for this particular type should look like. -- - -- Use the 'mkEmpty' function to create the set and add indices - -- with 'ixFun' (or 'ixGen'). - empty :: IxSet ixs a + -- Use the 'ixList' function to construct the list of indices, and use + -- 'ixFun' (or 'ixGen') for individual indices. + indices :: IxList ixs a -- | Constraint for membership in the type-level list. Says that 'ix' -- is contained in the index list 'ixs'. @@ -282,6 +296,9 @@ -- | Map over the index list, treating the selected different -- from the rest. + -- + -- The function 'mapAt' is lazy in the index list structure, + -- because it is used by query operations. mapAt :: (All Ord ixs) => (Ix ix a -> Ix ix a) -- ^ what to do with the selected index @@ -324,14 +341,22 @@ mapIxList _ Nil = Nil mapIxList f (x ::: xs) = f x ::: mapIxList f xs --- | 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" +-- | Map over an index list (spine-strict). +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 + +-- | Zip two index lists of compatible type (spine-strict). +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 @@ -406,62 +431,52 @@ -- '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. --- Here are some example types at which the function can be used: --- --- > ixSet :: Set a -> Ix ix1 a -> IxSet '[ix1] a --- > ixSet :: Set a -> Ix ix1 a -> Ix ix2 a -> IxSet '[ix1, ix2] a --- > ixSet :: Set a -> Ix ix1 a -> Ix ix2 a -> Ix ix3 a -> IxSet '[ix1, ix2, ix3] a --- > ixSet :: ... --- -ixSet :: MkIxSet ixs ixs a r => Set a -> r -ixSet s = ixSet' (IxSet s) +-- | An empty 'IxSet'. +empty :: Indexable ixs a => IxSet ixs a +empty = IxSet Set.empty indices --- | Create an empty 'IxSet' using a number of indices. Useful in the 'Indexable' --- 'empty' method. Use 'ixFun' and 'ixGen' for the individual indices. +-- | Create an (empty) 'IxList' from a number of indices. Useful in the 'Indexable' +-- 'indices' 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: -- --- > mkEmpty :: Ix ix1 a -> IxSet '[ix1] a --- > mkEmpty :: Ix ix1 a -> Ix ix2 a -> IxSet '[ix1, ix2] a --- > mkEmpty :: Ix ix1 a -> Ix ix2 a -> Ix ix3 a -> IxSet '[ix1, ix2, ix3] a --- > mkEmpty :: ... +-- > ixList :: Ix ix1 a -> IxList '[ix1] a +-- > ixList :: Ix ix1 a -> Ix ix2 a -> IxList '[ix1, ix2] a +-- > ixList :: Ix ix1 a -> Ix ix2 a -> Ix ix3 a -> IxList '[ix1, ix2, ix3] a +-- > ixList :: ... -- -- Concrete example use: -- -- > instance Indexable '[..., Index1Type, Index2Type] Type where --- > empty = mkEmpty +-- > indices = ixList -- > ... -- > (ixFun getIndex1) -- > (ixGen (Proxy :: Proxy Index2Type)) -- -mkEmpty :: MkIxSet ixs ixs a r => r -mkEmpty = ixSet Set.empty +ixList :: MkIxList ixs ixs a r => r +ixList = ixList' id -- | Class that allows a variable number of arguments to be passed to the -- 'ixSet' and 'mkEmpty' functions. See the documentation of these functions -- for more information. -class MkIxSet ixs ixs' a r | r -> a ixs ixs' where - ixSet' :: (IxList ixs a -> IxSet ixs' a) -> r +class MkIxList ixs ixs' a r | r -> a ixs ixs' where + ixList' :: (IxList ixs a -> IxList ixs' a) -> r -instance MkIxSet '[] ixs a (IxSet ixs a) where - ixSet' acc = acc Nil +instance MkIxList '[] ixs a (IxList ixs a) where + ixList' acc = acc Nil -instance MkIxSet ixs ixs' a r => MkIxSet (ix ': ixs) ixs' a (Ix ix a -> r) where - ixSet' acc ix = ixSet' (\ x -> acc (ix ::: x)) +instance MkIxList ixs ixs' a r => MkIxList (ix ': ixs) ixs' a (Ix ix a -> r) where + ixList' acc ix = ixList' (\ x -> acc (ix ::: x)) -- | Create a functional index. Provided function should return a list -- of indices where the value should be found. -- --- > getIndexes :: Type -> [IndexType] --- > getIndexes value = [...indices...] +-- > getIndices :: Type -> [IndexType] +-- > getIndices value = [...indices...] -- -- > instance Indexable '[IndexType] Type where --- > empty = mkEmpty (ixFun getIndexes) +-- > indices = ixList (ixFun getIndices) -- -- This is the recommended way to create indices. -- @@ -473,7 +488,7 @@ -- their 'Data' instances. -- -- > instance Indexable '[IndexType] Type where --- > empty = mkEmpty (ixGen (Proxy :: Proxy Type)) +-- > indices = ixList (ixGen (Proxy :: Proxy Type)) -- -- In production systems consider using 'ixFun' in place of 'ixGen' as -- the former one is much faster. @@ -555,7 +570,7 @@ typeList = mkTypeList (map conT entryPoints) in do i <- instanceD (fullContext) (conT ''Indexable `appT` typeList `appT` typeCon) - [valD (varP 'empty) (normalB (appsE ([| mkEmpty |] : map mkEntryPoint entryPoints))) []] + [valD (varP 'indices) (normalB (appsE ([| ixList |] : map mkEntryPoint entryPoints))) []] let ixType = conT ''IxSet `appT` typeList `appT` typeCon ixType' <- tySynD (mkName ixset) binders ixType return $ [i, ixType'] -- ++ d @@ -606,7 +621,7 @@ change opS opI x (IxSet a indexes) = IxSet (opS x a) v where v :: IxList ixs a - v = mapIxList update indexes + v = mapIxList' update indexes update :: forall ix. Ord ix => Ix ix a -> Ix ix a update (Ix index f) = Ix index' f @@ -623,7 +638,7 @@ insertList xs (IxSet a indexes) = IxSet (List.foldl' (\ b x -> Set.insert x b) a xs) v where v :: IxList ixs a - v = mapIxList update indexes + v = mapIxList' update indexes update :: forall ix. Ord ix => Ix ix a -> Ix ix a update (Ix index f) = Ix index' f @@ -647,8 +662,8 @@ -- keep new allocations low as much as possible. fromMapOfSets :: forall ixs ix a. (Indexable ixs a, IsIndexOf ix ixs) => Map ix (Set a) -> IxSet ixs a -fromMapOfSets partialindex = case empty of - IxSet _ ixs -> IxSet a (mapAt updateh updatet ixs) +fromMapOfSets partialindex = + IxSet a (mapAt updateh updatet indices) where a :: Set a a = Set.unions (Map.elems partialindex) @@ -703,6 +718,7 @@ deleteIx i ixset = maybe ixset (flip delete ixset) $ getOne $ ixset @= i + -------------------------------------------------------------------------- -- Conversions -------------------------------------------------------------------------- @@ -777,14 +793,14 @@ union :: Indexable ixs a => IxSet ixs a -> IxSet ixs a -> IxSet ixs a union (IxSet a1 x1) (IxSet a2 x2) = IxSet (Set.union a1 a2) - (zipWithIxList (\ (Ix a f) (Ix b _) -> Ix (Ix.union a b) f) x1 x2) + (zipWithIxList' (\ (Ix a f) (Ix b _) -> Ix (Ix.union a b) f) x1 x2) -- TODO: function is taken from the first -- | Takes the intersection of the two 'IxSet's. intersection :: Indexable ixs a => IxSet ixs a -> IxSet ixs a -> IxSet ixs a intersection (IxSet a1 x1) (IxSet a2 x2) = IxSet (Set.intersection a1 a2) - (zipWithIxList (\ (Ix a f) (Ix b _) -> Ix (Ix.intersection a b) f) x1 x2) + (zipWithIxList' (\ (Ix a f) (Ix b _) -> Ix (Ix.intersection a b) f) x1 x2) -- TODO: function is taken from the first -------------------------------------------------------------------------- diff --git a/src/Data/IxSet/Typed/Ix.hs b/src/Data/IxSet/Typed/Ix.hs --- a/src/Data/IxSet/Typed/Ix.hs +++ b/src/Data/IxSet/Typed/Ix.hs @@ -35,7 +35,7 @@ -- | 'Ix' is a 'Map' from some key (of type 'ix') to a 'Set' of -- values (of type 'a') for that key. data Ix (ix :: *) (a :: *) where - Ix :: Map ix (Set a) -> (a -> [ix]) -> Ix ix a + 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` () diff --git a/tests/Data/IxSet/Typed/Tests.hs b/tests/Data/IxSet/Typed/Tests.hs --- a/tests/Data/IxSet/Typed/Tests.hs +++ b/tests/Data/IxSet/Typed/Tests.hs @@ -62,7 +62,7 @@ inferIxSet "Foos" ''Foo 'fooCalcs [''String, ''Int] instance Indexable '[Int] S where - empty = mkEmpty (ixFun (\ (S x) -> [length x])) + indices = ixList (ixFun (\ (S x) -> [length x])) ixSetCheckMethodsOnDefault :: TestTree ixSetCheckMethodsOnDefault =