7df79cc · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Expand test case for sub aggregation parsing

7df79ccMichael Xavier11 years ago

src/Database/Bloodhound/Types.hs+3−3

compare with master

unifiedsplit

@@ -1786,15 +1786,15 @@ class BucketAggregation a where

1786 aggs :: a -> Maybe AggregationResults

1787

1788

1789−data Bucket a = Bucket { buckets :: [a]} deriving (Show)

1789+data Bucket a = Bucket { buckets :: [a]} deriving (Show, Eq)

1790

1791data BucketValue = TextValue Text

1792 | ScientificValue Scientific

1793− | BoolValue Bool deriving (Show)

1793+ | BoolValue Bool deriving (Show, Eq)

1794

1795data TermsResult = TermsResult { termKey :: BucketValue

1796 , termsDocCount :: Int

1797− , termsAggs :: Maybe AggregationResults } deriving (Show)

1797+ , termsAggs :: Maybe AggregationResults } deriving (Show, Eq)

1798

1799data DateHistogramResult = DateHistogramResult { dateKey :: Int

1800 , dateKeyStr :: Maybe Text

tests/tests.hs+45

@@ -1259,6 +1259,51 @@ main = hspec $ do

1259 liftIO $

1260 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))

1261

1262+ it "can parse sub aggregations" $ withTestEnv $ do

1263+ _ <- insertData

1264+ _ <- insertOther

1265+ let l2 = mkAggregations "level2" (TermsAgg (mkTermsAggregation "user"))

1266+ let l1 = mkAggregations "level1" (TermsAgg ((mkTermsAggregation "age") { termAggs = Just l2 }))

1267+ let search = mkAggregateSearch Nothing l1

1268+ eres <- fmapL show <$> searchTweets search

1269+ let finalResult = do

1270+ res <- eres

1271+ actualAggs <- note "no agg results returned" (aggregations res)

1272+ aggResults <- note "could not parse level1" (toTerms "level1" actualAggs)

1273+ let bucketsByTermKey = [(termKey tr, tr) | tr <- buckets aggResults]

1274+

1275+ nmaResult <- note "could not find notmyapp bucket" (lookup (TextValue "notmyapp") bucketsByTermKey)

1276+ nmaResultAgg <- note "notmyapp result had no aggs" (termsAggs nmaResult)

1277+ nmaBuckets <- note "could not parse notmyapp level2" (toTerms "level2" nmaResultAgg)

1278+ nmaBucket <- note "expected 1 notmyapp bucket" (headMay (buckets nmaBuckets))

1279+

1280+ bmaResult <- note "could not find bitemyapp bucket" (lookup (TextValue "bitemyapp") bucketsByTermKey)

1281+ bmaResultAgg <- note "bitemyapp result had no aggs" (termsAggs bmaResult)

1282+ bmaBuckets <- note "could not parse bitemyapp level2" (toTerms "level2" bmaResultAgg)

1283+ bmaBucket <- note "expected 1 bitemyapp bucket" (headMay (buckets bmaBuckets))

1284+ return (nmaResult, nmaBucket, bmaResult, bmaBucket)

1285+ liftIO $ case finalResult of

1286+ Left e -> expectationFailure e

1287+ Right (nmaResult, nmaBucket, bmaResult, bmaBucket) -> do

1288+ let nmaBucketExpected = TermsResult {

1289+ termKey = TextValue "notmyapp"

1290+ , termsDocCount = 1

1291+ , termsAggs = Nothing

1292+ }

1293+ let bmaBucketExpected = TermsResult {

1294+ termKey = TextValue "bitemyapp"

1295+ , termsDocCount = 1

1296+ , termsAggs = Nothing

1297+ }

1298+ termKey nmaResult `shouldBe` ScientificValue 1000.0

1299+ termsDocCount nmaResult `shouldBe` 1

1300+ nmaBucket `shouldBe` nmaBucketExpected

1301+

1302+ termKey bmaResult `shouldBe` ScientificValue 1000.0

1303+ termsDocCount bmaResult `shouldBe` 1

1304+ bmaBucket `shouldBe` bmaBucketExpected

1305+

1306+

1262 describe "Highlights API" $ do

1307 describe "Highlights API" $ do

1263

1308

1264 it "returns highlight from query when there should be one" $ withTestEnv $ do

1309 it "returns highlight from query when there should be one" $ withTestEnv $ do