3939fc6 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Merge pull request #27 from bitemyapp/26-bhenv

3939fc6Chris Allen11 years ago

.travis.yml+1−1

compare with master

unifiedsplit

@@ -25,7 +25,7 @@ before_install:

25 - sudo apt-get install cabal-install-1.20 ghc-$GHCVER

26 - sudo apt-get install happy-1.19.3

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

29 - sudo dpkg --force-all -i elasticsearch-$ESVER.deb

30 - sudo service elasticsearch start

README.md+36−18

@@ -57,6 +57,7 @@ Index Operations

58:set -XDeriveGeneric

59:{

60+import Control.Applicative

60import Database.Bloodhound

61import Database.Bloodhound

61import Data.Aeson

62import Data.Aeson

62import Data.Either (Either(..))

63import Data.Either (Either(..))

@@ -72,14 +73,17 @@ import qualified Network.HTTP.Types.Status as NHTS

72let testServer = (Server "http://localhost:9200")

73let testServer = (Server "http://localhost:9200")

73let testIndex = IndexName "twitter"

74let testIndex = IndexName "twitter"

74let testMapping = MappingName "tweet"

75let testMapping = MappingName "tweet"

76+let withBH' = withBH defaultManagerSettings testServer

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

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

77let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)

79let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)

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.

81-- response :: Reply, Reply is a synonym for Network.HTTP.Conduit.Response

85-- response :: Reply, Reply is a synonym for Network.HTTP.Conduit.Response

82−response <- createIndex testServer defaultIndexSettings testIndex

86+response <- withBH' $ createIndex defaultIndexSettings testIndex

83:}

87:}

85```

89```

@@ -91,7 +95,7 @@ response <- createIndex testServer defaultIndexSettings testIndex

91``` {.haskell}

95``` {.haskell}

93-- response :: Reply

97-- response :: Reply

94−response <- deleteIndex testServer testIndex

98+response <- withBH' $ deleteIndex testIndex

96```

100```

101

@@ -125,7 +129,7 @@ Response {responseStatus = Status {statusCode = 404, statusMessage = "Not Found"

125

129

126``` {.haskell}

130``` {.haskell}

127

131

128−resp <- refreshIndex testServer testIndex

132+resp <- withBH' $ refreshIndex testIndex

129

133

130```

134```

131

135

@@ -168,7 +172,7 @@ instance ToJSON TweetMapping where

168 object ["type" .= ("geo_point" :: Text)]]]]

172 object ["type" .= ("geo_point" :: Text)]]]]

169:}

173:}

170

174

171−resp <- putMapping testServer testIndex testMapping TweetMapping

175+resp <- withBH' $ putMapping testIndex testMapping TweetMapping

172

176

173```

177```

174

178

@@ -176,7 +180,7 @@ resp <- putMapping testServer testIndex testMapping TweetMapping

176

180

177``` {.haskell}

181``` {.haskell}

178

182

179−resp <- deleteMapping testServer testIndex testMapping

183+resp <- withBH' $ deleteMapping testIndex testMapping

180

184

181```

185```

182

186

@@ -221,7 +225,7 @@ instance FromJSON Location

221-- λ> encode $ Location 10.0 10.0

225-- λ> encode $ Location 10.0 10.0

222-- "{\"lat\":10,\"lon\":10}"

226-- "{\"lat\":10,\"lon\":10}"

223

227

224−resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")

228+resp <- withBH' $ indexDocument testIndex testMapping exampleTweet (DocId "1")

225

229

226```

230```

227

231

@@ -243,7 +247,7 @@ Response {responseStatus =

243

247

244``` {.haskell}

248``` {.haskell}

245

249

246−resp <- deleteDocument testServer testIndex testMapping (DocId "1")

250+resp <- withBH' $ deleteDocument testIndex testMapping (DocId "1")

247

251

248```

252```

249

253

@@ -253,7 +257,7 @@ resp <- deleteDocument testServer testIndex testMapping (DocId "1")

253

257

254-- n.b., you'll need the earlier imports. responseBody is from http-conduit

258-- n.b., you'll need the earlier imports. responseBody is from http-conduit

255

259

256−resp <- getDocument testServer testIndex testMapping (DocId "1")

260+resp <- withBH' $ getDocument testIndex testMapping (DocId "1")

257

261

258-- responseBody :: Response body -> body

262-- responseBody :: Response body -> body

259let body = responseBody resp

263let body = responseBody resp

@@ -328,8 +332,8 @@ let sndOp = BulkIndex testIndex

328let stream = [firstDoc, secondDoc]

332let stream = [firstDoc, secondDoc]

329

333

330-- Fire off the actual bulk request

334-- Fire off the actual bulk request

331−-- bulk :: Server -> [BulkOperation] -> IO Reply

335+-- bulk :: Vector BulkOperation -> IO Reply

332−resp <- bulk testServer stream

336+resp <- withBH' $ bulk stream

333:}

337:}

334

338

335```

339```

@@ -363,8 +367,8 @@ let firstDocEncoded = encode firstDoc :: L.ByteString

363let encodedOperations = encodeBulkOperations stream

367let encodedOperations = encodeBulkOperations stream

364

368

365-- to insert into a particular server

369-- to insert into a particular server

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

370+-- bulk :: V.Vector BulkOperation -> IO Reply

367−_ <- bulk testServer stream

371+_ <- withBH' $ bulk stream

368

372

369```

373```

370

374

@@ -379,7 +383,7 @@ Search

379

383

380-- exported by the Client module, just defaults some stuff.

384-- exported by the Client module, just defaults some stuff.

381-- mkSearch :: Maybe Query -> Maybe Filter -> Search

385-- 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)

383

387

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

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

385

389

@@ -393,7 +397,7 @@ let filter = IdentityFilter <&&> IdentityFilter

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

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

394

398

395-- you can also searchByType and specify the mapping name.

399-- you can also searchByType and specify the mapping name.

396−reply <- searchByIndex testServer testIndex search

400+reply <- withBH' $ searchByIndex testIndex search

397

401

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

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

399

403

@@ -484,7 +488,7 @@ let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending

484-- -> From -> Size

488-- -> From -> Size

485

489

486-- just add more sortspecs to the list if you want tie-breakers.

490-- 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)

488

492

489```

493```

490

494

@@ -534,7 +538,7 @@ let queryFilter = IdentityFilter <&&> IdentityFilter

534

538

535let search = mkSearch Nothing (Just queryFilter)

539let search = mkSearch Nothing (Just queryFilter)

536

540

537−reply <- searchByType testServer testIndex testMapping search

541+reply <- withBH' $ searchByType testIndex testMapping search

538

542

539```

543```

540

544

@@ -748,7 +752,7 @@ Aggregations are part of the reply structure of every search, in the form of

748-- Lift decode and response body to be in the IO monad.

752-- Lift decode and response body to be in the IO monad.

749let decode' = liftM decode

753let decode' = liftM decode

750let responseBody' = liftM responseBody

754let responseBody' = liftM responseBody

751−let reply = searchByIndex testServer testIndex search

755+let reply = withBH' $ searchByIndex testIndex search

752let response = decode' $ responseBody' reply :: IO (Maybe (SearchResult Tweet))

756let response = decode' $ responseBody' reply :: IO (Maybe (SearchResult Tweet))

753

757

754-- Now that we have our response, we can extract our terms aggregation result -- which is a list of buckets.

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

857

861

858For more information on the Date Histogram Aggregation, see: <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>

862For more information on the Date Histogram Aggregation, see: <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>

859

863

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+

860Possible future functionality

878Possible future functionality

861=============================

879=============================

862

880

bloodhound.cabal+16−7

@@ -35,8 +35,13 @@ 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,

42+ uri-bytestring >= 0.1 && <0.2,

43+ exceptions,

44+ data-default-class

40 default-language: Haskell2010

45 default-language: Haskell2010

42test-suite tests

47test-suite tests

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

56 semigroups,

61 semigroups,

57 QuickCheck,

62 QuickCheck,

58 vector,

63 vector,

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

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

65+ mtl

60 default-language: Haskell2010

66 default-language: Haskell2010

62test-suite doctests

68test-suite doctests

@@ -64,8 +70,11 @@ test-suite doctests

64 type: exitcode-stdio-1.0

70 type: exitcode-stdio-1.0

65 main-is: doctests.hs

71 main-is: doctests.hs

66 hs-source-dirs: tests

72 hs-source-dirs: tests

73+ if impl(ghc >= 7.8)

67− build-depends: base,

74+ build-depends: base,

68− directory,

75+ directory,

69− doctest,

76+ doctest,

70− doctest-prop,

77+ doctest-prop,

71− filepath

78+ filepath

79+ else

80+ buildable: False

src/Database/Bloodhound/Client.hs+189−131

@@ -1,4 +1,5 @@

1{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RecordWildCards #-}

3-------------------------------------------------------------------------------

4-------------------------------------------------------------------------------

4-- |

5-- |

@@ -20,8 +21,8 @@ module Database.Bloodhound.Client

20 -- and typeclass instances for the functions that make use of them.

21 -- and typeclass instances for the functions that make use of them.

22 -- $setup

23 -- $setup

23−

24+ withBH

24− createIndex

25+ , createIndex

25 , deleteIndex

26 , deleteIndex

26 , indexExists

27 , indexExists

27 , openIndex

28 , openIndex

@@ -49,17 +50,24 @@ module Database.Bloodhound.Client

49 )

50 )

50 where

51 where

53+import Control.Applicative

54+import Control.Monad

55+import Control.Monad.Catch

56+import Control.Monad.IO.Class

52import Data.Aeson

57import Data.Aeson

53import Data.ByteString.Lazy.Builder

58import Data.ByteString.Lazy.Builder

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

59+import qualified Data.ByteString.Lazy.Char8 as L

55−import Data.List (intercalate)

60+import Data.Default.Class

56−import Data.Maybe (fromMaybe)

61+import Data.Maybe (fromMaybe)

57−import Data.Text (Text)

62+import Data.Text (Text)

58−import qualified Data.Vector as V

63+import qualified Data.Text as T

64+import qualified Data.Text.Encoding as T

65+import qualified Data.Vector as V

59import Network.HTTP.Client

66import Network.HTTP.Client

60−import qualified Network.HTTP.Types.Method as NHTM

67+import qualified Network.HTTP.Types.Method as NHTM

61−import qualified Network.HTTP.Types.Status as NHTS

68+import qualified Network.HTTP.Types.Status as NHTS

62−import Prelude hiding (filter, head)

69+import Prelude hiding (filter, head)

70+import URI.ByteString hiding (Query)

64import Database.Bloodhound.Types

72import Database.Bloodhound.Types

@@ -69,12 +77,12 @@ import Database.Bloodhound.Types

69-- >>> import Database.Bloodhound

77-- >>> import Database.Bloodhound

70-- >>> import Test.DocTest.Prop (assert)

78-- >>> import Test.DocTest.Prop (assert)

71-- >>> let testServer = (Server "http://localhost:9200")

79-- >>> let testServer = (Server "http://localhost:9200")

80+-- >>> let runBH' = withBH defaultManagerSettings testServer

