git.iko.soy/typeable/bloodhound
on 26-bhenv help sign in
typeable/bloodhound/tests/tests.hs
613 lines 25 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
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 (..), secondsToDiffTime)
20import qualified Data.Vector as V
21import Database.Bloodhound
22import GHC.Generics (Generic)
23import Network.HTTP.Client
24import qualified Network.HTTP.Types.Status as NHTS
25import Prelude hiding (filter, putStrLn)
26import Test.Hspec
28import Test.Hspec.QuickCheck (prop)
29import Test.QuickCheck
31testServer :: Server
32testServer = Server "http://localhost:9200"
33testIndex :: IndexName
34testIndex = IndexName "bloodhound-tests-twitter-1"
35testMapping :: MappingName
36testMapping = MappingName "tweet"
38withTestEnv :: BH IO a -> IO a
39withTestEnv = withBH defaultManagerSettings testServer
41validateStatus :: Response body -> Int -> Expectation
42validateStatus resp expected =
43 (NHTS.statusCode $ responseStatus resp)
44 `shouldBe` (expected :: Int)
46createExampleIndex :: BH IO Reply
47createExampleIndex = createIndex defaultIndexSettings testIndex
48deleteExampleIndex :: BH IO Reply
49deleteExampleIndex = deleteIndex testIndex
51data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
53es14 :: ServerVersion
54es14 = ServerVersion 1 4 0
56es13 :: ServerVersion
57es13 = ServerVersion 1 3 0
59es12 :: ServerVersion
60es12 = ServerVersion 1 2 0
62es11 :: ServerVersion
63es11 = ServerVersion 1 1 0
65es10 :: ServerVersion
66es10 = ServerVersion 1 0 0
68serverBranch :: ServerVersion -> ServerVersion
69serverBranch (ServerVersion majorVer minorVer patchVer) =
70 ServerVersion majorVer minorVer patchVer
72mkServerVersion :: [Int] -> Maybe ServerVersion
73mkServerVersion [majorVer, minorVer, patchVer] =
74 Just (ServerVersion majorVer minorVer patchVer)
75mkServerVersion _ = Nothing
77getServerVersion :: IO (Maybe ServerVersion)
78getServerVersion = liftM extractVersion (withTestEnv getStatus)
79 where
80 version' = T.splitOn "." . number . version
81 toInt = read . T.unpack
82 parseVersion v = map toInt (version' v)
83 extractVersion = join . liftM (mkServerVersion . parseVersion)
85testServerBranch :: IO (Maybe ServerVersion)
86testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
88atleast :: ServerVersion -> IO Bool
89atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
91atmost :: ServerVersion -> IO Bool
92atmost v = testServerBranch >>= \x -> return $ x <= Just (serverBranch v)
94is :: ServerVersion -> IO Bool
95is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
97when' :: Monad m => m Bool -> m () -> m ()
98when' b f = b >>= \x -> when x f
100data Location = Location { lat :: Double
101 , lon :: Double } deriving (Eq, Generic, Show)
103data Tweet = Tweet { user :: Text
104 , postDate :: UTCTime
105 , message :: Text
106 , age :: Int
107 , location :: Location }
108 deriving (Eq, Generic, Show)
110instance ToJSON Tweet
111instance FromJSON Tweet
112instance ToJSON Location
113instance FromJSON Location
115data TweetMapping = TweetMapping deriving (Eq, Show)
117instance ToJSON TweetMapping where
118 toJSON TweetMapping =
119 object ["tweet" .=
120 object ["properties" .=
121 object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
123exampleTweet :: Tweet
124exampleTweet = Tweet { user = "bitemyapp"
125 , postDate = UTCTime
126 (ModifiedJulianDay 55000)
127 (secondsToDiffTime 10)
128 , message = "Use haskell!"
129 , age = 10000
130 , location = Location 40.12 (-71.34) }
132otherTweet :: Tweet
133otherTweet = Tweet { user = "notmyapp"
134 , postDate = UTCTime
135 (ModifiedJulianDay 55000)
136 (secondsToDiffTime 11)
137 , message = "Use haskell!"
138 , age = 1000
139 , location = Location 40.12 (-71.34) }
141insertData :: BH IO ()
142insertData = do
143 _ <- deleteExampleIndex
144 _ <- createExampleIndex
145 _ <- putMapping testIndex testMapping TweetMapping
146 _ <- indexDocument testIndex testMapping exampleTweet (DocId "1")
147 _ <- refreshIndex testIndex
148 return ()
150insertOther :: BH IO ()
151insertOther = do
152 _ <- indexDocument testIndex testMapping otherTweet (DocId "2")
153 _ <- refreshIndex testIndex
154 return ()
156searchTweet :: Search -> BH IO (Either String Tweet)
157searchTweet search = do
158 reply <- searchByIndex testIndex search
159 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
160 let myTweet = fmap (hitSource . head . hits . searchHits) result
161 return myTweet
163searchExpectNoResults :: Search -> BH IO ()
164searchExpectNoResults search = do
165 reply <- searchByIndex testIndex search
166 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
167 let emptyHits = fmap (hits . searchHits) result
168 liftIO $
169 emptyHits `shouldBe` Right []
171searchExpectAggs :: Search -> BH IO ()
172searchExpectAggs search = do
173 reply <- searchAll search
174 let isEmpty x = return (M.null x)
175 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
176 liftIO $
177 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
179searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
180searchValidBucketAgg search aggKey extractor = do
181 reply <- searchAll search
182 let bucketDocs = docCount . head . buckets
183 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
184 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
185 liftIO $
186 count `shouldBe` Just 1
188searchTermsAggHint :: [ExecutionHint] -> BH IO ()
189searchTermsAggHint hints = do
190 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
191 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
192 forM_ hints $ searchExpectAggs . search
193 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
195searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight))
196searchTweetHighlight search = do
197 reply <- searchByIndex testIndex search
198 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
199 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
200 return myHighlight
202data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
203instance FromJSON BulkTest
204instance ToJSON BulkTest
206noDuplicates :: Eq a => [a] -> Bool
207noDuplicates xs = nub xs == xs
209instance Arbitrary RegexpFlags where
210 arbitrary = oneof [ pure AllRegexpFlags
211 , pure NoRegexpFlags
212 , SomeRegexpFlags <$> arbitrary
213 ]
215instance Arbitrary a => Arbitrary (NonEmpty a) where
216 arbitrary = liftA2 (:|) arbitrary arbitrary
218instance Arbitrary RegexpFlag where
219 arbitrary = oneof [ pure AnyString
220 , pure Automaton
221 , pure Complement
222 , pure Empty
223 , pure Intersection
224 , pure Interval
225 ]
227main :: IO ()
228main = hspec $ do
230 describe "index create/delete API" $ do
231 it "creates and then deletes the requested index" $ withTestEnv $ do
232 -- priming state.
233 _ <- deleteExampleIndex
234 resp <- createExampleIndex
235 deleteResp <- deleteExampleIndex
236 liftIO $ do
237 validateStatus resp 200
238 validateStatus deleteResp 200
241 describe "document API" $ do
242 it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
243 _ <- insertData
244 docInserted <- getDocument testIndex testMapping (DocId "1")
245 let newTweet = eitherDecode
246 (responseBody docInserted) :: Either String (EsResult Tweet)
247 liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)
250 describe "bulk API" $ do
251 it "inserts all documents we request" $ withTestEnv $ do
252 _ <- insertData
253 let firstTest = BulkTest "blah"
254 let secondTest = BulkTest "bloo"
255 let firstDoc = BulkIndex testIndex
256 testMapping (DocId "2") (toJSON firstTest)
257 let secondDoc = BulkCreate testIndex
258 testMapping (DocId "3") (toJSON secondTest)
259 let stream = V.fromList [firstDoc, secondDoc]
260 _ <- bulk stream
261 _ <- refreshIndex testIndex
262 fDoc <- getDocument testIndex testMapping (DocId "2")
263 sDoc <- getDocument testIndex testMapping (DocId "3")
264 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
265 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
266 liftIO $ do
267 fmap _source maybeFirst `shouldBe` Right firstTest
268 fmap _source maybeSecond `shouldBe` Right secondTest
271 describe "query API" $ do
272 it "returns document for term query and identity filter" $ withTestEnv $ do
273 _ <- insertData
274 let query = TermQuery (Term "user" "bitemyapp") Nothing
275 let filter = IdentityFilter <&&> IdentityFilter
276 let search = mkSearch (Just query) (Just filter)
277 myTweet <- searchTweet search
278 liftIO $
279 myTweet `shouldBe` Right exampleTweet
281 it "returns document for terms query and identity filter" $ withTestEnv $ do
282 _ <- insertData
283 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])
284 let filter = IdentityFilter <&&> IdentityFilter
285 let search = mkSearch (Just query) (Just filter)
286 myTweet <- searchTweet search
287 liftIO $
288 myTweet `shouldBe` Right exampleTweet
290 it "returns document for match query" $ withTestEnv $ do
291 _ <- insertData
292 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
293 let search = mkSearch (Just query) Nothing
294 myTweet <- searchTweet search
295 liftIO $
296 myTweet `shouldBe` Right exampleTweet
298 it "returns document for multi-match query" $ withTestEnv $ do
299 _ <- insertData
300 let fields = [FieldName "user", FieldName "message"]
301 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
302 let search = mkSearch (Just query) Nothing
303 myTweet <- searchTweet search
304 liftIO $
305 myTweet `shouldBe` Right exampleTweet
307 it "returns document for bool query" $ withTestEnv $ do
308 _ <- insertData
309 let innerQuery = QueryMatchQuery $
310 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
311 let query = QueryBoolQuery $
312 mkBoolQuery [innerQuery] [] []
313 let search = mkSearch (Just query) Nothing
314 myTweet <- searchTweet search
315 liftIO $
316 myTweet `shouldBe` Right exampleTweet
318 it "returns document for boosting query" $ withTestEnv $ do
319 _ <- insertData
320 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
321 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
322 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
323 let search = mkSearch (Just query) Nothing
324 myTweet <- searchTweet search
325 liftIO $
326 myTweet `shouldBe` Right exampleTweet
328 it "returns document for common terms query" $ withTestEnv $ do
329 _ <- insertData
330 let query = QueryCommonTermsQuery $
331 CommonTermsQuery (FieldName "user")
332 (QueryString "bitemyapp")
333 (CutoffFrequency 0.0001)
334 Or Or Nothing Nothing Nothing Nothing
335 let search = mkSearch (Just query) Nothing
336 myTweet <- searchTweet search
337 liftIO $
338 myTweet `shouldBe` Right exampleTweet
341 describe "sorting" $ do
342 it "returns documents in the right order" $ withTestEnv $ do
343 _ <- insertData
344 _ <- insertOther
345 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
346 let search = Search Nothing
347 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
348 False (From 0) (Size 10)
349 reply <- searchByIndex testIndex search
350 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
351 let myTweet = fmap (hitSource . head . hits . searchHits) result
352 liftIO $
353 myTweet `shouldBe` Right otherTweet
356 describe "filtering API" $ do
357 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
358 _ <- insertData
359 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
360 <&&> IdentityFilter
361 let search = mkSearch Nothing (Just queryFilter)
362 myTweet <- searchTweet search
363 liftIO $
364 myTweet `shouldBe` Right exampleTweet
366 it "returns document for term filter" $ withTestEnv $ do
367 _ <- insertData
368 let termFilter = TermFilter (Term "user" "bitemyapp") False
369 let search = mkSearch Nothing (Just termFilter)
370 myTweet <- searchTweet search
371 liftIO $
372 myTweet `shouldBe` Right exampleTweet
374 it "returns document for existential filter" $ withTestEnv $ do
375 _ <- insertData
376 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
377 myTweet <- searchTweet search
378 liftIO $
379 myTweet `shouldBe` Right exampleTweet
381 it "returns document for geo boundingbox filter" $ withTestEnv $ do
382 _ <- insertData
383 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
384 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
385 let geoFilter = GeoBoundingBoxFilter bbConstraint
386 let search = mkSearch Nothing (Just geoFilter)
387 myTweet <- searchTweet search
388 liftIO $
389 myTweet `shouldBe` Right exampleTweet
391 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
392 _ <- insertData
393 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
394 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
395 let geoFilter = GeoBoundingBoxFilter bbConstraint
396 let search = mkSearch Nothing (Just geoFilter)
397 searchExpectNoResults search
399 it "returns document for geo distance filter" $ withTestEnv $ do
400 _ <- insertData
401 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
402 let distance = Distance 10.0 Miles
403 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
404 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
405 let search = mkSearch Nothing (Just geoFilter)
406 myTweet <- searchTweet search
407 liftIO $
408 myTweet `shouldBe` Right exampleTweet
410 it "returns document for geo distance range filter" $ withTestEnv $ do
411 _ <- insertData
412 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
413 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
414 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
415 let search = mkSearch Nothing (Just geoFilter)
416 myTweet <- searchTweet search
417 liftIO $
418 myTweet `shouldBe` Right exampleTweet
420 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
421 _ <- insertData
422 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
423 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
424 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
425 let search = mkSearch Nothing (Just geoFilter)
426 searchExpectNoResults search
428 it "returns document for geo polygon filter" $ withTestEnv $ do
429 _ <- insertData
430 let points = [LatLon 40.0 (-70.00),
431 LatLon 40.0 (-72.00),
432 LatLon 41.0 (-70.00),
433 LatLon 41.0 (-72.00)]
434 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
435 let search = mkSearch Nothing (Just geoFilter)
436 myTweet <- searchTweet search
437 liftIO $
438 myTweet `shouldBe` Right exampleTweet
440 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
441 _ <- insertData
442 let points = [LatLon 40.0 (-70.00),
443 LatLon 40.0 (-71.00),
444 LatLon 41.0 (-70.00),
445 LatLon 41.0 (-71.00)]
446 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
447 let search = mkSearch Nothing (Just geoFilter)
448 searchExpectNoResults search
450 it "returns document for ids filter" $ withTestEnv $ do
451 _ <- insertData
452 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
453 let search = mkSearch Nothing (Just filter)
454 myTweet <- searchTweet search
455 liftIO $
456 myTweet `shouldBe` Right exampleTweet
458 it "returns document for Double range filter" $ withTestEnv $ do
459 _ <- insertData
460 let filter = RangeFilter (FieldName "age")
461 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
462 RangeExecutionIndex False
463 let search = mkSearch Nothing (Just filter)
464 myTweet <- searchTweet search
465 liftIO $
466 myTweet `shouldBe` Right exampleTweet
468 it "returns document for UTCTime date filter" $ withTestEnv $ do
469 _ <- insertData
470 let filter = RangeFilter (FieldName "postDate")
471 (RangeDateGtLt
472 (GreaterThanD (UTCTime
473 (ModifiedJulianDay 55000)
474 (secondsToDiffTime 9)))
475 (LessThanD (UTCTime
476 (ModifiedJulianDay 55000)
477 (secondsToDiffTime 11))))
478 RangeExecutionIndex False
479 let search = mkSearch Nothing (Just filter)
480 myTweet <- searchTweet search
481 liftIO $
482 myTweet `shouldBe` Right exampleTweet
485 it "returns document for regexp filter" $ withTestEnv $ do
486 _ <- insertData
487 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
488 AllRegexpFlags (CacheName "test") False (CacheKey "key")
489 let search = mkSearch Nothing (Just filter)
490 myTweet <- searchTweet search
491 liftIO $
492 myTweet `shouldBe` Right exampleTweet
494 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
495 _ <- insertData
496 let filter = RegexpFilter (FieldName "user")
497 (Regexp "boy") AllRegexpFlags
498 (CacheName "test") False (CacheKey "key")
499 let search = mkSearch Nothing (Just filter)
500 searchExpectNoResults search
502 describe "Aggregation API" $ do
503 it "returns term aggregation results" $ withTestEnv $ do
504 _ <- insertData
505 let terms = TermsAgg $ mkTermsAggregation "user"
506 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
507 searchExpectAggs search
508 searchValidBucketAgg search "users" toTerms
510 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
511 _ <- insertData
512 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
513 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
514 searchExpectAggs search
515 searchValidBucketAgg search "users" toTerms
517 it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
518 _ <- insertData
519 searchTermsAggHint [Map, Ordinals]
521 it "can give execution hint paramters to term aggregations" $ when' (is es12) $ withTestEnv $ do
522 _ <- insertData
523 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
525 it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
526 _ <- insertData
527 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
529 it "returns date histogram aggregation results" $ withTestEnv $ do
530 _ <- insertData
531 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
532 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
533 searchExpectAggs search
534 searchValidBucketAgg search "byDate" toDateHistogram
536 it "returns date histogram using fractional date" $ withTestEnv $ do
537 _ <- insertData
538 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
539 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
540 let intervals = periods ++ fractionals
541 let histogram = mkDateHistogram (FieldName "postDate")
542 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
543 let expect interval = searchExpectAggs (search interval)
544 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
545 forM_ intervals expect
546 forM_ intervals valid
548 describe "Highlights API" $ do
550 it "returns highlight from query when there should be one" $ withTestEnv $ do
551 _ <- insertData
552 _ <- insertOther
553 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
554 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
556 let search = mkHighlightSearch (Just query) testHighlight
557 myHighlight <- searchTweetHighlight search
558 liftIO $
559 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
561 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
562 _ <- insertData
563 _ <- insertOther
564 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
565 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
567 let search = mkHighlightSearch (Just query) testHighlight
568 myHighlight <- searchTweetHighlight search
569 liftIO $
570 myHighlight `shouldBe` Right Nothing
574 describe "ToJSON RegexpFlags" $ do
575 it "generates the correct JSON for AllRegexpFlags" $
576 toJSON AllRegexpFlags `shouldBe` String "ALL"
578 it "generates the correct JSON for NoRegexpFlags" $
579 toJSON NoRegexpFlags `shouldBe` String "NONE"
581 it "generates the correct JSON for SomeRegexpFlags" $
582 let flags = AnyString :| [ Automaton
583 , Complement
584 , Empty
585 , Intersection
586 , Interval ]
587 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
589 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
590 let String str = toJSON flags
591 flagStrs = T.splitOn "|" str
592 in noDuplicates flagStrs
594 describe "omitNulls" $ do
595 it "checks that omitNulls drops list elements when it should" $
596 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
597 , "test2" .= (toJSON ("some value" :: Text))]
598 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
600 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
601 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
602 , "test2" .= (toJSON ("some value" :: Text))]
603 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
604 , ("test2", String "some value")])
605 it "checks that omitNulls drops non list elements when it should" $
606 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
607 , "test2" .= (toJSON ("some value" :: Text))]
608 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
609 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
610 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
611 , "test2" .= (toJSON ("some value" :: Text))]
612 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
613 , ("test2", String "some value")])