279e169 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

WIP adding manager and server url state

279e169Michael Xavier12 years ago

bloodhound.cabal+4−1

compare with master

unifiedsplit

@@ -35,6 +35,8 @@ library

35 semigroups >= 0.15 && <0.17,

36 time >= 1.4 && <1.6,

37 text >= 0.11 && <1.3,

38+ mtl >= 1.0 && <2.3,

39+ transformers >= 0.2 && <0.5,

38 http-types >= 0.8 && <0.9,

40 http-types >= 0.8 && <0.9,

39 vector >= 0.10.9 && <0.11

41 vector >= 0.10.9 && <0.11

40 default-language: Haskell2010

42 default-language: Haskell2010

@@ -56,7 +58,8 @@ test-suite tests

56 semigroups,

58 semigroups,

57 QuickCheck,

59 QuickCheck,

58 vector,

60 vector,

59− unordered-containers >= 0.2.5.0 && <0.3

61+ unordered-containers >= 0.2.5.0 && <0.3,

62+ mtl

60 default-language: Haskell2010

63 default-language: Haskell2010

62test-suite doctests

65test-suite doctests

src/Database/Bloodhound/Client.hs+94−79

@@ -49,6 +49,9 @@ module Database.Bloodhound.Client

49 )

50 where

52+import Control.Applicative

53+import Control.Monad

54+import Control.Monad.IO.Class

52import Data.Aeson

55import Data.Aeson

53import Data.ByteString.Lazy.Builder

56import Data.ByteString.Lazy.Builder

54import qualified Data.ByteString.Lazy.Char8 as L

57import qualified Data.ByteString.Lazy.Char8 as L

@@ -133,29 +136,39 @@ mkReplicaCount n

133emptyBody :: L.ByteString

136emptyBody :: L.ByteString

134emptyBody = L.pack ""

137emptyBody = L.pack ""

135

138

136−dispatch :: Method -> String -> Maybe L.ByteString

139+dispatch :: MonadBloodhound m => Method -> String -> Maybe L.ByteString

137− -> IO Reply

140+ -> m Reply

138dispatch dMethod url body = do

141dispatch dMethod url body = do

139− initReq <- parseUrl url

142+ initReq <- liftIO $ parseUrl url

140 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body

143 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body

141 let req = initReq { method = dMethod

144 let req = initReq { method = dMethod

142 , requestBody = reqBody

145 , requestBody = reqBody

143 , checkStatus = \_ _ _ -> Nothing}

146 , checkStatus = \_ _ _ -> Nothing}

144− withManager defaultManagerSettings $ httpLbs req

147+ mgr <- bhManager <$> getBHEnv

148+ liftIO $ httpLbs req mgr

149+

150+joinPath' :: [String] -> String

151+joinPath' = intercalate "/"

152+

153+joinPath :: MonadBloodhound m => [String] -> m String

154+joinPath ps = do

155+ Server s <- bhServer <$> getBHEnv

156+ return $ joinPath' (s:ps)

157+

158+bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c

159+bindM2 f ma mb = join (f <$> ma <*> mb)

145

160

146−joinPath :: [String] -> String

147−joinPath = intercalate "/"

148

161

149-- Shortcut functions for HTTP methods

162-- Shortcut functions for HTTP methods

150−delete :: String -> IO Reply

163+delete :: MonadBloodhound m => String -> m Reply

151delete = flip (dispatch NHTM.methodDelete) Nothing

164delete = flip (dispatch NHTM.methodDelete) Nothing

152−get :: String -> IO Reply

165+get :: MonadBloodhound m => String -> m Reply

153get = flip (dispatch NHTM.methodGet) Nothing

166get = flip (dispatch NHTM.methodGet) Nothing

154−head :: String -> IO Reply

167+head :: MonadBloodhound m => String -> m Reply

155head = flip (dispatch NHTM.methodHead) Nothing

168head = flip (dispatch NHTM.methodHead) Nothing

156−put :: String -> Maybe L.ByteString -> IO Reply

169+put :: MonadBloodhound m => String -> Maybe L.ByteString -> m Reply

157put = dispatch NHTM.methodPost

170put = dispatch NHTM.methodPost

158−post :: String -> Maybe L.ByteString -> IO Reply

171+post :: MonadBloodhound m => String -> Maybe L.ByteString -> m Reply

159post = dispatch NHTM.methodPost

172post = dispatch NHTM.methodPost

160

173

161-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)

174-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)

@@ -167,10 +180,12 @@ post = dispatch NHTM.methodPost

167-- >>> serverStatus <- getStatus testServer

180-- >>> serverStatus <- getStatus testServer

168-- >>> fmap status (serverStatus)

181-- >>> fmap status (serverStatus)

169-- Just 200

182-- Just 200

170−getStatus :: Server -> IO (Maybe Status)

183+getStatus :: MonadBloodhound m => m (Maybe Status)

171−getStatus (Server server) = do

184+getStatus = do

172− request <- parseUrl $ joinPath [server]

185+ url <- joinPath []

186+ request <- liftIO $ parseUrl url

187+ mgr <- bhManager <$> getBHEnv

173− response <- withManager defaultManagerSettings $ httpLbs request

188+ response <- liftIO $ httpLbs request mgr

174 return $ decode (responseBody response)

189 return $ decode (responseBody response)

175

190

176-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.

191-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.

@@ -180,10 +195,10 @@ getStatus (Server server) = do

180-- True

195-- True

181-- >>> indexExists testServer (IndexName "didimakeanindex")

196-- >>> indexExists testServer (IndexName "didimakeanindex")

182-- True

197-- True

183−createIndex :: Server -> IndexSettings -> IndexName -> IO Reply

198+createIndex :: MonadBloodhound m => IndexSettings -> IndexName -> m Reply

184−createIndex (Server server) indexSettings (IndexName indexName) =

199+createIndex indexSettings (IndexName indexName) =

185− put url body

200+ bindM2 put url (return body)

186− where url = joinPath [server, indexName]

201+ where url = joinPath [indexName]

187 body = Just $ encode indexSettings

202 body = Just $ encode indexSettings

188

203

189-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.

204-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.

@@ -194,9 +209,9 @@ createIndex (Server server) indexSettings (IndexName indexName) =

194-- True

209-- True

195-- >>> indexExists testServer testIndex

210-- >>> indexExists testServer testIndex

196-- False

211-- False

197−deleteIndex :: Server -> IndexName -> IO Reply