72-- >>> let testIndex = IndexName "twitter"

81-- >>> let testIndex = IndexName "twitter"

73-- >>> let testMapping = MappingName "tweet"

82-- >>> let testMapping = MappingName "tweet"

74-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)

83-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)

75-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)

84-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)

76−-- >>> _ <- deleteIndex testServer testIndex

77−-- >>> _ <- deleteMapping testServer testIndex testMapping

85+-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping

78-- >>> import GHC.Generics

86-- >>> import GHC.Generics

79-- >>> import Data.Time.Calendar (Day (..))

87-- >>> import Data.Time.Calendar (Day (..))

80-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)

88-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)

@@ -133,29 +141,49 @@ mkReplicaCount n

133emptyBody :: L.ByteString

141emptyBody :: L.ByteString

134emptyBody = L.pack ""

142emptyBody = L.pack ""

135

143

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

144+dispatch :: MonadBH m => Method -> Text -> Maybe L.ByteString

137− -> IO Reply

145+ -> m Reply

138dispatch dMethod url body = do

146dispatch dMethod url body = do

139− initReq <- parseUrl url

147+ initReq <- liftIO $ parseUrl' url

140 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body

148 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body

141 let req = initReq { method = dMethod

149 let req = initReq { method = dMethod

142 , requestBody = reqBody

150 , requestBody = reqBody

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

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

144− withManager defaultManagerSettings $ httpLbs req

152+ mgr <- bhManager <$> getBHEnv

145−

153+ liftIO $ httpLbs req mgr

154+

146−joinPath :: [String] -> String

155+joinPath' :: [Text] -> Text

147−joinPath = intercalate "/"

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

148

176

149-- Shortcut functions for HTTP methods

177-- Shortcut functions for HTTP methods

150−delete :: String -> IO Reply

178+delete :: MonadBH m => Text -> m Reply

151delete = flip (dispatch NHTM.methodDelete) Nothing

179delete = flip (dispatch NHTM.methodDelete) Nothing

152−get :: String -> IO Reply

180+get :: MonadBH m => Text -> m Reply

153get = flip (dispatch NHTM.methodGet) Nothing

181get = flip (dispatch NHTM.methodGet) Nothing

154−head :: String -> IO Reply

182+head :: MonadBH m => Text -> m Reply

155head = flip (dispatch NHTM.methodHead) Nothing

183head = flip (dispatch NHTM.methodHead) Nothing

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

184+put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply

157put = dispatch NHTM.methodPost

185put = dispatch NHTM.methodPost

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

186+post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply

159post = dispatch NHTM.methodPost

187post = dispatch NHTM.methodPost

160

188

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

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

@@ -164,39 +192,41 @@ post = dispatch NHTM.methodPost

164

192

165-- | 'getStatus' fetches the 'Status' of a 'Server'

193-- | 'getStatus' fetches the 'Status' of a 'Server'

166--

194--

167−-- >>> serverStatus <- getStatus testServer

195+-- >>> serverStatus <- runBH' getStatus

168-- >>> fmap status (serverStatus)

196-- >>> fmap status (serverStatus)

169-- Just 200

197-- Just 200

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

198+getStatus :: MonadBH m => m (Maybe Status)

171−getStatus (Server server) = do

199+getStatus = do

172− request <- parseUrl $ joinPath [server]

200+ url <- joinPath []

201+ request <- liftIO $ parseUrl' url

202+ mgr <- bhManager <$> getBHEnv

173− response <- withManager defaultManagerSettings $ httpLbs request

203+ response <- liftIO $ httpLbs request mgr

174 return $ decode (responseBody response)

204 return $ decode (responseBody response)

175

205

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

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

177--

207--

178−-- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex")

208+-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")

179-- >>> respIsTwoHunna response

209-- >>> respIsTwoHunna response

180-- True

210-- True

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

211+-- >>> runBH' $ indexExists (IndexName "didimakeanindex")

182-- True

212-- True

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

213+createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply

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

214+createIndex indexSettings (IndexName indexName) =

185− put url body

215+ bindM2 put url (return body)

186− where url = joinPath [server, indexName]

216+ where url = joinPath [indexName]

187 body = Just $ encode indexSettings

217 body = Just $ encode indexSettings

188

218

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

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

190--

220--

191−-- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex")

221+-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")

192−-- >>> response <- deleteIndex testServer (IndexName "didimakeanindex")

222+-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")

193-- >>> respIsTwoHunna response

223-- >>> respIsTwoHunna response

194-- True

224-- True

195−-- >>> indexExists testServer testIndex

225+-- >>> runBH' $ indexExists testIndex

196-- False

226-- False

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

227+deleteIndex :: MonadBH m => IndexName -> m Reply

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

228+deleteIndex (IndexName indexName) =

199− delete $ joinPath [server, indexName]

229+ delete =<< joinPath [indexName]

200

230

201statusCodeIs :: Int -> Reply -> Bool

231statusCodeIs :: Int -> Reply -> Bool

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

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

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

204respIsTwoHunna :: Reply -> Bool

234respIsTwoHunna :: Reply -> Bool

205respIsTwoHunna = statusCodeIs 200

235respIsTwoHunna = statusCodeIs 200

206

236

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

237+existentialQuery :: MonadBH m => Text -> m (Reply, Bool)

208existentialQuery url = do

238existentialQuery url = do

209 reply <- head url

239 reply <- head url

210 return (reply, respIsTwoHunna reply)

240 return (reply, respIsTwoHunna reply)

@@ -212,99 +242,98 @@ existentialQuery url = do

212-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'

242-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'

213-- in IO

243-- in IO

214--

244--

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

245+-- >>> exists <- runBH' $ indexExists testIndex

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

246+indexExists :: MonadBH m => IndexName -> m Bool

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

247+indexExists (IndexName indexName) = do

218− (_, exists) <- existentialQuery url

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

219 return exists

249 return exists

220− where url = joinPath [server, indexName]

221

250

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

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

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

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

224--

253--

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

254+-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex

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

255+-- >>> _ <- runBH' $ refreshIndex testIndex

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

256+refreshIndex :: MonadBH m => IndexName -> m Reply

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

257+refreshIndex (IndexName indexName) =

229− post url Nothing

258+ bindM2 post url (return Nothing)

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

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

231−

260+

232−stringifyOCIndex :: OpenCloseIndex -> String

261+stringifyOCIndex :: OpenCloseIndex -> Text

233stringifyOCIndex oci = case oci of

262stringifyOCIndex oci = case oci of

234 OpenIndex -> "_open"

263 OpenIndex -> "_open"

235 CloseIndex -> "_close"

264 CloseIndex -> "_close"

236

265

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

266+openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply

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

267+openOrCloseIndexes oci (IndexName indexName) =

239− post url Nothing

268+ bindM2 post url (return Nothing)

240 where ociString = stringifyOCIndex oci

269 where ociString = stringifyOCIndex oci

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

270+ url = joinPath [indexName, ociString]

242

271

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

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

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

245--

274--

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

275+-- >>> reply <- runBH' $ openIndex testIndex

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

276+openIndex :: MonadBH m => IndexName -> m Reply

248openIndex = openOrCloseIndexes OpenIndex

277openIndex = openOrCloseIndexes OpenIndex

249

278

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

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

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

252--

281--

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

282+-- >>> reply <- runBH' $ closeIndex testIndex

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

283+closeIndex :: MonadBH m => IndexName -> m Reply

255closeIndex = openOrCloseIndexes CloseIndex

284closeIndex = openOrCloseIndexes CloseIndex

256

285

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

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

258-- for documents in indexes.

287-- for documents in indexes.

259--

288--

260−-- >>> _ <- createIndex testServer defaultIndexSettings testIndex

289+-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex

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

290+-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping

262-- >>> print resp

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

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}

264−putMapping :: ToJSON a => Server -> IndexName

293+putMapping :: (MonadBH m, ToJSON a) => IndexName

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

294+ -> MappingName -> a -> m Reply

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

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

267− put url body

296+ bindM2 put url (return body)

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

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

269 body = Just $ encode mapping

298 body = Just $ encode mapping

270

299

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

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

272-- Mappings are schemas for documents in indexes.

301-- Mappings are schemas for documents in indexes.

273--

302--

274−-- >>> _ <- createIndex testServer defaultIndexSettings testIndex

303+-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex

275−-- >>> _ <- putMapping testServer testIndex testMapping TweetMapping

304+-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping

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

305+-- >>> resp <- runBH' $ deleteMapping testIndex testMapping

277-- >>> print resp

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

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

308+deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply

280−deleteMapping (Server server) (IndexName indexName)

309+deleteMapping (IndexName indexName)

281 (MappingName mappingName) =

310 (MappingName mappingName) =

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

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

283

312

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

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

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

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

286-- convert into a JSON 'Value'. The 'DocId' will function as the

315-- convert into a JSON 'Value'. The 'DocId' will function as the

287-- primary key for the document.

316-- primary key for the document.

288--

317--

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

318+-- >>> resp <- runBH' $ indexDocument testIndex testMapping exampleTweet (DocId "1")

290-- >>> print resp

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

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

321+indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName

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

322+ -> doc -> DocId -> m Reply

294−indexDocument (Server server) (IndexName indexName)

323+indexDocument (IndexName indexName)

295 (MappingName mappingName) document (DocId docId) =

324 (MappingName mappingName) document (DocId docId) =

296− put url body

325+ bindM2 put url (return body)

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

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

298 body = Just (encode document)

327 body = Just (encode document)

299

328

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

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

301--

330--

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

331+-- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")

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

332+deleteDocument :: MonadBH m => IndexName -> MappingName

304− -> DocId -> IO Reply

333+ -> DocId -> m Reply

305−deleteDocument (Server server) (IndexName indexName)

334+deleteDocument (IndexName indexName)

306 (MappingName mappingName) (DocId docId) =

335 (MappingName mappingName) (DocId docId) =

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

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

308

337

309-- | 'bulk' uses

338-- | 'bulk' uses

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

339-- <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)

314-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.

343-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.

315--

344--

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

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

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

346+-- >>> _ <- runBH' $ bulk stream

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

347+-- >>> _ <- runBH' $ refreshIndex testIndex

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

348+bulk :: MonadBH m => V.Vector BulkOperation -> m Reply

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

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

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

350+ where url = joinPath ["_bulk"]

322− body = Just $ encodeBulkOperations bulkOps

351+ body = Just $ encodeBulkOperations bulkOps

323

352

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

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

325-- into an 'L.ByteString'

354-- into an 'L.ByteString'

@@ -336,7 +365,7 @@ encodeBulkOperations stream = collapsed where

336mash :: Builder -> V.Vector L.ByteString -> Builder

365mash :: Builder -> V.Vector L.ByteString -> Builder

337mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))

366mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))

338

367

339−mkBulkStreamValue :: Text -> String -> String -> String -> Value

368+mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value

340mkBulkStreamValue operation indexName mappingName docId =

369mkBulkStreamValue operation indexName mappingName docId =

