hunt-searchengine-0.3.0.1: test/Hunt/Strict/Index.hs
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module Hunt.Strict.Index
(indexTests)
where
import Hunt.TestHelper ()
import Hunt.Strict.Helper
import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import Test.QuickCheck.Monadic (PropertyM,
monadicIO,
pick)
import Data.Text (Text)
import Hunt.Common
import qualified Hunt.Common.Positions as Pos
import qualified Hunt.Common.DocIdMap as DM
import qualified Hunt.Common.DocIdSet as DS
import Hunt.Common.IntermediateValue
import qualified Hunt.Index as Ix
import qualified Hunt.Index.InvertedIndex as InvIx
import qualified Hunt.Index.PrefixTreeIndex as PIx
import qualified Hunt.Index.PrefixTreeIndex2Dim as PIx2D
import qualified Hunt.Index.Proxy.KeyIndex as KeyProxy
import qualified Hunt.Index.RTreeIndex as RTree
-- ----------------------------------------------------------------------------
indexTests :: [Test]
indexTests =
-- strictness property for data-structures used in index and
-- document table
[ testProperty "prop_strictness_occurrences" prop_occs
-- strictness property for index implementations by function
-- insert / insertList
, testProperty "prop_strictness insert prefixtreeindex" prop_ptix
, testProperty "prop_strictness insert prefixtreeindex2D" prop_ptix2d
, testProperty "prop_strictness insert textindex" prop_invix1
, testProperty "prop_strictness insert numericindex" prop_invix2
, testProperty "prop_strictness insert dateindex" prop_invix3
, testProperty "prop_strictness insert geoindex" prop_invix4
, testProperty "prop_strictness insert geoindex rtree" prop_insert_rtree
, testProperty "prop_strictness insert proxy" prop_proxy
-- delete / deleteDocs
, testProperty "prop_strictness delete prefixtreeindex" prop_ptix_del
, testProperty "prop_strictness delete prefixtreeindex2D" prop_ptix2d_del
, testProperty "prop_strictness delete textindex" prop_invix1_del
, testProperty "prop_strictness delete numericindex" prop_invix2_del
, testProperty "prop_strictness delete dateindex" prop_invix3_del
, testProperty "prop_strictness delete geoindex" prop_invix4_del
, testProperty "prop_strictness delete geoindex rtree" prop_rtree_del
, testProperty "prop_strictness delete proxy" prop_proxy_del
-- map
, testProperty "prop_strictness map prefixtreeindex" prop_ptix_map
, testProperty "prop_strictness map prefixtreeindex2D" prop_ptix2d_map
, testProperty "prop_strictness map textindex" prop_invix1_map
, testProperty "prop_strictness map numericindex" prop_invix2_map
, testProperty "prop_strictness map dateindex" prop_invix3_map
, testProperty "prop_strictness map geoindex" prop_invix4_map
, testProperty "prop_strictness map geoindex rtree" prop_rtree_map
, testProperty "prop_strictness map proxy" prop_proxy_map
-- mapMaybe
, testProperty "prop_strictness mapMaybe prefixtreeindex" prop_ptix_map2
, testProperty "prop_strictness mapMaybe prefixtreeinde2d" prop_ptix2d_map2
, testProperty "prop_strictness mapMaybe textindex" prop_invix1_map2
, testProperty "prop_strictness mapMaybe numericindex" prop_invix2_map2
, testProperty "prop_strictness mapMaybe dateindex" prop_invix3_map2
, testProperty "prop_strictness mapMaybe geoindex" prop_invix4_map2
, testProperty "prop_strictness mapMaybe geoindex rtree" prop_rtree_map2
, testProperty "prop_strictness mapMaybe proxy" prop_proxy_map2
-- unionWith
, testProperty "prop_strictness unionWith prefixtreeindex" prop_ptix_union
, testProperty "prop_strictness unionWith prefixtreeind2d" prop_ptix2d_union
, testProperty "prop_strictness unionWith textindex" prop_invix1_union
, testProperty "prop_strictness unionWith numericindex" prop_invix2_union
, testProperty "prop_strictness unionWith dateindex" prop_invix3_union
, testProperty "prop_strictness unionWith geoindex" prop_invix4_union
, testProperty "prop_strictness unionWith geoindex rtree" prop_rtree_union
, testProperty "prop_strictness unionWith proxy" prop_proxy_union
]
-- ----------------------------------------------------------------------------
-- test data structures
-- ----------------------------------------------------------------------------
prop_occs :: Property
prop_occs = monadicIO $ do
x <- pick arbitrary :: PropertyM IO Occurrences
assertNF' $! x
-- ----------------------------------------------------------------------------
-- index implementations: insert function
-- ----------------------------------------------------------------------------
prop_ptix :: Property
prop_ptix
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert "key" (toIntermediate (val::Occurrences)) Ix.empty
prop_ptix2d :: Property
prop_ptix2d
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert "11" (toIntermediate (val::Occurrences)) Ix.empty
prop_invix1 :: Property
prop_invix1
= monadicIO $ do
ix <- pickIx :: PropertyM IO (InvIx.InvertedIndex)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert "key" (toIntermediate (val::Occurrences)) Ix.empty
prop_invix2 :: Property
prop_invix2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexInt)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert "1" (toIntermediate (val::Occurrences)) Ix.empty
prop_invix3 :: Property
prop_invix3
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexDate)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert "2013-01-01" (toIntermediate (val::Occurrences)) Ix.empty
prop_invix4 :: Property
prop_invix4
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.PrefixTreeIndexPosition)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert "1-1" (toIntermediate (val::Occurrences)) Ix.empty
prop_insert_rtree :: Property
prop_insert_rtree
= monadicIO $ do
ix <- pickIx :: PropertyM IO (RTree.RTreeIndex Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert (RTree.readPosition "1-1") (toIntermediate (val::Occurrences)) Ix.empty
prop_proxy :: Property
prop_proxy
= monadicIO $ do
ix <- pickIx :: PropertyM IO (KeyProxy.KeyProxyIndex Text (PIx.DmPrefixTree Occurrences))
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> return $ Ix.insert "key" (toIntermediate (val::Occurrences)) Ix.empty
-- ----------------------------------------------------------------------------
-- index implementations: delete function
-- ----------------------------------------------------------------------------
prop_ptix_del :: Property
prop_ptix_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete "key"
prop_ptix2d_del :: Property
prop_ptix2d_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete "11"
prop_invix1_del :: Property
prop_invix1_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (InvIx.InvertedIndex)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete "key"
prop_invix2_del :: Property
prop_invix2_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexInt)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete "1"
prop_invix3_del :: Property
prop_invix3_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexDate)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete "2013-01-01"
prop_invix4_del :: Property
prop_invix4_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.PrefixTreeIndexPosition)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete "1-1"
prop_rtree_del :: Property
prop_rtree_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (RTree.RTreeIndex Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete (RTree.readPosition "1-1")
prop_proxy_del :: Property
prop_proxy_del
= monadicIO $ do
ix <- pickIx :: PropertyM IO (KeyProxy.KeyProxyIndex Text (PIx.DmPrefixTree Occurrences))
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_delete "key"
insert_and_delete :: forall (m :: * -> *) a.
(Ix.ICon a, Monad m, IndexValue (Ix.IVal a), Ix.Index a) =>
Ix.IKey a -> DocIdMap Positions -> m a
insert_and_delete key v
= return $ Ix.delete docId
$ Ix.insert key (toIntermediate (v::Occurrences))
$ Ix.empty
where
docId = case DM.toList v of
((did,_):_) -> did
_ -> mkDocId (0::Int)
-- ----------------------------------------------------------------------------
-- index implementations: map function
-- ----------------------------------------------------------------------------
prop_ptix_map :: Property
prop_ptix_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map "key"
prop_ptix2d_map :: Property
prop_ptix2d_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map "11"
prop_invix1_map :: Property
prop_invix1_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (InvIx.InvertedIndex)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map "key"
prop_invix2_map :: Property
prop_invix2_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexInt)
assertNF' ix
where
pickIx = pick arbitrary >>= \val -> insert_and_map_withSet "1" (val :: DocIdSet)
prop_invix3_map :: Property
prop_invix3_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexDate)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map_withSet "2013-01-01"
prop_invix4_map :: Property
prop_invix4_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.PrefixTreeIndexPosition)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map_withSet "1-1"
prop_rtree_map :: Property
prop_rtree_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (RTree.RTreeIndex Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map (RTree.readPosition "1-1")
prop_proxy_map :: Property
prop_proxy_map
= monadicIO $ do
ix <- pickIx :: PropertyM IO (KeyProxy.KeyProxyIndex Text (PIx.DmPrefixTree Occurrences))
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map "key"
insert_and_map :: forall (m :: * -> *) a.
(Ix.ICon a, Monad m, Ix.Index a, Ix.IVal a ~ DocIdMap Positions) =>
Ix.IKey a -> Occurrences -> m a
insert_and_map key v
= return $ Ix.map (DM.insert (mkDocId (1 :: Int)) (Pos.singleton 1))
$ Ix.insert key (toIntermediate (v::Occurrences)) Ix.empty
insert_and_map_withSet :: forall (m :: * -> *) a.
(Ix.ICon a, Monad m, Ix.Index a, Ix.IVal a ~ DocIdSet) =>
Ix.IKey a -> DocIdSet -> m a
insert_and_map_withSet key v
= return $ Ix.map (DS.union (DS.singleton $ mkDocId (1 :: Int)))
$ Ix.insert key (toIntermediate (v::DocIdSet)) Ix.empty
-- ----------------------------------------------------------------------------
-- index implementations: mapMaybe function
-- ----------------------------------------------------------------------------
prop_ptix_map2 :: Property
prop_ptix_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2 "key"
prop_ptix2d_map2 :: Property
prop_ptix2d_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2 "11"
prop_invix1_map2 :: Property
prop_invix1_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (InvIx.InvertedIndex)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2 "key"
prop_invix2_map2 :: Property
prop_invix2_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexInt)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2_withSet "1"
prop_invix3_map2 :: Property
prop_invix3_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexDate)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2_withSet "2013-01-01"
prop_invix4_map2 :: Property
prop_invix4_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.PrefixTreeIndexPosition)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2_withSet "1-1"
prop_rtree_map2 :: Property
prop_rtree_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (RTree.RTreeIndex Occurrences)
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2 (RTree.readPosition "1-1")
prop_proxy_map2 :: Property
prop_proxy_map2
= monadicIO $ do
ix <- pickIx :: PropertyM IO (KeyProxy.KeyProxyIndex Text (PIx.DmPrefixTree Occurrences))
assertNF' ix
where
pickIx = pick arbitrary >>= insert_and_map2 "key"
insert_and_map2 :: forall (m :: * -> *) a.
(Ix.ICon a, Monad m, Ix.Index a, Ix.IVal a ~ DocIdMap Positions) =>
Ix.IKey a -> Occurrences -> m a
insert_and_map2 key v
= return $ Ix.mapMaybe (Just . DM.insert (mkDocId (1 :: Int)) (Pos.singleton 1))
$ Ix.insert key (toIntermediate (v::Occurrences)) Ix.empty
insert_and_map2_withSet :: forall (m :: * -> *) a.
(Ix.ICon a, Monad m, Ix.Index a, Ix.IVal a ~ DocIdSet) =>
Ix.IKey a -> DocIdSet -> m a
insert_and_map2_withSet key v
= return $ Ix.mapMaybe (Just . DS.union (DS.singleton $ mkDocId (1 :: Int)))
$ Ix.insert key (toIntermediate (v::DocIdSet)) Ix.empty
-- ----------------------------------------------------------------------------
-- index implementations: unionWith function
-- ----------------------------------------------------------------------------
prop_ptix_union :: Property
prop_ptix_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary
val2 <- pick arbitrary
insert_and_union "key" val1 val2
prop_ptix2d_union :: Property
prop_ptix2d_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.DmPrefixTree Occurrences)
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary
val2 <- pick arbitrary
insert_and_union "11" val1 val2
prop_invix1_union :: Property
prop_invix1_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (InvIx.InvertedIndex)
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary
val2 <- pick arbitrary
insert_and_union "key" val1 val2
prop_invix2_union :: Property
prop_invix2_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexInt)
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary
val2 <- pick arbitrary
insert_and_union_withSet "1" val1 val2
prop_invix3_union :: Property
prop_invix3_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx.PrefixTreeIndexDate)
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary :: PropertyM IO DocIdSet
val2 <- pick arbitrary :: PropertyM IO DocIdSet
insert_and_union_withSet "2013-01-01" val1 val2
prop_invix4_union :: Property
prop_invix4_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (PIx2D.PrefixTreeIndexPosition)
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary :: PropertyM IO DocIdSet
val2 <- pick arbitrary :: PropertyM IO DocIdSet
insert_and_union_withSet "1-1" val1 val2
prop_rtree_union :: Property
prop_rtree_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (RTree.RTreeIndex Occurrences)
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary :: PropertyM IO Occurrences
val2 <- pick arbitrary :: PropertyM IO Occurrences
insert_and_union (RTree.readPosition "1-1") val1 val2
prop_proxy_union :: Property
prop_proxy_union
= monadicIO $ do
ix <- pickIx :: PropertyM IO (KeyProxy.KeyProxyIndex Text (PIx.DmPrefixTree Occurrences))
assertNF' ix
where
pickIx = do
val1 <- pick arbitrary :: PropertyM IO Occurrences
val2 <- pick arbitrary :: PropertyM IO Occurrences
insert_and_union "key" val1 val2
insert_and_union :: forall (m :: * -> *) a v.
(Ix.ICon a, Monad m, IndexValue (DocIdMap v), Ix.Index a,
Ix.IVal a ~ DocIdMap v) =>
Ix.IKey a -> Occurrences -> Occurrences -> m a
insert_and_union key v1 v2
= return $ Ix.unionWith (DM.union)
(Ix.insert key (toIntermediate (v1::Occurrences)) Ix.empty)
(Ix.insert key (toIntermediate (v2::Occurrences)) Ix.empty)
insert_and_union_withSet :: forall (m :: * -> *) a.
(Ix.ICon a, Monad m, Ix.Index a, Ix.IVal a ~ DocIdSet) =>
Ix.IKey a -> DocIdSet -> DocIdSet -> m a
insert_and_union_withSet key v1 v2
= return $ Ix.unionWith (DS.union)
(Ix.insert key (toIntermediate (v1::DocIdSet)) Ix.empty)
(Ix.insert key (toIntermediate (v2::DocIdSet)) Ix.empty)