212+deleteIndex :: MonadBloodhound m => IndexName -> m Reply

198−deleteIndex (Server server) (IndexName indexName) =

213+deleteIndex (IndexName indexName) =

199− delete $ joinPath [server, indexName]

214+ delete =<< joinPath [indexName]

200

215

201statusCodeIs :: Int -> Reply -> Bool

216statusCodeIs :: Int -> Reply -> Bool

202statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n

217statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n

@@ -204,7 +219,7 @@ statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n

204respIsTwoHunna :: Reply -> Bool

219respIsTwoHunna :: Reply -> Bool

205respIsTwoHunna = statusCodeIs 200

220respIsTwoHunna = statusCodeIs 200

206

221

207−existentialQuery :: String -> IO (Reply, Bool)

222+existentialQuery :: MonadBloodhound m => String -> m (Reply, Bool)

208existentialQuery url = do

223existentialQuery url = do

209 reply <- head url

224 reply <- head url

210 return (reply, respIsTwoHunna reply)

225 return (reply, respIsTwoHunna reply)

@@ -213,45 +228,44 @@ existentialQuery url = do

213-- in IO

228-- in IO

214--

229--

215-- >>> exists <- indexExists testServer testIndex

230-- >>> exists <- indexExists testServer testIndex

216−indexExists :: Server -> IndexName -> IO Bool

231+indexExists :: MonadBloodhound m => IndexName -> m Bool

217−indexExists (Server server) (IndexName indexName) = do

232+indexExists (IndexName indexName) = do

218− (_, exists) <- existentialQuery url

233+ (_, exists) <- existentialQuery =<< joinPath [indexName]

219 return exists

234 return exists

220− where url = joinPath [server, indexName]

221

235

222-- | 'refreshIndex' will force a refresh on an index. You must

236-- | 'refreshIndex' will force a refresh on an index. You must

223-- do this if you want to read what you wrote.

237-- do this if you want to read what you wrote.

224--

238--

225-- >>> _ <- createIndex testServer defaultIndexSettings testIndex

239-- >>> _ <- createIndex testServer defaultIndexSettings testIndex

226-- >>> _ <- refreshIndex testServer testIndex

240-- >>> _ <- refreshIndex testServer testIndex

227−refreshIndex :: Server -> IndexName -> IO Reply

241+refreshIndex :: MonadBloodhound m => IndexName -> m Reply

228−refreshIndex (Server server) (IndexName indexName) =

242+refreshIndex (IndexName indexName) =

229− post url Nothing

243+ bindM2 post url (return Nothing)

230− where url = joinPath [server, indexName, "_refresh"]

244+ where url = joinPath [indexName, "_refresh"]

231

245

232stringifyOCIndex :: OpenCloseIndex -> String

246stringifyOCIndex :: OpenCloseIndex -> String

233stringifyOCIndex oci = case oci of

247stringifyOCIndex oci = case oci of

234 OpenIndex -> "_open"

248 OpenIndex -> "_open"

235 CloseIndex -> "_close"

249 CloseIndex -> "_close"

236

250

237−openOrCloseIndexes :: OpenCloseIndex -> Server -> IndexName -> IO Reply

251+openOrCloseIndexes :: MonadBloodhound m => OpenCloseIndex -> IndexName -> m Reply

238−openOrCloseIndexes oci (Server server) (IndexName indexName) =

252+openOrCloseIndexes oci (IndexName indexName) =

239− post url Nothing

253+ bindM2 post url (return Nothing)

240 where ociString = stringifyOCIndex oci

254 where ociString = stringifyOCIndex oci

241− url = joinPath [server, indexName, ociString]

255+ url = joinPath [indexName, ociString]

242

256

243-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at

257-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at

244-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>

258-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>

245--

259--

246-- >>> reply <- openIndex testServer testIndex

260-- >>> reply <- openIndex testServer testIndex

247−openIndex :: Server -> IndexName -> IO Reply

261+openIndex :: MonadBloodhound m => IndexName -> m Reply

248openIndex = openOrCloseIndexes OpenIndex

262openIndex = openOrCloseIndexes OpenIndex

249

263

250-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at

264-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at

251-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>

265-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>

252--

266--

253-- >>> reply <- closeIndex testServer testIndex

267-- >>> reply <- closeIndex testServer testIndex

254−closeIndex :: Server -> IndexName -> IO Reply

268+closeIndex :: MonadBloodhound m => IndexName -> m Reply

255closeIndex = openOrCloseIndexes CloseIndex

269closeIndex = openOrCloseIndexes CloseIndex

256

270

257-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas

271-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas

@@ -261,11 +275,11 @@ closeIndex = openOrCloseIndexes CloseIndex

261-- >>> resp <- putMapping testServer testIndex testMapping TweetMapping

275-- >>> resp <- putMapping testServer testIndex testMapping TweetMapping

262-- >>> print resp

276-- >>> print resp

263-- 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}

277-- 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

278+putMapping :: (MonadBloodhound m, ToJSON a) => IndexName

265− -> MappingName -> a -> IO Reply

279+ -> MappingName -> a -> m Reply

266−putMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =

280+putMapping (IndexName indexName) (MappingName mappingName) mapping =

267− put url body

281+ bindM2 put url (return body)

268− where url = joinPath [server, indexName, mappingName, "_mapping"]

282+ where url = joinPath [indexName, mappingName, "_mapping"]

269 body = Just $ encode mapping

283 body = Just $ encode mapping

270

284

271-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.

285-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.

@@ -276,10 +290,10 @@ putMapping (Server server) (IndexName indexName) (MappingName mappingName) mappi

276-- >>> resp <- deleteMapping testServer testIndex testMapping

290-- >>> resp <- deleteMapping testServer testIndex testMapping

277-- >>> print resp

291-- >>> print resp

278-- 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}

292-- 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

293+deleteMapping :: MonadBloodhound m => IndexName -> MappingName -> m Reply

280−deleteMapping (Server server) (IndexName indexName)

294+deleteMapping (IndexName indexName)

281 (MappingName mappingName) =

295 (MappingName mappingName) =

282− delete $ joinPath [server, indexName, mappingName, "_mapping"]

296+ delete =<< joinPath [indexName, mappingName, "_mapping"]

283

297

284-- | 'indexDocument' is the primary way to save a single document in

298-- | 'indexDocument' is the primary way to save a single document in

285-- Elasticsearch. The document itself is simply something we can

299-- Elasticsearch. The document itself is simply something we can