341 object [operation .=

370 object [operation .=

342 object [ "_index" .= indexName

371 object [ "_index" .= indexName

@@ -379,26 +408,26 @@ encodeBulkOperation (BulkUpdate (IndexName indexName)

379-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.

408-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.

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

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

381--

410--

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

411+-- >>> yourDoc <- runBH' $ getDocument testIndex testMapping (DocId "1")

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

412+getDocument :: MonadBH m => IndexName -> MappingName

384− -> DocId -> IO Reply

413+ -> DocId -> m Reply

385−getDocument (Server server) (IndexName indexName)

414+getDocument (IndexName indexName)

386 (MappingName mappingName) (DocId docId) =

415 (MappingName mappingName) (DocId docId) =

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

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

388

417

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

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

390-- in IO

419-- in IO

391--

420--

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

421+-- >>> exists <- runBH' $ documentExists testIndex testMapping (DocId "1")

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

422+documentExists :: MonadBH m => IndexName -> MappingName

394− -> DocId -> IO Bool

423+ -> DocId -> m Bool

395−documentExists (Server server) (IndexName indexName)

424+documentExists (IndexName indexName)

396 (MappingName mappingName) (DocId docId) = do

425 (MappingName mappingName) (DocId docId) = do

397− (_, exists) <- existentialQuery url

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

398− return exists where

427+ return exists

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

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

400

429

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

430+dispatchSearch :: MonadBH m => Text -> Search -> m Reply

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

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

403

432

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

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

@@ -406,31 +435,32 @@ dispatchSearch url search = post url (Just (encode search))

406--

435--

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

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

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

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

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

438+-- >>> reply <- runBH' $ searchAll search

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

439+searchAll :: MonadBH m => Search -> m Reply

411−searchAll (Server server) = dispatchSearch url where

440+searchAll = bindM2 dispatchSearch url . return

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

441+ where url = joinPath ["_search"]

413

442

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

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

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

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

416--

445--

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

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

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

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

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

448+-- >>> reply <- runBH' $ searchByIndex testIndex search

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

449+searchByIndex :: MonadBH m => IndexName -> Search -> m Reply

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

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

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

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

423

452

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

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

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

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

426--

455--

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

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

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

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

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

458+-- >>> reply <- runBH' $ searchByType testIndex testMapping search

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

459+searchByType :: MonadBH m => IndexName -> MappingName -> Search

460+ -> m Reply

431−searchByType (Server server) (IndexName indexName)

461+searchByType (IndexName indexName)

432− (MappingName mappingName) = dispatchSearch url where

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

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

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

434

464

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

465-- | '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

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

@@ -439,9 +469,9 @@ searchByType (Server server) (IndexName indexName)

439--

469--

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

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

441-- >>> mkSearch (Just query) Nothing

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

443mkSearch :: Maybe Query -> Maybe Filter -> Search

473mkSearch :: 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)

445

475

446-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for

476-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for

447-- the 'Query' and the 'Aggregation'.

477-- the 'Query' and the 'Aggregation'.

@@ -451,7 +481,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10

451-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})

481-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})

452-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms

482-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms

453mkAggregateSearch :: Maybe Query -> Aggregations -> Search

483mkAggregateSearch :: 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)

455

485

456-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for

486-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for

457-- the 'Query' and the 'Aggregation'.

487-- the 'Query' and the 'Aggregation'.

@@ -460,7 +490,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear

460-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]

490-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]

461-- >>> let search = mkHighlightSearch (Just query) testHighlight

491-- >>> let search = mkHighlightSearch (Just query) testHighlight

462mkHighlightSearch :: Maybe Query -> Highlights -> Search

492mkHighlightSearch :: 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)

464

494

465-- | 'pageSearch' is a helper function that takes a search and assigns the from

495-- | 'pageSearch' is a helper function that takes a search and assigns the from

466-- and size fields for the search. The from parameter defines the offset

496-- and size fields for the search. The from parameter defines the offset

@@ -470,11 +500,39 @@ mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing

470-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

500-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

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

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

472-- >>> search

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

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}

474−-- >>> pageSearch 10 100 search

504+-- >>> pageSearch (From 10) (Size 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}

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}

476−pageSearch :: Int -- ^ The result offset

506+pageSearch :: From -- ^ The result offset

477− -> Int -- ^ The number of results to return

507+ -> Size -- ^ The number of results to return

478 -> Search -- ^ The current seach

508 -> Search -- ^ The current seach

479 -> Search -- ^ The paged search

509 -> Search -- ^ The paged search

480pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }

510pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }

511+

512+parseUrl' :: MonadThrow m => Text -> m Request

513+parseUrl' t =

514+ case parseURI laxURIParserOptions (T.encodeUtf8 t) of

515+ Right uri -> setURI def uri

516+ Left e -> throwM $ InvalidUrlException (T.unpack t) ("Invalid URL: " ++ show e)

517+

518+setURI :: MonadThrow m => Request -> URI -> m Request

519+setURI req URI{..} = do

520+ Authority {..} <- maybe missingUA return uriAuthority

521+ let req' = req { secure = isSecure

522+ , host = hostBS authorityHost

523+ , port = thePort

524+ , path = uriPath

525+ }

526+ thePort = maybe defPort portNumber authorityPort

527+ addAuth = maybe id addAuth' authorityUserInfo

528+ return $ setQueryString theQueryString $ addAuth req'

529+ where

530+ missingUA = throwM $ InvalidUrlException "N/A" "Missing URI host/port"

531+ addAuth' UserInfo {..} = applyBasicProxyAuth uiUsername uiPassword

532+ defPort

533+ | isSecure = 443

534+ | otherwise = 80

535+ isSecure = case uriScheme of

536+ Scheme "https" -> True

537+ _ -> False

538+ theQueryString = [(k , Just v) | (k, v) <- queryPairs uriQuery]

src/Database/Bloodhound/Types.hs+219−156

@@ -1,6 +1,11 @@

1−{-# LANGUAGE DeriveGeneric #-}

1+{-# LANGUAGE DeriveGeneric #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE FlexibleInstances #-}

4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

2−{-# LANGUAGE OverloadedStrings #-}

6+{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE RecordWildCards #-}

7+{-# LANGUAGE RecordWildCards #-}

8+{-# LANGUAGE UndecidableInstances #-}

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

10-------------------------------------------------------------------------------

6-- |

11-- |

@@ -39,6 +44,10 @@ module Database.Bloodhound.Types

39 , toTerms

44 , toTerms

40 , toDateHistogram

45 , toDateHistogram

41 , omitNulls

46 , omitNulls

47+ , BH

48+ , runBH

49+ , BHEnv(..)

50+ , MonadBH(..)

42 , Version(..)

51 , Version(..)

43 , Status(..)

52 , Status(..)

44 , Existence(..)

53 , Existence(..)

@@ -51,6 +60,9 @@ module Database.Bloodhound.Types

51 , Search(..)

60 , Search(..)

52 , SearchResult(..)

61 , SearchResult(..)

53 , SearchHits(..)

62 , SearchHits(..)

63+ , TrackSortScores

64+ , From(..)

65+ , Size(..)

54 , ShardResult(..)

66 , ShardResult(..)

55 , Hit(..)

67 , Hit(..)

56 , Filter(..)

68 , Filter(..)

@@ -138,6 +150,8 @@ module Database.Bloodhound.Types

138 , IgnoreTermFrequency(..)

150 , IgnoreTermFrequency(..)

139 , MaxQueryTerms(..)

151 , MaxQueryTerms(..)

140 , ScoreType(..)

152 , ScoreType(..)

153+ , Score

154+ , Cache

141 , TypeName(..)

155 , TypeName(..)

142 , BoostTerms(..)

156 , BoostTerms(..)

143 , MaxWordLength(..)

157 , MaxWordLength(..)

@@ -194,13 +208,16 @@ module Database.Bloodhound.Types

194 ) where

208 ) where

195

209

196import Control.Applicative

210import Control.Applicative

211+import Control.Monad.Error

212+import Control.Monad.Reader

213+import Control.Monad.State

214+import Control.Monad.Writer

197import Data.Aeson

215import Data.Aeson

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

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

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

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

200import Data.List (nub)

218import Data.List (nub)

201−import Data.List.NonEmpty (NonEmpty(..), toList)

219+import Data.List.NonEmpty (NonEmpty (..), toList)

202import qualified Data.Map.Strict as M

220import qualified Data.Map.Strict as M

203−import Data.Monoid

204import Data.Text (Text)

221import Data.Text (Text)

205import qualified Data.Text as T

222import qualified Data.Text as T

206import Data.Time.Clock (UTCTime)

223import Data.Time.Clock (UTCTime)

@@ -222,6 +239,52 @@ import Database.Bloodhound.Types.Class

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

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

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

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

224

241

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+

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

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

226data Version = Version { number :: Text

289data Version = Version { number :: Text

227 , build_hash :: Text

290 , build_hash :: Text

@@ -400,22 +463,22 @@ newtype ReplicaCount = ReplicaCount Int deriving (Eq, Show, Generic)

400

463

401{-| 'Server' is used with the client functions to point at the ES instance

464{-| 'Server' is used with the client functions to point at the ES instance

402-}

465-}

403−newtype Server = Server String deriving (Eq, Show)

466+newtype Server = Server Text deriving (Eq, Show)

404

467

405{-| 'IndexName' is used to describe which index to query/create/delete

468{-| 'IndexName' is used to describe which index to query/create/delete

406-}

469-}

407−newtype IndexName = IndexName String deriving (Eq, Generic, Show)

470+newtype IndexName = IndexName Text deriving (Eq, Generic, Show)

408

471

409{-| 'MappingName' is part of mappings which are how ES describes and schematizes

472{-| 'MappingName' is part of mappings which are how ES describes and schematizes

410 the data in the indices.

473 the data in the indices.

411-}

474-}

412−newtype MappingName = MappingName String deriving (Eq, Generic, Show)

475+newtype MappingName = MappingName Text deriving (Eq, Generic, Show)

413

476

414{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.

477{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.

415 Can be set by the user or created by ES itself. Often used in client

478 Can be set by the user or created by ES itself. Often used in client

416 functions for poking at specific documents.

479 functions for poking at specific documents.

417-}

480-}

418−newtype DocId = DocId String deriving (Eq, Generic, Show)

481+newtype DocId = DocId Text deriving (Eq, Generic, Show)

419

482

420{-| 'QueryString' is used to wrap query text bodies, be they human written or not.

483{-| 'QueryString' is used to wrap query text bodies, be they human written or not.

421-}

484-}

@@ -526,12 +589,12 @@ newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, Generic)

526

589

527{-| 'unpackId' is a silly convenience function that gets used once.

590{-| 'unpackId' is a silly convenience function that gets used once.

528-}

591-}

529−unpackId :: DocId -> String

592+unpackId :: DocId -> Text

530unpackId (DocId docId) = docId

593unpackId (DocId docId) = docId

531

594

532type TrackSortScores = Bool

595type TrackSortScores = Bool

533−type From = Int

596+newtype From = From Int deriving (Eq, Show, ToJSON)

534−type Size = Int

597+newtype Size = Size Int deriving (Eq, Show, ToJSON)

535

598

536data Search = Search { queryBody :: Maybe Query

599data Search = Search { queryBody :: Maybe Query

537 , filterBody :: Maybe Filter

600 , filterBody :: Maybe Filter

@@ -1195,29 +1258,29 @@ instance Show TimeInterval where

1195instance ToJSON Aggregation where

1258instance ToJSON Aggregation where

1196 toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =

1259 toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =

1197 omitNulls ["terms" .= omitNulls [ toJSON' term,

1260 omitNulls ["terms" .= omitNulls [ toJSON' term,

1198− "include" .= toJSON include,

1261+ "include" .= include,

1199− "exclude" .= toJSON exclude,

1262+ "exclude" .= exclude,

1200− "order" .= toJSON order,

1263+ "order" .= order,

1201− "min_doc_count" .= toJSON minDocCount,

1264+ "min_doc_count" .= minDocCount,

1202− "size" .= toJSON size,

1265+ "size" .= size,

1203− "shard_size" .= toJSON shardSize,

1266+ "shard_size" .= shardSize,

1204− "collect_mode" .= toJSON collectMode,

1267+ "collect_mode" .= collectMode,

1205− "execution_hint" .= toJSON executionHint

1268+ "execution_hint" .= executionHint

1206 ],

1269 ],

1207− "aggs" .= toJSON termAggs ]

1270+ "aggs" .= termAggs ]

1208 where

1271 where

1209− toJSON' x = case x of { Left y -> "field" .= toJSON y; Right y -> "script" .= toJSON y }

1272+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }

1210

1273

1211 toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =

1274 toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =

1212− omitNulls ["date_histogram" .= omitNulls [ "field" .= toJSON field,

1275+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,

1213− "interval" .= toJSON interval,

1276+ "interval" .= interval,

1214− "format" .= toJSON format,

1277+ "format" .= format,

1215− "pre_zone" .= toJSON preZone,

1278+ "pre_zone" .= preZone,

1216− "post_zone" .= toJSON postZone,

1279+ "post_zone" .= postZone,

1217− "pre_offset" .= toJSON preOffset,

1280+ "pre_offset" .= preOffset,

1218− "post_offset" .= toJSON postOffset

1281+ "post_offset" .= postOffset

1219 ],

1282 ],

1220− "aggs" .= toJSON dateHistoAggs ]

1283+ "aggs" .= dateHistoAggs ]

1221

1284

1222type AggregationResults = M.Map Text Value

1285type AggregationResults = M.Map Text Value

1223

1286

@@ -1295,7 +1358,7 @@ instance ToJSON Filter where

1295

1358

1296 toJSON (NotFilter notFilter cache) =

1359 toJSON (NotFilter notFilter cache) =

1297 object ["not" .=

1360 object ["not" .=

1298− object ["filter" .= toJSON notFilter

1361+ object ["filter" .= notFilter

1299 , "_cache" .= cache]]

1362 , "_cache" .= cache]]

1300

1363

1301 toJSON (IdentityFilter) =

1364 toJSON (IdentityFilter) =

@@ -1311,26 +1374,26 @@ instance ToJSON Filter where

1311 ["field" .= fieldName]]

1374 ["field" .= fieldName]]

1312

1375

1313 toJSON (BoolFilter boolMatch) =

1376 toJSON (BoolFilter boolMatch) =

1314− object ["bool" .= toJSON boolMatch]

1377+ object ["bool" .= boolMatch]

1315

1378

1316 toJSON (GeoBoundingBoxFilter bbConstraint) =

1379 toJSON (GeoBoundingBoxFilter bbConstraint) =

1317− object ["geo_bounding_box" .= toJSON bbConstraint]

1380+ object ["geo_bounding_box" .= bbConstraint]

1318

1381

1319 toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)

1382 toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)

