git.iko.soy/typeable/bloodhound
on master help sign in
Merge pull request #27 from bitemyapp/26-bhenv

26 bhenv

commit3939fc6ae15d58cc8ac5111ab727573688fe178b authorChris Allen <cma@bitemyapp.com> dateTue 12 May 2015, 02:33 (11 years ago) parent20ed65b7626b30
6 files changed+588−412
compare with master
unifiedsplit
.travis.yml+1−1 README.md+36−18 bloodhound.cabal+16−7 src/Database/Bloodhound/Client.hs+189−131 src/Database/Bloodhound/Types.hs+219−156 tests/tests.hs+127−99
.travis.yml+1−1
@@ -25,7 +25,7 @@ before_install:
2525 - sudo apt-get install cabal-install-1.20 ghc-$GHCVER
2626 - sudo apt-get install happy-1.19.3
2727 - export PATH=/opt/ghc/$GHCVER/bin:/opt/happy/1.19.3/bin:$PATH
28− - wget https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-$ESVER.deb
28+ - wget --no-check-certificate https://download.elasticsearch.org/elasticsearch/elasticsearch/elasticsearch-$ESVER.deb
2929 - sudo dpkg --force-all -i elasticsearch-$ESVER.deb
3030 - sudo service elasticsearch start
3131
README.md+36−18
@@ -57,6 +57,7 @@ Index Operations
5757
5858:set -XDeriveGeneric
5959:{
60+import Control.Applicative
6061import Database.Bloodhound
6162import Data.Aeson
6263import Data.Either (Either(..))
@@ -72,14 +73,17 @@ import qualified Network.HTTP.Types.Status as NHTS
7273let testServer = (Server "http://localhost:9200")
7374let testIndex = IndexName "twitter"
7475let testMapping = MappingName "tweet"
76+let withBH' = withBH defaultManagerSettings testServer
7577
7678-- defaultIndexSettings is exported by Database.Bloodhound as well
7779let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
7880
79−-- createIndex returns IO Reply
81+-- createIndex returns MonadBH m => m Reply. You can use withBH for
82+ one-off commands or you can use runBH to group together commands
83+ and to pass in your own HTTP manager for pipelining.
8084
8185-- response :: Reply, Reply is a synonym for Network.HTTP.Conduit.Response
82−response <- createIndex testServer defaultIndexSettings testIndex
86+response <- withBH' $ createIndex defaultIndexSettings testIndex
8387:}
8488
8589```
@@ -91,7 +95,7 @@ response <- createIndex testServer defaultIndexSettings testIndex
9195``` {.haskell}
9296
9397-- response :: Reply
94−response <- deleteIndex testServer testIndex
98+response <- withBH' $ deleteIndex testIndex
9599
96100```
97101
@@ -125,7 +129,7 @@ Response {responseStatus = Status {statusCode = 404, statusMessage = "Not Found"
125129
126130``` {.haskell}
127131
128−resp <- refreshIndex testServer testIndex
132+resp <- withBH' $ refreshIndex testIndex
129133
130134```
131135
@@ -168,7 +172,7 @@ instance ToJSON TweetMapping where
168172 object ["type" .= ("geo_point" :: Text)]]]]
169173:}
170174
171−resp <- putMapping testServer testIndex testMapping TweetMapping
175+resp <- withBH' $ putMapping testIndex testMapping TweetMapping
172176
173177```
174178
@@ -176,7 +180,7 @@ resp <- putMapping testServer testIndex testMapping TweetMapping
176180
177181``` {.haskell}
178182
179−resp <- deleteMapping testServer testIndex testMapping
183+resp <- withBH' $ deleteMapping testIndex testMapping
180184
181185```
182186
@@ -221,7 +225,7 @@ instance FromJSON Location
221225-- λ> encode $ Location 10.0 10.0
222226-- "{\"lat\":10,\"lon\":10}"
223227
224−resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
228+resp <- withBH' $ indexDocument testIndex testMapping exampleTweet (DocId "1")
225229
226230```
227231
@@ -243,7 +247,7 @@ Response {responseStatus =
243247
244248``` {.haskell}
245249
246−resp <- deleteDocument testServer testIndex testMapping (DocId "1")
250+resp <- withBH' $ deleteDocument testIndex testMapping (DocId "1")
247251
248252```
249253
@@ -253,7 +257,7 @@ resp <- deleteDocument testServer testIndex testMapping (DocId "1")
253257
254258-- n.b., you'll need the earlier imports. responseBody is from http-conduit
255259
256−resp <- getDocument testServer testIndex testMapping (DocId "1")
260+resp <- withBH' $ getDocument testIndex testMapping (DocId "1")
257261
258262-- responseBody :: Response body -> body
259263let body = responseBody resp
@@ -328,8 +332,8 @@ let sndOp = BulkIndex testIndex
328332let stream = [firstDoc, secondDoc]
329333
330334-- Fire off the actual bulk request
331−-- bulk :: Server -> [BulkOperation] -> IO Reply
332−resp <- bulk testServer stream
335+-- bulk :: Vector BulkOperation -> IO Reply
336+resp <- withBH' $ bulk stream
333337:}
334338
335339```
@@ -363,8 +367,8 @@ let firstDocEncoded = encode firstDoc :: L.ByteString
363367let encodedOperations = encodeBulkOperations stream
364368
365369-- to insert into a particular server
366−-- bulk :: Server -> V.Vector BulkOperation -> IO Reply
367−_ <- bulk testServer stream
370+-- bulk :: V.Vector BulkOperation -> IO Reply
371+_ <- withBH' $ bulk stream
368372
369373```
370374
@@ -379,7 +383,7 @@ Search
379383
380384-- exported by the Client module, just defaults some stuff.
381385-- mkSearch :: Maybe Query -> Maybe Filter -> Search
382−-- mkSearch query filter = Search query filter Nothing False 0 10
386+-- mkSearch query filter = Search query filter Nothing False (From 0) (Size 10)
383387
384388let query = TermQuery (Term "user" "bitemyapp") Nothing
385389
@@ -393,7 +397,7 @@ let filter = IdentityFilter <&&> IdentityFilter
393397let search = mkSearch (Just query) (Just filter)
394398
395399-- you can also searchByType and specify the mapping name.
396−reply <- searchByIndex testServer testIndex search
400+reply <- withBH' $ searchByIndex testIndex search
397401
398402let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
399403
@@ -484,7 +488,7 @@ let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
484488-- -> From -> Size
485489
486490-- just add more sortspecs to the list if you want tie-breakers.
487−let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False 0 10
491+let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False (From 0) (Size 10)
488492
489493```
490494
@@ -534,7 +538,7 @@ let queryFilter = IdentityFilter <&&> IdentityFilter
534538
535539let search = mkSearch Nothing (Just queryFilter)
536540
537−reply <- searchByType testServer testIndex testMapping search
541+reply <- withBH' $ searchByType testIndex testMapping search
538542
539543```
540544
@@ -748,7 +752,7 @@ Aggregations are part of the reply structure of every search, in the form of
748752-- Lift decode and response body to be in the IO monad.
749753let decode' = liftM decode
750754let responseBody' = liftM responseBody
751−let reply = searchByIndex testServer testIndex search
755+let reply = withBH' $ searchByIndex testIndex search
752756let response = decode' $ responseBody' reply :: IO (Maybe (SearchResult Tweet))
753757
754758-- Now that we have our response, we can extract our terms aggregation result -- which is a list of buckets.
@@ -857,6 +861,20 @@ Buckets can be extracted from a using
857861
858862For more information on the Date Histogram Aggregation, see: <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>
859863
864+
865+Contributors
866+============
867+
868+* [Chris Allen](https://github.com/bitemyapp)
869+* [Liam Atkinson](https://github.com/latkins)
870+* [Christopher Guiney](https://github.com/chrisguiney)
871+* [Curtis Carter](https://github.com/ccarter)
872+* [Michael Xavier](https://github.com/MichaelXavier)
873+* [Bob Long](https://github.com/bobjflong)
874+* [Maximilian Tagher](https://github.com/MaxGabriel)
875+* [Anna Kopp](https://github.com/annakopp)
876+* [Matvey B. Aksenov](https://github.com/supki)
877+
860878Possible future functionality
861879=============================
862880
bloodhound.cabal+16−7
@@ -35,8 +35,13 @@ library
3535 semigroups >= 0.15 && <0.17,
3636 time >= 1.4 && <1.6,
3737 text >= 0.11 && <1.3,
38+ mtl >= 1.0 && <2.3,
39+ transformers >= 0.2 && <0.5,
3840 http-types >= 0.8 && <0.9,
39− vector >= 0.10.9 && <0.11
41+ vector >= 0.10.9 && <0.11,
42+ uri-bytestring >= 0.1 && <0.2,
43+ exceptions,
44+ data-default-class
4045 default-language: Haskell2010
4146
4247test-suite tests
@@ -56,7 +61,8 @@ test-suite tests
5661 semigroups,
5762 QuickCheck,
5863 vector,
59− unordered-containers >= 0.2.5.0 && <0.3
64+ unordered-containers >= 0.2.5.0 && <0.3,
65+ mtl
6066 default-language: Haskell2010
6167
6268test-suite doctests
@@ -64,8 +70,11 @@ test-suite doctests
6470 type: exitcode-stdio-1.0
6571 main-is: doctests.hs
6672 hs-source-dirs: tests
67− build-depends: base,
68− directory,
69− doctest,
70− doctest-prop,
71− filepath
73+ if impl(ghc >= 7.8)
74+ build-depends: base,
75+ directory,
76+ doctest,
77+ doctest-prop,
78+ filepath
79+ else
80+ buildable: False
src/Database/Bloodhound/Client.hs+189−131
@@ -1,4 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards #-}
23
34-------------------------------------------------------------------------------
45-- |
@@ -20,8 +21,8 @@ module Database.Bloodhound.Client
2021 -- and typeclass instances for the functions that make use of them.
2122
2223 -- $setup
23−
24− createIndex
24+ withBH
25+ , createIndex
2526 , deleteIndex
2627 , indexExists
2728 , openIndex
@@ -49,17 +50,24 @@ module Database.Bloodhound.Client
4950 )
5051 where
5152
53+import Control.Applicative
54+import Control.Monad
55+import Control.Monad.Catch
56+import Control.Monad.IO.Class
5257import Data.Aeson
5358import Data.ByteString.Lazy.Builder
54−import qualified Data.ByteString.Lazy.Char8 as L
55−import Data.List (intercalate)
56−import Data.Maybe (fromMaybe)
57−import Data.Text (Text)
58−import qualified Data.Vector as V
59+import qualified Data.ByteString.Lazy.Char8 as L
60+import Data.Default.Class
61+import Data.Maybe (fromMaybe)
62+import Data.Text (Text)
63+import qualified Data.Text as T
64+import qualified Data.Text.Encoding as T
65+import qualified Data.Vector as V
5966import Network.HTTP.Client
60−import qualified Network.HTTP.Types.Method as NHTM
61−import qualified Network.HTTP.Types.Status as NHTS
62−import Prelude hiding (filter, head)
67+import qualified Network.HTTP.Types.Method as NHTM
68+import qualified Network.HTTP.Types.Status as NHTS
69+import Prelude hiding (filter, head)
70+import URI.ByteString hiding (Query)
6371
6472import Database.Bloodhound.Types
6573
@@ -69,12 +77,12 @@ import Database.Bloodhound.Types
6977-- >>> import Database.Bloodhound
7078-- >>> import Test.DocTest.Prop (assert)
7179-- >>> let testServer = (Server "http://localhost:9200")
80+-- >>> let runBH' = withBH defaultManagerSettings testServer
7281-- >>> let testIndex = IndexName "twitter"
7382-- >>> let testMapping = MappingName "tweet"
7483-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
7584-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
76−-- >>> _ <- deleteIndex testServer testIndex
77−-- >>> _ <- deleteMapping testServer testIndex testMapping
85+-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping
7886-- >>> import GHC.Generics
7987-- >>> import Data.Time.Calendar (Day (..))
8088-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
@@ -133,29 +141,49 @@ mkReplicaCount n
133141emptyBody :: L.ByteString
134142emptyBody = L.pack ""
135143
136−dispatch :: Method -> String -> Maybe L.ByteString
137− -> IO Reply
144+dispatch :: MonadBH m => Method -> Text -> Maybe L.ByteString
145+ -> m Reply
138146dispatch dMethod url body = do
139− initReq <- parseUrl url
147+ initReq <- liftIO $ parseUrl' url
140148 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
141149 let req = initReq { method = dMethod
142150 , requestBody = reqBody
143151 , checkStatus = \_ _ _ -> Nothing}
144− withManager defaultManagerSettings $ httpLbs req
145−
146−joinPath :: [String] -> String
147−joinPath = intercalate "/"
152+ mgr <- bhManager <$> getBHEnv
153+ liftIO $ httpLbs req mgr
154+
155+joinPath' :: [Text] -> Text
156+joinPath' = T.intercalate "/"
157+
158+joinPath :: MonadBH m => [Text] -> m Text
159+joinPath ps = do
160+ Server s <- bhServer <$> getBHEnv
161+ return $ joinPath' (s:ps)
162+
163+bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
164+bindM2 f ma mb = join (f <$> ma <*> mb)
165+
166+-- | Convenience function that sets up a mananager and BHEnv and runs
167+-- the given set of bloodhound operations. Connections will be
168+-- pipelined automatically in accordance with the given manager
169+-- settings in IO. If you've got your own monad transformer stack, you
170+-- should use 'runBH' directly.
171+withBH :: ManagerSettings -> Server -> BH IO a -> IO a
172+withBH ms s f = withManager ms $ \mgr -> do
173+ let env = BHEnv { bhServer = s
174+ , bhManager = mgr }
175+ runBH env f
148176
149177-- Shortcut functions for HTTP methods
150−delete :: String -> IO Reply
178+delete :: MonadBH m => Text -> m Reply
151179delete = flip (dispatch NHTM.methodDelete) Nothing
152−get :: String -> IO Reply
180+get :: MonadBH m => Text -> m Reply
153181get = flip (dispatch NHTM.methodGet) Nothing
154−head :: String -> IO Reply
182+head :: MonadBH m => Text -> m Reply
155183head = flip (dispatch NHTM.methodHead) Nothing
156−put :: String -> Maybe L.ByteString -> IO Reply
184+put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
157185put = dispatch NHTM.methodPost
158−post :: String -> Maybe L.ByteString -> IO Reply
186+post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
159187post = dispatch NHTM.methodPost
160188
161189-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
@@ -164,39 +192,41 @@ post = dispatch NHTM.methodPost
164192
165193-- | 'getStatus' fetches the 'Status' of a 'Server'
166194--
167−-- >>> serverStatus <- getStatus testServer
195+-- >>> serverStatus <- runBH' getStatus
168196-- >>> fmap status (serverStatus)
169197-- Just 200
170−getStatus :: Server -> IO (Maybe Status)
171−getStatus (Server server) = do
172− request <- parseUrl $ joinPath [server]
173− response <- withManager defaultManagerSettings $ httpLbs request
198+getStatus :: MonadBH m => m (Maybe Status)
199+getStatus = do
200+ url <- joinPath []
201+ request <- liftIO $ parseUrl' url
202+ mgr <- bhManager <$> getBHEnv
203+ response <- liftIO $ httpLbs request mgr
174204 return $ decode (responseBody response)
175205
176206-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
177207--
178−-- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex")
208+-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
179209-- >>> respIsTwoHunna response
180210-- True
181−-- >>> indexExists testServer (IndexName "didimakeanindex")
211+-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
182212-- True
183−createIndex :: Server -> IndexSettings -> IndexName -> IO Reply
184−createIndex (Server server) indexSettings (IndexName indexName) =
185− put url body
186− where url = joinPath [server, indexName]
213+createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
214+createIndex indexSettings (IndexName indexName) =
215+ bindM2 put url (return body)
216+ where url = joinPath [indexName]
187217 body = Just $ encode indexSettings
188218
189219-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
190220--
191−-- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex")
192−-- >>> response <- deleteIndex testServer (IndexName "didimakeanindex")
221+-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
222+-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
193223-- >>> respIsTwoHunna response
194224-- True
195−-- >>> indexExists testServer testIndex
225+-- >>> runBH' $ indexExists testIndex
196226-- False
197−deleteIndex :: Server -> IndexName -> IO Reply
198−deleteIndex (Server server) (IndexName indexName) =
199− delete $ joinPath [server, indexName]
227+deleteIndex :: MonadBH m => IndexName -> m Reply
228+deleteIndex (IndexName indexName) =
229+ delete =<< joinPath [indexName]
200230
201231statusCodeIs :: Int -> Reply -> Bool
202232statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
@@ -204,7 +234,7 @@ statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
204234respIsTwoHunna :: Reply -> Bool
205235respIsTwoHunna = statusCodeIs 200
206236
207−existentialQuery :: String -> IO (Reply, Bool)
237+existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
208238existentialQuery url = do
209239 reply <- head url
210240 return (reply, respIsTwoHunna reply)
@@ -212,99 +242,98 @@ existentialQuery url = do
212242-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
213243-- in IO
214244--
215−-- >>> exists <- indexExists testServer testIndex
216−indexExists :: Server -> IndexName -> IO Bool
217−indexExists (Server server) (IndexName indexName) = do
218− (_, exists) <- existentialQuery url
245+-- >>> exists <- runBH' $ indexExists testIndex
246+indexExists :: MonadBH m => IndexName -> m Bool
247+indexExists (IndexName indexName) = do
248+ (_, exists) <- existentialQuery =<< joinPath [indexName]
219249 return exists
220− where url = joinPath [server, indexName]
221250
222251-- | 'refreshIndex' will force a refresh on an index. You must
223252-- do this if you want to read what you wrote.
224253--
225−-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
226−-- >>> _ <- refreshIndex testServer testIndex
227−refreshIndex :: Server -> IndexName -> IO Reply
228−refreshIndex (Server server) (IndexName indexName) =
229− post url Nothing
230− where url = joinPath [server, indexName, "_refresh"]
231−
232−stringifyOCIndex :: OpenCloseIndex -> String
254+-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
255+-- >>> _ <- runBH' $ refreshIndex testIndex
256+refreshIndex :: MonadBH m => IndexName -> m Reply
257+refreshIndex (IndexName indexName) =
258+ bindM2 post url (return Nothing)
259+ where url = joinPath [indexName, "_refresh"]
260+
261+stringifyOCIndex :: OpenCloseIndex -> Text
233262stringifyOCIndex oci = case oci of
234263 OpenIndex -> "_open"
235264 CloseIndex -> "_close"
236265
237−openOrCloseIndexes :: OpenCloseIndex -> Server -> IndexName -> IO Reply
238−openOrCloseIndexes oci (Server server) (IndexName indexName) =
239− post url Nothing
266+openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
267+openOrCloseIndexes oci (IndexName indexName) =
268+ bindM2 post url (return Nothing)
240269 where ociString = stringifyOCIndex oci
241− url = joinPath [server, indexName, ociString]
270+ url = joinPath [indexName, ociString]
242271
243−-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
272+-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
244273-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
245274--
246−-- >>> reply <- openIndex testServer testIndex
247−openIndex :: Server -> IndexName -> IO Reply
275+-- >>> reply <- runBH' $ openIndex testIndex
276+openIndex :: MonadBH m => IndexName -> m Reply
248277openIndex = openOrCloseIndexes OpenIndex
249278
250−-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
279+-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
251280-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
252281--
253−-- >>> reply <- closeIndex testServer testIndex
254−closeIndex :: Server -> IndexName -> IO Reply
282+-- >>> reply <- runBH' $ closeIndex testIndex
283+closeIndex :: MonadBH m => IndexName -> m Reply
255284closeIndex = openOrCloseIndexes CloseIndex
256285
257286-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
258287-- for documents in indexes.
259288--
260−-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
261−-- >>> resp <- putMapping testServer testIndex testMapping TweetMapping
289+-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
290+-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
262291-- >>> print resp
263292-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
264−putMapping :: ToJSON a => Server -> IndexName
265− -> MappingName -> a -> IO Reply
266−putMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =
267− put url body
268− where url = joinPath [server, indexName, mappingName, "_mapping"]
293+putMapping :: (MonadBH m, ToJSON a) => IndexName
294+ -> MappingName -> a -> m Reply
295+putMapping (IndexName indexName) (MappingName mappingName) mapping =
296+ bindM2 put url (return body)
297+ where url = joinPath [indexName, mappingName, "_mapping"]
269298 body = Just $ encode mapping
270299
271300-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
272301-- Mappings are schemas for documents in indexes.
273302--
274−-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
275−-- >>> _ <- putMapping testServer testIndex testMapping TweetMapping
276−-- >>> resp <- deleteMapping testServer testIndex testMapping
303+-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
304+-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping
305+-- >>> resp <- runBH' $ deleteMapping testIndex testMapping
277306-- >>> print resp
278307-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
279−deleteMapping :: Server -> IndexName -> MappingName -> IO Reply
280−deleteMapping (Server server) (IndexName indexName)
308+deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
309+deleteMapping (IndexName indexName)
281310 (MappingName mappingName) =
282− delete $ joinPath [server, indexName, mappingName, "_mapping"]
311+ delete =<< joinPath [indexName, mappingName, "_mapping"]
283312
284313-- | 'indexDocument' is the primary way to save a single document in
285314-- Elasticsearch. The document itself is simply something we can
286315-- convert into a JSON 'Value'. The 'DocId' will function as the
287316-- primary key for the document.
288317--
289−-- >>> resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
318+-- >>> resp <- runBH' $ indexDocument testIndex testMapping exampleTweet (DocId "1")
290319-- >>> print resp
291320-- Response {responseStatus = Status {statusCode = 201, statusMessage = "Created"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","74")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":1,\"created\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
292−indexDocument :: ToJSON doc => Server -> IndexName -> MappingName
293− -> doc -> DocId -> IO Reply
294−indexDocument (Server server) (IndexName indexName)
321+indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
322+ -> doc -> DocId -> m Reply
323+indexDocument (IndexName indexName)
295324 (MappingName mappingName) document (DocId docId) =
296− put url body
297− where url = joinPath [server, indexName, mappingName, docId]
325+ bindM2 put url (return body)
326+ where url = joinPath [indexName, mappingName, docId]
298327 body = Just (encode document)
299328
300329-- | 'deleteDocument' is the primary way to delete a single document.
301330--
302−-- >>> _ <- deleteDocument testServer testIndex testMapping (DocId "1")
303−deleteDocument :: Server -> IndexName -> MappingName
304− -> DocId -> IO Reply
305−deleteDocument (Server server) (IndexName indexName)
331+-- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")
332+deleteDocument :: MonadBH m => IndexName -> MappingName
333+ -> DocId -> m Reply
334+deleteDocument (IndexName indexName)
306335 (MappingName mappingName) (DocId docId) =
307− delete $ joinPath [server, indexName, mappingName, docId]
336+ delete =<< joinPath [indexName, mappingName, docId]
308337
309338-- | 'bulk' uses
310339-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
@@ -314,12 +343,12 @@ deleteDocument (Server server) (IndexName indexName)
314343-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
315344--
316345-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
317−-- >>> _ <- bulk testServer stream
318−-- >>> _ <- refreshIndex testServer testIndex
319−bulk :: Server -> V.Vector BulkOperation -> IO Reply
320−bulk (Server server) bulkOps = post url body where
321− url = joinPath [server, "_bulk"]
322− body = Just $ encodeBulkOperations bulkOps
346+-- >>> _ <- runBH' $ bulk stream
347+-- >>> _ <- runBH' $ refreshIndex testIndex
348+bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
349+bulk bulkOps = bindM2 post url (return body)
350+ where url = joinPath ["_bulk"]
351+ body = Just $ encodeBulkOperations bulkOps
323352
324353-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
325354-- into an 'L.ByteString'
@@ -336,7 +365,7 @@ encodeBulkOperations stream = collapsed where
336365mash :: Builder -> V.Vector L.ByteString -> Builder
337366mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
338367
339−mkBulkStreamValue :: Text -> String -> String -> String -> Value
368+mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
340369mkBulkStreamValue operation indexName mappingName docId =
341370 object [operation .=
342371 object [ "_index" .= indexName
@@ -379,26 +408,26 @@ encodeBulkOperation (BulkUpdate (IndexName indexName)
379408-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
380409-- The 'DocId' is the primary key for your Elasticsearch document.
381410--
382−-- >>> yourDoc <- getDocument testServer testIndex testMapping (DocId "1")
383−getDocument :: Server -> IndexName -> MappingName
384− -> DocId -> IO Reply
385−getDocument (Server server) (IndexName indexName)
411+-- >>> yourDoc <- runBH' $ getDocument testIndex testMapping (DocId "1")
412+getDocument :: MonadBH m => IndexName -> MappingName
413+ -> DocId -> m Reply
414+getDocument (IndexName indexName)
386415 (MappingName mappingName) (DocId docId) =
387− get $ joinPath [server, indexName, mappingName, docId]
416+ get =<< joinPath [indexName, mappingName, docId]
388417
389418-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
390419-- in IO
391420--
392−-- >>> exists <- documentExists testServer testIndex testMapping (DocId "1")
393−documentExists :: Server -> IndexName -> MappingName
394− -> DocId -> IO Bool
395−documentExists (Server server) (IndexName indexName)
421+-- >>> exists <- runBH' $ documentExists testIndex testMapping (DocId "1")
422+documentExists :: MonadBH m => IndexName -> MappingName
423+ -> DocId -> m Bool
424+documentExists (IndexName indexName)
396425 (MappingName mappingName) (DocId docId) = do
397− (_, exists) <- existentialQuery url
398− return exists where
399− url = joinPath [server, indexName, mappingName, docId]
426+ (_, exists) <- existentialQuery =<< url
427+ return exists
428+ where url = joinPath [indexName, mappingName, docId]
400429
401−dispatchSearch :: String -> Search -> IO Reply
430+dispatchSearch :: MonadBH m => Text -> Search -> m Reply
402431dispatchSearch url search = post url (Just (encode search))
403432
404433-- | 'searchAll', given a 'Search', will perform that search against all indexes
@@ -406,31 +435,32 @@ dispatchSearch url search = post url (Just (encode search))
406435--
407436-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
408437-- >>> let search = mkSearch (Just query) Nothing
409−-- >>> reply <- searchAll testServer search
410−searchAll :: Server -> Search -> IO Reply
411−searchAll (Server server) = dispatchSearch url where
412− url = joinPath [server, "_search"]
438+-- >>> reply <- runBH' $ searchAll search
439+searchAll :: MonadBH m => Search -> m Reply
440+searchAll = bindM2 dispatchSearch url . return
441+ where url = joinPath ["_search"]
413442
414443-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
415444-- against all mappings within an index on an Elasticsearch server.
416445--
417446-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
418447-- >>> let search = mkSearch (Just query) Nothing
419−-- >>> reply <- searchByIndex testServer testIndex search
420−searchByIndex :: Server -> IndexName -> Search -> IO Reply
421−searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where
422− url = joinPath [server, indexName, "_search"]
448+-- >>> reply <- runBH' $ searchByIndex testIndex search
449+searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
450+searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
451+ where url = joinPath [indexName, "_search"]
423452
424453-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
425454-- search against a specific mapping within an index on an Elasticsearch server.
426455--
427456-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
428457-- >>> let search = mkSearch (Just query) Nothing
429−-- >>> reply <- searchByType testServer testIndex testMapping search
430−searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply
431−searchByType (Server server) (IndexName indexName)
432− (MappingName mappingName) = dispatchSearch url where
433− url = joinPath [server, indexName, mappingName, "_search"]
458+-- >>> reply <- runBH' $ searchByType testIndex testMapping search
459+searchByType :: MonadBH m => IndexName -> MappingName -> Search
460+ -> m Reply
461+searchByType (IndexName indexName)
462+ (MappingName mappingName) = bindM2 dispatchSearch url . return
463+ where url = joinPath [indexName, mappingName, "_search"]
434464
435465-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
436466-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
@@ -439,9 +469,9 @@ searchByType (Server server) (IndexName indexName)
439469--
440470-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
441471-- >>> mkSearch (Just query) Nothing
442−-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 0, size = 10}
472+-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10}
443473mkSearch :: Maybe Query -> Maybe Filter -> Search
444−mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10
474+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10)
445475
446476-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
447477-- the 'Query' and the 'Aggregation'.
@@ -451,7 +481,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10
451481-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
452482-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
453483mkAggregateSearch :: Maybe Query -> Aggregations -> Search
454−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False 0 0
484+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0)
455485
456486-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
457487-- the 'Query' and the 'Aggregation'.
@@ -460,7 +490,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
460490-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
461491-- >>> let search = mkHighlightSearch (Just query) testHighlight
462492mkHighlightSearch :: Maybe Query -> Highlights -> Search
463−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False 0 10
493+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10)
464494
465495-- | 'pageSearch' is a helper function that takes a search and assigns the from
466496-- and size fields for the search. The from parameter defines the offset
@@ -470,11 +500,39 @@ mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing
470500-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
471501-- >>> let search = mkSearch (Just query) Nothing
472502-- >>> search
473−-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 0, size = 10}
474−-- >>> pageSearch 10 100 search
475−-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 10, size = 100}
476−pageSearch :: Int -- ^ The result offset
477− -> Int -- ^ The number of results to return
503+-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10}
504+-- >>> pageSearch (From 10) (Size 100) search
505+-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100}
506+pageSearch :: From -- ^ The result offset
507+ -> Size -- ^ The number of results to return
478508 -> Search -- ^ The current seach
479509 -> Search -- ^ The paged search
480510pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
511+
512+parseUrl' :: MonadThrow m => Text -> m Request
513+parseUrl' t =
514+ case parseURI laxURIParserOptions (T.encodeUtf8 t) of
515+ Right uri -> setURI def uri
516+ Left e -> throwM $ InvalidUrlException (T.unpack t) ("Invalid URL: " ++ show e)
517+
518+setURI :: MonadThrow m => Request -> URI -> m Request
519+setURI req URI{..} = do
520+ Authority {..} <- maybe missingUA return uriAuthority
521+ let req' = req { secure = isSecure
522+ , host = hostBS authorityHost
523+ , port = thePort
524+ , path = uriPath
525+ }
526+ thePort = maybe defPort portNumber authorityPort
527+ addAuth = maybe id addAuth' authorityUserInfo
528+ return $ setQueryString theQueryString $ addAuth req'
529+ where
530+ missingUA = throwM $ InvalidUrlException "N/A" "Missing URI host/port"
531+ addAuth' UserInfo {..} = applyBasicProxyAuth uiUsername uiPassword
532+ defPort
533+ | isSecure = 443
534+ | otherwise = 80
535+ isSecure = case uriScheme of
536+ Scheme "https" -> True
537+ _ -> False
538+ theQueryString = [(k , Just v) | (k, v) <- queryPairs uriQuery]
src/Database/Bloodhound/Types.hs+219−156
@@ -1,6 +1,11 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE RecordWildCards #-}
8+{-# LANGUAGE UndecidableInstances #-}
49
510-------------------------------------------------------------------------------
611-- |
@@ -39,6 +44,10 @@ module Database.Bloodhound.Types
3944 , toTerms
4045 , toDateHistogram
4146 , omitNulls
47+ , BH
48+ , runBH
49+ , BHEnv(..)
50+ , MonadBH(..)
4251 , Version(..)
4352 , Status(..)
4453 , Existence(..)
@@ -51,6 +60,9 @@ module Database.Bloodhound.Types
5160 , Search(..)
5261 , SearchResult(..)
5362 , SearchHits(..)
63+ , TrackSortScores
64+ , From(..)
65+ , Size(..)
5466 , ShardResult(..)
5567 , Hit(..)
5668 , Filter(..)
@@ -138,6 +150,8 @@ module Database.Bloodhound.Types
138150 , IgnoreTermFrequency(..)
139151 , MaxQueryTerms(..)
140152 , ScoreType(..)
153+ , Score
154+ , Cache
141155 , TypeName(..)
142156 , BoostTerms(..)
143157 , MaxWordLength(..)
@@ -194,13 +208,16 @@ module Database.Bloodhound.Types
194208 ) where
195209
196210import Control.Applicative
211+import Control.Monad.Error
212+import Control.Monad.Reader
213+import Control.Monad.State
214+import Control.Monad.Writer
197215import Data.Aeson
198216import Data.Aeson.Types (Pair, emptyObject, parseMaybe)
199217import qualified Data.ByteString.Lazy.Char8 as L
200218import Data.List (nub)
201−import Data.List.NonEmpty (NonEmpty(..), toList)
219+import Data.List.NonEmpty (NonEmpty (..), toList)
202220import qualified Data.Map.Strict as M
203−import Data.Monoid
204221import Data.Text (Text)
205222import qualified Data.Text as T
206223import Data.Time.Clock (UTCTime)
@@ -222,6 +239,52 @@ import Database.Bloodhound.Types.Class
222239-- defaultIndexSettings is exported by Database.Bloodhound as well
223240-- no trailing slashes in servers, library handles building the path.
224241
242+{-| Common environment for Elasticsearch calls. Connections will be
243+ pipelined according to the provided HTTP connection manager.
244+-}
245+data BHEnv = BHEnv { bhServer :: Server
246+ , bhManager :: Manager
247+ }
248+
249+{-| All API calls to Elasticsearch operate within
250+ MonadBH. The idea is that it can be easily embedded in your
251+ own monad transformer stack. A default instance for a ReaderT and
252+ alias 'BH' is provided for the simple case.
253+-}
254+class (Functor m, Applicative m, MonadIO m) => MonadBH m where
255+ getBHEnv :: m BHEnv
256+
257+newtype BH m a = BH {
258+ unBH :: ReaderT BHEnv m a
259+ } deriving ( Functor
260+ , Applicative
261+ , Monad
262+ , MonadIO
263+ , MonadState s
264+ , MonadWriter w
265+ , MonadError e
266+ , Alternative
267+ , MonadPlus
268+ , MonadFix)
269+
270+instance MonadTrans BH where
271+ lift = BH . lift
272+
273+instance (MonadReader r m) => MonadReader r (BH m) where
274+ ask = lift ask
275+ local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
276+ local f (m r)
277+
278+instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
279+ getBHEnv = BH getBHEnv
280+
281+
282+instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
283+ getBHEnv = ask
284+
285+runBH :: BHEnv -> BH m a -> m a
286+runBH e f = runReaderT (unBH f) e
287+
225288{-| 'Version' is embedded in 'Status' -}
226289data Version = Version { number :: Text
227290 , build_hash :: Text
@@ -400,22 +463,22 @@ newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic)
400463
401464{-| 'Server' is used with the client functions to point at the ES instance
402465-}
403−newtype Server = Server String deriving (Eq, Show)
466+newtype Server = Server Text deriving (Eq, Show)
404467
405468{-| 'IndexName' is used to describe which index to query/create/delete
406469-}
407−newtype IndexName = IndexName String deriving (Eq, Generic, Show)
470+newtype IndexName = IndexName Text deriving (Eq, Generic, Show)
408471
409472{-| 'MappingName' is part of mappings which are how ES describes and schematizes
410473 the data in the indices.
411474-}
412−newtype MappingName = MappingName String deriving (Eq, Generic, Show)
475+newtype MappingName = MappingName Text deriving (Eq, Generic, Show)
413476
414477{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
415478 Can be set by the user or created by ES itself. Often used in client
416479 functions for poking at specific documents.
417480-}
418−newtype DocId = DocId String deriving (Eq, Generic, Show)
481+newtype DocId = DocId Text deriving (Eq, Generic, Show)
419482
420483{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
421484-}
@@ -526,12 +589,12 @@ newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic)
526589
527590{-| 'unpackId' is a silly convenience function that gets used once.
528591-}
529−unpackId :: DocId -> String
592+unpackId :: DocId -> Text
530593unpackId (DocId docId) = docId
531594
532595type TrackSortScores = Bool
533−type From = Int
534−type Size = Int
596+newtype From = From Int deriving (Eq, Show, ToJSON)
597+newtype Size = Size Int deriving (Eq, Show, ToJSON)
535598
536599data Search = Search { queryBody :: Maybe Query
537600 , filterBody :: Maybe Filter
@@ -1195,29 +1258,29 @@ instance Show TimeInterval where
11951258instance ToJSON Aggregation where
11961259 toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
11971260 omitNulls ["terms" .= omitNulls [ toJSON' term,
1198− "include" .= toJSON include,
1199− "exclude" .= toJSON exclude,
1200− "order" .= toJSON order,
1201− "min_doc_count" .= toJSON minDocCount,
1202− "size" .= toJSON size,
1203− "shard_size" .= toJSON shardSize,
1204− "collect_mode" .= toJSON collectMode,
1205− "execution_hint" .= toJSON executionHint
1261+ "include" .= include,
1262+ "exclude" .= exclude,
1263+ "order" .= order,
1264+ "min_doc_count" .= minDocCount,
1265+ "size" .= size,
1266+ "shard_size" .= shardSize,
1267+ "collect_mode" .= collectMode,
1268+ "execution_hint" .= executionHint
12061269 ],
1207− "aggs" .= toJSON termAggs ]
1270+ "aggs" .= termAggs ]
12081271 where
1209− toJSON' x = case x of { Left y -> "field" .= toJSON y; Right y -> "script" .= toJSON y }
1272+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
12101273
12111274 toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1212− omitNulls ["date_histogram" .= omitNulls [ "field" .= toJSON field,
1213− "interval" .= toJSON interval,
1214− "format" .= toJSON format,
1215− "pre_zone" .= toJSON preZone,
1216− "post_zone" .= toJSON postZone,
1217− "pre_offset" .= toJSON preOffset,
1218− "post_offset" .= toJSON postOffset
1275+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1276+ "interval" .= interval,
1277+ "format" .= format,
1278+ "pre_zone" .= preZone,
1279+ "post_zone" .= postZone,
1280+ "pre_offset" .= preOffset,
1281+ "post_offset" .= postOffset
12191282 ],
1220− "aggs" .= toJSON dateHistoAggs ]
1283+ "aggs" .= dateHistoAggs ]
12211284
12221285type AggregationResults = M.Map Text Value
12231286
@@ -1295,7 +1358,7 @@ instance ToJSON Filter where
12951358
12961359 toJSON (NotFilter notFilter cache) =
12971360 object ["not" .=
1298− object ["filter" .= toJSON notFilter
1361+ object ["filter" .= notFilter
12991362 , "_cache" .= cache]]
13001363
13011364 toJSON (IdentityFilter) =
@@ -1311,26 +1374,26 @@ instance ToJSON Filter where
13111374 ["field" .= fieldName]]
13121375
13131376 toJSON (BoolFilter boolMatch) =
1314− object ["bool" .= toJSON boolMatch]
1377+ object ["bool" .= boolMatch]
13151378
13161379 toJSON (GeoBoundingBoxFilter bbConstraint) =
1317− object ["geo_bounding_box" .= toJSON bbConstraint]
1380+ object ["geo_bounding_box" .= bbConstraint]
13181381
13191382 toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
13201383 distance distanceType optimizeBbox cache) =
13211384 object ["geo_distance" .=
1322− object ["distance" .= toJSON distance
1323− , "distance_type" .= toJSON distanceType
1385+ object ["distance" .= distance
1386+ , "distance_type" .= distanceType
13241387 , "optimize_bbox" .= optimizeBbox
1325− , distanceGeoField .= toJSON geoDistLatLon
1388+ , distanceGeoField .= geoDistLatLon
13261389 , "_cache" .= cache]]
13271390
13281391 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
13291392 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
13301393 object ["geo_distance_range" .=
1331− object ["from" .= toJSON geoDistRangeDistFrom
1332− , "to" .= toJSON drDistanceTo
1333− , gddrField .= toJSON drLatLon]]
1394+ object ["from" .= geoDistRangeDistFrom
1395+ , "to" .= drDistanceTo
1396+ , gddrField .= drLatLon]]
13341397
13351398 toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
13361399 object ["geo_polygon" .=
@@ -1340,7 +1403,7 @@ instance ToJSON Filter where
13401403 toJSON (IdsFilter (MappingName mappingName) values) =
13411404 object ["ids" .=
13421405 object ["type" .= mappingName
1343− , "values" .= fmap (T.pack . unpackId) values]]
1406+ , "values" .= fmap unpackId values]]
13441407
13451408 toJSON (LimitFilter limit) =
13461409 object ["limit" .= object ["value" .= limit]]
@@ -1359,7 +1422,7 @@ instance ToJSON Filter where
13591422 toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
13601423 object ["range" .=
13611424 object [ fieldName .= object (rangeValueToPair rangeValue)
1362− , "execution" .= toJSON rangeExecution
1425+ , "execution" .= rangeExecution
13631426 , "_cache" .= cache]]
13641427
13651428 toJSON (RegexpFilter (FieldName fieldName)
@@ -1367,14 +1430,14 @@ instance ToJSON Filter where
13671430 object ["regexp" .=
13681431 object [fieldName .=
13691432 object ["value" .= regexText
1370− , "flags" .= toJSON flags]
1433+ , "flags" .= flags]
13711434 , "_name" .= cacheName
13721435 , "_cache" .= cache
13731436 , "_cache_key" .= cacheKey]]
13741437
13751438instance ToJSON GeoPoint where
13761439 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
1377− object [ geoPointField .= toJSON geoPointLatLon ]
1440+ object [ geoPointField .= geoPointLatLon ]
13781441
13791442
13801443instance ToJSON Query where
@@ -1394,82 +1457,82 @@ instance ToJSON Query where
13941457 getTermValue (Term _ v) = v
13951458 toJSON (IdsQuery idsQueryMappingName docIds) =
13961459 object [ "ids" .= object conjoined ]
1397− where conjoined = [ "type" .= toJSON idsQueryMappingName
1460+ where conjoined = [ "type" .= idsQueryMappingName
13981461 , "values" .= fmap toJSON docIds ]
13991462
14001463 toJSON (QueryQueryStringQuery qQueryStringQuery) =
1401− object [ "query_string" .= toJSON qQueryStringQuery ]
1464+ object [ "query_string" .= qQueryStringQuery ]
14021465
14031466 toJSON (QueryMatchQuery matchQuery) =
1404− object [ "match" .= toJSON matchQuery ]
1467+ object [ "match" .= matchQuery ]
14051468
14061469 toJSON (QueryMultiMatchQuery multiMatchQuery) =
14071470 toJSON multiMatchQuery
14081471
14091472 toJSON (QueryBoolQuery boolQuery) =
1410− object [ "bool" .= toJSON boolQuery ]
1473+ object [ "bool" .= boolQuery ]
14111474
14121475 toJSON (QueryBoostingQuery boostingQuery) =
1413− object [ "boosting" .= toJSON boostingQuery ]
1476+ object [ "boosting" .= boostingQuery ]
14141477
14151478 toJSON (QueryCommonTermsQuery commonTermsQuery) =
1416− object [ "common" .= toJSON commonTermsQuery ]
1479+ object [ "common" .= commonTermsQuery ]
14171480
14181481 toJSON (ConstantScoreFilter csFilter boost) =
1419− object [ "constant_score" .= toJSON csFilter
1420− , "boost" .= toJSON boost]
1482+ object [ "constant_score" .= csFilter
1483+ , "boost" .= boost]
14211484
14221485 toJSON (ConstantScoreQuery query boost) =
1423− object [ "constant_score" .= toJSON query
1424− , "boost" .= toJSON boost]
1486+ object [ "constant_score" .= query
1487+ , "boost" .= boost]
14251488
14261489 toJSON (QueryDisMaxQuery disMaxQuery) =
1427− object [ "dis_max" .= toJSON disMaxQuery ]
1490+ object [ "dis_max" .= disMaxQuery ]
14281491
14291492 toJSON (QueryFilteredQuery qFilteredQuery) =
1430− object [ "filtered" .= toJSON qFilteredQuery ]
1493+ object [ "filtered" .= qFilteredQuery ]
14311494
14321495 toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
1433− object [ "fuzzy_like_this" .= toJSON fuzzyQuery ]
1496+ object [ "fuzzy_like_this" .= fuzzyQuery ]
14341497
14351498 toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
1436− object [ "fuzzy_like_this_field" .= toJSON fuzzyFieldQuery ]
1499+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
14371500
14381501 toJSON (QueryFuzzyQuery fuzzyQuery) =
1439− object [ "fuzzy" .= toJSON fuzzyQuery ]
1502+ object [ "fuzzy" .= fuzzyQuery ]
14401503
14411504 toJSON (QueryHasChildQuery childQuery) =
1442− object [ "has_child" .= toJSON childQuery ]
1505+ object [ "has_child" .= childQuery ]
14431506
14441507 toJSON (QueryHasParentQuery parentQuery) =
1445− object [ "has_parent" .= toJSON parentQuery ]
1508+ object [ "has_parent" .= parentQuery ]
14461509
14471510 toJSON (QueryIndicesQuery qIndicesQuery) =
1448− object [ "indices" .= toJSON qIndicesQuery ]
1511+ object [ "indices" .= qIndicesQuery ]
14491512
14501513 toJSON (MatchAllQuery boost) =
14511514 object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
14521515
14531516 toJSON (QueryMoreLikeThisQuery query) =
1454− object [ "more_like_this" .= toJSON query ]
1517+ object [ "more_like_this" .= query ]
14551518
14561519 toJSON (QueryMoreLikeThisFieldQuery query) =
1457− object [ "more_like_this_field" .= toJSON query ]
1520+ object [ "more_like_this_field" .= query ]
14581521
14591522 toJSON (QueryNestedQuery query) =
1460− object [ "nested" .= toJSON query ]
1523+ object [ "nested" .= query ]
14611524
14621525 toJSON (QueryPrefixQuery query) =
1463− object [ "prefix" .= toJSON query ]
1526+ object [ "prefix" .= query ]
14641527
14651528 toJSON (QueryRangeQuery query) =
1466− object [ "range" .= toJSON query ]
1529+ object [ "range" .= query ]
14671530
14681531 toJSON (QueryRegexpQuery query) =
1469− object [ "regexp" .= toJSON query ]
1532+ object [ "regexp" .= query ]
14701533
14711534 toJSON (QuerySimpleQueryStringQuery query) =
1472− object [ "simple_query_string" .= toJSON query ]
1535+ object [ "simple_query_string" .= query ]
14731536
14741537
14751538omitNulls :: [(Text, Value)] -> Value
@@ -1482,7 +1545,7 @@ omitNulls = object . filter notNull where
14821545instance ToJSON SimpleQueryStringQuery where
14831546 toJSON SimpleQueryStringQuery {..} =
14841547 omitNulls (base ++ maybeAdd)
1485− where base = [ "query" .= toJSON simpleQueryStringQuery ]
1548+ where base = [ "query" .= simpleQueryStringQuery ]
14861549 maybeAdd = [ "fields" .= simpleQueryStringField
14871550 , "default_operator" .= simpleQueryStringOperator
14881551 , "analyzer" .= simpleQueryStringAnalyzer
@@ -1518,7 +1581,7 @@ instance ToJSON RegexpQuery where
15181581 rqQueryBoost) =
15191582 object [ rqQueryField .= omitNulls base ]
15201583 where base = [ "value" .= regexpQueryQuery
1521− , "flags" .= toJSON rqQueryFlags
1584+ , "flags" .= rqQueryFlags
15221585 , "boost" .= rqQueryBoost ]
15231586
15241587
@@ -1534,7 +1597,7 @@ instance ToJSON QueryStringQuery where
15341597 qsLenient qsLocale) =
15351598 omitNulls base
15361599 where
1537− base = [ "query" .= toJSON qsQueryString
1600+ base = [ "query" .= qsQueryString
15381601 , "default_field" .= qsDefaultField
15391602 , "default_operator" .= qsOperator
15401603 , "analyzer" .= qsAnalyzer
@@ -1556,21 +1619,21 @@ instance ToJSON QueryStringQuery where
15561619instance ToJSON RangeQuery where
15571620 toJSON (RangeQuery (FieldName fieldName) range boost) =
15581621 object [ fieldName .= conjoined ]
1559− where conjoined = [ "boost" .= toJSON boost ] ++ (rangeValueToPair range)
1622+ where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
15601623
15611624
15621625instance ToJSON PrefixQuery where
15631626 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
15641627 object [ fieldName .= omitNulls base ]
1565− where base = [ "value" .= toJSON queryValue
1628+ where base = [ "value" .= queryValue
15661629 , "boost" .= boost ]
15671630
15681631
15691632instance ToJSON NestedQuery where
15701633 toJSON (NestedQuery nqPath nqScoreType nqQuery) =
1571− object [ "path" .= toJSON nqPath
1572− , "score_mode" .= toJSON nqScoreType
1573− , "query" .= toJSON nqQuery ]
1634+ object [ "path" .= nqPath
1635+ , "score_mode" .= nqScoreType
1636+ , "query" .= nqQuery ]
15741637
15751638
15761639instance ToJSON MoreLikeThisFieldQuery where
@@ -1578,7 +1641,7 @@ instance ToJSON MoreLikeThisFieldQuery where
15781641 percent mtf mqt stopwords mindf maxdf
15791642 minwl maxwl boostTerms boost analyzer) =
15801643 object [ fieldName .= omitNulls base ]
1581− where base = [ "like_text" .= toJSON text
1644+ where base = [ "like_text" .= text
15821645 , "percent_terms_to_match" .= percent
15831646 , "min_term_freq" .= mtf
15841647 , "max_query_terms" .= mqt
@@ -1597,7 +1660,7 @@ instance ToJSON MoreLikeThisQuery where
15971660 mtf mqt stopwords mindf maxdf
15981661 minwl maxwl boostTerms boost analyzer) =
15991662 omitNulls base
1600− where base = [ "like_text" .= toJSON text
1663+ where base = [ "like_text" .= text
16011664 , "fields" .= fields
16021665 , "percent_terms_to_match" .= percent
16031666 , "min_term_freq" .= mtf
@@ -1614,34 +1677,34 @@ instance ToJSON MoreLikeThisQuery where
16141677
16151678instance ToJSON IndicesQuery where
16161679 toJSON (IndicesQuery indices query noMatch) =
1617− omitNulls [ "indices" .= toJSON indices
1618− , "no_match_query" .= toJSON noMatch
1619− , "query" .= toJSON query ]
1680+ omitNulls [ "indices" .= indices
1681+ , "no_match_query" .= noMatch
1682+ , "query" .= query ]
16201683
16211684
16221685instance ToJSON HasParentQuery where
16231686 toJSON (HasParentQuery queryType query scoreType) =
1624− omitNulls [ "parent_type" .= toJSON queryType
1625− , "score_type" .= toJSON scoreType
1626− , "query" .= toJSON query ]
1687+ omitNulls [ "parent_type" .= queryType
1688+ , "score_type" .= scoreType
1689+ , "query" .= query ]
16271690
16281691
16291692instance ToJSON HasChildQuery where
16301693 toJSON (HasChildQuery queryType query scoreType) =
1631− omitNulls [ "query" .= toJSON query
1632− , "score_type" .= toJSON scoreType
1633− , "type" .= toJSON queryType ]
1694+ omitNulls [ "query" .= query
1695+ , "score_type" .= scoreType
1696+ , "type" .= queryType ]
16341697
16351698
16361699instance ToJSON FuzzyQuery where
16371700 toJSON (FuzzyQuery (FieldName fieldName) queryText
16381701 prefixLength maxEx fuzziness boost) =
16391702 object [ fieldName .= omitNulls base ]
1640− where base = [ "value" .= toJSON queryText
1641− , "fuzziness" .= toJSON fuzziness
1642− , "prefix_length" .= toJSON prefixLength
1643− , "boost" .= toJSON boost
1644− , "max_expansions" .= toJSON maxEx ]
1703+ where base = [ "value" .= queryText
1704+ , "fuzziness" .= fuzziness
1705+ , "prefix_length" .= prefixLength
1706+ , "boost" .= boost
1707+ , "max_expansions" .= maxEx ]
16451708
16461709
16471710instance ToJSON FuzzyLikeFieldQuery where
@@ -1649,41 +1712,41 @@ instance ToJSON FuzzyLikeFieldQuery where
16491712 fieldText maxTerms ignoreFreq fuzziness prefixLength
16501713 boost analyzer) =
16511714 object [ fieldName .=
1652− omitNulls [ "like_text" .= toJSON fieldText
1653− , "max_query_terms" .= toJSON maxTerms
1654− , "ignore_tf" .= toJSON ignoreFreq
1655− , "fuzziness" .= toJSON fuzziness
1656− , "prefix_length" .= toJSON prefixLength
1657− , "analyzer" .= toJSON analyzer
1658− , "boost" .= toJSON boost ]]
1715+ omitNulls [ "like_text" .= fieldText
1716+ , "max_query_terms" .= maxTerms
1717+ , "ignore_tf" .= ignoreFreq
1718+ , "fuzziness" .= fuzziness
1719+ , "prefix_length" .= prefixLength
1720+ , "analyzer" .= analyzer
1721+ , "boost" .= boost ]]
16591722
16601723
16611724instance ToJSON FuzzyLikeThisQuery where
16621725 toJSON (FuzzyLikeThisQuery fields text maxTerms
16631726 ignoreFreq fuzziness prefixLength boost analyzer) =
16641727 omitNulls base
1665− where base = [ "fields" .= toJSON fields
1666− , "like_text" .= toJSON text
1667− , "max_query_terms" .= toJSON maxTerms
1668− , "ignore_tf" .= toJSON ignoreFreq
1669− , "fuzziness" .= toJSON fuzziness
1670− , "prefix_length" .= toJSON prefixLength
1671− , "analyzer" .= toJSON analyzer
1672− , "boost" .= toJSON boost ]
1728+ where base = [ "fields" .= fields
1729+ , "like_text" .= text
1730+ , "max_query_terms" .= maxTerms
1731+ , "ignore_tf" .= ignoreFreq
1732+ , "fuzziness" .= fuzziness
1733+ , "prefix_length" .= prefixLength
1734+ , "analyzer" .= analyzer
1735+ , "boost" .= boost ]
16731736
16741737
16751738instance ToJSON FilteredQuery where
16761739 toJSON (FilteredQuery query fFilter) =
1677− object [ "query" .= toJSON query
1678− , "filter" .= toJSON fFilter ]
1740+ object [ "query" .= query
1741+ , "filter" .= fFilter ]
16791742
16801743
16811744instance ToJSON DisMaxQuery where
16821745 toJSON (DisMaxQuery queries tiebreaker boost) =
16831746 omitNulls base
1684− where base = [ "queries" .= toJSON queries
1685− , "boost" .= toJSON boost
1686− , "tie_breaker" .= toJSON tiebreaker ]
1747+ where base = [ "queries" .= queries
1748+ , "boost" .= boost
1749+ , "tie_breaker" .= tiebreaker ]
16871750
16881751
16891752instance ToJSON CommonTermsQuery where
@@ -1691,38 +1754,38 @@ instance ToJSON CommonTermsQuery where
16911754 (QueryString query) cf lfo hfo msm
16921755 boost analyzer disableCoord) =
16931756 object [fieldName .= omitNulls base ]
1694− where base = [ "query" .= toJSON query
1695− , "cutoff_frequency" .= toJSON cf
1696− , "low_freq_operator" .= toJSON lfo
1697− , "minimum_should_match" .= toJSON msm
1698− , "boost" .= toJSON boost
1699− , "analyzer" .= toJSON analyzer
1700− , "disable_coord" .= toJSON disableCoord
1701− , "high_freq_operator" .= toJSON hfo ]
1757+ where base = [ "query" .= query
1758+ , "cutoff_frequency" .= cf
1759+ , "low_freq_operator" .= lfo
1760+ , "minimum_should_match" .= msm
1761+ , "boost" .= boost
1762+ , "analyzer" .= analyzer
1763+ , "disable_coord" .= disableCoord
1764+ , "high_freq_operator" .= hfo ]
17021765
17031766
17041767instance ToJSON CommonMinimumMatch where
17051768 toJSON (CommonMinimumMatch mm) = toJSON mm
17061769 toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1707− object [ "low_freq" .= toJSON lowF
1708− , "high_freq" .= toJSON highF ]
1770+ object [ "low_freq" .= lowF
1771+ , "high_freq" .= highF ]
17091772
17101773instance ToJSON BoostingQuery where
17111774 toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1712− object [ "positive" .= toJSON bqPositiveQuery
1713− , "negative" .= toJSON bqNegativeQuery
1714− , "negative_boost" .= toJSON bqNegativeBoost ]
1775+ object [ "positive" .= bqPositiveQuery
1776+ , "negative" .= bqNegativeQuery
1777+ , "negative_boost" .= bqNegativeBoost ]
17151778
17161779
17171780instance ToJSON BoolQuery where
17181781 toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
17191782 omitNulls base
1720− where base = [ "must" .= toJSON mustM
1721− , "must_not" .= toJSON notM
1722− , "should" .= toJSON shouldM
1723− , "minimum_should_match" .= toJSON bqMin
1724− , "boost" .= toJSON boost
1725− , "disable_coord" .= toJSON disableCoord ]
1783+ where base = [ "must" .= mustM
1784+ , "must_not" .= notM
1785+ , "should" .= shouldM
1786+ , "minimum_should_match" .= bqMin
1787+ , "boost" .= boost
1788+ , "disable_coord" .= disableCoord ]
17261789
17271790
17281791instance ToJSON MatchQuery where
@@ -1732,13 +1795,13 @@ instance ToJSON MatchQuery where
17321795 analyzer maxExpansions lenient) =
17331796 object [ fieldName .= omitNulls base ]
17341797 where base = [ "query" .= mqQueryString
1735− , "operator" .= toJSON booleanOperator
1736− , "zero_terms_query" .= toJSON zeroTermsQuery
1737− , "cutoff_frequency" .= toJSON cutoffFrequency
1738− , "type" .= toJSON matchQueryType
1739− , "analyzer" .= toJSON analyzer
1740− , "max_expansions" .= toJSON maxExpansions
1741− , "lenient" .= toJSON lenient ]
1798+ , "operator" .= booleanOperator
1799+ , "zero_terms_query" .= zeroTermsQuery
1800+ , "cutoff_frequency" .= cutoffFrequency
1801+ , "type" .= matchQueryType
1802+ , "analyzer" .= analyzer
1803+ , "max_expansions" .= maxExpansions
1804+ , "lenient" .= lenient ]
17421805
17431806
17441807instance ToJSON MultiMatchQuery where
@@ -1747,14 +1810,14 @@ instance ToJSON MultiMatchQuery where
17471810 object ["multi_match" .= omitNulls base]
17481811 where base = [ "fields" .= fmap toJSON fields
17491812 , "query" .= query
1750− , "operator" .= toJSON boolOp
1751− , "zero_terms_query" .= toJSON ztQ
1752− , "tiebreaker" .= toJSON tb
1753− , "type" .= toJSON mmqt
1754− , "cutoff_frequency" .= toJSON cf
1755− , "analyzer" .= toJSON analyzer
1756− , "max_expansions" .= toJSON maxEx
1757− , "lenient" .= toJSON lenient ]
1813+ , "operator" .= boolOp
1814+ , "zero_terms_query" .= ztQ
1815+ , "tiebreaker" .= tb
1816+ , "type" .= mmqt
1817+ , "cutoff_frequency" .= cf
1818+ , "analyzer" .= analyzer
1819+ , "max_expansions" .= maxEx
1820+ , "lenient" .= lenient ]
17581821
17591822
17601823instance ToJSON MultiMatchQueryType where
@@ -1866,7 +1929,7 @@ instance ToJSON FieldHighlight where
18661929
18671930instance ToJSON Highlights where
18681931 toJSON (Highlights global fields) =
1869− omitNulls (("fields" .= toJSON fields)
1932+ omitNulls (("fields" .= fields)
18701933 : highlightSettingsPairs global)
18711934
18721935instance ToJSON HighlightSettings where
@@ -1944,16 +2007,16 @@ instance ToJSON SortSpec where
19442007 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
19452008 dsSortMode dsMissingSort dsNestedFilter)) =
19462009 object [dsSortFieldName .= omitNulls base] where
1947− base = [ "order" .= toJSON dsSortOrder
2010+ base = [ "order" .= dsSortOrder
19482011 , "ignore_unmapped" .= dsIgnoreUnmapped
19492012 , "mode" .= dsSortMode
19502013 , "missing" .= dsMissingSort
19512014 , "nested_filter" .= dsNestedFilter ]
19522015
19532016 toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
1954− object [ "unit" .= toJSON units
1955− , field .= toJSON gdsLatLon
1956− , "order" .= toJSON gdsSortOrder ]
2017+ object [ "unit" .= units
2018+ , field .= gdsLatLon
2019+ , "order" .= gdsSortOrder ]
19572020
19582021
19592022instance ToJSON SortOrder where
@@ -2015,7 +2078,7 @@ instance ToJSON OptimizeBbox where
20152078instance ToJSON GeoBoundingBoxConstraint where
20162079 toJSON (GeoBoundingBoxConstraint
20172080 (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
2018− object [gbbcGeoBBField .= toJSON gbbcConstraintBox
2081+ object [gbbcGeoBBField .= gbbcConstraintBox
20192082 , "_cache" .= cache
20202083 , "type" .= type']
20212084
@@ -2027,8 +2090,8 @@ instance ToJSON GeoFilterType where
20272090
20282091instance ToJSON GeoBoundingBox where
20292092 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
2030− object ["top_left" .= toJSON gbbTopLeft
2031− , "bottom_right" .= toJSON gbbBottomRight]
2093+ object ["top_left" .= gbbTopLeft
2094+ , "bottom_right" .= gbbBottomRight]
20322095
20332096
20342097instance ToJSON LatLon where
@@ -2061,9 +2124,9 @@ instance ToJSON Term where
20612124
20622125
20632126instance ToJSON BoolMatch where
2064− toJSON (MustMatch term cache) = object ["must" .= toJSON term,
2127+ toJSON (MustMatch term cache) = object ["must" .= term,
20652128 "_cache" .= cache]
2066− toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
2129+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
20672130 "_cache" .= cache]
20682131 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
20692132 "_cache" .= cache]
tests/tests.hs+127−99
@@ -6,8 +6,9 @@ module Main where
66
77import Control.Applicative
88import Control.Monad
9+import Control.Monad.Reader
910import Data.Aeson
10−import qualified Data.HashMap.Strict as HM
11+import qualified Data.HashMap.Strict as HM
1112import Data.List (nub)
1213import Data.List.NonEmpty (NonEmpty (..))
1314import qualified Data.List.NonEmpty as NE
@@ -34,15 +35,18 @@ testIndex = IndexName "bloodhound-tests-twitter-1"
3435testMapping :: MappingName
3536testMapping = MappingName "tweet"
3637
38+withTestEnv :: BH IO a -> IO a
39+withTestEnv = withBH defaultManagerSettings testServer
40+
3741validateStatus :: Response body -> Int -> Expectation
3842validateStatus resp expected =
3943 (NHTS.statusCode $ responseStatus resp)
4044 `shouldBe` (expected :: Int)
4145
42−createExampleIndex :: IO Reply
43−createExampleIndex = createIndex testServer defaultIndexSettings testIndex
44−deleteExampleIndex :: IO Reply
45−deleteExampleIndex = deleteIndex testServer testIndex
46+createExampleIndex :: BH IO Reply
47+createExampleIndex = createIndex defaultIndexSettings testIndex
48+deleteExampleIndex :: BH IO Reply
49+deleteExampleIndex = deleteIndex testIndex
4650
4751data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
4852
@@ -70,18 +74,16 @@ mkServerVersion [majorVer, minorVer, patchVer] =
7074 Just (ServerVersion majorVer minorVer patchVer)
7175mkServerVersion _ = Nothing
7276
73−getServerVersion :: Server -> IO (Maybe ServerVersion)
74−getServerVersion s = liftM extractVersion (getStatus s)
77+getServerVersion :: IO (Maybe ServerVersion)
78+getServerVersion = liftM extractVersion (withTestEnv getStatus)
7579 where
7680 version' = T.splitOn "." . number . version
7781 toInt = read . T.unpack
7882 parseVersion v = map toInt (version' v)
7983 extractVersion = join . liftM (mkServerVersion . parseVersion)
8084
81−
82−
8385testServerBranch :: IO (Maybe ServerVersion)
84−testServerBranch = getServerVersion testServer >>= \v -> return $ liftM serverBranch v
86+testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
8587
8688atleast :: ServerVersion -> IO Bool
8789atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
@@ -136,60 +138,63 @@ otherTweet = Tweet { user = "notmyapp"
136138 , age = 1000
137139 , location = Location 40.12 (-71.34) }
138140
139−insertData :: IO ()
141+insertData :: BH IO ()
140142insertData = do
141143 _ <- deleteExampleIndex
142144 _ <- createExampleIndex
143− _ <- putMapping testServer testIndex testMapping TweetMapping
144− _ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
145− _ <- refreshIndex testServer testIndex
145+ _ <- putMapping testIndex testMapping TweetMapping
146+ _ <- indexDocument testIndex testMapping exampleTweet (DocId "1")
147+ _ <- refreshIndex testIndex
146148 return ()
147149
148−insertOther :: IO ()
150+insertOther :: BH IO ()
149151insertOther = do
150− _ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")
151− _ <- refreshIndex testServer testIndex
152+ _ <- indexDocument testIndex testMapping otherTweet (DocId "2")
153+ _ <- refreshIndex testIndex
152154 return ()
153155
154−searchTweet :: Search -> IO (Either String Tweet)
156+searchTweet :: Search -> BH IO (Either String Tweet)
155157searchTweet search = do
156− reply <- searchByIndex testServer testIndex search
158+ reply <- searchByIndex testIndex search
157159 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
158160 let myTweet = fmap (hitSource . head . hits . searchHits) result
159161 return myTweet
160162
161−searchExpectNoResults :: Search -> IO ()
163+searchExpectNoResults :: Search -> BH IO ()
162164searchExpectNoResults search = do
163− reply <- searchByIndex testServer testIndex search
165+ reply <- searchByIndex testIndex search
164166 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
165167 let emptyHits = fmap (hits . searchHits) result
166− emptyHits `shouldBe` Right []
168+ liftIO $
169+ emptyHits `shouldBe` Right []
167170
168−searchExpectAggs :: Search -> IO ()
171+searchExpectAggs :: Search -> BH IO ()
169172searchExpectAggs search = do
170− reply <- searchAll testServer search
173+ reply <- searchAll search
171174 let isEmpty x = return (M.null x)
172175 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
173− (result >>= aggregations >>= isEmpty) `shouldBe` Just False
176+ liftIO $
177+ (result >>= aggregations >>= isEmpty) `shouldBe` Just False
174178
175−searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> IO ()
179+searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
176180searchValidBucketAgg search aggKey extractor = do
177− reply <- searchAll testServer search
181+ reply <- searchAll search
178182 let bucketDocs = docCount . head . buckets
179183 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
180184 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
181− count `shouldBe` Just 1
185+ liftIO $
186+ count `shouldBe` Just 1
182187
183−searchTermsAggHint :: [ExecutionHint] -> IO ()
188+searchTermsAggHint :: [ExecutionHint] -> BH IO ()
184189searchTermsAggHint hints = do
185190 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
186191 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
187192 forM_ hints $ searchExpectAggs . search
188193 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
189194
190−searchTweetHighlight :: Search -> IO (Either String (Maybe HitHighlight))
195+searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight))
191196searchTweetHighlight search = do
192− reply <- searchByIndex testServer testIndex search
197+ reply <- searchByIndex testIndex search
193198 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
194199 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
195200 return myHighlight
@@ -223,26 +228,27 @@ main :: IO ()
223228main = hspec $ do
224229
225230 describe "index create/delete API" $ do
226− it "creates and then deletes the requested index" $ do
231+ it "creates and then deletes the requested index" $ withTestEnv $ do
227232 -- priming state.
228233 _ <- deleteExampleIndex
229234 resp <- createExampleIndex
230235 deleteResp <- deleteExampleIndex
231− validateStatus resp 200
232− validateStatus deleteResp 200
236+ liftIO $ do
237+ validateStatus resp 200
238+ validateStatus deleteResp 200
233239
234240
235241 describe "document API" $ do
236− it "indexes, gets, and then deletes the generated document" $ do
242+ it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
237243 _ <- insertData
238− docInserted <- getDocument testServer testIndex testMapping (DocId "1")
244+ docInserted <- getDocument testIndex testMapping (DocId "1")
239245 let newTweet = eitherDecode
240246 (responseBody docInserted) :: Either String (EsResult Tweet)
241− fmap _source newTweet `shouldBe` Right exampleTweet
247+ liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)
242248
243249
244250 describe "bulk API" $ do
245− it "inserts all documents we request" $ do
251+ it "inserts all documents we request" $ withTestEnv $ do
246252 _ <- insertData
247253 let firstTest = BulkTest "blah"
248254 let secondTest = BulkTest "bloo"
@@ -251,49 +257,54 @@ main = hspec $ do
251257 let secondDoc = BulkCreate testIndex
252258 testMapping (DocId "3") (toJSON secondTest)
253259 let stream = V.fromList [firstDoc, secondDoc]
254− _ <- bulk testServer stream
255− _ <- refreshIndex testServer testIndex
256− fDoc <- getDocument testServer testIndex testMapping (DocId "2")
257− sDoc <- getDocument testServer testIndex testMapping (DocId "3")
260+ _ <- bulk stream
261+ _ <- refreshIndex testIndex
262+ fDoc <- getDocument testIndex testMapping (DocId "2")
263+ sDoc <- getDocument testIndex testMapping (DocId "3")
258264 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
259265 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
260− fmap _source maybeFirst `shouldBe` Right firstTest
261− fmap _source maybeSecond `shouldBe` Right secondTest
266+ liftIO $ do
267+ fmap _source maybeFirst `shouldBe` Right firstTest
268+ fmap _source maybeSecond `shouldBe` Right secondTest
262269
263270
264271 describe "query API" $ do
265− it "returns document for term query and identity filter" $ do
272+ it "returns document for term query and identity filter" $ withTestEnv $ do
266273 _ <- insertData
267274 let query = TermQuery (Term "user" "bitemyapp") Nothing
268275 let filter = IdentityFilter <&&> IdentityFilter
269276 let search = mkSearch (Just query) (Just filter)
270277 myTweet <- searchTweet search
271− myTweet `shouldBe` Right exampleTweet
278+ liftIO $
279+ myTweet `shouldBe` Right exampleTweet
272280
273− it "returns document for terms query and identity filter" $ do
281+ it "returns document for terms query and identity filter" $ withTestEnv $ do
274282 _ <- insertData
275283 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])
276284 let filter = IdentityFilter <&&> IdentityFilter
277285 let search = mkSearch (Just query) (Just filter)
278286 myTweet <- searchTweet search
279− myTweet `shouldBe` Right exampleTweet
287+ liftIO $
288+ myTweet `shouldBe` Right exampleTweet
280289
281− it "returns document for match query" $ do
290+ it "returns document for match query" $ withTestEnv $ do
282291 _ <- insertData
283292 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
284293 let search = mkSearch (Just query) Nothing
285294 myTweet <- searchTweet search
286− myTweet `shouldBe` Right exampleTweet
295+ liftIO $
296+ myTweet `shouldBe` Right exampleTweet
287297
288− it "returns document for multi-match query" $ do
298+ it "returns document for multi-match query" $ withTestEnv $ do
289299 _ <- insertData
290300 let fields = [FieldName "user", FieldName "message"]
291301 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
292302 let search = mkSearch (Just query) Nothing
293303 myTweet <- searchTweet search
294− myTweet `shouldBe` Right exampleTweet
304+ liftIO $
305+ myTweet `shouldBe` Right exampleTweet
295306
296− it "returns document for bool query" $ do
307+ it "returns document for bool query" $ withTestEnv $ do
297308 _ <- insertData
298309 let innerQuery = QueryMatchQuery $
299310 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
@@ -301,18 +312,20 @@ main = hspec $ do
301312 mkBoolQuery [innerQuery] [] []
302313 let search = mkSearch (Just query) Nothing
303314 myTweet <- searchTweet search
304− myTweet `shouldBe` Right exampleTweet
315+ liftIO $
316+ myTweet `shouldBe` Right exampleTweet
305317
306− it "returns document for boosting query" $ do
318+ it "returns document for boosting query" $ withTestEnv $ do
307319 _ <- insertData
308320 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
309321 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
310322 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
311323 let search = mkSearch (Just query) Nothing
312324 myTweet <- searchTweet search
313− myTweet `shouldBe` Right exampleTweet
325+ liftIO $
326+ myTweet `shouldBe` Right exampleTweet
314327
315− it "returns document for common terms query" $ do
328+ it "returns document for common terms query" $ withTestEnv $ do
316329 _ <- insertData
317330 let query = QueryCommonTermsQuery $
318331 CommonTermsQuery (FieldName "user")
@@ -321,55 +334,61 @@ main = hspec $ do
321334 Or Or Nothing Nothing Nothing Nothing
322335 let search = mkSearch (Just query) Nothing
323336 myTweet <- searchTweet search
324− myTweet `shouldBe` Right exampleTweet
337+ liftIO $
338+ myTweet `shouldBe` Right exampleTweet
325339
326340
327341 describe "sorting" $ do
328− it "returns documents in the right order" $ do
342+ it "returns documents in the right order" $ withTestEnv $ do
329343 _ <- insertData
330344 _ <- insertOther
331345 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
332346 let search = Search Nothing
333347 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
334− False 0 10
335− reply <- searchByIndex testServer testIndex search
348+ False (From 0) (Size 10)
349+ reply <- searchByIndex testIndex search
336350 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
337351 let myTweet = fmap (hitSource . head . hits . searchHits) result
338− myTweet `shouldBe` Right otherTweet
352+ liftIO $
353+ myTweet `shouldBe` Right otherTweet
339354
340355
341356 describe "filtering API" $ do
342− it "returns document for composed boolmatch and identity" $ do
357+ it "returns document for composed boolmatch and identity" $ withTestEnv $ do
343358 _ <- insertData
344359 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
345360 <&&> IdentityFilter
346361 let search = mkSearch Nothing (Just queryFilter)
347362 myTweet <- searchTweet search
348− myTweet `shouldBe` Right exampleTweet
363+ liftIO $
364+ myTweet `shouldBe` Right exampleTweet
349365
350− it "returns document for term filter" $ do
366+ it "returns document for term filter" $ withTestEnv $ do
351367 _ <- insertData
352368 let termFilter = TermFilter (Term "user" "bitemyapp") False
353369 let search = mkSearch Nothing (Just termFilter)
354370 myTweet <- searchTweet search
355− myTweet `shouldBe` Right exampleTweet
371+ liftIO $
372+ myTweet `shouldBe` Right exampleTweet
356373
357− it "returns document for existential filter" $ do
374+ it "returns document for existential filter" $ withTestEnv $ do
358375 _ <- insertData
359376 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
360377 myTweet <- searchTweet search
361− myTweet `shouldBe` Right exampleTweet
378+ liftIO $
379+ myTweet `shouldBe` Right exampleTweet
362380
363− it "returns document for geo boundingbox filter" $ do
381+ it "returns document for geo boundingbox filter" $ withTestEnv $ do
364382 _ <- insertData
365383 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
366384 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
367385 let geoFilter = GeoBoundingBoxFilter bbConstraint
368386 let search = mkSearch Nothing (Just geoFilter)
369387 myTweet <- searchTweet search
370− myTweet `shouldBe` Right exampleTweet
388+ liftIO $
389+ myTweet `shouldBe` Right exampleTweet
371390
372− it "doesn't return document for nonsensical boundingbox filter" $ do
391+ it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
373392 _ <- insertData
374393 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
375394 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
@@ -377,7 +396,7 @@ main = hspec $ do
377396 let search = mkSearch Nothing (Just geoFilter)
378397 searchExpectNoResults search
379398
380− it "returns document for geo distance filter" $ do
399+ it "returns document for geo distance filter" $ withTestEnv $ do
381400 _ <- insertData
382401 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
383402 let distance = Distance 10.0 Miles
@@ -385,18 +404,20 @@ main = hspec $ do
385404 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
386405 let search = mkSearch Nothing (Just geoFilter)
387406 myTweet <- searchTweet search
388− myTweet `shouldBe` Right exampleTweet
407+ liftIO $
408+ myTweet `shouldBe` Right exampleTweet
389409
390− it "returns document for geo distance range filter" $ do
410+ it "returns document for geo distance range filter" $ withTestEnv $ do
391411 _ <- insertData
392412 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
393413 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
394414 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
395415 let search = mkSearch Nothing (Just geoFilter)
396416 myTweet <- searchTweet search
397− myTweet `shouldBe` Right exampleTweet
417+ liftIO $
418+ myTweet `shouldBe` Right exampleTweet
398419
399− it "doesn't return document for wild geo distance range filter" $ do
420+ it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
400421 _ <- insertData
401422 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
402423 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
@@ -404,7 +425,7 @@ main = hspec $ do
404425 let search = mkSearch Nothing (Just geoFilter)
405426 searchExpectNoResults search
406427
407− it "returns document for geo polygon filter" $ do
428+ it "returns document for geo polygon filter" $ withTestEnv $ do
408429 _ <- insertData
409430 let points = [LatLon 40.0 (-70.00),
410431 LatLon 40.0 (-72.00),
@@ -413,9 +434,10 @@ main = hspec $ do
413434 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
414435 let search = mkSearch Nothing (Just geoFilter)
415436 myTweet <- searchTweet search
416− myTweet `shouldBe` Right exampleTweet
437+ liftIO $
438+ myTweet `shouldBe` Right exampleTweet
417439
418− it "doesn't return document for bad geo polygon filter" $ do
440+ it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
419441 _ <- insertData
420442 let points = [LatLon 40.0 (-70.00),
421443 LatLon 40.0 (-71.00),
@@ -425,23 +447,25 @@ main = hspec $ do
425447 let search = mkSearch Nothing (Just geoFilter)
426448 searchExpectNoResults search
427449
428− it "returns document for ids filter" $ do
450+ it "returns document for ids filter" $ withTestEnv $ do
429451 _ <- insertData
430452 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
431453 let search = mkSearch Nothing (Just filter)
432454 myTweet <- searchTweet search
433− myTweet `shouldBe` Right exampleTweet
455+ liftIO $
456+ myTweet `shouldBe` Right exampleTweet
434457
435− it "returns document for Double range filter" $ do
458+ it "returns document for Double range filter" $ withTestEnv $ do
436459 _ <- insertData
437460 let filter = RangeFilter (FieldName "age")
438461 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
439462 RangeExecutionIndex False
440463 let search = mkSearch Nothing (Just filter)
441464 myTweet <- searchTweet search
442− myTweet `shouldBe` Right exampleTweet
465+ liftIO $
466+ myTweet `shouldBe` Right exampleTweet
443467
444− it "returns document for UTCTime date filter" $ do
468+ it "returns document for UTCTime date filter" $ withTestEnv $ do
445469 _ <- insertData
446470 let filter = RangeFilter (FieldName "postDate")
447471 (RangeDateGtLt
@@ -454,18 +478,20 @@ main = hspec $ do
454478 RangeExecutionIndex False
455479 let search = mkSearch Nothing (Just filter)
456480 myTweet <- searchTweet search
457− myTweet `shouldBe` Right exampleTweet
481+ liftIO $
482+ myTweet `shouldBe` Right exampleTweet
458483
459484
460− it "returns document for regexp filter" $ do
485+ it "returns document for regexp filter" $ withTestEnv $ do
461486 _ <- insertData
462487 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
463488 AllRegexpFlags (CacheName "test") False (CacheKey "key")
464489 let search = mkSearch Nothing (Just filter)
465490 myTweet <- searchTweet search
466− myTweet `shouldBe` Right exampleTweet
491+ liftIO $
492+ myTweet `shouldBe` Right exampleTweet
467493
468− it "doesn't return document for non-matching regexp filter" $ do
494+ it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
469495 _ <- insertData
470496 let filter = RegexpFilter (FieldName "user")
471497 (Regexp "boy") AllRegexpFlags
@@ -474,40 +500,40 @@ main = hspec $ do
474500 searchExpectNoResults search
475501
476502 describe "Aggregation API" $ do
477− it "returns term aggregation results" $ do
503+ it "returns term aggregation results" $ withTestEnv $ do
478504 _ <- insertData
479505 let terms = TermsAgg $ mkTermsAggregation "user"
480506 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
481507 searchExpectAggs search
482508 searchValidBucketAgg search "users" toTerms
483509
484− it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ do
510+ it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
485511 _ <- insertData
486512 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
487513 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
488514 searchExpectAggs search
489515 searchValidBucketAgg search "users" toTerms
490516
491− it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ do
517+ it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
492518 _ <- insertData
493519 searchTermsAggHint [Map, Ordinals]
494520
495− it "can give execution hint paramters to term aggregations" $ when' (is es12) $ do
521+ it "can give execution hint paramters to term aggregations" $ when' (is es12) $ withTestEnv $ do
496522 _ <- insertData
497523 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
498524
499− it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ do
525+ it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
500526 _ <- insertData
501527 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
502528
503− it "returns date histogram aggregation results" $ do
529+ it "returns date histogram aggregation results" $ withTestEnv $ do
504530 _ <- insertData
505531 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
506532 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
507533 searchExpectAggs search
508534 searchValidBucketAgg search "byDate" toDateHistogram
509535
510− it "returns date histogram using fractional date" $ do
536+ it "returns date histogram using fractional date" $ withTestEnv $ do
511537 _ <- insertData
512538 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
513539 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
@@ -521,7 +547,7 @@ main = hspec $ do
521547
522548 describe "Highlights API" $ do
523549
524− it "returns highlight from query when there should be one" $ do
550+ it "returns highlight from query when there should be one" $ withTestEnv $ do
525551 _ <- insertData
526552 _ <- insertOther
527553 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
@@ -529,9 +555,10 @@ main = hspec $ do
529555
530556 let search = mkHighlightSearch (Just query) testHighlight
531557 myHighlight <- searchTweetHighlight search
532− myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
558+ liftIO $
559+ myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
533560
534− it "doesn't return highlight from a query when it shouldn't" $ do
561+ it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
535562 _ <- insertData
536563 _ <- insertOther
537564 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
@@ -539,7 +566,8 @@ main = hspec $ do
539566
540567 let search = mkHighlightSearch (Just query) testHighlight
541568 myHighlight <- searchTweetHighlight search
542− myHighlight `shouldBe` Right Nothing
569+ liftIO $
570+ myHighlight `shouldBe` Right Nothing
543571
544572
545573