@@ -289,22 +303,22 @@ deleteMapping (Server server) (IndexName indexName)

289-- >>> resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")

303-- >>> resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")

290-- >>> print resp

304-- >>> print resp

291-- 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}

305-- 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

306+indexDocument :: (ToJSON doc, MonadBloodhound m) => IndexName -> MappingName

293− -> doc -> DocId -> IO Reply

307+ -> doc -> DocId -> m Reply

294−indexDocument (Server server) (IndexName indexName)

308+indexDocument (IndexName indexName)

295 (MappingName mappingName) document (DocId docId) =

309 (MappingName mappingName) document (DocId docId) =

296− put url body

310+ bindM2 put url (return body)

297− where url = joinPath [server, indexName, mappingName, docId]

311+ where url = joinPath [indexName, mappingName, docId]

298 body = Just (encode document)

312 body = Just (encode document)

299

313

300-- | 'deleteDocument' is the primary way to delete a single document.

314-- | 'deleteDocument' is the primary way to delete a single document.

301--

315--

302-- >>> _ <- deleteDocument testServer testIndex testMapping (DocId "1")

316-- >>> _ <- deleteDocument testServer testIndex testMapping (DocId "1")

303−deleteDocument :: Server -> IndexName -> MappingName

317+deleteDocument :: MonadBloodhound m => IndexName -> MappingName

304− -> DocId -> IO Reply

318+ -> DocId -> m Reply

305−deleteDocument (Server server) (IndexName indexName)

319+deleteDocument (IndexName indexName)

306 (MappingName mappingName) (DocId docId) =

320 (MappingName mappingName) (DocId docId) =

307− delete $ joinPath [server, indexName, mappingName, docId]

321+ delete =<< joinPath [indexName, mappingName, docId]

308

322

309-- | 'bulk' uses

323-- | 'bulk' uses

310-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>

324-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>

@@ -316,10 +330,10 @@ deleteDocument (Server server) (IndexName indexName)

316-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]

330-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]

317-- >>> _ <- bulk testServer stream

331-- >>> _ <- bulk testServer stream

318-- >>> _ <- refreshIndex testServer testIndex

332-- >>> _ <- refreshIndex testServer testIndex

319−bulk :: Server -> V.Vector BulkOperation -> IO Reply

333+bulk :: MonadBloodhound m => V.Vector BulkOperation -> m Reply

320−bulk (Server server) bulkOps = post url body where

334+bulk bulkOps = bindM2 post url (return body)

321− url = joinPath [server, "_bulk"]

335+ where url = joinPath ["_bulk"]

322− body = Just $ encodeBulkOperations bulkOps

336+ body = Just $ encodeBulkOperations bulkOps

323

337

324-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'

338-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'

325-- into an 'L.ByteString'

339-- into an 'L.ByteString'

@@ -380,25 +394,25 @@ encodeBulkOperation (BulkUpdate (IndexName indexName)

380-- The 'DocId' is the primary key for your Elasticsearch document.

394-- The 'DocId' is the primary key for your Elasticsearch document.

381--

395--

382-- >>> yourDoc <- getDocument testServer testIndex testMapping (DocId "1")

396-- >>> yourDoc <- getDocument testServer testIndex testMapping (DocId "1")

383−getDocument :: Server -> IndexName -> MappingName

397+getDocument :: MonadBloodhound m => IndexName -> MappingName

384− -> DocId -> IO Reply

398+ -> DocId -> m Reply

385−getDocument (Server server) (IndexName indexName)

399+getDocument (IndexName indexName)

386 (MappingName mappingName) (DocId docId) =

400 (MappingName mappingName) (DocId docId) =

387− get $ joinPath [server, indexName, mappingName, docId]

401+ get =<< joinPath [indexName, mappingName, docId]

388

402

389-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'

403-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'

390-- in IO

404-- in IO

391--

405--

392-- >>> exists <- documentExists testServer testIndex testMapping (DocId "1")

406-- >>> exists <- documentExists testServer testIndex testMapping (DocId "1")

393−documentExists :: Server -> IndexName -> MappingName

407+documentExists :: MonadBloodhound m => IndexName -> MappingName

394− -> DocId -> IO Bool

408+ -> DocId -> m Bool

395−documentExists (Server server) (IndexName indexName)

409+documentExists (IndexName indexName)

396 (MappingName mappingName) (DocId docId) = do

410 (MappingName mappingName) (DocId docId) = do

397− (_, exists) <- existentialQuery url

411+ (_, exists) <- existentialQuery =<< url

398− return exists where

412+ return exists

399− url = joinPath [server, indexName, mappingName, docId]

413+ where url = joinPath [indexName, mappingName, docId]

400

414

401−dispatchSearch :: String -> Search -> IO Reply

415+dispatchSearch :: MonadBloodhound m => String -> Search -> m Reply

402dispatchSearch url search = post url (Just (encode search))

416dispatchSearch url search = post url (Just (encode search))

403

417

404-- | 'searchAll', given a 'Search', will perform that search against all indexes

418-- | 'searchAll', given a 'Search', will perform that search against all indexes

@@ -407,9 +421,9 @@ dispatchSearch url search = post url (Just (encode search))

407-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing

421-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing

408-- >>> let search = mkSearch (Just query) Nothing

422-- >>> let search = mkSearch (Just query) Nothing

409-- >>> reply <- searchAll testServer search

423-- >>> reply <- searchAll testServer search

410−searchAll :: Server -> Search -> IO Reply

424+searchAll :: MonadBloodhound m => Search -> m Reply

411−searchAll (Server server) = dispatchSearch url where

425+searchAll = bindM2 dispatchSearch url . return

412− url = joinPath [server, "_search"]

426+ where url = joinPath ["_search"]

413

427

414-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search

428-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search

415-- against all mappings within an index on an Elasticsearch server.

429-- against all mappings within an index on an Elasticsearch server.

@@ -417,9 +431,9 @@ searchAll (Server server) = dispatchSearch url where

417-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing

431-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing

418-- >>> let search = mkSearch (Just query) Nothing

432-- >>> let search = mkSearch (Just query) Nothing

419-- >>> reply <- searchByIndex testServer testIndex search

433-- >>> reply <- searchByIndex testServer testIndex search

420−searchByIndex :: Server -> IndexName -> Search -> IO Reply

434+searchByIndex :: MonadBloodhound m => IndexName -> Search -> m Reply

421−searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where

435+searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return

422− url = joinPath [server, indexName, "_search"]

436+ where url = joinPath [indexName, "_search"]

423

437

424-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that

438-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that

425-- search against a specific mapping within an index on an Elasticsearch server.

439-- search against a specific mapping within an index on an Elasticsearch server.

@@ -427,10 +441,11 @@ searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where

427-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing

441-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing

428-- >>> let search = mkSearch (Just query) Nothing

442-- >>> let search = mkSearch (Just query) Nothing

429-- >>> reply <- searchByType testServer testIndex testMapping search

443-- >>> reply <- searchByType testServer testIndex testMapping search

430−searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply

444+searchByType :: MonadBloodhound m => IndexName -> MappingName -> Search

445+ -> m Reply

431−searchByType (Server server) (IndexName indexName)

446+searchByType (IndexName indexName)

432− (MappingName mappingName) = dispatchSearch url where

447+ (MappingName mappingName) = bindM2 dispatchSearch url . return

433− url = joinPath [server, indexName, mappingName, "_search"]

448+ where url = joinPath [indexName, mappingName, "_search"]

434

449

435-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'

450-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'

436-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update

451-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update

src/Database/Bloodhound/Types.hs+16

@@ -1,6 +1,8 @@

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE FlexibleInstances #-}

5+{-# LANGUAGE FlexibleContexts #-}

5-------------------------------------------------------------------------------

7-------------------------------------------------------------------------------

6-- |

8-- |

@@ -39,6 +41,8 @@ module Database.Bloodhound.Types

39 , toTerms

41 , toTerms

40 , toDateHistogram

42 , toDateHistogram

41 , omitNulls

43 , omitNulls

44+ , BHEnv(..)

45+ , MonadBloodhound(..)

42 , Version(..)

46 , Version(..)

43 , Status(..)

47 , Status(..)

44 , Existence(..)

48 , Existence(..)

@@ -194,6 +198,8 @@ module Database.Bloodhound.Types

194 ) where

198 ) where

