git.iko.soy/typeable/bloodhound
on 31-search-hits-monoid help sign in
typeable/bloodhound/tests/tests.hs
652 lines 27 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Main where
7import Control.Applicative
8import Control.Monad
9import Control.Monad.Reader
10import Data.Aeson
11import qualified Data.HashMap.Strict as HM
12import Data.List (nub)
13import Data.List.NonEmpty (NonEmpty (..))
14import qualified Data.List.NonEmpty as NE
15import qualified Data.Map.Strict as M
16import Data.Text (Text)
17import qualified Data.Text as T
18import Data.Time.Calendar (Day (..))
19import Data.Time.Clock (UTCTime (..),
20 secondsToDiffTime)
21import qualified Data.Vector as V
22import Database.Bloodhound
23import GHC.Generics (Generic)
24import Network.HTTP.Client
25import qualified Network.HTTP.Types.Status as NHTS
26import Prelude hiding (filter, putStrLn)
27import Test.Hspec
28import Test.QuickCheck.Property.Monoid
30import Test.Hspec.QuickCheck (prop)
31import Test.QuickCheck
33testServer :: Server
34testServer = Server "http://localhost:9200"
35testIndex :: IndexName
36testIndex = IndexName "bloodhound-tests-twitter-1"
37testMapping :: MappingName
38testMapping = MappingName "tweet"
40withTestEnv :: BH IO a -> IO a
41withTestEnv = withBH defaultManagerSettings testServer
43validateStatus :: Response body -> Int -> Expectation
44validateStatus resp expected =
45 (NHTS.statusCode $ responseStatus resp)
46 `shouldBe` (expected :: Int)
48createExampleIndex :: BH IO Reply
49createExampleIndex = createIndex defaultIndexSettings testIndex
50deleteExampleIndex :: BH IO Reply
51deleteExampleIndex = deleteIndex testIndex
53data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
55es14 :: ServerVersion
56es14 = ServerVersion 1 4 0
58es13 :: ServerVersion
59es13 = ServerVersion 1 3 0
61es12 :: ServerVersion
62es12 = ServerVersion 1 2 0
64es11 :: ServerVersion
65es11 = ServerVersion 1 1 0
67es10 :: ServerVersion
68es10 = ServerVersion 1 0 0
70serverBranch :: ServerVersion -> ServerVersion
71serverBranch (ServerVersion majorVer minorVer patchVer) =
72 ServerVersion majorVer minorVer patchVer
74mkServerVersion :: [Int] -> Maybe ServerVersion
75mkServerVersion [majorVer, minorVer, patchVer] =
76 Just (ServerVersion majorVer minorVer patchVer)
77mkServerVersion _ = Nothing
79getServerVersion :: IO (Maybe ServerVersion)
80getServerVersion = liftM extractVersion (withTestEnv getStatus)
81 where
82 version' = T.splitOn "." . number . version
83 toInt = read . T.unpack
84 parseVersion v = map toInt (version' v)
85 extractVersion = join . liftM (mkServerVersion . parseVersion)
87testServerBranch :: IO (Maybe ServerVersion)
88testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
90atleast :: ServerVersion -> IO Bool
91atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
93atmost :: ServerVersion -> IO Bool
94atmost v = testServerBranch >>= \x -> return $ x <= Just (serverBranch v)
96is :: ServerVersion -> IO Bool
97is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
99when' :: Monad m => m Bool -> m () -> m ()
100when' b f = b >>= \x -> when x f
102data Location = Location { lat :: Double
103 , lon :: Double } deriving (Eq, Generic, Show)
105data Tweet = Tweet { user :: Text
106 , postDate :: UTCTime
107 , message :: Text
108 , age :: Int
109 , location :: Location }
110 deriving (Eq, Generic, Show)
112instance ToJSON Tweet
113instance FromJSON Tweet
114instance ToJSON Location
115instance FromJSON Location
117data TweetMapping = TweetMapping deriving (Eq, Show)
119instance ToJSON TweetMapping where
120 toJSON TweetMapping =
121 object ["tweet" .=
122 object ["properties" .=
123 object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
125exampleTweet :: Tweet
126exampleTweet = Tweet { user = "bitemyapp"
127 , postDate = UTCTime
128 (ModifiedJulianDay 55000)
129 (secondsToDiffTime 10)
130 , message = "Use haskell!"
131 , age = 10000
132 , location = Location 40.12 (-71.34) }
134otherTweet :: Tweet
135otherTweet = Tweet { user = "notmyapp"
136 , postDate = UTCTime
137 (ModifiedJulianDay 55000)
138 (secondsToDiffTime 11)
139 , message = "Use haskell!"
140 , age = 1000
141 , location = Location 40.12 (-71.34) }
143insertData :: BH IO ()
144insertData = do
145 _ <- deleteExampleIndex
146 _ <- createExampleIndex
147 _ <- putMapping testIndex testMapping TweetMapping
148 _ <- indexDocument testIndex testMapping exampleTweet (DocId "1")
149 _ <- refreshIndex testIndex
150 return ()
152insertOther :: BH IO ()
153insertOther = do
154 _ <- indexDocument testIndex testMapping otherTweet (DocId "2")
155 _ <- refreshIndex testIndex
156 return ()
158searchTweet :: Search -> BH IO (Either String Tweet)
159searchTweet search = do
160 reply <- searchByIndex testIndex search
161 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
162 let myTweet = fmap (hitSource . head . hits . searchHits) result
163 return myTweet
165searchExpectNoResults :: Search -> BH IO ()
166searchExpectNoResults search = do
167 reply <- searchByIndex testIndex search
168 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
169 let emptyHits = fmap (hits . searchHits) result
170 liftIO $
171 emptyHits `shouldBe` Right []
173searchExpectAggs :: Search -> BH IO ()
174searchExpectAggs search = do
175 reply <- searchAll search
176 let isEmpty x = return (M.null x)
177 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
178 liftIO $
179 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
181searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
182searchValidBucketAgg search aggKey extractor = do
183 reply <- searchAll search
184 let bucketDocs = docCount . head . buckets
185 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
186 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
187 liftIO $
188 count `shouldBe` Just 1
190searchTermsAggHint :: [ExecutionHint] -> BH IO ()
191searchTermsAggHint hints = do
192 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
193 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
194 forM_ hints $ searchExpectAggs . search
195 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
197searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight))
198searchTweetHighlight search = do
199 reply <- searchByIndex testIndex search
200 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
201 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
202 return myHighlight
204data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
205instance FromJSON BulkTest
206instance ToJSON BulkTest
208noDuplicates :: Eq a => [a] -> Bool
209noDuplicates xs = nub xs == xs
211instance Arbitrary RegexpFlags where
212 arbitrary = oneof [ pure AllRegexpFlags
213 , pure NoRegexpFlags
214 , SomeRegexpFlags <$> arbitrary
215 ]
217instance Arbitrary a => Arbitrary (NonEmpty a) where
218 arbitrary = liftA2 (:|) arbitrary arbitrary
220instance Arbitrary RegexpFlag where
221 arbitrary = oneof [ pure AnyString
222 , pure Automaton
223 , pure Complement
224 , pure Empty
225 , pure Intersection
226 , pure Interval
227 ]
229arbitraryScore :: Gen Score
230arbitraryScore = fmap getPositive <$> arbitrary
232instance Arbitrary Text where
233 arbitrary = T.pack <$> arbitrary
235instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where
236 arbitrary = M.fromList <$> arbitrary
238instance Arbitrary IndexName where
239 arbitrary = IndexName <$> arbitrary
241instance Arbitrary MappingName where
242 arbitrary = MappingName <$> arbitrary
244instance Arbitrary DocId where
245 arbitrary = DocId <$> arbitrary
247instance Arbitrary a => Arbitrary (Hit a) where
248 arbitrary = Hit <$> arbitrary
249 <*> arbitrary
250 <*> arbitrary
251 <*> arbitraryScore
252 <*> arbitrary
253 <*> arbitrary
256instance Arbitrary a => Arbitrary (SearchHits a) where
257 arbitrary = sized $ \n -> resize (n `div` 2) $ do
258 tot <- getPositive <$> arbitrary
259 score <- arbitraryScore
260 hs <- arbitrary
261 return $ SearchHits tot score hs
263main :: IO ()
264main = hspec $ do
266 describe "index create/delete API" $ do
267 it "creates and then deletes the requested index" $ withTestEnv $ do
268 -- priming state.
269 _ <- deleteExampleIndex
270 resp <- createExampleIndex
271 deleteResp <- deleteExampleIndex
272 liftIO $ do
273 validateStatus resp 200
274 validateStatus deleteResp 200
277 describe "document API" $ do
278 it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
279 _ <- insertData
280 docInserted <- getDocument testIndex testMapping (DocId "1")
281 let newTweet = eitherDecode
282 (responseBody docInserted) :: Either String (EsResult Tweet)
283 liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)
286 describe "bulk API" $ do
287 it "inserts all documents we request" $ withTestEnv $ do
288 _ <- insertData
289 let firstTest = BulkTest "blah"
290 let secondTest = BulkTest "bloo"
291 let firstDoc = BulkIndex testIndex
292 testMapping (DocId "2") (toJSON firstTest)
293 let secondDoc = BulkCreate testIndex
294 testMapping (DocId "3") (toJSON secondTest)
295 let stream = V.fromList [firstDoc, secondDoc]
296 _ <- bulk stream
297 _ <- refreshIndex testIndex
298 fDoc <- getDocument testIndex testMapping (DocId "2")
299 sDoc <- getDocument testIndex testMapping (DocId "3")
300 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
301 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
302 liftIO $ do
303 fmap _source maybeFirst `shouldBe` Right firstTest
304 fmap _source maybeSecond `shouldBe` Right secondTest
307 describe "query API" $ do
308 it "returns document for term query and identity filter" $ withTestEnv $ do
309 _ <- insertData
310 let query = TermQuery (Term "user" "bitemyapp") Nothing
311 let filter = IdentityFilter <&&> IdentityFilter
312 let search = mkSearch (Just query) (Just filter)
313 myTweet <- searchTweet search
314 liftIO $
315 myTweet `shouldBe` Right exampleTweet
317 it "returns document for terms query and identity filter" $ withTestEnv $ do
318 _ <- insertData
319 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])
320 let filter = IdentityFilter <&&> IdentityFilter
321 let search = mkSearch (Just query) (Just filter)
322 myTweet <- searchTweet search
323 liftIO $
324 myTweet `shouldBe` Right exampleTweet
326 it "returns document for match query" $ withTestEnv $ do
327 _ <- insertData
328 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
329 let search = mkSearch (Just query) Nothing
330 myTweet <- searchTweet search
331 liftIO $
332 myTweet `shouldBe` Right exampleTweet
334 it "returns document for multi-match query" $ withTestEnv $ do
335 _ <- insertData
336 let fields = [FieldName "user", FieldName "message"]
337 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
338 let search = mkSearch (Just query) Nothing
339 myTweet <- searchTweet search
340 liftIO $
341 myTweet `shouldBe` Right exampleTweet
343 it "returns document for bool query" $ withTestEnv $ do
344 _ <- insertData
345 let innerQuery = QueryMatchQuery $
346 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
347 let query = QueryBoolQuery $
348 mkBoolQuery [innerQuery] [] []
349 let search = mkSearch (Just query) Nothing
350 myTweet <- searchTweet search
351 liftIO $
352 myTweet `shouldBe` Right exampleTweet
354 it "returns document for boosting query" $ withTestEnv $ do
355 _ <- insertData
356 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
357 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
358 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
359 let search = mkSearch (Just query) Nothing
360 myTweet <- searchTweet search
361 liftIO $
362 myTweet `shouldBe` Right exampleTweet
364 it "returns document for common terms query" $ withTestEnv $ do
365 _ <- insertData
366 let query = QueryCommonTermsQuery $
367 CommonTermsQuery (FieldName "user")
368 (QueryString "bitemyapp")
369 (CutoffFrequency 0.0001)
370 Or Or Nothing Nothing Nothing Nothing
371 let search = mkSearch (Just query) Nothing
372 myTweet <- searchTweet search
373 liftIO $
374 myTweet `shouldBe` Right exampleTweet
377 describe "sorting" $ do
378 it "returns documents in the right order" $ withTestEnv $ do
379 _ <- insertData
380 _ <- insertOther
381 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
382 let search = Search Nothing
383 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
384 False (From 0) (Size 10)
385 reply <- searchByIndex testIndex search
386 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
387 let myTweet = fmap (hitSource . head . hits . searchHits) result
388 liftIO $
389 myTweet `shouldBe` Right otherTweet
392 describe "filtering API" $ do
393 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
394 _ <- insertData
395 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
396 <&&> IdentityFilter
397 let search = mkSearch Nothing (Just queryFilter)
398 myTweet <- searchTweet search
399 liftIO $
400 myTweet `shouldBe` Right exampleTweet
402 it "returns document for term filter" $ withTestEnv $ do
403 _ <- insertData
404 let termFilter = TermFilter (Term "user" "bitemyapp") False
405 let search = mkSearch Nothing (Just termFilter)
406 myTweet <- searchTweet search
407 liftIO $
408 myTweet `shouldBe` Right exampleTweet
410 it "returns document for existential filter" $ withTestEnv $ do
411 _ <- insertData
412 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
413 myTweet <- searchTweet search
414 liftIO $
415 myTweet `shouldBe` Right exampleTweet
417 it "returns document for geo boundingbox filter" $ withTestEnv $ do
418 _ <- insertData
419 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
420 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
421 let geoFilter = GeoBoundingBoxFilter bbConstraint
422 let search = mkSearch Nothing (Just geoFilter)
423 myTweet <- searchTweet search
424 liftIO $
425 myTweet `shouldBe` Right exampleTweet
427 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
428 _ <- insertData
429 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
430 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
431 let geoFilter = GeoBoundingBoxFilter bbConstraint
432 let search = mkSearch Nothing (Just geoFilter)
433 searchExpectNoResults search
435 it "returns document for geo distance filter" $ withTestEnv $ do
436 _ <- insertData
437 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
438 let distance = Distance 10.0 Miles
439 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
440 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
441 let search = mkSearch Nothing (Just geoFilter)
442 myTweet <- searchTweet search
443 liftIO $
444 myTweet `shouldBe` Right exampleTweet
446 it "returns document for geo distance range filter" $ withTestEnv $ do
447 _ <- insertData
448 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
449 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
450 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
451 let search = mkSearch Nothing (Just geoFilter)
452 myTweet <- searchTweet search
453 liftIO $
454 myTweet `shouldBe` Right exampleTweet
456 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
457 _ <- insertData
458 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
459 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
460 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
461 let search = mkSearch Nothing (Just geoFilter)
462 searchExpectNoResults search
464 it "returns document for geo polygon filter" $ withTestEnv $ do
465 _ <- insertData
466 let points = [LatLon 40.0 (-70.00),
467 LatLon 40.0 (-72.00),
468 LatLon 41.0 (-70.00),
469 LatLon 41.0 (-72.00)]
470 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
471 let search = mkSearch Nothing (Just geoFilter)
472 myTweet <- searchTweet search
473 liftIO $
474 myTweet `shouldBe` Right exampleTweet
476 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
477 _ <- insertData
478 let points = [LatLon 40.0 (-70.00),
479 LatLon 40.0 (-71.00),
480 LatLon 41.0 (-70.00),
481 LatLon 41.0 (-71.00)]
482 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
483 let search = mkSearch Nothing (Just geoFilter)
484 searchExpectNoResults search
486 it "returns document for ids filter" $ withTestEnv $ do
487 _ <- insertData
488 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
489 let search = mkSearch Nothing (Just filter)
490 myTweet <- searchTweet search
491 liftIO $
492 myTweet `shouldBe` Right exampleTweet
494 it "returns document for Double range filter" $ withTestEnv $ do
495 _ <- insertData
496 let filter = RangeFilter (FieldName "age")
497 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
498 RangeExecutionIndex False
499 let search = mkSearch Nothing (Just filter)
500 myTweet <- searchTweet search
501 liftIO $
502 myTweet `shouldBe` Right exampleTweet
504 it "returns document for UTCTime date filter" $ withTestEnv $ do
505 _ <- insertData
506 let filter = RangeFilter (FieldName "postDate")
507 (RangeDateGtLt
508 (GreaterThanD (UTCTime
509 (ModifiedJulianDay 55000)
510 (secondsToDiffTime 9)))
511 (LessThanD (UTCTime
512 (ModifiedJulianDay 55000)
513 (secondsToDiffTime 11))))
514 RangeExecutionIndex False
515 let search = mkSearch Nothing (Just filter)
516 myTweet <- searchTweet search
517 liftIO $
518 myTweet `shouldBe` Right exampleTweet
521 it "returns document for regexp filter" $ withTestEnv $ do
522 _ <- insertData
523 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
524 AllRegexpFlags (CacheName "test") False (CacheKey "key")
525 let search = mkSearch Nothing (Just filter)
526 myTweet <- searchTweet search
527 liftIO $
528 myTweet `shouldBe` Right exampleTweet
530 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
531 _ <- insertData
532 let filter = RegexpFilter (FieldName "user")
533 (Regexp "boy") AllRegexpFlags
534 (CacheName "test") False (CacheKey "key")
535 let search = mkSearch Nothing (Just filter)
536 searchExpectNoResults search
538 describe "Aggregation API" $ do
539 it "returns term aggregation results" $ withTestEnv $ do
540 _ <- insertData
541 let terms = TermsAgg $ mkTermsAggregation "user"
542 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
543 searchExpectAggs search
544 searchValidBucketAgg search "users" toTerms
546 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
547 _ <- insertData
548 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
549 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
550 searchExpectAggs search
551 searchValidBucketAgg search "users" toTerms
553 it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
554 _ <- insertData
555 searchTermsAggHint [Map, Ordinals]
557 it "can give execution hint paramters to term aggregations" $ when' (is es12) $ withTestEnv $ do
558 _ <- insertData
559 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
561 it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
562 _ <- insertData
563 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
565 it "returns date histogram aggregation results" $ withTestEnv $ do
566 _ <- insertData
567 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
568 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
569 searchExpectAggs search
570 searchValidBucketAgg search "byDate" toDateHistogram
572 it "returns date histogram using fractional date" $ withTestEnv $ do
573 _ <- insertData
574 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
575 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
576 let intervals = periods ++ fractionals
577 let histogram = mkDateHistogram (FieldName "postDate")
578 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
579 let expect interval = searchExpectAggs (search interval)
580 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
581 forM_ intervals expect
582 forM_ intervals valid
584 describe "Highlights API" $ do
586 it "returns highlight from query when there should be one" $ withTestEnv $ do
587 _ <- insertData
588 _ <- insertOther
589 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
590 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
592 let search = mkHighlightSearch (Just query) testHighlight
593 myHighlight <- searchTweetHighlight search
594 liftIO $
595 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
597 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
598 _ <- insertData
599 _ <- insertOther
600 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
601 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
603 let search = mkHighlightSearch (Just query) testHighlight
604 myHighlight <- searchTweetHighlight search
605 liftIO $
606 myHighlight `shouldBe` Right Nothing
610 describe "ToJSON RegexpFlags" $ do
611 it "generates the correct JSON for AllRegexpFlags" $
612 toJSON AllRegexpFlags `shouldBe` String "ALL"
614 it "generates the correct JSON for NoRegexpFlags" $
615 toJSON NoRegexpFlags `shouldBe` String "NONE"
617 it "generates the correct JSON for SomeRegexpFlags" $
618 let flags = AnyString :| [ Automaton
619 , Complement
620 , Empty
621 , Intersection
622 , Interval ]
623 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
625 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
626 let String str = toJSON flags
627 flagStrs = T.splitOn "|" str
628 in noDuplicates flagStrs
630 describe "omitNulls" $ do
631 it "checks that omitNulls drops list elements when it should" $
632 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
633 , "test2" .= (toJSON ("some value" :: Text))]
634 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
636 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
637 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
638 , "test2" .= (toJSON ("some value" :: Text))]
639 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
640 , ("test2", String "some value")])
641 it "checks that omitNulls drops non list elements when it should" $
642 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
643 , "test2" .= (toJSON ("some value" :: Text))]
644 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
645 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
646 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
647 , "test2" .= (toJSON ("some value" :: Text))]
648 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
649 , ("test2", String "some value")])
650 describe "Monoid (SearchHits a)" $ do
651 prop "abides the monoid laws" $ eq $
652 prop_Monoid (T :: T (SearchHits ()))