1320 distance distanceType optimizeBbox cache) =

1383 distance distanceType optimizeBbox cache) =

1321 object ["geo_distance" .=

1384 object ["geo_distance" .=

1322− object ["distance" .= toJSON distance

1385+ object ["distance" .= distance

1323− , "distance_type" .= toJSON distanceType

1386+ , "distance_type" .= distanceType

1324 , "optimize_bbox" .= optimizeBbox

1387 , "optimize_bbox" .= optimizeBbox

1325− , distanceGeoField .= toJSON geoDistLatLon

1388+ , distanceGeoField .= geoDistLatLon

1326 , "_cache" .= cache]]

1389 , "_cache" .= cache]]

1327

1390

1328 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)

1391 toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)

1329 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =

1392 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =

1330 object ["geo_distance_range" .=

1393 object ["geo_distance_range" .=

1331− object ["from" .= toJSON geoDistRangeDistFrom

1394+ object ["from" .= geoDistRangeDistFrom

1332− , "to" .= toJSON drDistanceTo

1395+ , "to" .= drDistanceTo

1333− , gddrField .= toJSON drLatLon]]

1396+ , gddrField .= drLatLon]]

1334

1397

1335 toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =

1398 toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =

1336 object ["geo_polygon" .=

1399 object ["geo_polygon" .=

@@ -1340,7 +1403,7 @@ instance ToJSON Filter where

1340 toJSON (IdsFilter (MappingName mappingName) values) =

1403 toJSON (IdsFilter (MappingName mappingName) values) =

1341 object ["ids" .=

1404 object ["ids" .=

1342 object ["type" .= mappingName

1405 object ["type" .= mappingName

1343− , "values" .= fmap (T.pack . unpackId) values]]

1406+ , "values" .= fmap unpackId values]]

1344

1407

1345 toJSON (LimitFilter limit) =

1408 toJSON (LimitFilter limit) =

1346 object ["limit" .= object ["value" .= limit]]

1409 object ["limit" .= object ["value" .= limit]]

@@ -1359,7 +1422,7 @@ instance ToJSON Filter where

1359 toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =

1422 toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =

1360 object ["range" .=

1423 object ["range" .=

1361 object [ fieldName .= object (rangeValueToPair rangeValue)

1424 object [ fieldName .= object (rangeValueToPair rangeValue)

1362− , "execution" .= toJSON rangeExecution

1425+ , "execution" .= rangeExecution

1363 , "_cache" .= cache]]

1426 , "_cache" .= cache]]

1364

1427

1365 toJSON (RegexpFilter (FieldName fieldName)

1428 toJSON (RegexpFilter (FieldName fieldName)

@@ -1367,14 +1430,14 @@ instance ToJSON Filter where

1367 object ["regexp" .=

1430 object ["regexp" .=

1368 object [fieldName .=

1431 object [fieldName .=

1369 object ["value" .= regexText

1432 object ["value" .= regexText

1370− , "flags" .= toJSON flags]

1433+ , "flags" .= flags]

1371 , "_name" .= cacheName

1434 , "_name" .= cacheName

1372 , "_cache" .= cache

1435 , "_cache" .= cache

1373 , "_cache_key" .= cacheKey]]

1436 , "_cache_key" .= cacheKey]]

1374

1437

1375instance ToJSON GeoPoint where

1438instance ToJSON GeoPoint where

1376 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

1439 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

1377− object [ geoPointField .= toJSON geoPointLatLon ]

1440+ object [ geoPointField .= geoPointLatLon ]

1378

1441

1379

1442

1380instance ToJSON Query where

1443instance ToJSON Query where

@@ -1394,82 +1457,82 @@ instance ToJSON Query where

1394 getTermValue (Term _ v) = v

1457 getTermValue (Term _ v) = v

1395 toJSON (IdsQuery idsQueryMappingName docIds) =

1458 toJSON (IdsQuery idsQueryMappingName docIds) =

1396 object [ "ids" .= object conjoined ]

1459 object [ "ids" .= object conjoined ]

1397− where conjoined = [ "type" .= toJSON idsQueryMappingName

1460+ where conjoined = [ "type" .= idsQueryMappingName

1398 , "values" .= fmap toJSON docIds ]

1461 , "values" .= fmap toJSON docIds ]

1399

1462

1400 toJSON (QueryQueryStringQuery qQueryStringQuery) =

1463 toJSON (QueryQueryStringQuery qQueryStringQuery) =

1401− object [ "query_string" .= toJSON qQueryStringQuery ]

1464+ object [ "query_string" .= qQueryStringQuery ]

1402

1465

1403 toJSON (QueryMatchQuery matchQuery) =

1466 toJSON (QueryMatchQuery matchQuery) =

1404− object [ "match" .= toJSON matchQuery ]

1467+ object [ "match" .= matchQuery ]

1405

1468

1406 toJSON (QueryMultiMatchQuery multiMatchQuery) =

1469 toJSON (QueryMultiMatchQuery multiMatchQuery) =

1407 toJSON multiMatchQuery

1470 toJSON multiMatchQuery

1408

1471

1409 toJSON (QueryBoolQuery boolQuery) =

1472 toJSON (QueryBoolQuery boolQuery) =

1410− object [ "bool" .= toJSON boolQuery ]

1473+ object [ "bool" .= boolQuery ]

1411

1474

1412 toJSON (QueryBoostingQuery boostingQuery) =

1475 toJSON (QueryBoostingQuery boostingQuery) =

1413− object [ "boosting" .= toJSON boostingQuery ]

1476+ object [ "boosting" .= boostingQuery ]

1414

1477

1415 toJSON (QueryCommonTermsQuery commonTermsQuery) =

1478 toJSON (QueryCommonTermsQuery commonTermsQuery) =

1416− object [ "common" .= toJSON commonTermsQuery ]

1479+ object [ "common" .= commonTermsQuery ]

1417

1480

1418 toJSON (ConstantScoreFilter csFilter boost) =

1481 toJSON (ConstantScoreFilter csFilter boost) =

1419− object [ "constant_score" .= toJSON csFilter

1482+ object [ "constant_score" .= csFilter

1420− , "boost" .= toJSON boost]

1483+ , "boost" .= boost]

1421

1484

1422 toJSON (ConstantScoreQuery query boost) =

1485 toJSON (ConstantScoreQuery query boost) =

1423− object [ "constant_score" .= toJSON query

1486+ object [ "constant_score" .= query

1424− , "boost" .= toJSON boost]

1487+ , "boost" .= boost]

1425

1488

1426 toJSON (QueryDisMaxQuery disMaxQuery) =

1489 toJSON (QueryDisMaxQuery disMaxQuery) =

1427− object [ "dis_max" .= toJSON disMaxQuery ]

1490+ object [ "dis_max" .= disMaxQuery ]

1428

1491

1429 toJSON (QueryFilteredQuery qFilteredQuery) =

1492 toJSON (QueryFilteredQuery qFilteredQuery) =

1430− object [ "filtered" .= toJSON qFilteredQuery ]

1493+ object [ "filtered" .= qFilteredQuery ]

1431

1494

1432 toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =

1495 toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =

1433− object [ "fuzzy_like_this" .= toJSON fuzzyQuery ]

1496+ object [ "fuzzy_like_this" .= fuzzyQuery ]

1434

1497

1435 toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =

1498 toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =

1436− object [ "fuzzy_like_this_field" .= toJSON fuzzyFieldQuery ]

1499+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]

1437

1500

1438 toJSON (QueryFuzzyQuery fuzzyQuery) =

1501 toJSON (QueryFuzzyQuery fuzzyQuery) =

1439− object [ "fuzzy" .= toJSON fuzzyQuery ]

1502+ object [ "fuzzy" .= fuzzyQuery ]

1440

1503

1441 toJSON (QueryHasChildQuery childQuery) =

1504 toJSON (QueryHasChildQuery childQuery) =

1442− object [ "has_child" .= toJSON childQuery ]

1505+ object [ "has_child" .= childQuery ]

1443

1506

1444 toJSON (QueryHasParentQuery parentQuery) =

1507 toJSON (QueryHasParentQuery parentQuery) =

1445− object [ "has_parent" .= toJSON parentQuery ]

1508+ object [ "has_parent" .= parentQuery ]

1446

1509

1447 toJSON (QueryIndicesQuery qIndicesQuery) =

1510 toJSON (QueryIndicesQuery qIndicesQuery) =

1448− object [ "indices" .= toJSON qIndicesQuery ]

1511+ object [ "indices" .= qIndicesQuery ]

1449

1512

1450 toJSON (MatchAllQuery boost) =

1513 toJSON (MatchAllQuery boost) =

1451 object [ "match_all" .= omitNulls [ "boost" .= boost ] ]

1514 object [ "match_all" .= omitNulls [ "boost" .= boost ] ]

1452

1515

1453 toJSON (QueryMoreLikeThisQuery query) =

1516 toJSON (QueryMoreLikeThisQuery query) =

1454− object [ "more_like_this" .= toJSON query ]

1517+ object [ "more_like_this" .= query ]

1455

1518

1456 toJSON (QueryMoreLikeThisFieldQuery query) =

1519 toJSON (QueryMoreLikeThisFieldQuery query) =

1457− object [ "more_like_this_field" .= toJSON query ]

1520+ object [ "more_like_this_field" .= query ]

1458

1521

1459 toJSON (QueryNestedQuery query) =

1522 toJSON (QueryNestedQuery query) =

1460− object [ "nested" .= toJSON query ]

1523+ object [ "nested" .= query ]

1461

1524

1462 toJSON (QueryPrefixQuery query) =

1525 toJSON (QueryPrefixQuery query) =

1463− object [ "prefix" .= toJSON query ]

1526+ object [ "prefix" .= query ]

1464

1527

1465 toJSON (QueryRangeQuery query) =

1528 toJSON (QueryRangeQuery query) =

1466− object [ "range" .= toJSON query ]

1529+ object [ "range" .= query ]

1467

1530

1468 toJSON (QueryRegexpQuery query) =

1531 toJSON (QueryRegexpQuery query) =

1469− object [ "regexp" .= toJSON query ]

1532+ object [ "regexp" .= query ]

1470

1533

1471 toJSON (QuerySimpleQueryStringQuery query) =

1534 toJSON (QuerySimpleQueryStringQuery query) =

1472− object [ "simple_query_string" .= toJSON query ]

1535+ object [ "simple_query_string" .= query ]

1473

1536

1474

1537

1475omitNulls :: [(Text, Value)] -> Value

1538omitNulls :: [(Text, Value)] -> Value

@@ -1482,7 +1545,7 @@ omitNulls = object . filter notNull where

1482instance ToJSON SimpleQueryStringQuery where

1545instance ToJSON SimpleQueryStringQuery where

1483 toJSON SimpleQueryStringQuery {..} =

1546 toJSON SimpleQueryStringQuery {..} =

1484 omitNulls (base ++ maybeAdd)

1547 omitNulls (base ++ maybeAdd)

1485− where base = [ "query" .= toJSON simpleQueryStringQuery ]

1548+ where base = [ "query" .= simpleQueryStringQuery ]

1486 maybeAdd = [ "fields" .= simpleQueryStringField

1549 maybeAdd = [ "fields" .= simpleQueryStringField

1487 , "default_operator" .= simpleQueryStringOperator

1550 , "default_operator" .= simpleQueryStringOperator

1488 , "analyzer" .= simpleQueryStringAnalyzer

1551 , "analyzer" .= simpleQueryStringAnalyzer

@@ -1518,7 +1581,7 @@ instance ToJSON RegexpQuery where

1518 rqQueryBoost) =

1581 rqQueryBoost) =

1519 object [ rqQueryField .= omitNulls base ]

1582 object [ rqQueryField .= omitNulls base ]

1520 where base = [ "value" .= regexpQueryQuery

1583 where base = [ "value" .= regexpQueryQuery

1521− , "flags" .= toJSON rqQueryFlags

1584+ , "flags" .= rqQueryFlags

1522 , "boost" .= rqQueryBoost ]

1585 , "boost" .= rqQueryBoost ]

1523

1586

1524

1587

@@ -1534,7 +1597,7 @@ instance ToJSON QueryStringQuery where

1534 qsLenient qsLocale) =

1597 qsLenient qsLocale) =

1535 omitNulls base

1598 omitNulls base

1536 where

1599 where

1537− base = [ "query" .= toJSON qsQueryString

1600+ base = [ "query" .= qsQueryString

1538 , "default_field" .= qsDefaultField

1601 , "default_field" .= qsDefaultField

1539 , "default_operator" .= qsOperator

1602 , "default_operator" .= qsOperator

1540 , "analyzer" .= qsAnalyzer

1603 , "analyzer" .= qsAnalyzer

@@ -1556,21 +1619,21 @@ instance ToJSON QueryStringQuery where

1556instance ToJSON RangeQuery where

1619instance ToJSON RangeQuery where

1557 toJSON (RangeQuery (FieldName fieldName) range boost) =

1620 toJSON (RangeQuery (FieldName fieldName) range boost) =

1558 object [ fieldName .= conjoined ]

1621 object [ fieldName .= conjoined ]

1559− where conjoined = [ "boost" .= toJSON boost ] ++ (rangeValueToPair range)

1622+ where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)

1560

1623

1561

1624

1562instance ToJSON PrefixQuery where

1625instance ToJSON PrefixQuery where

1563 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =

1626 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =

1564 object [ fieldName .= omitNulls base ]

1627 object [ fieldName .= omitNulls base ]

1565− where base = [ "value" .= toJSON queryValue

1628+ where base = [ "value" .= queryValue

1566 , "boost" .= boost ]

1629 , "boost" .= boost ]

1567

1630

1568

1631

1569instance ToJSON NestedQuery where

1632instance ToJSON NestedQuery where

1570 toJSON (NestedQuery nqPath nqScoreType nqQuery) =

1633 toJSON (NestedQuery nqPath nqScoreType nqQuery) =

1571− object [ "path" .= toJSON nqPath

1634+ object [ "path" .= nqPath

1572− , "score_mode" .= toJSON nqScoreType

1635+ , "score_mode" .= nqScoreType

1573− , "query" .= toJSON nqQuery ]

1636+ , "query" .= nqQuery ]

1574

1637

1575

1638

1576instance ToJSON MoreLikeThisFieldQuery where

1639instance ToJSON MoreLikeThisFieldQuery where

@@ -1578,7 +1641,7 @@ instance ToJSON MoreLikeThisFieldQuery where

1578 percent mtf mqt stopwords mindf maxdf

1641 percent mtf mqt stopwords mindf maxdf

1579 minwl maxwl boostTerms boost analyzer) =

1642 minwl maxwl boostTerms boost analyzer) =