195

199

196import Control.Applicative

200import Control.Applicative

201+import Control.Monad.IO.Class

202+import Control.Monad.Reader

197import Data.Aeson

203import Data.Aeson

198import Data.Aeson.Types (Pair, emptyObject, parseMaybe)

204import Data.Aeson.Types (Pair, emptyObject, parseMaybe)

199import qualified Data.ByteString.Lazy.Char8 as L

205import qualified Data.ByteString.Lazy.Char8 as L

@@ -222,6 +228,16 @@ import Database.Bloodhound.Types.Class

222-- defaultIndexSettings is exported by Database.Bloodhound as well

228-- defaultIndexSettings is exported by Database.Bloodhound as well

223-- no trailing slashes in servers, library handles building the path.

229-- no trailing slashes in servers, library handles building the path.

224

230

231+data BHEnv = BHEnv { bhServer :: Server

232+ , bhManager :: Manager

233+ }

234+

235+class (Functor m, Applicative m, MonadIO m) => MonadBloodhound m where

236+ getBHEnv :: m BHEnv

237+

238+instance (Functor m, Applicative m, MonadIO m) => MonadBloodhound (ReaderT BHEnv m) where

239+ getBHEnv = ask

240+

225{-| 'Version' is embedded in 'Status' -}

241{-| 'Version' is embedded in 'Status' -}

226data Version = Version { number :: Text

242data Version = Version { number :: Text

227 , build_hash :: Text

243 , build_hash :: Text

tests/tests.hs+130−97

@@ -6,6 +6,7 @@ module Main where

7import Control.Applicative

8import Control.Monad

9+import Control.Monad.Reader

9import Data.Aeson

10import Data.Aeson

10import qualified Data.HashMap.Strict as HM

11import qualified Data.HashMap.Strict as HM

11import Data.List (nub)

12import Data.List (nub)

@@ -34,15 +35,23 @@ testIndex = IndexName "bloodhound-tests-twitter-1"

34testMapping :: MappingName

35testMapping :: MappingName

35testMapping = MappingName "tweet"

36testMapping = MappingName "tweet"

38+

39+--TODO: similar convenience function in Client

40+-- withTestEnv :: MonadIO m => Reader m a -> IO a

41+withTestEnv f = withManager defaultManagerSettings $ \mgr -> do

42+ let env = BHEnv { bhServer = testServer

43+ , bhManager = mgr }

44+ runReaderT f env

45+

37validateStatus :: Response body -> Int -> Expectation

46validateStatus :: Response body -> Int -> Expectation

38validateStatus resp expected =

47validateStatus resp expected =

39 (NHTS.statusCode $ responseStatus resp)

48 (NHTS.statusCode $ responseStatus resp)

40 `shouldBe` (expected :: Int)

49 `shouldBe` (expected :: Int)

42−createExampleIndex :: IO Reply

51+-- createExampleIndex :: IO Reply

43−createExampleIndex = createIndex testServer defaultIndexSettings testIndex

52+createExampleIndex = createIndex defaultIndexSettings testIndex

44−deleteExampleIndex :: IO Reply

53+-- deleteExampleIndex :: IO Reply

45−deleteExampleIndex = deleteIndex testServer testIndex

54+deleteExampleIndex = deleteIndex testIndex

47data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)

56data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)

@@ -70,18 +79,16 @@ mkServerVersion [majorVer, minorVer, patchVer] =

70 Just (ServerVersion majorVer minorVer patchVer)

79 Just (ServerVersion majorVer minorVer patchVer)

71mkServerVersion _ = Nothing

80mkServerVersion _ = Nothing

73−getServerVersion :: Server -> IO (Maybe ServerVersion)

82+-- getServerVersion :: IO (Maybe ServerVersion)

74−getServerVersion s = liftM extractVersion (getStatus s)

83+getServerVersion = liftM extractVersion (withTestEnv getStatus)

75 where

84 where

76 version' = T.splitOn "." . number . version

85 version' = T.splitOn "." . number . version

77 toInt = read . T.unpack

86 toInt = read . T.unpack

78 parseVersion v = map toInt (version' v)

87 parseVersion v = map toInt (version' v)

79 extractVersion = join . liftM (mkServerVersion . parseVersion)

88 extractVersion = join . liftM (mkServerVersion . parseVersion)

81−

82−

83testServerBranch :: IO (Maybe ServerVersion)

90testServerBranch :: IO (Maybe ServerVersion)

84−testServerBranch = getServerVersion testServer >>= \v -> return $ liftM serverBranch v

91+testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v

86atleast :: ServerVersion -> IO Bool

93atleast :: ServerVersion -> IO Bool

87atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)

94atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)

