git.iko.soy/typeable/bloodhound
on 7131ac8 help sign in
typeable/bloodhound/tests/V1/Test/Aggregation.hs
132 lines 7.1 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module Test.Aggregation (spec) where
5import Test.Common
6import Test.Import
8import Control.Error (fmapL, note)
9import qualified Data.Map as M
10import qualified Database.V1.Bloodhound
12spec :: Spec
13spec =
14 describe "Aggregation API" $ do
15 it "returns term aggregation results" $ withTestEnv $ do
16 _ <- insertData
17 let terms = TermsAgg $ mkTermsAggregation "user"
18 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
19 searchExpectAggs search
20 searchValidBucketAgg search "users" toTerms
22 it "return sub-aggregation results" $ withTestEnv $ do
23 _ <- insertData
24 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
25 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
26 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
27 reply <- searchByIndex testIndex search
28 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
29 usersAggResults = result >>= aggregations >>= toTerms "users"
30 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
31 subAddResultsExists = isJust subAggResults
32 liftIO $ subAddResultsExists `shouldBe` True
34 it "returns cardinality aggregation results" $ withTestEnv $ do
35 _ <- insertData
36 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
37 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
38 let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }
39 searchExpectAggs search'
40 let docCountPair k n = (k, object ["value" .= Number n])
41 res <- searchTweets search'
42 liftIO $
43 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
45 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
46 _ <- insertData
47 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
48 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
49 searchExpectAggs search
50 searchValidBucketAgg search "users" toTerms
52 -- One of these fails with 1.7.3
53 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
54 _ <- insertData
55 searchTermsAggHint [Map, Ordinals]
57 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
58 _ <- insertData
59 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
61 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
62 _ <- insertData
63 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
64 -- One of the above.
66 it "can execute value_count aggregations" $ withTestEnv $ do
67 _ <- insertData
68 _ <- insertOther
69 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
70 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
71 let search = mkAggregateSearch Nothing ags
72 let docCountPair k n = (k, object ["value" .= Number n])
73 res <- searchTweets search
74 liftIO $
75 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
76 , docCountPair "bogus_count" 0
77 ]))
79 it "can execute date_range aggregations" $ withTestEnv $ do
80 let now = fromGregorian 2015 3 14
81 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
82 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
83 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
84 let newDoc = exampleTweet { postDate = ltAWeekAgo }
85 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
86 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
87 _ <- refreshIndex testIndex
88 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
89 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
90 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
91 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
92 let search = mkAggregateSearch Nothing ags
93 res <- searchTweets search
94 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
95 let bucks = do magrs <- fmapL show (aggregations <$> res)
96 agrs <- note "no aggregations returned" magrs
97 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
98 parseEither parseJSON rawBucks
99 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
100 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
101 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
102 (Just fromMonthT)
103 (Just "2015-02-14T00:00:00.000Z")
104 Nothing
105 Nothing
106 2
107 Nothing
108 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
109 (Just fromWeekT)
110 (Just "2015-03-07T00:00:00.000Z")
111 Nothing
112 Nothing
113 1
114 Nothing
115 ]
117 it "returns date histogram aggregation results" $ withTestEnv $ do
118 _ <- insertData
119 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
120 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
121 searchExpectAggs search
122 searchValidBucketAgg search "byDate" toDateHistogram
124 it "can execute missing aggregations" $ withTestEnv $ do
125 _ <- insertData
126 _ <- insertExtra
127 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
128 let search = mkAggregateSearch Nothing ags
129 let docCountPair k n = (k, object ["doc_count" .= Number n])
130 res <- searchTweets search
131 liftIO $
132 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))