1580 object [ fieldName .= omitNulls base ]

1643 object [ fieldName .= omitNulls base ]

1581− where base = [ "like_text" .= toJSON text

1644+ where base = [ "like_text" .= text

1582 , "percent_terms_to_match" .= percent

1645 , "percent_terms_to_match" .= percent

1583 , "min_term_freq" .= mtf

1646 , "min_term_freq" .= mtf

1584 , "max_query_terms" .= mqt

1647 , "max_query_terms" .= mqt

@@ -1597,7 +1660,7 @@ instance ToJSON MoreLikeThisQuery where

1597 mtf mqt stopwords mindf maxdf

1660 mtf mqt stopwords mindf maxdf

1598 minwl maxwl boostTerms boost analyzer) =

1661 minwl maxwl boostTerms boost analyzer) =

1599 omitNulls base

1662 omitNulls base

1600− where base = [ "like_text" .= toJSON text

1663+ where base = [ "like_text" .= text

1601 , "fields" .= fields

1664 , "fields" .= fields

1602 , "percent_terms_to_match" .= percent

1665 , "percent_terms_to_match" .= percent

1603 , "min_term_freq" .= mtf

1666 , "min_term_freq" .= mtf

@@ -1614,34 +1677,34 @@ instance ToJSON MoreLikeThisQuery where

1614

1677

1615instance ToJSON IndicesQuery where

1678instance ToJSON IndicesQuery where

1616 toJSON (IndicesQuery indices query noMatch) =

1679 toJSON (IndicesQuery indices query noMatch) =

1617− omitNulls [ "indices" .= toJSON indices

1680+ omitNulls [ "indices" .= indices

1618− , "no_match_query" .= toJSON noMatch

1681+ , "no_match_query" .= noMatch

1619− , "query" .= toJSON query ]

1682+ , "query" .= query ]

1620

1683

1621

1684

1622instance ToJSON HasParentQuery where

1685instance ToJSON HasParentQuery where

1623 toJSON (HasParentQuery queryType query scoreType) =

1686 toJSON (HasParentQuery queryType query scoreType) =

1624− omitNulls [ "parent_type" .= toJSON queryType

1687+ omitNulls [ "parent_type" .= queryType

1625− , "score_type" .= toJSON scoreType

1688+ , "score_type" .= scoreType

1626− , "query" .= toJSON query ]

1689+ , "query" .= query ]

1627

1690

1628

1691

1629instance ToJSON HasChildQuery where

1692instance ToJSON HasChildQuery where

1630 toJSON (HasChildQuery queryType query scoreType) =

1693 toJSON (HasChildQuery queryType query scoreType) =

1631− omitNulls [ "query" .= toJSON query

1694+ omitNulls [ "query" .= query

1632− , "score_type" .= toJSON scoreType

1695+ , "score_type" .= scoreType

1633− , "type" .= toJSON queryType ]

1696+ , "type" .= queryType ]

1634

1697

1635

1698

1636instance ToJSON FuzzyQuery where

1699instance ToJSON FuzzyQuery where

1637 toJSON (FuzzyQuery (FieldName fieldName) queryText

1700 toJSON (FuzzyQuery (FieldName fieldName) queryText

1638 prefixLength maxEx fuzziness boost) =

1701 prefixLength maxEx fuzziness boost) =

1639 object [ fieldName .= omitNulls base ]

1702 object [ fieldName .= omitNulls base ]

1640− where base = [ "value" .= toJSON queryText

1703+ where base = [ "value" .= queryText

1641− , "fuzziness" .= toJSON fuzziness

1704+ , "fuzziness" .= fuzziness

1642− , "prefix_length" .= toJSON prefixLength

1705+ , "prefix_length" .= prefixLength

1643− , "boost" .= toJSON boost

1706+ , "boost" .= boost

1644− , "max_expansions" .= toJSON maxEx ]

1707+ , "max_expansions" .= maxEx ]

1645

1708

1646

1709

1647instance ToJSON FuzzyLikeFieldQuery where

1710instance ToJSON FuzzyLikeFieldQuery where

@@ -1649,41 +1712,41 @@ instance ToJSON FuzzyLikeFieldQuery where

1649 fieldText maxTerms ignoreFreq fuzziness prefixLength

1712 fieldText maxTerms ignoreFreq fuzziness prefixLength

1650 boost analyzer) =

1713 boost analyzer) =

