git.iko.soy/typeable/bloodhound
on master help sign in
Merge remote-tracking branch 'origin/next-gen'
commite447be9d5c671f83a59cd2ec83da2d3aab66c56b authorChris Allen <cma@bitemyapp.com> dateThu 4 Jun 2015, 17:27 (11 years ago) parent13775d07da3fe2
6 files changed+651−428
compare with master
unifiedsplit
.travis.yml+1−1 README.md+36−18 bloodhound.cabal+17−7 src/Database/Bloodhound/Client.hs+189−131 src/Database/Bloodhound/Types.hs+227−157 tests/tests.hs+181−114
.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+17−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,9 @@ 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,
66+ quickcheck-properties
6067 default-language: Haskell2010
6168
6269test-suite doctests
@@ -64,8 +71,11 @@ test-suite doctests
6471 type: exitcode-stdio-1.0
6572 main-is: doctests.hs
6673 hs-source-dirs: tests
67− build-depends: base,
68− directory,
69− doctest,
70− doctest-prop,
71− filepath
74+ if impl(ghc >= 7.8)
75+ build-depends: base,
76+ directory,
77+ doctest,
78+ doctest-prop,
79+ filepath
80+ else
81+ 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+227−157
@@ -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
@@ -1055,13 +1118,20 @@ data SearchResult a =
10551118 , searchHits :: SearchHits a
10561119 , aggregations :: Maybe AggregationResults } deriving (Eq, Show)
10571120
1058−type Score = Double
1121+type Score = Maybe Double
10591122
10601123data SearchHits a =
10611124 SearchHits { hitsTotal :: Int
10621125 , maxScore :: Score
10631126 , hits :: [Hit a] } deriving (Eq, Show)
10641127
1128+
1129+instance Monoid (SearchHits a) where
1130+ mempty = SearchHits 0 Nothing mempty
1131+ mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =
1132+ SearchHits (ta + tb) (max ma mb) (ha <> hb)
1133+
1134+
10651135data Hit a =
10661136 Hit { hitIndex :: IndexName
10671137 , hitType :: MappingName
@@ -1195,29 +1265,29 @@ instance Show TimeInterval where
11951265instance ToJSON Aggregation where
11961266 toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
11971267 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
1268+ "include" .= include,
1269+ "exclude" .= exclude,
1270+ "order" .= order,
1271+ "min_doc_count" .= minDocCount,
1272+ "size" .= size,
1273+ "shard_size" .= shardSize,
1274+ "collect_mode" .= collectMode,
1275+ "execution_hint" .= executionHint
12061276 ],
1207− "aggs" .= toJSON termAggs ]
1277+ "aggs" .= termAggs ]
12081278 where
1209− toJSON' x = case x of { Left y -> "field" .= toJSON y; Right y -> "script" .= toJSON y }
1279+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
12101280
12111281 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
1282+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1283+ "interval" .= interval,
1284+ "format" .= format,
1285+ "pre_zone" .= preZone,
1286+ "post_zone" .= postZone,
1287+ "pre_offset" .= preOffset,
1288+ "post_offset" .= postOffset
12191289 ],
1220− "aggs" .= toJSON dateHistoAggs ]
1290+ "aggs" .= dateHistoAggs ]
12211291
12221292type AggregationResults = M.Map Text Value
12231293
@@ -1296,7 +1366,7 @@ instance ToJSON Filter where
12961366
12971367 toJSON (NotFilter notFilter cache) =
12981368 object ["not" .=
1299− object ["filter" .= toJSON notFilter
1369+ object ["filter" .= notFilter
13001370 , "_cache" .= cache]]
13011371
13021372 toJSON (IdentityFilter) =
@@ -1312,26 +1382,26 @@ instance ToJSON Filter where
13121382 ["field" .= fieldName]]
13131383
13141384 toJSON (BoolFilter boolMatch) =
1315− object ["bool" .= toJSON boolMatch]
1385+ object ["bool" .= boolMatch]
13161386
13171387 toJSON (GeoBoundingBoxFilter bbConstraint) =
1318− object ["geo_bounding_box" .= toJSON bbConstraint]
1388+ object ["geo_bounding_box" .= bbConstraint]
13191389
13201390 toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
13211391 distance distanceType optimizeBbox cache) =
13221392 object ["geo_distance" .=
1323− object ["distance" .= toJSON distance
1324− , "distance_type" .= toJSON distanceType
1393+ object ["distance" .= distance
1394+ , "distance_type" .= distanceType
13251395 , "optimize_bbox" .= optimizeBbox
1326− , distanceGeoField .= toJSON geoDistLatLon
1396+ , distanceGeoField .= geoDistLatLon
13271397 , "_cache" .= cache]]
13281398
13291399 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
13301400 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
13311401 object ["geo_distance_range" .=
1332− object ["from" .= toJSON geoDistRangeDistFrom
1333− , "to" .= toJSON drDistanceTo
1334− , gddrField .= toJSON drLatLon]]
1402+ object ["from" .= geoDistRangeDistFrom
1403+ , "to" .= drDistanceTo
1404+ , gddrField .= drLatLon]]
13351405
13361406 toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
13371407 object ["geo_polygon" .=
@@ -1341,7 +1411,7 @@ instance ToJSON Filter where
13411411 toJSON (IdsFilter (MappingName mappingName) values) =
13421412 object ["ids" .=
13431413 object ["type" .= mappingName
1344− , "values" .= fmap (T.pack . unpackId) values]]
1414+ , "values" .= fmap unpackId values]]
13451415
13461416 toJSON (LimitFilter limit) =
13471417 object ["limit" .= object ["value" .= limit]]
@@ -1360,7 +1430,7 @@ instance ToJSON Filter where
13601430 toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
13611431 object ["range" .=
13621432 object [ fieldName .= object (rangeValueToPair rangeValue)
1363− , "execution" .= toJSON rangeExecution
1433+ , "execution" .= rangeExecution
13641434 , "_cache" .= cache]]
13651435
13661436 toJSON (RegexpFilter (FieldName fieldName)
@@ -1368,14 +1438,14 @@ instance ToJSON Filter where
13681438 object ["regexp" .=
13691439 object [fieldName .=
13701440 object ["value" .= regexText
1371− , "flags" .= toJSON flags]
1441+ , "flags" .= flags]
13721442 , "_name" .= cacheName
13731443 , "_cache" .= cache
13741444 , "_cache_key" .= cacheKey]]
13751445
13761446instance ToJSON GeoPoint where
13771447 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
1378− object [ geoPointField .= toJSON geoPointLatLon ]
1448+ object [ geoPointField .= geoPointLatLon ]
13791449
13801450
13811451instance ToJSON Query where
@@ -1395,82 +1465,82 @@ instance ToJSON Query where
13951465 getTermValue (Term _ v) = v
13961466 toJSON (IdsQuery idsQueryMappingName docIds) =
13971467 object [ "ids" .= object conjoined ]
1398− where conjoined = [ "type" .= toJSON idsQueryMappingName
1468+ where conjoined = [ "type" .= idsQueryMappingName
13991469 , "values" .= fmap toJSON docIds ]
14001470
14011471 toJSON (QueryQueryStringQuery qQueryStringQuery) =
1402− object [ "query_string" .= toJSON qQueryStringQuery ]
1472+ object [ "query_string" .= qQueryStringQuery ]
14031473
14041474 toJSON (QueryMatchQuery matchQuery) =
1405− object [ "match" .= toJSON matchQuery ]
1475+ object [ "match" .= matchQuery ]
14061476
14071477 toJSON (QueryMultiMatchQuery multiMatchQuery) =
14081478 toJSON multiMatchQuery
14091479
14101480 toJSON (QueryBoolQuery boolQuery) =
1411− object [ "bool" .= toJSON boolQuery ]
1481+ object [ "bool" .= boolQuery ]
14121482
14131483 toJSON (QueryBoostingQuery boostingQuery) =
1414− object [ "boosting" .= toJSON boostingQuery ]
1484+ object [ "boosting" .= boostingQuery ]
14151485
14161486 toJSON (QueryCommonTermsQuery commonTermsQuery) =
1417− object [ "common" .= toJSON commonTermsQuery ]
1487+ object [ "common" .= commonTermsQuery ]
14181488
14191489 toJSON (ConstantScoreFilter csFilter boost) =
1420− object [ "constant_score" .= toJSON csFilter
1421− , "boost" .= toJSON boost]
1490+ object [ "constant_score" .= csFilter
1491+ , "boost" .= boost]
14221492
14231493 toJSON (ConstantScoreQuery query boost) =
1424− object [ "constant_score" .= toJSON query
1425− , "boost" .= toJSON boost]
1494+ object [ "constant_score" .= query
1495+ , "boost" .= boost]
14261496
14271497 toJSON (QueryDisMaxQuery disMaxQuery) =
1428− object [ "dis_max" .= toJSON disMaxQuery ]
1498+ object [ "dis_max" .= disMaxQuery ]
14291499
14301500 toJSON (QueryFilteredQuery qFilteredQuery) =
1431− object [ "filtered" .= toJSON qFilteredQuery ]
1501+ object [ "filtered" .= qFilteredQuery ]
14321502
14331503 toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
1434− object [ "fuzzy_like_this" .= toJSON fuzzyQuery ]
1504+ object [ "fuzzy_like_this" .= fuzzyQuery ]
14351505
14361506 toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
1437− object [ "fuzzy_like_this_field" .= toJSON fuzzyFieldQuery ]
1507+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
14381508
14391509 toJSON (QueryFuzzyQuery fuzzyQuery) =
1440− object [ "fuzzy" .= toJSON fuzzyQuery ]
1510+ object [ "fuzzy" .= fuzzyQuery ]
14411511
14421512 toJSON (QueryHasChildQuery childQuery) =
1443− object [ "has_child" .= toJSON childQuery ]
1513+ object [ "has_child" .= childQuery ]
14441514
14451515 toJSON (QueryHasParentQuery parentQuery) =
1446− object [ "has_parent" .= toJSON parentQuery ]
1516+ object [ "has_parent" .= parentQuery ]
14471517
14481518 toJSON (QueryIndicesQuery qIndicesQuery) =
1449− object [ "indices" .= toJSON qIndicesQuery ]
1519+ object [ "indices" .= qIndicesQuery ]
14501520
14511521 toJSON (MatchAllQuery boost) =
14521522 object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
14531523
14541524 toJSON (QueryMoreLikeThisQuery query) =
1455− object [ "more_like_this" .= toJSON query ]
1525+ object [ "more_like_this" .= query ]
14561526
14571527 toJSON (QueryMoreLikeThisFieldQuery query) =
1458− object [ "more_like_this_field" .= toJSON query ]
1528+ object [ "more_like_this_field" .= query ]
14591529
14601530 toJSON (QueryNestedQuery query) =
1461− object [ "nested" .= toJSON query ]
1531+ object [ "nested" .= query ]
14621532
14631533 toJSON (QueryPrefixQuery query) =
1464− object [ "prefix" .= toJSON query ]
1534+ object [ "prefix" .= query ]
14651535
14661536 toJSON (QueryRangeQuery query) =
1467− object [ "range" .= toJSON query ]
1537+ object [ "range" .= query ]
14681538
14691539 toJSON (QueryRegexpQuery query) =
1470− object [ "regexp" .= toJSON query ]
1540+ object [ "regexp" .= query ]
14711541
14721542 toJSON (QuerySimpleQueryStringQuery query) =
1473− object [ "simple_query_string" .= toJSON query ]
1543+ object [ "simple_query_string" .= query ]
14741544
14751545
14761546omitNulls :: [(Text, Value)] -> Value
@@ -1483,7 +1553,7 @@ omitNulls = object . filter notNull where
14831553instance ToJSON SimpleQueryStringQuery where
14841554 toJSON SimpleQueryStringQuery {..} =
14851555 omitNulls (base ++ maybeAdd)
1486− where base = [ "query" .= toJSON simpleQueryStringQuery ]
1556+ where base = [ "query" .= simpleQueryStringQuery ]
14871557 maybeAdd = [ "fields" .= simpleQueryStringField
14881558 , "default_operator" .= simpleQueryStringOperator
14891559 , "analyzer" .= simpleQueryStringAnalyzer
@@ -1519,7 +1589,7 @@ instance ToJSON RegexpQuery where
15191589 rqQueryBoost) =
15201590 object [ rqQueryField .= omitNulls base ]
15211591 where base = [ "value" .= regexpQueryQuery
1522− , "flags" .= toJSON rqQueryFlags
1592+ , "flags" .= rqQueryFlags
15231593 , "boost" .= rqQueryBoost ]
15241594
15251595
@@ -1535,7 +1605,7 @@ instance ToJSON QueryStringQuery where
15351605 qsLenient qsLocale) =
15361606 omitNulls base
15371607 where
1538− base = [ "query" .= toJSON qsQueryString
1608+ base = [ "query" .= qsQueryString
15391609 , "default_field" .= qsDefaultField
15401610 , "default_operator" .= qsOperator
15411611 , "analyzer" .= qsAnalyzer
@@ -1557,21 +1627,21 @@ instance ToJSON QueryStringQuery where
15571627instance ToJSON RangeQuery where
15581628 toJSON (RangeQuery (FieldName fieldName) range boost) =
15591629 object [ fieldName .= conjoined ]
1560− where conjoined = [ "boost" .= toJSON boost ] ++ (rangeValueToPair range)
1630+ where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
15611631
15621632
15631633instance ToJSON PrefixQuery where
15641634 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
15651635 object [ fieldName .= omitNulls base ]
1566− where base = [ "value" .= toJSON queryValue
1636+ where base = [ "value" .= queryValue
15671637 , "boost" .= boost ]
15681638
15691639
15701640instance ToJSON NestedQuery where
15711641 toJSON (NestedQuery nqPath nqScoreType nqQuery) =
1572− object [ "path" .= toJSON nqPath
1573− , "score_mode" .= toJSON nqScoreType
1574− , "query" .= toJSON nqQuery ]
1642+ object [ "path" .= nqPath
1643+ , "score_mode" .= nqScoreType
1644+ , "query" .= nqQuery ]
15751645
15761646
15771647instance ToJSON MoreLikeThisFieldQuery where
@@ -1579,7 +1649,7 @@ instance ToJSON MoreLikeThisFieldQuery where
15791649 percent mtf mqt stopwords mindf maxdf
15801650 minwl maxwl boostTerms boost analyzer) =
15811651 object [ fieldName .= omitNulls base ]
1582− where base = [ "like_text" .= toJSON text
1652+ where base = [ "like_text" .= text
15831653 , "percent_terms_to_match" .= percent
15841654 , "min_term_freq" .= mtf
15851655 , "max_query_terms" .= mqt
@@ -1598,7 +1668,7 @@ instance ToJSON MoreLikeThisQuery where
15981668 mtf mqt stopwords mindf maxdf
15991669 minwl maxwl boostTerms boost analyzer) =
16001670 omitNulls base
1601− where base = [ "like_text" .= toJSON text
1671+ where base = [ "like_text" .= text
16021672 , "fields" .= fields
16031673 , "percent_terms_to_match" .= percent
16041674 , "min_term_freq" .= mtf
@@ -1615,34 +1685,34 @@ instance ToJSON MoreLikeThisQuery where
16151685
16161686instance ToJSON IndicesQuery where
16171687 toJSON (IndicesQuery indices query noMatch) =
1618− omitNulls [ "indices" .= toJSON indices
1619− , "no_match_query" .= toJSON noMatch
1620− , "query" .= toJSON query ]
1688+ omitNulls [ "indices" .= indices
1689+ , "no_match_query" .= noMatch
1690+ , "query" .= query ]
16211691
16221692
16231693instance ToJSON HasParentQuery where
16241694 toJSON (HasParentQuery queryType query scoreType) =
1625− omitNulls [ "parent_type" .= toJSON queryType
1626− , "score_type" .= toJSON scoreType
1627− , "query" .= toJSON query ]
1695+ omitNulls [ "parent_type" .= queryType
1696+ , "score_type" .= scoreType
1697+ , "query" .= query ]
16281698
16291699
16301700instance ToJSON HasChildQuery where
16311701 toJSON (HasChildQuery queryType query scoreType) =
1632− omitNulls [ "query" .= toJSON query
1633− , "score_type" .= toJSON scoreType
1634− , "type" .= toJSON queryType ]
1702+ omitNulls [ "query" .= query
1703+ , "score_type" .= scoreType
1704+ , "type" .= queryType ]
16351705
16361706
16371707instance ToJSON FuzzyQuery where
16381708 toJSON (FuzzyQuery (FieldName fieldName) queryText
16391709 prefixLength maxEx fuzziness boost) =
16401710 object [ fieldName .= omitNulls base ]
1641− where base = [ "value" .= toJSON queryText
1642− , "fuzziness" .= toJSON fuzziness
1643− , "prefix_length" .= toJSON prefixLength
1644− , "boost" .= toJSON boost
1645− , "max_expansions" .= toJSON maxEx ]
1711+ where base = [ "value" .= queryText
1712+ , "fuzziness" .= fuzziness
1713+ , "prefix_length" .= prefixLength
1714+ , "boost" .= boost
1715+ , "max_expansions" .= maxEx ]
16461716
16471717
16481718instance ToJSON FuzzyLikeFieldQuery where
@@ -1650,41 +1720,41 @@ instance ToJSON FuzzyLikeFieldQuery where
16501720 fieldText maxTerms ignoreFreq fuzziness prefixLength
16511721 boost analyzer) =
16521722 object [ fieldName .=
1653− omitNulls [ "like_text" .= toJSON fieldText
1654− , "max_query_terms" .= toJSON maxTerms
1655− , "ignore_tf" .= toJSON ignoreFreq
1656− , "fuzziness" .= toJSON fuzziness
1657− , "prefix_length" .= toJSON prefixLength
1658− , "analyzer" .= toJSON analyzer
1659− , "boost" .= toJSON boost ]]
1723+ omitNulls [ "like_text" .= fieldText
1724+ , "max_query_terms" .= maxTerms
1725+ , "ignore_tf" .= ignoreFreq
1726+ , "fuzziness" .= fuzziness
1727+ , "prefix_length" .= prefixLength
1728+ , "analyzer" .= analyzer
1729+ , "boost" .= boost ]]
16601730
16611731
16621732instance ToJSON FuzzyLikeThisQuery where
16631733 toJSON (FuzzyLikeThisQuery fields text maxTerms
16641734 ignoreFreq fuzziness prefixLength boost analyzer) =
16651735 omitNulls base
1666− where base = [ "fields" .= toJSON fields
1667− , "like_text" .= toJSON text
1668− , "max_query_terms" .= toJSON maxTerms
1669− , "ignore_tf" .= toJSON ignoreFreq
1670− , "fuzziness" .= toJSON fuzziness
1671− , "prefix_length" .= toJSON prefixLength
1672− , "analyzer" .= toJSON analyzer
1673− , "boost" .= toJSON boost ]
1736+ where base = [ "fields" .= fields
1737+ , "like_text" .= text
1738+ , "max_query_terms" .= maxTerms
1739+ , "ignore_tf" .= ignoreFreq
1740+ , "fuzziness" .= fuzziness
1741+ , "prefix_length" .= prefixLength
1742+ , "analyzer" .= analyzer
1743+ , "boost" .= boost ]
16741744
16751745
16761746instance ToJSON FilteredQuery where
16771747 toJSON (FilteredQuery query fFilter) =
1678− object [ "query" .= toJSON query
1679− , "filter" .= toJSON fFilter ]
1748+ object [ "query" .= query
1749+ , "filter" .= fFilter ]
16801750
16811751
16821752instance ToJSON DisMaxQuery where
16831753 toJSON (DisMaxQuery queries tiebreaker boost) =
16841754 omitNulls base
1685− where base = [ "queries" .= toJSON queries
1686− , "boost" .= toJSON boost
1687− , "tie_breaker" .= toJSON tiebreaker ]
1755+ where base = [ "queries" .= queries
1756+ , "boost" .= boost
1757+ , "tie_breaker" .= tiebreaker ]
16881758
16891759
16901760instance ToJSON CommonTermsQuery where
@@ -1692,38 +1762,38 @@ instance ToJSON CommonTermsQuery where
16921762 (QueryString query) cf lfo hfo msm
16931763 boost analyzer disableCoord) =
16941764 object [fieldName .= omitNulls base ]
1695− where base = [ "query" .= toJSON query
1696− , "cutoff_frequency" .= toJSON cf
1697− , "low_freq_operator" .= toJSON lfo
1698− , "minimum_should_match" .= toJSON msm
1699− , "boost" .= toJSON boost
1700− , "analyzer" .= toJSON analyzer
1701− , "disable_coord" .= toJSON disableCoord
1702− , "high_freq_operator" .= toJSON hfo ]
1765+ where base = [ "query" .= query
1766+ , "cutoff_frequency" .= cf
1767+ , "low_freq_operator" .= lfo
1768+ , "minimum_should_match" .= msm
1769+ , "boost" .= boost
1770+ , "analyzer" .= analyzer
1771+ , "disable_coord" .= disableCoord
1772+ , "high_freq_operator" .= hfo ]
17031773
17041774
17051775instance ToJSON CommonMinimumMatch where
17061776 toJSON (CommonMinimumMatch mm) = toJSON mm
17071777 toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1708− object [ "low_freq" .= toJSON lowF
1709− , "high_freq" .= toJSON highF ]
1778+ object [ "low_freq" .= lowF
1779+ , "high_freq" .= highF ]
17101780
17111781instance ToJSON BoostingQuery where
17121782 toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1713− object [ "positive" .= toJSON bqPositiveQuery
1714− , "negative" .= toJSON bqNegativeQuery
1715− , "negative_boost" .= toJSON bqNegativeBoost ]
1783+ object [ "positive" .= bqPositiveQuery
1784+ , "negative" .= bqNegativeQuery
1785+ , "negative_boost" .= bqNegativeBoost ]
17161786
17171787
17181788instance ToJSON BoolQuery where
17191789 toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
17201790 omitNulls base
1721− where base = [ "must" .= toJSON mustM
1722− , "must_not" .= toJSON notM
1723− , "should" .= toJSON shouldM
1724− , "minimum_should_match" .= toJSON bqMin
1725− , "boost" .= toJSON boost
1726− , "disable_coord" .= toJSON disableCoord ]
1791+ where base = [ "must" .= mustM
1792+ , "must_not" .= notM
1793+ , "should" .= shouldM
1794+ , "minimum_should_match" .= bqMin
1795+ , "boost" .= boost
1796+ , "disable_coord" .= disableCoord ]
17271797
17281798
17291799instance ToJSON MatchQuery where
@@ -1733,13 +1803,13 @@ instance ToJSON MatchQuery where
17331803 analyzer maxExpansions lenient) =
17341804 object [ fieldName .= omitNulls base ]
17351805 where base = [ "query" .= mqQueryString
1736− , "operator" .= toJSON booleanOperator
1737− , "zero_terms_query" .= toJSON zeroTermsQuery
1738− , "cutoff_frequency" .= toJSON cutoffFrequency
1739− , "type" .= toJSON matchQueryType
1740− , "analyzer" .= toJSON analyzer
1741− , "max_expansions" .= toJSON maxExpansions
1742− , "lenient" .= toJSON lenient ]
1806+ , "operator" .= booleanOperator
1807+ , "zero_terms_query" .= zeroTermsQuery
1808+ , "cutoff_frequency" .= cutoffFrequency
1809+ , "type" .= matchQueryType
1810+ , "analyzer" .= analyzer
1811+ , "max_expansions" .= maxExpansions
1812+ , "lenient" .= lenient ]
17431813
17441814
17451815instance ToJSON MultiMatchQuery where
@@ -1748,14 +1818,14 @@ instance ToJSON MultiMatchQuery where
17481818 object ["multi_match" .= omitNulls base]
17491819 where base = [ "fields" .= fmap toJSON fields
17501820 , "query" .= query
1751− , "operator" .= toJSON boolOp
1752− , "zero_terms_query" .= toJSON ztQ
1753− , "tiebreaker" .= toJSON tb
1754− , "type" .= toJSON mmqt
1755− , "cutoff_frequency" .= toJSON cf
1756− , "analyzer" .= toJSON analyzer
1757− , "max_expansions" .= toJSON maxEx
1758− , "lenient" .= toJSON lenient ]
1821+ , "operator" .= boolOp
1822+ , "zero_terms_query" .= ztQ
1823+ , "tiebreaker" .= tb
1824+ , "type" .= mmqt
1825+ , "cutoff_frequency" .= cf
1826+ , "analyzer" .= analyzer
1827+ , "max_expansions" .= maxEx
1828+ , "lenient" .= lenient ]
17591829
17601830
17611831instance ToJSON MultiMatchQueryType where
@@ -1867,7 +1937,7 @@ instance ToJSON FieldHighlight where
18671937
18681938instance ToJSON Highlights where
18691939 toJSON (Highlights global fields) =
1870− omitNulls (("fields" .= toJSON fields)
1940+ omitNulls (("fields" .= fields)
18711941 : highlightSettingsPairs global)
18721942
18731943instance ToJSON HighlightSettings where
@@ -1945,16 +2015,16 @@ instance ToJSON SortSpec where
19452015 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
19462016 dsSortMode dsMissingSort dsNestedFilter)) =
19472017 object [dsSortFieldName .= omitNulls base] where
1948− base = [ "order" .= toJSON dsSortOrder
2018+ base = [ "order" .= dsSortOrder
19492019 , "ignore_unmapped" .= dsIgnoreUnmapped
19502020 , "mode" .= dsSortMode
19512021 , "missing" .= dsMissingSort
19522022 , "nested_filter" .= dsNestedFilter ]
19532023
19542024 toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
1955− object [ "unit" .= toJSON units
1956− , field .= toJSON gdsLatLon
1957− , "order" .= toJSON gdsSortOrder ]
2025+ object [ "unit" .= units
2026+ , field .= gdsLatLon
2027+ , "order" .= gdsSortOrder ]
19582028
19592029
19602030instance ToJSON SortOrder where
@@ -2016,7 +2086,7 @@ instance ToJSON OptimizeBbox where
20162086instance ToJSON GeoBoundingBoxConstraint where
20172087 toJSON (GeoBoundingBoxConstraint
20182088 (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
2019− object [gbbcGeoBBField .= toJSON gbbcConstraintBox
2089+ object [gbbcGeoBBField .= gbbcConstraintBox
20202090 , "_cache" .= cache
20212091 , "type" .= type']
20222092
@@ -2028,8 +2098,8 @@ instance ToJSON GeoFilterType where
20282098
20292099instance ToJSON GeoBoundingBox where
20302100 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
2031− object ["top_left" .= toJSON gbbTopLeft
2032− , "bottom_right" .= toJSON gbbBottomRight]
2101+ object ["top_left" .= gbbTopLeft
2102+ , "bottom_right" .= gbbBottomRight]
20332103
20342104
20352105instance ToJSON LatLon where
@@ -2062,9 +2132,9 @@ instance ToJSON Term where
20622132
20632133
20642134instance ToJSON BoolMatch where
2065− toJSON (MustMatch term cache) = object ["must" .= toJSON term,
2135+ toJSON (MustMatch term cache) = object ["must" .= term,
20662136 "_cache" .= cache]
2067− toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
2137+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
20682138 "_cache" .= cache]
20692139 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
20702140 "_cache" .= cache]
tests/tests.hs+181−114
@@ -1,30 +1,33 @@
11{-# LANGUAGE DeriveGeneric #-}
22{-# LANGUAGE OverloadedStrings #-}
33{-# LANGUAGE ScopedTypeVariables #-}
4−
4+{-# OPTIONS_GHC -fno-warn-orphans #-}
55module 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 Data.List (nub)
12−import Data.List.NonEmpty (NonEmpty (..))
13−import qualified Data.List.NonEmpty as NE
14−import qualified Data.Map.Strict as M
15−import Data.Text (Text)
16−import qualified Data.Text as T
17−import Data.Time.Calendar (Day (..))
18−import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
19−import qualified Data.Vector as V
11+import qualified Data.HashMap.Strict as HM
12+import Data.List (nub)
13+import Data.List.NonEmpty (NonEmpty (..))
14+import qualified Data.List.NonEmpty as NE
15+import qualified Data.Map.Strict as M
16+import Data.Text (Text)
17+import qualified Data.Text as T
18+import Data.Time.Calendar (Day (..))
19+import Data.Time.Clock (UTCTime (..),
20+ secondsToDiffTime)
21+import qualified Data.Vector as V
2022import Database.Bloodhound
21−import GHC.Generics (Generic)
23+import GHC.Generics (Generic)
2224import Network.HTTP.Client
23−import qualified Network.HTTP.Types.Status as NHTS
24−import Prelude hiding (filter, putStrLn)
25+import qualified Network.HTTP.Types.Status as NHTS
26+import Prelude hiding (filter, putStrLn)
2527import Test.Hspec
28+import Test.QuickCheck.Property.Monoid
2629
27−import Test.Hspec.QuickCheck (prop)
30+import Test.Hspec.QuickCheck (prop)
2831import Test.QuickCheck
2932
3033testServer :: Server
@@ -34,15 +37,18 @@ testIndex = IndexName "bloodhound-tests-twitter-1"
3437testMapping :: MappingName
3538testMapping = MappingName "tweet"
3639
40+withTestEnv :: BH IO a -> IO a
41+withTestEnv = withBH defaultManagerSettings testServer
42+
3743validateStatus :: Response body -> Int -> Expectation
3844validateStatus resp expected =
3945 (NHTS.statusCode $ responseStatus resp)
4046 `shouldBe` (expected :: Int)
4147
42−createExampleIndex :: IO Reply
43−createExampleIndex = createIndex testServer defaultIndexSettings testIndex
44−deleteExampleIndex :: IO Reply
45−deleteExampleIndex = deleteIndex testServer testIndex
48+createExampleIndex :: BH IO Reply
49+createExampleIndex = createIndex defaultIndexSettings testIndex
50+deleteExampleIndex :: BH IO Reply
51+deleteExampleIndex = deleteIndex testIndex
4652
4753data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
4854
@@ -70,18 +76,16 @@ mkServerVersion [majorVer, minorVer, patchVer] =
7076 Just (ServerVersion majorVer minorVer patchVer)
7177mkServerVersion _ = Nothing
7278
73−getServerVersion :: Server -> IO (Maybe ServerVersion)
74−getServerVersion s = liftM extractVersion (getStatus s)
79+getServerVersion :: IO (Maybe ServerVersion)
80+getServerVersion = liftM extractVersion (withTestEnv getStatus)
7581 where
7682 version' = T.splitOn "." . number . version
7783 toInt = read . T.unpack
7884 parseVersion v = map toInt (version' v)
7985 extractVersion = join . liftM (mkServerVersion . parseVersion)
8086
81−
82−
8387testServerBranch :: IO (Maybe ServerVersion)
84−testServerBranch = getServerVersion testServer >>= \v -> return $ liftM serverBranch v
88+testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
8589
8690atleast :: ServerVersion -> IO Bool
8791atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
@@ -136,60 +140,63 @@ otherTweet = Tweet { user = "notmyapp"
136140 , age = 1000
137141 , location = Location 40.12 (-71.34) }
138142
139−insertData :: IO ()
143+insertData :: BH IO ()
140144insertData = do
141145 _ <- deleteExampleIndex
142146 _ <- createExampleIndex
143− _ <- putMapping testServer testIndex testMapping TweetMapping
144− _ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
145− _ <- refreshIndex testServer testIndex
147+ _ <- putMapping testIndex testMapping TweetMapping
148+ _ <- indexDocument testIndex testMapping exampleTweet (DocId "1")
149+ _ <- refreshIndex testIndex
146150 return ()
147151
148−insertOther :: IO ()
152+insertOther :: BH IO ()
149153insertOther = do
150− _ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")
151− _ <- refreshIndex testServer testIndex
154+ _ <- indexDocument testIndex testMapping otherTweet (DocId "2")
155+ _ <- refreshIndex testIndex
152156 return ()
153157
154−searchTweet :: Search -> IO (Either String Tweet)
158+searchTweet :: Search -> BH IO (Either String Tweet)
155159searchTweet search = do
156− reply <- searchByIndex testServer testIndex search
160+ reply <- searchByIndex testIndex search
157161 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
158162 let myTweet = fmap (hitSource . head . hits . searchHits) result
159163 return myTweet
160164
161−searchExpectNoResults :: Search -> IO ()
165+searchExpectNoResults :: Search -> BH IO ()
162166searchExpectNoResults search = do
163− reply <- searchByIndex testServer testIndex search
167+ reply <- searchByIndex testIndex search
164168 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
165169 let emptyHits = fmap (hits . searchHits) result
166− emptyHits `shouldBe` Right []
170+ liftIO $
171+ emptyHits `shouldBe` Right []
167172
168−searchExpectAggs :: Search -> IO ()
173+searchExpectAggs :: Search -> BH IO ()
169174searchExpectAggs search = do
170− reply <- searchAll testServer search
175+ reply <- searchAll search
171176 let isEmpty x = return (M.null x)
172177 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
173− (result >>= aggregations >>= isEmpty) `shouldBe` Just False
178+ liftIO $
179+ (result >>= aggregations >>= isEmpty) `shouldBe` Just False
174180
175−searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> IO ()
181+searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
176182searchValidBucketAgg search aggKey extractor = do
177− reply <- searchAll testServer search
183+ reply <- searchAll search
178184 let bucketDocs = docCount . head . buckets
179185 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
180186 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
181− count `shouldBe` Just 1
187+ liftIO $
188+ count `shouldBe` Just 1
182189
183−searchTermsAggHint :: [ExecutionHint] -> IO ()
190+searchTermsAggHint :: [ExecutionHint] -> BH IO ()
184191searchTermsAggHint hints = do
185192 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
186193 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
187194 forM_ hints $ searchExpectAggs . search
188195 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
189196
190−searchTweetHighlight :: Search -> IO (Either String (Maybe HitHighlight))
197+searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight))
191198searchTweetHighlight search = do
192− reply <- searchByIndex testServer testIndex search
199+ reply <- searchByIndex testIndex search
193200 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
194201 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
195202 return myHighlight
@@ -219,30 +226,65 @@ instance Arbitrary RegexpFlag where
219226 , pure Interval
220227 ]
221228
229+arbitraryScore :: Gen Score
230+arbitraryScore = fmap getPositive <$> arbitrary
231+
232+instance Arbitrary Text where
233+ arbitrary = T.pack <$> arbitrary
234+
235+instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where
236+ arbitrary = M.fromList <$> arbitrary
237+
238+instance Arbitrary IndexName where
239+ arbitrary = IndexName <$> arbitrary
240+
241+instance Arbitrary MappingName where
242+ arbitrary = MappingName <$> arbitrary
243+
244+instance Arbitrary DocId where
245+ arbitrary = DocId <$> arbitrary
246+
247+instance Arbitrary a => Arbitrary (Hit a) where
248+ arbitrary = Hit <$> arbitrary
249+ <*> arbitrary
250+ <*> arbitrary
251+ <*> arbitraryScore
252+ <*> arbitrary
253+ <*> arbitrary
254+
255+
256+instance Arbitrary a => Arbitrary (SearchHits a) where
257+ arbitrary = sized $ \n -> resize (n `div` 2) $ do
258+ tot <- getPositive <$> arbitrary
259+ score <- arbitraryScore
260+ hs <- arbitrary
261+ return $ SearchHits tot score hs
262+
222263main :: IO ()
223264main = hspec $ do
224265
225266 describe "index create/delete API" $ do
226− it "creates and then deletes the requested index" $ do
267+ it "creates and then deletes the requested index" $ withTestEnv $ do
227268 -- priming state.
228269 _ <- deleteExampleIndex
229270 resp <- createExampleIndex
230271 deleteResp <- deleteExampleIndex
231− validateStatus resp 200
232− validateStatus deleteResp 200
272+ liftIO $ do
273+ validateStatus resp 200
274+ validateStatus deleteResp 200
233275
234276
235277 describe "document API" $ do
236− it "indexes, gets, and then deletes the generated document" $ do
278+ it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
237279 _ <- insertData
238− docInserted <- getDocument testServer testIndex testMapping (DocId "1")
280+ docInserted <- getDocument testIndex testMapping (DocId "1")
239281 let newTweet = eitherDecode
240282 (responseBody docInserted) :: Either String (EsResult Tweet)
241− fmap _source newTweet `shouldBe` Right exampleTweet
283+ liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)
242284
243285
244286 describe "bulk API" $ do
245− it "inserts all documents we request" $ do
287+ it "inserts all documents we request" $ withTestEnv $ do
246288 _ <- insertData
247289 let firstTest = BulkTest "blah"
248290 let secondTest = BulkTest "bloo"
@@ -251,49 +293,54 @@ main = hspec $ do
251293 let secondDoc = BulkCreate testIndex
252294 testMapping (DocId "3") (toJSON secondTest)
253295 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")
296+ _ <- bulk stream
297+ _ <- refreshIndex testIndex
298+ fDoc <- getDocument testIndex testMapping (DocId "2")
299+ sDoc <- getDocument testIndex testMapping (DocId "3")
258300 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
259301 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
260− fmap _source maybeFirst `shouldBe` Right firstTest
261− fmap _source maybeSecond `shouldBe` Right secondTest
302+ liftIO $ do
303+ fmap _source maybeFirst `shouldBe` Right firstTest
304+ fmap _source maybeSecond `shouldBe` Right secondTest
262305
263306
264307 describe "query API" $ do
265− it "returns document for term query and identity filter" $ do
308+ it "returns document for term query and identity filter" $ withTestEnv $ do
266309 _ <- insertData
267310 let query = TermQuery (Term "user" "bitemyapp") Nothing
268311 let filter = IdentityFilter <&&> IdentityFilter
269312 let search = mkSearch (Just query) (Just filter)
270313 myTweet <- searchTweet search
271− myTweet `shouldBe` Right exampleTweet
314+ liftIO $
315+ myTweet `shouldBe` Right exampleTweet
272316
273− it "returns document for terms query and identity filter" $ do
317+ it "returns document for terms query and identity filter" $ withTestEnv $ do
274318 _ <- insertData
275319 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])
276320 let filter = IdentityFilter <&&> IdentityFilter
277321 let search = mkSearch (Just query) (Just filter)
278322 myTweet <- searchTweet search
279− myTweet `shouldBe` Right exampleTweet
323+ liftIO $
324+ myTweet `shouldBe` Right exampleTweet
280325
281− it "returns document for match query" $ do
326+ it "returns document for match query" $ withTestEnv $ do
282327 _ <- insertData
283328 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
284329 let search = mkSearch (Just query) Nothing
285330 myTweet <- searchTweet search
286− myTweet `shouldBe` Right exampleTweet
331+ liftIO $
332+ myTweet `shouldBe` Right exampleTweet
287333
288− it "returns document for multi-match query" $ do
334+ it "returns document for multi-match query" $ withTestEnv $ do
289335 _ <- insertData
290336 let fields = [FieldName "user", FieldName "message"]
291337 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
292338 let search = mkSearch (Just query) Nothing
293339 myTweet <- searchTweet search
294− myTweet `shouldBe` Right exampleTweet
340+ liftIO $
341+ myTweet `shouldBe` Right exampleTweet
295342
296− it "returns document for bool query" $ do
343+ it "returns document for bool query" $ withTestEnv $ do
297344 _ <- insertData
298345 let innerQuery = QueryMatchQuery $
299346 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
@@ -301,18 +348,20 @@ main = hspec $ do
301348 mkBoolQuery [innerQuery] [] []
302349 let search = mkSearch (Just query) Nothing
303350 myTweet <- searchTweet search
304− myTweet `shouldBe` Right exampleTweet
351+ liftIO $
352+ myTweet `shouldBe` Right exampleTweet
305353
306− it "returns document for boosting query" $ do
354+ it "returns document for boosting query" $ withTestEnv $ do
307355 _ <- insertData
308356 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
309357 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
310358 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
311359 let search = mkSearch (Just query) Nothing
312360 myTweet <- searchTweet search
313− myTweet `shouldBe` Right exampleTweet
361+ liftIO $
362+ myTweet `shouldBe` Right exampleTweet
314363
315− it "returns document for common terms query" $ do
364+ it "returns document for common terms query" $ withTestEnv $ do
316365 _ <- insertData
317366 let query = QueryCommonTermsQuery $
318367 CommonTermsQuery (FieldName "user")
@@ -321,55 +370,61 @@ main = hspec $ do
321370 Or Or Nothing Nothing Nothing Nothing
322371 let search = mkSearch (Just query) Nothing
323372 myTweet <- searchTweet search
324− myTweet `shouldBe` Right exampleTweet
373+ liftIO $
374+ myTweet `shouldBe` Right exampleTweet
325375
326376
327377 describe "sorting" $ do
328− it "returns documents in the right order" $ do
378+ it "returns documents in the right order" $ withTestEnv $ do
329379 _ <- insertData
330380 _ <- insertOther
331381 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
332382 let search = Search Nothing
333383 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
334− False 0 10
335− reply <- searchByIndex testServer testIndex search
384+ False (From 0) (Size 10)
385+ reply <- searchByIndex testIndex search
336386 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
337387 let myTweet = fmap (hitSource . head . hits . searchHits) result
338− myTweet `shouldBe` Right otherTweet
388+ liftIO $
389+ myTweet `shouldBe` Right otherTweet
339390
340391
341392 describe "filtering API" $ do
342− it "returns document for composed boolmatch and identity" $ do
393+ it "returns document for composed boolmatch and identity" $ withTestEnv $ do
343394 _ <- insertData
344395 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
345396 <&&> IdentityFilter
346397 let search = mkSearch Nothing (Just queryFilter)
347398 myTweet <- searchTweet search
348− myTweet `shouldBe` Right exampleTweet
399+ liftIO $
400+ myTweet `shouldBe` Right exampleTweet
349401
350− it "returns document for term filter" $ do
402+ it "returns document for term filter" $ withTestEnv $ do
351403 _ <- insertData
352404 let termFilter = TermFilter (Term "user" "bitemyapp") False
353405 let search = mkSearch Nothing (Just termFilter)
354406 myTweet <- searchTweet search
355− myTweet `shouldBe` Right exampleTweet
407+ liftIO $
408+ myTweet `shouldBe` Right exampleTweet
356409
357− it "returns document for existential filter" $ do
410+ it "returns document for existential filter" $ withTestEnv $ do
358411 _ <- insertData
359412 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
360413 myTweet <- searchTweet search
361− myTweet `shouldBe` Right exampleTweet
414+ liftIO $
415+ myTweet `shouldBe` Right exampleTweet
362416
363− it "returns document for geo boundingbox filter" $ do
417+ it "returns document for geo boundingbox filter" $ withTestEnv $ do
364418 _ <- insertData
365419 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
366420 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
367421 let geoFilter = GeoBoundingBoxFilter bbConstraint
368422 let search = mkSearch Nothing (Just geoFilter)
369423 myTweet <- searchTweet search
370− myTweet `shouldBe` Right exampleTweet
424+ liftIO $
425+ myTweet `shouldBe` Right exampleTweet
371426
372− it "doesn't return document for nonsensical boundingbox filter" $ do
427+ it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
373428 _ <- insertData
374429 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
375430 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
@@ -377,7 +432,7 @@ main = hspec $ do
377432 let search = mkSearch Nothing (Just geoFilter)
378433 searchExpectNoResults search
379434
380− it "returns document for geo distance filter" $ do
435+ it "returns document for geo distance filter" $ withTestEnv $ do
381436 _ <- insertData
382437 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
383438 let distance = Distance 10.0 Miles
@@ -385,18 +440,20 @@ main = hspec $ do
385440 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
386441 let search = mkSearch Nothing (Just geoFilter)
387442 myTweet <- searchTweet search
388− myTweet `shouldBe` Right exampleTweet
443+ liftIO $
444+ myTweet `shouldBe` Right exampleTweet
389445
390− it "returns document for geo distance range filter" $ do
446+ it "returns document for geo distance range filter" $ withTestEnv $ do
391447 _ <- insertData
392448 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
393449 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
394450 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
395451 let search = mkSearch Nothing (Just geoFilter)
396452 myTweet <- searchTweet search
397− myTweet `shouldBe` Right exampleTweet
453+ liftIO $
454+ myTweet `shouldBe` Right exampleTweet
398455
399− it "doesn't return document for wild geo distance range filter" $ do
456+ it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
400457 _ <- insertData
401458 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
402459 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
@@ -404,7 +461,7 @@ main = hspec $ do
404461 let search = mkSearch Nothing (Just geoFilter)
405462 searchExpectNoResults search
406463
407− it "returns document for geo polygon filter" $ do
464+ it "returns document for geo polygon filter" $ withTestEnv $ do
408465 _ <- insertData
409466 let points = [LatLon 40.0 (-70.00),
410467 LatLon 40.0 (-72.00),
@@ -413,9 +470,10 @@ main = hspec $ do
413470 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
414471 let search = mkSearch Nothing (Just geoFilter)
415472 myTweet <- searchTweet search
416− myTweet `shouldBe` Right exampleTweet
473+ liftIO $
474+ myTweet `shouldBe` Right exampleTweet
417475
418− it "doesn't return document for bad geo polygon filter" $ do
476+ it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
419477 _ <- insertData
420478 let points = [LatLon 40.0 (-70.00),
421479 LatLon 40.0 (-71.00),
@@ -425,23 +483,25 @@ main = hspec $ do
425483 let search = mkSearch Nothing (Just geoFilter)
426484 searchExpectNoResults search
427485
428− it "returns document for ids filter" $ do
486+ it "returns document for ids filter" $ withTestEnv $ do
429487 _ <- insertData
430488 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
431489 let search = mkSearch Nothing (Just filter)
432490 myTweet <- searchTweet search
433− myTweet `shouldBe` Right exampleTweet
491+ liftIO $
492+ myTweet `shouldBe` Right exampleTweet
434493
435− it "returns document for Double range filter" $ do
494+ it "returns document for Double range filter" $ withTestEnv $ do
436495 _ <- insertData
437496 let filter = RangeFilter (FieldName "age")
438497 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
439498 RangeExecutionIndex False
440499 let search = mkSearch Nothing (Just filter)
441500 myTweet <- searchTweet search
442− myTweet `shouldBe` Right exampleTweet
501+ liftIO $
502+ myTweet `shouldBe` Right exampleTweet
443503
444− it "returns document for UTCTime date filter" $ do
504+ it "returns document for UTCTime date filter" $ withTestEnv $ do
445505 _ <- insertData
446506 let filter = RangeFilter (FieldName "postDate")
447507 (RangeDateGtLt
@@ -454,18 +514,20 @@ main = hspec $ do
454514 RangeExecutionIndex False
455515 let search = mkSearch Nothing (Just filter)
456516 myTweet <- searchTweet search
457− myTweet `shouldBe` Right exampleTweet
517+ liftIO $
518+ myTweet `shouldBe` Right exampleTweet
458519
459520
460− it "returns document for regexp filter" $ do
521+ it "returns document for regexp filter" $ withTestEnv $ do
461522 _ <- insertData
462523 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
463524 AllRegexpFlags (CacheName "test") False (CacheKey "key")
464525 let search = mkSearch Nothing (Just filter)
465526 myTweet <- searchTweet search
466− myTweet `shouldBe` Right exampleTweet
527+ liftIO $
528+ myTweet `shouldBe` Right exampleTweet
467529
468− it "doesn't return document for non-matching regexp filter" $ do
530+ it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
469531 _ <- insertData
470532 let filter = RegexpFilter (FieldName "user")
471533 (Regexp "boy") AllRegexpFlags
@@ -474,40 +536,40 @@ main = hspec $ do
474536 searchExpectNoResults search
475537
476538 describe "Aggregation API" $ do
477− it "returns term aggregation results" $ do
539+ it "returns term aggregation results" $ withTestEnv $ do
478540 _ <- insertData
479541 let terms = TermsAgg $ mkTermsAggregation "user"
480542 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
481543 searchExpectAggs search
482544 searchValidBucketAgg search "users" toTerms
483545
484− it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ do
546+ it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
485547 _ <- insertData
486548 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
487549 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
488550 searchExpectAggs search
489551 searchValidBucketAgg search "users" toTerms
490552
491− it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ do
553+ it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
492554 _ <- insertData
493555 searchTermsAggHint [Map, Ordinals]
494556
495− it "can give execution hint paramters to term aggregations" $ when' (is es12) $ do
557+ it "can give execution hint paramters to term aggregations" $ when' (is es12) $ withTestEnv $ do
496558 _ <- insertData
497559 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
498560
499− it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ do
561+ it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
500562 _ <- insertData
501563 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
502564
503− it "returns date histogram aggregation results" $ do
565+ it "returns date histogram aggregation results" $ withTestEnv $ do
504566 _ <- insertData
505567 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
506568 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
507569 searchExpectAggs search
508570 searchValidBucketAgg search "byDate" toDateHistogram
509571
510− it "returns date histogram using fractional date" $ do
572+ it "returns date histogram using fractional date" $ withTestEnv $ do
511573 _ <- insertData
512574 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
513575 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
@@ -521,7 +583,7 @@ main = hspec $ do
521583
522584 describe "Highlights API" $ do
523585
524− it "returns highlight from query when there should be one" $ do
586+ it "returns highlight from query when there should be one" $ withTestEnv $ do
525587 _ <- insertData
526588 _ <- insertOther
527589 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
@@ -529,9 +591,10 @@ main = hspec $ do
529591
530592 let search = mkHighlightSearch (Just query) testHighlight
531593 myHighlight <- searchTweetHighlight search
532− myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
594+ liftIO $
595+ myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
533596
534− it "doesn't return highlight from a query when it shouldn't" $ do
597+ it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
535598 _ <- insertData
536599 _ <- insertOther
537600 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
@@ -539,7 +602,8 @@ main = hspec $ do
539602
540603 let search = mkHighlightSearch (Just query) testHighlight
541604 myHighlight <- searchTweetHighlight search
542− myHighlight `shouldBe` Right Nothing
605+ liftIO $
606+ myHighlight `shouldBe` Right Nothing
543607
544608
545609
@@ -582,4 +646,7 @@ main = hspec $ do
582646 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
583647 , "test2" .= (toJSON ("some value" :: Text))]
584648 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
585− , ("test2", String "some value")])
649+ , ("test2", String "some value")])
650+ describe "Monoid (SearchHits a)" $ do
651+ prop "abides the monoid laws" $ eq $
652+ prop_Monoid (T :: T (SearchHits ()))