@@ -136,60 +143,63 @@ otherTweet = Tweet { user = "notmyapp"

136 , age = 1000

143 , age = 1000

137 , location = Location 40.12 (-71.34) }

144 , location = Location 40.12 (-71.34) }

138

145

139−insertData :: IO ()

146+insertData :: ReaderT BHEnv IO ()

140insertData = do

147insertData = do

141 _ <- deleteExampleIndex

148 _ <- deleteExampleIndex

142 _ <- createExampleIndex

149 _ <- createExampleIndex

143− _ <- putMapping testServer testIndex testMapping TweetMapping

150+ _ <- putMapping testIndex testMapping TweetMapping

144− _ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")

151+ _ <- indexDocument testIndex testMapping exampleTweet (DocId "1")

145− _ <- refreshIndex testServer testIndex

152+ _ <- refreshIndex testIndex

146 return ()

153 return ()

147

154

148−insertOther :: IO ()

155+-- insertOther :: IO ()

149insertOther = do

156insertOther = do

150− _ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")

157+ _ <- indexDocument testIndex testMapping otherTweet (DocId "2")

151− _ <- refreshIndex testServer testIndex

158+ _ <- refreshIndex testIndex

152 return ()

159 return ()

153

160

154−searchTweet :: Search -> IO (Either String Tweet)

161+-- searchTweet :: Search -> IO (Either String Tweet)

155searchTweet search = do

162searchTweet search = do

156− reply <- searchByIndex testServer testIndex search

163+ reply <- searchByIndex testIndex search

157 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

164 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

158 let myTweet = fmap (hitSource . head . hits . searchHits) result

165 let myTweet = fmap (hitSource . head . hits . searchHits) result

159 return myTweet

166 return myTweet

160

167

161−searchExpectNoResults :: Search -> IO ()

168+-- searchExpectNoResults :: Search -> IO ()

162searchExpectNoResults search = do

169searchExpectNoResults search = do

163− reply <- searchByIndex testServer testIndex search

170+ reply <- searchByIndex testIndex search

164 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

171 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

165 let emptyHits = fmap (hits . searchHits) result

172 let emptyHits = fmap (hits . searchHits) result

173+ liftIO $

166− emptyHits `shouldBe` Right []

174+ emptyHits `shouldBe` Right []

167

175

168−searchExpectAggs :: Search -> IO ()

176+-- searchExpectAggs :: Search -> IO ()

169searchExpectAggs search = do

177searchExpectAggs search = do

170− reply <- searchAll testServer search

178+ reply <- searchAll search

171 let isEmpty x = return (M.null x)

179 let isEmpty x = return (M.null x)

172 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)

180 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)

181+ liftIO $

173− (result >>= aggregations >>= isEmpty) `shouldBe` Just False

182+ (result >>= aggregations >>= isEmpty) `shouldBe` Just False

174

183

175−searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> IO ()

184+-- searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) => Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> IO ()

176searchValidBucketAgg search aggKey extractor = do

185searchValidBucketAgg search aggKey extractor = do

177− reply <- searchAll testServer search

186+ reply <- searchAll search

178 let bucketDocs = docCount . head . buckets

187 let bucketDocs = docCount . head . buckets

179 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)

188 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)

180 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)

189 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)

190+ liftIO $

181− count `shouldBe` Just 1

191+ count `shouldBe` Just 1

182

192

183−searchTermsAggHint :: [ExecutionHint] -> IO ()

193+-- searchTermsAggHint :: [ExecutionHint] -> IO ()

184searchTermsAggHint hints = do

194searchTermsAggHint hints = do

185 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }

195 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }

186 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint

196 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint

187 forM_ hints $ searchExpectAggs . search

197 forM_ hints $ searchExpectAggs . search

188 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)

198 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)

189

199

190−searchTweetHighlight :: Search -> IO (Either String (Maybe HitHighlight))

200+-- searchTweetHighlight :: Search -> IO (Either String (Maybe HitHighlight))

191searchTweetHighlight search = do

201searchTweetHighlight search = do

192− reply <- searchByIndex testServer testIndex search

202+ reply <- searchByIndex testIndex search

193 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

203 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

194 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result

204 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result

195 return myHighlight

205 return myHighlight

@@ -223,26 +233,27 @@ main :: IO ()

223main = hspec $ do

233main = hspec $ do

224

234

225 describe "index create/delete API" $ do

235 describe "index create/delete API" $ do

226− it "creates and then deletes the requested index" $ do

236+ it "creates and then deletes the requested index" $ withTestEnv $ do

227 -- priming state.

237 -- priming state.

228 _ <- deleteExampleIndex

238 _ <- deleteExampleIndex

229 resp <- createExampleIndex

239 resp <- createExampleIndex

230 deleteResp <- deleteExampleIndex

240 deleteResp <- deleteExampleIndex

241+ liftIO $ do

231− validateStatus resp 200

242+ validateStatus resp 200

232− validateStatus deleteResp 200

243+ validateStatus deleteResp 200

233

244

234

245

235 describe "document API" $ do

246 describe "document API" $ do

236− it "indexes, gets, and then deletes the generated document" $ do

247+ it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do

237 _ <- insertData

248 _ <- insertData

238− docInserted <- getDocument testServer testIndex testMapping (DocId "1")

249+ docInserted <- getDocument testIndex testMapping (DocId "1")

239 let newTweet = eitherDecode

250 let newTweet = eitherDecode

240 (responseBody docInserted) :: Either String (EsResult Tweet)

251 (responseBody docInserted) :: Either String (EsResult Tweet)

241− fmap _source newTweet `shouldBe` Right exampleTweet

252+ liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)

242

253

243

254

244 describe "bulk API" $ do

255 describe "bulk API" $ do

245− it "inserts all documents we request" $ do

256+ it "inserts all documents we request" $ withTestEnv $ do

246 _ <- insertData

257 _ <- insertData

247 let firstTest = BulkTest "blah"

258 let firstTest = BulkTest "blah"

248 let secondTest = BulkTest "bloo"

259 let secondTest = BulkTest "bloo"

@@ -251,49 +262,54 @@ main = hspec $ do

251 let secondDoc = BulkCreate testIndex

262 let secondDoc = BulkCreate testIndex

252 testMapping (DocId "3") (toJSON secondTest)

263 testMapping (DocId "3") (toJSON secondTest)

253 let stream = V.fromList [firstDoc, secondDoc]