1651 object [ fieldName .=

1714 object [ fieldName .=

1652− omitNulls [ "like_text" .= toJSON fieldText

1715+ omitNulls [ "like_text" .= fieldText

1653− , "max_query_terms" .= toJSON maxTerms

1716+ , "max_query_terms" .= maxTerms

1654− , "ignore_tf" .= toJSON ignoreFreq

1717+ , "ignore_tf" .= ignoreFreq

1655− , "fuzziness" .= toJSON fuzziness

1718+ , "fuzziness" .= fuzziness

1656− , "prefix_length" .= toJSON prefixLength

1719+ , "prefix_length" .= prefixLength

1657− , "analyzer" .= toJSON analyzer

1720+ , "analyzer" .= analyzer

1658− , "boost" .= toJSON boost ]]

1721+ , "boost" .= boost ]]

1659

1722

1660

1723

1661instance ToJSON FuzzyLikeThisQuery where

1724instance ToJSON FuzzyLikeThisQuery where

1662 toJSON (FuzzyLikeThisQuery fields text maxTerms

1725 toJSON (FuzzyLikeThisQuery fields text maxTerms

1663 ignoreFreq fuzziness prefixLength boost analyzer) =

1726 ignoreFreq fuzziness prefixLength boost analyzer) =

1664 omitNulls base

1727 omitNulls base

1665− where base = [ "fields" .= toJSON fields

1728+ where base = [ "fields" .= fields

1666− , "like_text" .= toJSON text

1729+ , "like_text" .= text

1667− , "max_query_terms" .= toJSON maxTerms

1730+ , "max_query_terms" .= maxTerms

1668− , "ignore_tf" .= toJSON ignoreFreq

1731+ , "ignore_tf" .= ignoreFreq

1669− , "fuzziness" .= toJSON fuzziness

1732+ , "fuzziness" .= fuzziness

1670− , "prefix_length" .= toJSON prefixLength

1733+ , "prefix_length" .= prefixLength

1671− , "analyzer" .= toJSON analyzer

1734+ , "analyzer" .= analyzer

1672− , "boost" .= toJSON boost ]

1735+ , "boost" .= boost ]

1673

1736

1674

1737

1675instance ToJSON FilteredQuery where

1738instance ToJSON FilteredQuery where

1676 toJSON (FilteredQuery query fFilter) =

1739 toJSON (FilteredQuery query fFilter) =

1677− object [ "query" .= toJSON query

1740+ object [ "query" .= query

1678− , "filter" .= toJSON fFilter ]

1741+ , "filter" .= fFilter ]

1679

1742

1680

1743

1681instance ToJSON DisMaxQuery where

1744instance ToJSON DisMaxQuery where

1682 toJSON (DisMaxQuery queries tiebreaker boost) =

1745 toJSON (DisMaxQuery queries tiebreaker boost) =

1683 omitNulls base

1746 omitNulls base

1684− where base = [ "queries" .= toJSON queries

1747+ where base = [ "queries" .= queries

1685− , "boost" .= toJSON boost

1748+ , "boost" .= boost

1686− , "tie_breaker" .= toJSON tiebreaker ]

1749+ , "tie_breaker" .= tiebreaker ]

1687

1750

1688

1751

1689instance ToJSON CommonTermsQuery where

1752instance ToJSON CommonTermsQuery where

@@ -1691,38 +1754,38 @@ instance ToJSON CommonTermsQuery where

1691 (QueryString query) cf lfo hfo msm

1754 (QueryString query) cf lfo hfo msm

1692 boost analyzer disableCoord) =

1755 boost analyzer disableCoord) =

1693 object [fieldName .= omitNulls base ]

1756 object [fieldName .= omitNulls base ]

1694− where base = [ "query" .= toJSON query

1757+ where base = [ "query" .= query

1695− , "cutoff_frequency" .= toJSON cf

1758+ , "cutoff_frequency" .= cf

1696− , "low_freq_operator" .= toJSON lfo

1759+ , "low_freq_operator" .= lfo

1697− , "minimum_should_match" .= toJSON msm

1760+ , "minimum_should_match" .= msm

1698− , "boost" .= toJSON boost

1761+ , "boost" .= boost

1699− , "analyzer" .= toJSON analyzer

1762+ , "analyzer" .= analyzer

1700− , "disable_coord" .= toJSON disableCoord

1763+ , "disable_coord" .= disableCoord

1701− , "high_freq_operator" .= toJSON hfo ]

1764+ , "high_freq_operator" .= hfo ]

1702

1765

1703

1766

1704instance ToJSON CommonMinimumMatch where

1767instance ToJSON CommonMinimumMatch where

1705 toJSON (CommonMinimumMatch mm) = toJSON mm

1768 toJSON (CommonMinimumMatch mm) = toJSON mm

1706 toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =

1769 toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =

1707− object [ "low_freq" .= toJSON lowF

1770+ object [ "low_freq" .= lowF

1708− , "high_freq" .= toJSON highF ]

1771+ , "high_freq" .= highF ]

1709

1772

1710instance ToJSON BoostingQuery where

1773instance ToJSON BoostingQuery where

1711 toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =

1774 toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =

1712− object [ "positive" .= toJSON bqPositiveQuery

1775+ object [ "positive" .= bqPositiveQuery

1713− , "negative" .= toJSON bqNegativeQuery

1776+ , "negative" .= bqNegativeQuery

1714− , "negative_boost" .= toJSON bqNegativeBoost ]

1777+ , "negative_boost" .= bqNegativeBoost ]

1715

1778

1716

1779

1717instance ToJSON BoolQuery where

1780instance ToJSON BoolQuery where

1718 toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =

1781 toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =

1719 omitNulls base

1782 omitNulls base

1720− where base = [ "must" .= toJSON mustM

1783+ where base = [ "must" .= mustM

1721− , "must_not" .= toJSON notM

1784+ , "must_not" .= notM

1722− , "should" .= toJSON shouldM

1785+ , "should" .= shouldM

1723− , "minimum_should_match" .= toJSON bqMin

1786+ , "minimum_should_match" .= bqMin

1724− , "boost" .= toJSON boost

1787+ , "boost" .= boost

1725− , "disable_coord" .= toJSON disableCoord ]

1788+ , "disable_coord" .= disableCoord ]

1726

1789

1727

1790

1728instance ToJSON MatchQuery where

1791instance ToJSON MatchQuery where

@@ -1732,13 +1795,13 @@ instance ToJSON MatchQuery where

1732 analyzer maxExpansions lenient) =

1795 analyzer maxExpansions lenient) =

1733 object [ fieldName .= omitNulls base ]

1796 object [ fieldName .= omitNulls base ]

1734 where base = [ "query" .= mqQueryString

1797 where base = [ "query" .= mqQueryString

1735− , "operator" .= toJSON booleanOperator

1798+ , "operator" .= booleanOperator

1736− , "zero_terms_query" .= toJSON zeroTermsQuery

1799+ , "zero_terms_query" .= zeroTermsQuery

1737− , "cutoff_frequency" .= toJSON cutoffFrequency

1800+ , "cutoff_frequency" .= cutoffFrequency

1738− , "type" .= toJSON matchQueryType

1801+ , "type" .= matchQueryType

1739− , "analyzer" .= toJSON analyzer

1802+ , "analyzer" .= analyzer

1740− , "max_expansions" .= toJSON maxExpansions

1803+ , "max_expansions" .= maxExpansions

1741− , "lenient" .= toJSON lenient ]

1804+ , "lenient" .= lenient ]

1742

1805

1743

1806

1744instance ToJSON MultiMatchQuery where

1807instance ToJSON MultiMatchQuery where

@@ -1747,14 +1810,14 @@ instance ToJSON MultiMatchQuery where

1747 object ["multi_match" .= omitNulls base]

1810 object ["multi_match" .= omitNulls base]

1748 where base = [ "fields" .= fmap toJSON fields

1811 where base = [ "fields" .= fmap toJSON fields

1749 , "query" .= query

1812 , "query" .= query

1750− , "operator" .= toJSON boolOp

1813+ , "operator" .= boolOp

1751− , "zero_terms_query" .= toJSON ztQ

1814+ , "zero_terms_query" .= ztQ

1752− , "tiebreaker" .= toJSON tb

1815+ , "tiebreaker" .= tb

1753− , "type" .= toJSON mmqt

1816+ , "type" .= mmqt

1754− , "cutoff_frequency" .= toJSON cf

1817+ , "cutoff_frequency" .= cf

1755− , "analyzer" .= toJSON analyzer

1818+ , "analyzer" .= analyzer

1756− , "max_expansions" .= toJSON maxEx

1819+ , "max_expansions" .= maxEx

1757− , "lenient" .= toJSON lenient ]

1820+ , "lenient" .= lenient ]

1758

1821

1759

1822

1760instance ToJSON MultiMatchQueryType where

1823instance ToJSON MultiMatchQueryType where

@@ -1866,7 +1929,7 @@ instance ToJSON FieldHighlight where

1866

1929

1867instance ToJSON Highlights where

1930instance ToJSON Highlights where

1868 toJSON (Highlights global fields) =

1931 toJSON (Highlights global fields) =

1869− omitNulls (("fields" .= toJSON fields)

1932+ omitNulls (("fields" .= fields)

1870 : highlightSettingsPairs global)

1933 : highlightSettingsPairs global)

1871

1934

1872instance ToJSON HighlightSettings where

1935instance ToJSON HighlightSettings where

@@ -1944,16 +2007,16 @@ instance ToJSON SortSpec where

1944 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

2007 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

1945 dsSortMode dsMissingSort dsNestedFilter)) =

2008 dsSortMode dsMissingSort dsNestedFilter)) =

1946 object [dsSortFieldName .= omitNulls base] where

2009 object [dsSortFieldName .= omitNulls base] where

1947− base = [ "order" .= toJSON dsSortOrder

2010+ base = [ "order" .= dsSortOrder

1948 , "ignore_unmapped" .= dsIgnoreUnmapped

2011 , "ignore_unmapped" .= dsIgnoreUnmapped

1949 , "mode" .= dsSortMode

2012 , "mode" .= dsSortMode

1950 , "missing" .= dsMissingSort

2013 , "missing" .= dsMissingSort

1951 , "nested_filter" .= dsNestedFilter ]

2014 , "nested_filter" .= dsNestedFilter ]

1952

2015

1953 toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =

2016 toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =

1954− object [ "unit" .= toJSON units

2017+ object [ "unit" .= units

1955− , field .= toJSON gdsLatLon

2018+ , field .= gdsLatLon

1956− , "order" .= toJSON gdsSortOrder ]

2019+ , "order" .= gdsSortOrder ]

1957

2020

1958

2021

1959instance ToJSON SortOrder where

