ixset 1.0.7 → 1.1

raw patch · 5 files changed

+320/−7 lines, 5 filesdep +Cabaldep +HUnitdep +QuickCheckdep ~basedep ~containersnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal, HUnit, QuickCheck, ixset, random, semigroups

Dependency ranges changed: base, containers

API changes (from Hackage documentation)

Files

• ixset.cabal +19/−3
• src/Data/IxSet.hs +7/−3
• src/Data/IxSet/Ix.hs +1/−1
• tests/Data/IxSet/Tests.hs +279/−0
• tests/Test.hs +14/−0

@@ -1,5 +1,5 @@ Name:                ixset-Version:             1.0.7+Version:             1.1 Synopsis:            Efficient relational queries on Haskell sets. Description:     Create and query sets that are indexed by multiple indices.@@ -10,8 +10,8 @@ homepage:            http://happstack.com Category:            Data Structures Build-Type:          Simple-Cabal-Version:       >= 1.8-tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1+Cabal-Version:       >= 1.10+tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2  source-repository head     type:     git@@ -25,6 +25,8 @@   else     Build-Depends:     base < 4 +  if impl(ghc < 8.4)+    build-depends: semigroups == 0.18.*   if impl(ghc >= 6.12.1)     Build-Depends:    syb-with-class >= 0.6.1   else@@ -44,4 +46,18 @@      ghc-options:      -Wall -fno-warn-unused-do-bind   else      ghc-options:      -Wall+  default-language: Haskell2010 +Test-Suite test-ixset+    Default-Language:    Haskell2010+    type: exitcode-stdio-1.0+    main-is: Test.hs+    other-modules: Data.IxSet.Tests+    hs-source-dirs:    tests+    build-depends:     base,+                       Cabal >= 1.10,+                       containers,+                       HUnit,+                       ixset,+                       QuickCheck,+                       random

@@ -135,6 +135,8 @@      (@>=<=),      (@+),      (@*),+     getOrd,+     getOrd2,      getEQ,      getLT,      getGT,@@ -171,7 +173,7 @@ import qualified Data.Set       as Set import           Data.Typeable  (Typeable, cast, typeOf) import Language.Haskell.TH      as TH-+import           Data.Semigroup  ------------------------------------------------- -- Type proxies@@ -258,7 +260,7 @@          , SYBWC.Data ctx [a]          , SYBWC.Sat (ctx (IxSet a))          , SYBWC.Sat (ctx [a])-         , SYBWC.Typeable1 IxSet+         , SYBWC.Typeable IxSet          , Indexable a          , Data a          , Ord a@@ -793,7 +795,9 @@ * can we index on xpath rather than just type?  --}-+instance (Indexable a, Typeable a, Ord a) => Semigroup (IxSet a) where+    (<>) = union+     instance (Indexable a, Typeable a, Ord a) => Monoid (IxSet a) where     mempty = empty     mappend = union

@@ -52,7 +52,7 @@ ixDataType :: SYBWC.DataType ixDataType = SYBWC.mkDataType "Ix" [ixConstr] -instance (SYBWC.Typeable1 Ix, SYBWC.Data ctx a, SYBWC.Sat (ctx (Ix a)))+instance (SYBWC.Typeable Ix, SYBWC.Data ctx a, SYBWC.Sat (ctx (Ix a)))        => SYBWC.Data ctx (Ix a) where     gfoldl _ _ _ _ = error "gfoldl Ix" :: w (Ix a)     toConstr _ (Ix _ _)    = ixConstr