264 let stream = V.fromList [firstDoc, secondDoc]

254− _ <- bulk testServer stream

265+ _ <- bulk stream

255− _ <- refreshIndex testServer testIndex

266+ _ <- refreshIndex testIndex

256− fDoc <- getDocument testServer testIndex testMapping (DocId "2")

267+ fDoc <- getDocument testIndex testMapping (DocId "2")

257− sDoc <- getDocument testServer testIndex testMapping (DocId "3")

268+ sDoc <- getDocument testIndex testMapping (DocId "3")

258 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)

269 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)

259 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)

270 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)

271+ liftIO $ do

260− fmap _source maybeFirst `shouldBe` Right firstTest

272+ fmap _source maybeFirst `shouldBe` Right firstTest

261− fmap _source maybeSecond `shouldBe` Right secondTest

273+ fmap _source maybeSecond `shouldBe` Right secondTest

262

274

263

275

264 describe "query API" $ do

276 describe "query API" $ do

265− it "returns document for term query and identity filter" $ do

277+ it "returns document for term query and identity filter" $ withTestEnv $ do

266 _ <- insertData

278 _ <- insertData

267 let query = TermQuery (Term "user" "bitemyapp") Nothing

279 let query = TermQuery (Term "user" "bitemyapp") Nothing

268 let filter = IdentityFilter <&&> IdentityFilter

280 let filter = IdentityFilter <&&> IdentityFilter

269 let search = mkSearch (Just query) (Just filter)

281 let search = mkSearch (Just query) (Just filter)

270 myTweet <- searchTweet search

282 myTweet <- searchTweet search

283+ liftIO $

271− myTweet `shouldBe` Right exampleTweet

284+ myTweet `shouldBe` Right exampleTweet

272

285

273− it "returns document for terms query and identity filter" $ do

286+ it "returns document for terms query and identity filter" $ withTestEnv $ do

274 _ <- insertData

287 _ <- insertData

275 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])

288 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])

276 let filter = IdentityFilter <&&> IdentityFilter

289 let filter = IdentityFilter <&&> IdentityFilter

277 let search = mkSearch (Just query) (Just filter)

290 let search = mkSearch (Just query) (Just filter)

278 myTweet <- searchTweet search

291 myTweet <- searchTweet search

292+ liftIO $

279− myTweet `shouldBe` Right exampleTweet

293+ myTweet `shouldBe` Right exampleTweet

280

294

281− it "returns document for match query" $ do

295+ it "returns document for match query" $ withTestEnv $ do

282 _ <- insertData

296 _ <- insertData

283 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

297 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

284 let search = mkSearch (Just query) Nothing

298 let search = mkSearch (Just query) Nothing

285 myTweet <- searchTweet search

299 myTweet <- searchTweet search

300+ liftIO $

286− myTweet `shouldBe` Right exampleTweet

301+ myTweet `shouldBe` Right exampleTweet

287

302

288− it "returns document for multi-match query" $ do

303+ it "returns document for multi-match query" $ withTestEnv $ do

289 _ <- insertData

304 _ <- insertData

290 let fields = [FieldName "user", FieldName "message"]

305 let fields = [FieldName "user", FieldName "message"]

291 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")

306 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")

292 let search = mkSearch (Just query) Nothing

307 let search = mkSearch (Just query) Nothing

293 myTweet <- searchTweet search

308 myTweet <- searchTweet search

309+ liftIO $

294− myTweet `shouldBe` Right exampleTweet

310+ myTweet `shouldBe` Right exampleTweet

295

311

296− it "returns document for bool query" $ do

312+ it "returns document for bool query" $ withTestEnv $ do

297 _ <- insertData

313 _ <- insertData

298 let innerQuery = QueryMatchQuery $

314 let innerQuery = QueryMatchQuery $

299 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

315 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

@@ -301,18 +317,20 @@ main = hspec $ do

301 mkBoolQuery [innerQuery] [] []

317 mkBoolQuery [innerQuery] [] []

302 let search = mkSearch (Just query) Nothing

318 let search = mkSearch (Just query) Nothing

303 myTweet <- searchTweet search

319 myTweet <- searchTweet search

320+ liftIO $

304− myTweet `shouldBe` Right exampleTweet

321+ myTweet `shouldBe` Right exampleTweet

305

322

306− it "returns document for boosting query" $ do

323+ it "returns document for boosting query" $ withTestEnv $ do

307 _ <- insertData

324 _ <- insertData

308 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

325 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")

309 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")

326 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")

310 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)

327 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)

311 let search = mkSearch (Just query) Nothing

328 let search = mkSearch (Just query) Nothing

312 myTweet <- searchTweet search

329 myTweet <- searchTweet search

330+ liftIO $

313− myTweet `shouldBe` Right exampleTweet

331+ myTweet `shouldBe` Right exampleTweet

314

332

315− it "returns document for common terms query" $ do

333+ it "returns document for common terms query" $ withTestEnv $ do

316 _ <- insertData

334 _ <- insertData

317 let query = QueryCommonTermsQuery $

335 let query = QueryCommonTermsQuery $

318 CommonTermsQuery (FieldName "user")

336 CommonTermsQuery (FieldName "user")

@@ -321,55 +339,61 @@ main = hspec $ do

321 Or Or Nothing Nothing Nothing Nothing

339 Or Or Nothing Nothing Nothing Nothing

322 let search = mkSearch (Just query) Nothing

340 let search = mkSearch (Just query) Nothing

323 myTweet <- searchTweet search

341 myTweet <- searchTweet search

342+ liftIO $

324− myTweet `shouldBe` Right exampleTweet

343+ myTweet `shouldBe` Right exampleTweet

325

344

326

345

327 describe "sorting" $ do

346 describe "sorting" $ do

328− it "returns documents in the right order" $ do

347+ it "returns documents in the right order" $ withTestEnv $ do

329 _ <- insertData

348 _ <- insertData

330 _ <- insertOther

349 _ <- insertOther

331 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending

350 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending

332 let search = Search Nothing

351 let search = Search Nothing

333 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing

352 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing

334 False 0 10

353 False 0 10

335− reply <- searchByIndex testServer testIndex search

354+ reply <- searchByIndex testIndex search

336 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

355 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)

337 let myTweet = fmap (hitSource . head . hits . searchHits) result

356 let myTweet = fmap (hitSource . head . hits . searchHits) result

357+ liftIO $

338− myTweet `shouldBe` Right otherTweet