2022instance ToJSON SortOrder where

@@ -2015,7 +2078,7 @@ instance ToJSON OptimizeBbox where

2015instance ToJSON GeoBoundingBoxConstraint where

2078instance ToJSON GeoBoundingBoxConstraint where

2016 toJSON (GeoBoundingBoxConstraint

2079 toJSON (GeoBoundingBoxConstraint

2017 (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =

2080 (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =

2018− object [gbbcGeoBBField .= toJSON gbbcConstraintBox

2081+ object [gbbcGeoBBField .= gbbcConstraintBox

2019 , "_cache" .= cache

2082 , "_cache" .= cache

2020 , "type" .= type']

2083 , "type" .= type']

2021

2084

@@ -2027,8 +2090,8 @@ instance ToJSON GeoFilterType where

2027

2090

2028instance ToJSON GeoBoundingBox where

2091instance ToJSON GeoBoundingBox where

2029 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =

2092 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =

2030− object ["top_left" .= toJSON gbbTopLeft

2093+ object ["top_left" .= gbbTopLeft

2031− , "bottom_right" .= toJSON gbbBottomRight]

2094+ , "bottom_right" .= gbbBottomRight]

2032

2095

2033

2096

2034instance ToJSON LatLon where

2097instance ToJSON LatLon where

@@ -2061,9 +2124,9 @@ instance ToJSON Term where

2061

2124

2062

2125

2063instance ToJSON BoolMatch where

2126instance ToJSON BoolMatch where

2064− toJSON (MustMatch term cache) = object ["must" .= toJSON term,

2127+ toJSON (MustMatch term cache) = object ["must" .= term,

2065 "_cache" .= cache]

2128 "_cache" .= cache]

2066− toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,

2129+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,

2067 "_cache" .= cache]

2130 "_cache" .= cache]

2068 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,

2131 toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,

2069 "_cache" .= cache]

2132 "_cache" .= cache]

tests/tests.hs+127−99

@@ -6,8 +6,9 @@ module Main where

7import Control.Applicative

8import Control.Monad

9+import Control.Monad.Reader

9import Data.Aeson

10import Data.Aeson

10−import qualified Data.HashMap.Strict as HM

11+import qualified Data.HashMap.Strict as HM

11import Data.List (nub)

12import Data.List (nub)

12import Data.List.NonEmpty (NonEmpty (..))

13import Data.List.NonEmpty (NonEmpty (..))

13import qualified Data.List.NonEmpty as NE

14import qualified Data.List.NonEmpty as NE

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

34testMapping :: MappingName

35testMapping :: MappingName

35testMapping = MappingName "tweet"

36testMapping = MappingName "tweet"

38+withTestEnv :: BH IO a -> IO a

39+withTestEnv = withBH defaultManagerSettings testServer

40+

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

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

38validateStatus resp expected =

42validateStatus resp expected =

39 (NHTS.statusCode $ responseStatus resp)

43 (NHTS.statusCode $ responseStatus resp)

40 `shouldBe` (expected :: Int)

44 `shouldBe` (expected :: Int)

42−createExampleIndex :: IO Reply

46+createExampleIndex :: BH IO Reply

43−createExampleIndex = createIndex testServer defaultIndexSettings testIndex

47+createExampleIndex = createIndex defaultIndexSettings testIndex

44−deleteExampleIndex :: IO Reply

48+deleteExampleIndex :: BH IO Reply

45−deleteExampleIndex = deleteIndex testServer testIndex

49+deleteExampleIndex = deleteIndex testIndex

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

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

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

70 Just (ServerVersion majorVer minorVer patchVer)

74 Just (ServerVersion majorVer minorVer patchVer)

71mkServerVersion _ = Nothing

75mkServerVersion _ = Nothing

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

77+getServerVersion :: IO (Maybe ServerVersion)

74−getServerVersion s = liftM extractVersion (getStatus s)

78+getServerVersion = liftM extractVersion (withTestEnv getStatus)

75 where

79 where

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

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

77 toInt = read . T.unpack

81 toInt = read . T.unpack

78 parseVersion v = map toInt (version' v)

82 parseVersion v = map toInt (version' v)

79 extractVersion = join . liftM (mkServerVersion . parseVersion)

83 extractVersion = join . liftM (mkServerVersion . parseVersion)

81−

82−

83testServerBranch :: IO (Maybe ServerVersion)

85testServerBranch :: IO (Maybe ServerVersion)

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

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

86atleast :: ServerVersion -> IO Bool

88atleast :: ServerVersion -> IO Bool

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

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

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

136 , age = 1000

138 , age = 1000

137 , location = Location 40.12 (-71.34) }

139 , location = Location 40.12 (-71.34) }

138

140

139−insertData :: IO ()

141+insertData :: BH IO ()

140insertData = do

142insertData = do

141 _ <- deleteExampleIndex

143 _ <- deleteExampleIndex

142 _ <- createExampleIndex

144 _ <- createExampleIndex

143− _ <- putMapping testServer testIndex testMapping TweetMapping

145+ _ <- putMapping testIndex testMapping TweetMapping

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

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

145− _ <- refreshIndex testServer testIndex

147+ _ <- refreshIndex testIndex

146 return ()

148 return ()

147

149

148−insertOther :: IO ()

150+insertOther :: BH IO ()

149insertOther = do

151insertOther = do

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

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

151− _ <- refreshIndex testServer testIndex

153+ _ <- refreshIndex testIndex

152 return ()

154 return ()

153

155

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

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

155searchTweet search = do

157searchTweet search = do

156− reply <- searchByIndex testServer testIndex search

158+ reply <- searchByIndex testIndex search

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

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

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

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

159 return myTweet

161 return myTweet

160

162

161−searchExpectNoResults :: Search -> IO ()

163+searchExpectNoResults :: Search -> BH IO ()

162searchExpectNoResults search = do

164searchExpectNoResults search = do

163− reply <- searchByIndex testServer testIndex search

165+ reply <- searchByIndex testIndex search

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

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

165 let emptyHits = fmap (hits . searchHits) result

167 let emptyHits = fmap (hits . searchHits) result

168+ liftIO $

166− emptyHits `shouldBe` Right []

169+ emptyHits `shouldBe` Right []

167

170

168−searchExpectAggs :: Search -> IO ()

171+searchExpectAggs :: Search -> BH IO ()

169searchExpectAggs search = do

172searchExpectAggs search = do

170− reply <- searchAll testServer search

173+ reply <- searchAll search

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

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

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

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

176+ liftIO $

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

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

174

178

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

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

176searchValidBucketAgg search aggKey extractor = do

180searchValidBucketAgg search aggKey extractor = do

177− reply <- searchAll testServer search

181+ reply <- searchAll search

178 let bucketDocs = docCount . head . buckets

182 let bucketDocs = docCount . head . buckets

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

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

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

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

185+ liftIO $

181− count `shouldBe` Just 1

186+ count `shouldBe` Just 1

182

187

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

188+searchTermsAggHint :: [ExecutionHint] -> BH IO ()

184searchTermsAggHint hints = do

189searchTermsAggHint hints = do

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

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

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

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

187 forM_ hints $ searchExpectAggs . search

192 forM_ hints $ searchExpectAggs . search

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

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

189

194

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

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

191searchTweetHighlight search = do

196searchTweetHighlight search = do

192− reply <- searchByIndex testServer testIndex search

197+ reply <- searchByIndex testIndex search

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

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

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

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

195 return myHighlight

200 return myHighlight

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

223main = hspec $ do

228main = hspec $ do

224

229

225 describe "index create/delete API" $ do

230 describe "index create/delete API" $ do

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

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

227 -- priming state.

232 -- priming state.

228 _ <- deleteExampleIndex

233 _ <- deleteExampleIndex

229 resp <- createExampleIndex

234 resp <- createExampleIndex

230 deleteResp <- deleteExampleIndex

235 deleteResp <- deleteExampleIndex

236+ liftIO $ do

231− validateStatus resp 200

237+ validateStatus resp 200

232− validateStatus deleteResp 200

238+ validateStatus deleteResp 200

233

239

234

240

235 describe "document API" $ do

241 describe "document API" $ do

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

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

237 _ <- insertData

243 _ <- insertData

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

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

239 let newTweet = eitherDecode

245 let newTweet = eitherDecode

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

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

241− fmap _source newTweet `shouldBe` Right exampleTweet

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

242

248

243

249

244 describe "bulk API" $ do

250 describe "bulk API" $ do

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

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

246 _ <- insertData

252 _ <- insertData

247 let firstTest = BulkTest "blah"

253 let firstTest = BulkTest "blah"

248 let secondTest = BulkTest "bloo"

254 let secondTest = BulkTest "bloo"

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

251 let secondDoc = BulkCreate testIndex

257 let secondDoc = BulkCreate testIndex

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

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

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

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

254− _ <- bulk testServer stream

260+ _ <- bulk stream

255− _ <- refreshIndex testServer testIndex

261+ _ <- refreshIndex testIndex

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

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

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

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

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

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

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

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

266+ liftIO $ do

260− fmap _source maybeFirst `shouldBe` Right firstTest

267+ fmap _source maybeFirst `shouldBe` Right firstTest

261− fmap _source maybeSecond `shouldBe` Right secondTest

268+ fmap _source maybeSecond `shouldBe` Right secondTest

262

269

263

270

264 describe "query API" $ do

271 describe "query API" $ do

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

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

266 _ <- insertData

273 _ <- insertData

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

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

268 let filter = IdentityFilter <&&> IdentityFilter

275 let filter = IdentityFilter <&&> IdentityFilter

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

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

270 myTweet <- searchTweet search

277 myTweet <- searchTweet search

278+ liftIO $

271− myTweet `shouldBe` Right exampleTweet

279+ myTweet `shouldBe` Right exampleTweet

272

280

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

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

274 _ <- insertData

282 _ <- insertData

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

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

276 let filter = IdentityFilter <&&> IdentityFilter

284 let filter = IdentityFilter <&&> IdentityFilter

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

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

278 myTweet <- searchTweet search

286 myTweet <- searchTweet search

287+ liftIO $

279− myTweet `shouldBe` Right exampleTweet

288+ myTweet `shouldBe` Right exampleTweet

280

289

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

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

282 _ <- insertData

291 _ <- insertData

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

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

284 let search = mkSearch (Just query) Nothing

293 let search = mkSearch (Just query) Nothing

285 myTweet <- searchTweet search

294 myTweet <- searchTweet search

295+ liftIO $

286− myTweet `shouldBe` Right exampleTweet

296+ myTweet `shouldBe` Right exampleTweet

287

297

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

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

289 _ <- insertData

299 _ <- insertData

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

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

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

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

292 let search = mkSearch (Just query) Nothing

302 let search = mkSearch (Just query) Nothing

293 myTweet <- searchTweet search

303 myTweet <- searchTweet search

304+ liftIO $

294− myTweet `shouldBe` Right exampleTweet

305+ myTweet `shouldBe` Right exampleTweet

295

306

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

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

297 _ <- insertData

308 _ <- insertData

298 let innerQuery = QueryMatchQuery $

309 let innerQuery = QueryMatchQuery $

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

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

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

301 mkBoolQuery [innerQuery] [] []

312 mkBoolQuery [innerQuery] [] []

302 let search = mkSearch (Just query) Nothing

313 let search = mkSearch (Just query) Nothing

303 myTweet <- searchTweet search

314 myTweet <- searchTweet search

315+ liftIO $

304− myTweet `shouldBe` Right exampleTweet

316+ myTweet `shouldBe` Right exampleTweet

305

317

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

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

307 _ <- insertData

319 _ <- insertData

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

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

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

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

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

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

311 let search = mkSearch (Just query) Nothing

323 let search = mkSearch (Just query) Nothing

312 myTweet <- searchTweet search

324 myTweet <- searchTweet search

325+ liftIO $

313− myTweet `shouldBe` Right exampleTweet

326+ myTweet `shouldBe` Right exampleTweet

314

327

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

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

316 _ <- insertData

329 _ <- insertData

317 let query = QueryCommonTermsQuery $

330 let query = QueryCommonTermsQuery $

318 CommonTermsQuery (FieldName "user")

331 CommonTermsQuery (FieldName "user")

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

321 Or Or Nothing Nothing Nothing Nothing

334 Or Or Nothing Nothing Nothing Nothing

322 let search = mkSearch (Just query) Nothing

335 let search = mkSearch (Just query) Nothing

323 myTweet <- searchTweet search

336 myTweet <- searchTweet search

337+ liftIO $

324− myTweet `shouldBe` Right exampleTweet

338+ myTweet `shouldBe` Right exampleTweet

325

339

326

340

327 describe "sorting" $ do

341 describe "sorting" $ do

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

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

329 _ <- insertData

343 _ <- insertData

330 _ <- insertOther

344 _ <- insertOther

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

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

332 let search = Search Nothing

346 let search = Search Nothing

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

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

334− False 0 10

348+ False (From 0) (Size 10)

335− reply <- searchByIndex testServer testIndex search

349+ reply <- searchByIndex testIndex search

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

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

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

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

352+ liftIO $

338− myTweet `shouldBe` Right otherTweet

353+ myTweet `shouldBe` Right otherTweet

339

354

340

355

341 describe "filtering API" $ do

356 describe "filtering API" $ do

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

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

343 _ <- insertData

358 _ <- insertData

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

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

345 <&&> IdentityFilter

360 <&&> IdentityFilter

346 let search = mkSearch Nothing (Just queryFilter)

361 let search = mkSearch Nothing (Just queryFilter)

347 myTweet <- searchTweet search

362 myTweet <- searchTweet search

363+ liftIO $

348− myTweet `shouldBe` Right exampleTweet

364+ myTweet `shouldBe` Right exampleTweet

349

365

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

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

351 _ <- insertData

367 _ <- insertData

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

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

353 let search = mkSearch Nothing (Just termFilter)

369 let search = mkSearch Nothing (Just termFilter)

354 myTweet <- searchTweet search

370 myTweet <- searchTweet search

371+ liftIO $

355− myTweet `shouldBe` Right exampleTweet

372+ myTweet `shouldBe` Right exampleTweet

356

373

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

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

358 _ <- insertData

375 _ <- insertData

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

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

360 myTweet <- searchTweet search

377 myTweet <- searchTweet search

378+ liftIO $

361− myTweet `shouldBe` Right exampleTweet

379+ myTweet `shouldBe` Right exampleTweet

362

380

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

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

364 _ <- insertData

382 _ <- insertData

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

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

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

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

367 let geoFilter = GeoBoundingBoxFilter bbConstraint

385 let geoFilter = GeoBoundingBoxFilter bbConstraint

368 let search = mkSearch Nothing (Just geoFilter)

386 let search = mkSearch Nothing (Just geoFilter)

369 myTweet <- searchTweet search

387 myTweet <- searchTweet search

388+ liftIO $

370− myTweet `shouldBe` Right exampleTweet

389+ myTweet `shouldBe` Right exampleTweet

371

390

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

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

373 _ <- insertData

392 _ <- insertData

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

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

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

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

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

377 let search = mkSearch Nothing (Just geoFilter)

396 let search = mkSearch Nothing (Just geoFilter)

378 searchExpectNoResults search

397 searchExpectNoResults search

379

398

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

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

381 _ <- insertData

400 _ <- insertData

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

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

383 let distance = Distance 10.0 Miles

402 let distance = Distance 10.0 Miles

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

385 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False

404 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False

386 let search = mkSearch Nothing (Just geoFilter)

405 let search = mkSearch Nothing (Just geoFilter)

387 myTweet <- searchTweet search

406 myTweet <- searchTweet search

407+ liftIO $

388− myTweet `shouldBe` Right exampleTweet

408+ myTweet `shouldBe` Right exampleTweet

389

409

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

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

391 _ <- insertData

411 _ <- insertData

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

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

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

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

394 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange

414 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange

395 let search = mkSearch Nothing (Just geoFilter)

415 let search = mkSearch Nothing (Just geoFilter)

396 myTweet <- searchTweet search

416 myTweet <- searchTweet search

417+ liftIO $

397− myTweet `shouldBe` Right exampleTweet

418+ myTweet `shouldBe` Right exampleTweet

398

419

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

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

400 _ <- insertData

421 _ <- insertData

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

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

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

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

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

404 let search = mkSearch Nothing (Just geoFilter)

425 let search = mkSearch Nothing (Just geoFilter)

405 searchExpectNoResults search

426 searchExpectNoResults search

406

427

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

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

408 _ <- insertData

429 _ <- insertData

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

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

410 LatLon 40.0 (-72.00),

431 LatLon 40.0 (-72.00),

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

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

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

414 let search = mkSearch Nothing (Just geoFilter)

435 let search = mkSearch Nothing (Just geoFilter)

415 myTweet <- searchTweet search

436 myTweet <- searchTweet search

437+ liftIO $

416− myTweet `shouldBe` Right exampleTweet

438+ myTweet `shouldBe` Right exampleTweet

417

439

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

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

419 _ <- insertData

441 _ <- insertData

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

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

421 LatLon 40.0 (-71.00),

443 LatLon 40.0 (-71.00),

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

425 let search = mkSearch Nothing (Just geoFilter)

447 let search = mkSearch Nothing (Just geoFilter)

426 searchExpectNoResults search

448 searchExpectNoResults search

427

449

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

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

429 _ <- insertData

451 _ <- insertData

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

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

431 let search = mkSearch Nothing (Just filter)

453 let search = mkSearch Nothing (Just filter)

432 myTweet <- searchTweet search

454 myTweet <- searchTweet search

455+ liftIO $

433− myTweet `shouldBe` Right exampleTweet

456+ myTweet `shouldBe` Right exampleTweet

434

457

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

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

436 _ <- insertData

459 _ <- insertData

437 let filter = RangeFilter (FieldName "age")

460 let filter = RangeFilter (FieldName "age")

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

461 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))

