{-# 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