358+ myTweet `shouldBe` Right otherTweet

339

359

340

360

341 describe "filtering API" $ do

361 describe "filtering API" $ do

342− it "returns document for composed boolmatch and identity" $ do

362+ it "returns document for composed boolmatch and identity" $ withTestEnv $ do

343 _ <- insertData

363 _ <- insertData

344 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)

364 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)

345 <&&> IdentityFilter

365 <&&> IdentityFilter

346 let search = mkSearch Nothing (Just queryFilter)

366 let search = mkSearch Nothing (Just queryFilter)

347 myTweet <- searchTweet search

367 myTweet <- searchTweet search

368+ liftIO $

348− myTweet `shouldBe` Right exampleTweet

369+ myTweet `shouldBe` Right exampleTweet

349

370

350− it "returns document for term filter" $ do

371+ it "returns document for term filter" $ withTestEnv $ do

351 _ <- insertData

372 _ <- insertData

352 let termFilter = TermFilter (Term "user" "bitemyapp") False

373 let termFilter = TermFilter (Term "user" "bitemyapp") False

353 let search = mkSearch Nothing (Just termFilter)

374 let search = mkSearch Nothing (Just termFilter)

354 myTweet <- searchTweet search

375 myTweet <- searchTweet search

376+ liftIO $

355− myTweet `shouldBe` Right exampleTweet

377+ myTweet `shouldBe` Right exampleTweet

356

378

357− it "returns document for existential filter" $ do

379+ it "returns document for existential filter" $ withTestEnv $ do

358 _ <- insertData

380 _ <- insertData

359 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))

381 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))

360 myTweet <- searchTweet search

382 myTweet <- searchTweet search

383+ liftIO $

361− myTweet `shouldBe` Right exampleTweet

384+ myTweet `shouldBe` Right exampleTweet

362

385

363− it "returns document for geo boundingbox filter" $ do

386+ it "returns document for geo boundingbox filter" $ withTestEnv $ do

364 _ <- insertData

387 _ <- insertData

365 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))

388 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))

366 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory

389 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory

367 let geoFilter = GeoBoundingBoxFilter bbConstraint

390 let geoFilter = GeoBoundingBoxFilter bbConstraint

368 let search = mkSearch Nothing (Just geoFilter)

391 let search = mkSearch Nothing (Just geoFilter)

369 myTweet <- searchTweet search

392 myTweet <- searchTweet search

393+ liftIO $

370− myTweet `shouldBe` Right exampleTweet

394+ myTweet `shouldBe` Right exampleTweet

371

395

372− it "doesn't return document for nonsensical boundingbox filter" $ do

396+ it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do

373 _ <- insertData

397 _ <- insertData

374 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))

398 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))

375 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory

399 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory

@@ -377,7 +401,7 @@ main = hspec $ do

377 let search = mkSearch Nothing (Just geoFilter)

401 let search = mkSearch Nothing (Just geoFilter)

378 searchExpectNoResults search

402 searchExpectNoResults search

379

403

380− it "returns document for geo distance filter" $ do

404+ it "returns document for geo distance filter" $ withTestEnv $ do

381 _ <- insertData

405 _ <- insertData

382 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))

406 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))

383 let distance = Distance 10.0 Miles

407 let distance = Distance 10.0 Miles

@@ -385,18 +409,20 @@ main = hspec $ do

385 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False

409 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False

386 let search = mkSearch Nothing (Just geoFilter)

410 let search = mkSearch Nothing (Just geoFilter)

387 myTweet <- searchTweet search

411 myTweet <- searchTweet search

412+ liftIO $

388− myTweet `shouldBe` Right exampleTweet

413+ myTweet `shouldBe` Right exampleTweet

389

414

390− it "returns document for geo distance range filter" $ do

415+ it "returns document for geo distance range filter" $ withTestEnv $ do

391 _ <- insertData

416 _ <- insertData

392 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))

417 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))

393 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)

418 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)

394 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange

419 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange

395 let search = mkSearch Nothing (Just geoFilter)

420 let search = mkSearch Nothing (Just geoFilter)

396 myTweet <- searchTweet search

421 myTweet <- searchTweet search

422+ liftIO $

397− myTweet `shouldBe` Right exampleTweet

423+ myTweet `shouldBe` Right exampleTweet

398

424

399− it "doesn't return document for wild geo distance range filter" $ do

425+ it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do

400 _ <- insertData

426 _ <- insertData

401 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))

427 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))

402 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)

428 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)

@@ -404,7 +430,7 @@ main = hspec $ do

404 let search = mkSearch Nothing (Just geoFilter)

430 let search = mkSearch Nothing (Just geoFilter)

405 searchExpectNoResults search

431 searchExpectNoResults search

406

432

407− it "returns document for geo polygon filter" $ do

433+ it "returns document for geo polygon filter" $ withTestEnv $ do

408 _ <- insertData

434 _ <- insertData

409 let points = [LatLon 40.0 (-70.00),

435 let points = [LatLon 40.0 (-70.00),

410 LatLon 40.0 (-72.00),

436 LatLon 40.0 (-72.00),

@@ -413,9 +439,10 @@ main = hspec $ do

413 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points

439 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points

414 let search = mkSearch Nothing (Just geoFilter)

440 let search = mkSearch Nothing (Just geoFilter)

415 myTweet <- searchTweet search

441 myTweet <- searchTweet search

442+ liftIO $

416− myTweet `shouldBe` Right exampleTweet

443+ myTweet `shouldBe` Right exampleTweet

417

444

418− it "doesn't return document for bad geo polygon filter" $ do

445+ it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do

419 _ <- insertData

446 _ <- insertData

420 let points = [LatLon 40.0 (-70.00),

447 let points = [LatLon 40.0 (-70.00),

421 LatLon 40.0 (-71.00),

448 LatLon 40.0 (-71.00),

@@ -425,23 +452,25 @@ main = hspec $ do

425 let search = mkSearch Nothing (Just geoFilter)

452 let search = mkSearch Nothing (Just geoFilter)

426 searchExpectNoResults search

453 searchExpectNoResults search

427

454

428− it "returns document for ids filter" $ do

455+ it "returns document for ids filter" $ withTestEnv $ do

429 _ <- insertData

456 _ <- insertData

430 let filter = IdsFilter (MappingName "tweet") [DocId "1"]

457 let filter = IdsFilter (MappingName "tweet") [DocId "1"]

431 let search = mkSearch Nothing (Just filter)

458 let search = mkSearch Nothing (Just filter)

432 myTweet <- searchTweet search

459 myTweet <- searchTweet search

460+ liftIO $

433− myTweet `shouldBe` Right exampleTweet

461+ myTweet `shouldBe` Right exampleTweet

434

462

435− it "returns document for Double range filter" $ do

463+ it "returns document for Double range filter" $ withTestEnv $ do

436 _ <- insertData

464 _ <- insertData

437 let filter = RangeFilter (FieldName "age")

465 let filter = RangeFilter (FieldName "age")

438 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))

466 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))