439 RangeExecutionIndex False

462 RangeExecutionIndex False

440 let search = mkSearch Nothing (Just filter)

463 let search = mkSearch Nothing (Just filter)

441 myTweet <- searchTweet search

464 myTweet <- searchTweet search

465+ liftIO $

442− myTweet `shouldBe` Right exampleTweet

466+ myTweet `shouldBe` Right exampleTweet

443

467

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

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

445 _ <- insertData

469 _ <- insertData

446 let filter = RangeFilter (FieldName "postDate")

470 let filter = RangeFilter (FieldName "postDate")

447 (RangeDateGtLt

471 (RangeDateGtLt

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

454 RangeExecutionIndex False

478 RangeExecutionIndex False

455 let search = mkSearch Nothing (Just filter)

479 let search = mkSearch Nothing (Just filter)

456 myTweet <- searchTweet search

480 myTweet <- searchTweet search

481+ liftIO $

457− myTweet `shouldBe` Right exampleTweet

482+ myTweet `shouldBe` Right exampleTweet

458

483

459

484

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

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

461 _ <- insertData

486 _ <- insertData

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

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

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

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

464 let search = mkSearch Nothing (Just filter)

489 let search = mkSearch Nothing (Just filter)

465 myTweet <- searchTweet search

490 myTweet <- searchTweet search

491+ liftIO $

466− myTweet `shouldBe` Right exampleTweet

492+ myTweet `shouldBe` Right exampleTweet

467

493

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

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

469 _ <- insertData

495 _ <- insertData

470 let filter = RegexpFilter (FieldName "user")

496 let filter = RegexpFilter (FieldName "user")

471 (Regexp "boy") AllRegexpFlags

497 (Regexp "boy") AllRegexpFlags

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

474 searchExpectNoResults search

500 searchExpectNoResults search

475

501

476 describe "Aggregation API" $ do

502 describe "Aggregation API" $ do

477− it "returns term aggregation results" $ do

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

478 _ <- insertData

504 _ <- insertData

479 let terms = TermsAgg $ mkTermsAggregation "user"

505 let terms = TermsAgg $ mkTermsAggregation "user"

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

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

481 searchExpectAggs search

507 searchExpectAggs search

482 searchValidBucketAgg search "users" toTerms

508 searchValidBucketAgg search "users" toTerms

483

509

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

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

485 _ <- insertData

511 _ <- insertData

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

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

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

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

488 searchExpectAggs search

514 searchExpectAggs search

489 searchValidBucketAgg search "users" toTerms

515 searchValidBucketAgg search "users" toTerms

490

516

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

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

492 _ <- insertData

518 _ <- insertData

493 searchTermsAggHint [Map, Ordinals]

519 searchTermsAggHint [Map, Ordinals]

494

520

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

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

496 _ <- insertData

522 _ <- insertData

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

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

498

524

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

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

500 _ <- insertData

526 _ <- insertData

501 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

527 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

502

528

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

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

504 _ <- insertData

530 _ <- insertData

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

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

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

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

507 searchExpectAggs search

533 searchExpectAggs search

508 searchValidBucketAgg search "byDate" toDateHistogram

534 searchValidBucketAgg search "byDate" toDateHistogram

509

535

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

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

511 _ <- insertData

537 _ <- insertData

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

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

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

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

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

521

547

522 describe "Highlights API" $ do

548 describe "Highlights API" $ do

523

549

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

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

525 _ <- insertData

551 _ <- insertData

526 _ <- insertOther

552 _ <- insertOther

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

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

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

529

555

530 let search = mkHighlightSearch (Just query) testHighlight

556 let search = mkHighlightSearch (Just query) testHighlight

531 myHighlight <- searchTweetHighlight search

557 myHighlight <- searchTweetHighlight search

558+ liftIO $

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

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

533

560

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

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

535 _ <- insertData

562 _ <- insertData

536 _ <- insertOther

563 _ <- insertOther

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

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

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

539

566

540 let search = mkHighlightSearch (Just query) testHighlight

567 let search = mkHighlightSearch (Just query) testHighlight

541 myHighlight <- searchTweetHighlight search

568 myHighlight <- searchTweetHighlight search

569+ liftIO $

542− myHighlight `shouldBe` Right Nothing

570+ myHighlight `shouldBe` Right Nothing

543

571

544

572

545

573