@@ -0,0 +1,279 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, OverlappingInstances, UndecidableInstances, TemplateHaskell, KindSignatures #-}++-- Check that the SYBWC Data instance for IxSet works, by testing+-- that going to and from XML works.++module Data.IxSet.Tests where++import           Control.Monad+import           Control.Exception as E+import           Data.Data         as Data+import           Data.IxSet        as IxSet+import           Data.Map          (Map)+import qualified Data.Map          as Map+import           Data.Maybe+import           Data.Set          (Set)+import qualified Data.Set          as Set+import           System.Random+import           Test.HUnit        (Test,(~:),(@=?), test)+import qualified Test.HUnit        as HU+import           Test.QuickCheck+import qualified Test.QuickCheck   as QC++qccheck :: QC.Testable a => QC.Args -> a -> HU.Test+qccheck args prop =+  HU.TestCase $+    do result <- QC.quickCheckWithResult args prop+       case result of+         (QC.Success {}) -> return ()+         (QC.GaveUp {}) ->+             let ntest = QC.numTests result+             in HU.assertFailure $ "Arguments exhausted after" ++ show ntest ++ (if ntest == 1 then " test." else " tests.")+         (QC.Failure {}) -> HU.assertFailure (QC.reason result)+         (QC.NoExpectedFailure {}) -> HU.assertFailure $ "No Expected Failure"++qctest :: QC.Testable a => a -> HU.Test+qctest = qccheck QC.stdArgs+++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)+++$(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])++fooCalcs (Foo s _) = s ++ "bar"+$(inferIxSet "Foos" ''Foo 'fooCalcs [''String, ''Int])+++instance Indexable S where+    empty =  ixSet [ ixFun (\(S x) -> [length x])+                   ]+    -- calcs _ = ()++ixSetCheckMethodsOnDefault :: Test+ixSetCheckMethodsOnDefault = "ixSetCheckMethodsOnDefault" ~: test+   [ "size is zero" ~: 0 @=?+     size (IxSet.empty :: Foos)+   , "getOne returns Nothing" ~:+     Nothing @=? getOne (IxSet.empty :: Foos)+   , "getOneOr returns default" ~:+     Foo1 "" 44 @=? getOneOr (Foo1 "" 44) IxSet.empty+   , "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 :: Test+ixSetCheckSetMethods = "ixSetCheckSetMethods" ~: test+   [ "size abc is 3" ~: 3 @=?+     size foox_set_abc+   , "size cde is 3" ~: 3 @=?+     size foox_set_cde+   , "getOne returns Nothing" ~:+     Nothing @=? getOne foox_set_abc+   , "getOneOr returns default" ~:+     Foo1 "" 44 @=? getOneOr (Foo1 "" 44) foox_set_abc+   , "toList returns 3 element list" ~:+     3 @=? length (toList foox_set_abc)+   ]++isError :: a -> IO Bool+isError x = (x `seq` return False) `E.catch` \(ErrorCall _) -> return True++badIndexSafeguard :: Test+badIndexSafeguard = "badIndexSafeguard" ~: test+                    [ "check if there is error when no first index on value" ~:+                      isError (size $ insert (BadlyIndexed 123) empty)+                    , "check if indexing with missing index" ~:+                      isError (getOne (foox_set_cde @= True))+                    ]++testTriple :: Test+testTriple = "testTriple" ~: test+             [ "check if we can find element" ~:+               1 @=? size ((insert (Triple 1 2 3) empty)+                           @= (1::Int) @= (2::Int))+             ]+++instance Arbitrary Foo where+    arbitrary = liftM2 Foo arbitrary arbitrary++instance (Arbitrary a,Data.Data a, Ord a, Indexable a) =>+    Arbitrary (IxSet a) where+    arbitrary = liftM fromList arbitrary++prop_sizeEqToListLength :: Foos -> Bool+prop_sizeEqToListLength ixset = size ixset == length (toList ixset)++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_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++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++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+++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)++funSet :: IxSet S+funSet = IxSet.fromList [S "", S "abc", S "def", S "abcde"]++funIndexes :: Test+funIndexes = "funIndexes" ~: test+   [ "has zero length element" ~: 1 @=?+     size (funSet @= (0 :: Int))+   , "has two lengh 3 elements" ~: 2 @=?+     size (funSet @= (3 :: Int))+   , "has three lengh [3;7] elements" ~: 3 @=?+     size (funSet @>=<= (3 :: Int, 7 :: Int))+   ]++allTests :: [Test]+allTests =+    [ ixSetCheckMethodsOnDefault+    , ixSetCheckSetMethods+    , badIndexSafeguard+    , test (True @=? findElement 1 1)+    , testTriple+    , funIndexes+    , "prop_sizeEqToListLength" ~: qctest prop_sizeEqToListLength+    , "prop_union"              ~: qctest prop_union+    , "prop_union"              ~: qctest prop_intersection+    , "prop_opers"              ~: qctest prop_opers+    , "prop_sureelem"           ~: qctest prop_sureelem+    , "prop_ranges"             ~: qctest prop_ranges+    , "prop_any"                ~: qctest prop_any+    , "prop_all"                ~: qctest prop_all+    ]++++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

@@ -0,0 +1,14 @@+module Main where++import Data.IxSet.Tests (allTests)+import Prelude hiding (catch)+import Test.HUnit (failures, runTestTT)+import qualified Test.HUnit as HUnit+import System.Exit (exitFailure)+import qualified System.Exit as Exit+import Test.HUnit+import Test.HUnit.Text++main = do+    count <- HUnit.runTestTT (TestList allTests)+    if HUnit.failures count > 0 then Exit.exitFailure else return ()