439 RangeExecutionIndex False

467 RangeExecutionIndex False

440 let search = mkSearch Nothing (Just filter)

468 let search = mkSearch Nothing (Just filter)

441 myTweet <- searchTweet search

469 myTweet <- searchTweet search

470+ liftIO $

442− myTweet `shouldBe` Right exampleTweet

471+ myTweet `shouldBe` Right exampleTweet

443

472

444− it "returns document for UTCTime date filter" $ do

473+ it "returns document for UTCTime date filter" $ withTestEnv $ do

445 _ <- insertData

474 _ <- insertData

446 let filter = RangeFilter (FieldName "postDate")

475 let filter = RangeFilter (FieldName "postDate")

447 (RangeDateGtLt

476 (RangeDateGtLt

@@ -454,18 +483,20 @@ main = hspec $ do

454 RangeExecutionIndex False

483 RangeExecutionIndex False

455 let search = mkSearch Nothing (Just filter)

484 let search = mkSearch Nothing (Just filter)

456 myTweet <- searchTweet search

485 myTweet <- searchTweet search

486+ liftIO $

457− myTweet `shouldBe` Right exampleTweet

487+ myTweet `shouldBe` Right exampleTweet

458

488

459

489

460− it "returns document for regexp filter" $ do

490+ it "returns document for regexp filter" $ withTestEnv $ do

461 _ <- insertData

491 _ <- insertData

462 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")

492 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")

463 AllRegexpFlags (CacheName "test") False (CacheKey "key")

493 AllRegexpFlags (CacheName "test") False (CacheKey "key")

464 let search = mkSearch Nothing (Just filter)

494 let search = mkSearch Nothing (Just filter)

465 myTweet <- searchTweet search

495 myTweet <- searchTweet search

496+ liftIO $

466− myTweet `shouldBe` Right exampleTweet

497+ myTweet `shouldBe` Right exampleTweet

467

498

468− it "doesn't return document for non-matching regexp filter" $ do

499+ it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do

469 _ <- insertData

500 _ <- insertData

470 let filter = RegexpFilter (FieldName "user")

501 let filter = RegexpFilter (FieldName "user")

471 (Regexp "boy") AllRegexpFlags

502 (Regexp "boy") AllRegexpFlags

@@ -474,40 +505,40 @@ main = hspec $ do

474 searchExpectNoResults search

505 searchExpectNoResults search

475

506

476 describe "Aggregation API" $ do

507 describe "Aggregation API" $ do

477− it "returns term aggregation results" $ do

508+ it "returns term aggregation results" $ withTestEnv $ do

478 _ <- insertData

509 _ <- insertData

479 let terms = TermsAgg $ mkTermsAggregation "user"

510 let terms = TermsAgg $ mkTermsAggregation "user"

480 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms

511 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms

481 searchExpectAggs search

512 searchExpectAggs search

482 searchValidBucketAgg search "users" toTerms

513 searchValidBucketAgg search "users" toTerms

483

514

484− it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ do

515+ it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do

485 _ <- insertData

516 _ <- insertData

486 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }

517 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }

487 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms

518 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms

488 searchExpectAggs search

519 searchExpectAggs search

489 searchValidBucketAgg search "users" toTerms

520 searchValidBucketAgg search "users" toTerms

490

521

491− it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ do

522+ it "can give execution hint paramters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do

492 _ <- insertData

523 _ <- insertData

493 searchTermsAggHint [Map, Ordinals]

524 searchTermsAggHint [Map, Ordinals]

494

525

495− it "can give execution hint paramters to term aggregations" $ when' (is es12) $ do

526+ it "can give execution hint paramters to term aggregations" $ when' (is es12) $ withTestEnv $ do

496 _ <- insertData

527 _ <- insertData

497 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]

528 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]

498

529

499− it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ do

530+ it "can give execution hint paramters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do

500 _ <- insertData

531 _ <- insertData

501 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

532 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

502

533

503− it "returns date histogram aggregation results" $ do

534+ it "returns date histogram aggregation results" $ withTestEnv $ do

504 _ <- insertData

535 _ <- insertData

505 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute

536 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute

506 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)

537 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)

507 searchExpectAggs search

538 searchExpectAggs search

508 searchValidBucketAgg search "byDate" toDateHistogram

539 searchValidBucketAgg search "byDate" toDateHistogram

509

540

510− it "returns date histogram using fractional date" $ do

541+ it "returns date histogram using fractional date" $ withTestEnv $ do

511 _ <- insertData

542 _ <- insertData

512 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]

543 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]

513 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]

544 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]

@@ -521,7 +552,7 @@ main = hspec $ do

521

552

522 describe "Highlights API" $ do

553 describe "Highlights API" $ do

523

554

524− it "returns highlight from query when there should be one" $ do

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

525 _ <- insertData

556 _ <- insertData

526 _ <- insertOther

557 _ <- insertOther

527 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

558 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

@@ -529,9 +560,10 @@ main = hspec $ do

529

560

530 let search = mkHighlightSearch (Just query) testHighlight

561 let search = mkHighlightSearch (Just query) testHighlight

531 myHighlight <- searchTweetHighlight search

562 myHighlight <- searchTweetHighlight search

563+ liftIO $

532− myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))

564+ myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))

533

565

534− it "doesn't return highlight from a query when it shouldn't" $ do

566+ it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do

535 _ <- insertData

567 _ <- insertData

536 _ <- insertOther

568 _ <- insertOther

537 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

569 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

@@ -539,7 +571,8 @@ main = hspec $ do

539

571

540 let search = mkHighlightSearch (Just query) testHighlight

572 let search = mkHighlightSearch (Just query) testHighlight

541 myHighlight <- searchTweetHighlight search

573 myHighlight <- searchTweetHighlight search

574+ liftIO $

542− myHighlight `shouldBe` Right Nothing

575+ myHighlight `shouldBe` Right Nothing

543

576

544

577

545

578