e447be9 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Merge remote-tracking branch 'origin/next-gen'

e447be9Chris 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+17−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,9 @@ 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,

66+ quickcheck-properties

60 default-language: Haskell2010

67 default-language: Haskell2010

62test-suite doctests

69test-suite doctests

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

64 type: exitcode-stdio-1.0

71 type: exitcode-stdio-1.0

65 main-is: doctests.hs

72 main-is: doctests.hs

66 hs-source-dirs: tests

73 hs-source-dirs: tests

74+ if impl(ghc >= 7.8)

67− build-depends: base,

75+ build-depends: base,

68− directory,

76+ directory,

69− doctest,

77+ doctest,

70− doctest-prop,

78+ doctest-prop,

71− filepath

79+ filepath

80+ else

81+ 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+227−157

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

@@ -1055,13 +1118,20 @@ data SearchResult a =

1055 , searchHits :: SearchHits a

1118 , searchHits :: SearchHits a

1056 , aggregations :: Maybe AggregationResults } deriving (Eq, Show)

1119 , aggregations :: Maybe AggregationResults } deriving (Eq, Show)

1057

1120

1058−type Score = Double

1121+type Score = Maybe Double

1059

1122

1060data SearchHits a =

1123data SearchHits a =

1061 SearchHits { hitsTotal :: Int

1124 SearchHits { hitsTotal :: Int

1062 , maxScore :: Score

1125 , maxScore :: Score

1063 , hits :: [Hit a] } deriving (Eq, Show)

1126 , hits :: [Hit a] } deriving (Eq, Show)

1064

1127

1128+

1129+instance Monoid (SearchHits a) where

1130+ mempty = SearchHits 0 Nothing mempty

1131+ mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =

1132+ SearchHits (ta + tb) (max ma mb) (ha <> hb)

1133+

1134+

1065data Hit a =

1135data Hit a =

1066 Hit { hitIndex :: IndexName

1136 Hit { hitIndex :: IndexName

1067 , hitType :: MappingName

1137 , hitType :: MappingName

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

1195instance ToJSON Aggregation where

1265instance ToJSON Aggregation where

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

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

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

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

1198− "include" .= toJSON include,

1268+ "include" .= include,

1199− "exclude" .= toJSON exclude,

1269+ "exclude" .= exclude,

1200− "order" .= toJSON order,

1270+ "order" .= order,

1201− "min_doc_count" .= toJSON minDocCount,

1271+ "min_doc_count" .= minDocCount,

1202− "size" .= toJSON size,

1272+ "size" .= size,

1203− "shard_size" .= toJSON shardSize,

1273+ "shard_size" .= shardSize,

1204− "collect_mode" .= toJSON collectMode,

1274+ "collect_mode" .= collectMode,

1205− "execution_hint" .= toJSON executionHint

1275+ "execution_hint" .= executionHint

1206 ],

1276 ],

1207− "aggs" .= toJSON termAggs ]

1277+ "aggs" .= termAggs ]

1208 where

1278 where

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

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

1210

1280

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

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

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

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

1213− "interval" .= toJSON interval,

1283+ "interval" .= interval,

1214− "format" .= toJSON format,

1284+ "format" .= format,

1215− "pre_zone" .= toJSON preZone,

1285+ "pre_zone" .= preZone,

1216− "post_zone" .= toJSON postZone,

1286+ "post_zone" .= postZone,

1217− "pre_offset" .= toJSON preOffset,

1287+ "pre_offset" .= preOffset,

1218− "post_offset" .= toJSON postOffset

1288+ "post_offset" .= postOffset

1219 ],

1289 ],

1220− "aggs" .= toJSON dateHistoAggs ]

1290+ "aggs" .= dateHistoAggs ]

1221

1291

1222type AggregationResults = M.Map Text Value

1292type AggregationResults = M.Map Text Value

1223

1293

@@ -1296,7 +1366,7 @@ instance ToJSON Filter where

1296

1366

1297 toJSON (NotFilter notFilter cache) =

1367 toJSON (NotFilter notFilter cache) =

1298 object ["not" .=

1368 object ["not" .=

1299− object ["filter" .= toJSON notFilter

1369+ object ["filter" .= notFilter

1300 , "_cache" .= cache]]

1370 , "_cache" .= cache]]

1301

1371

1302 toJSON (IdentityFilter) =

1372 toJSON (IdentityFilter) =

@@ -1312,26 +1382,26 @@ instance ToJSON Filter where

1312 ["field" .= fieldName]]

1382 ["field" .= fieldName]]

1313

1383

1314 toJSON (BoolFilter boolMatch) =

1384 toJSON (BoolFilter boolMatch) =

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

1385+ object ["bool" .= boolMatch]

1316

1386

1317 toJSON (GeoBoundingBoxFilter bbConstraint) =

1387 toJSON (GeoBoundingBoxFilter bbConstraint) =

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

1388+ object ["geo_bounding_box" .= bbConstraint]

1319

1389

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

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

1321 distance distanceType optimizeBbox cache) =

1391 distance distanceType optimizeBbox cache) =

1322 object ["geo_distance" .=

1392 object ["geo_distance" .=

1323− object ["distance" .= toJSON distance

1393+ object ["distance" .= distance

1324− , "distance_type" .= toJSON distanceType

1394+ , "distance_type" .= distanceType

1325 , "optimize_bbox" .= optimizeBbox

1395 , "optimize_bbox" .= optimizeBbox

1326− , distanceGeoField .= toJSON geoDistLatLon

1396+ , distanceGeoField .= geoDistLatLon

1327 , "_cache" .= cache]]

1397 , "_cache" .= cache]]

1328

1398

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

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

1330 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =

1400 (DistanceRange geoDistRangeDistFrom drDistanceTo)) =

1331 object ["geo_distance_range" .=

1401 object ["geo_distance_range" .=

1332− object ["from" .= toJSON geoDistRangeDistFrom

1402+ object ["from" .= geoDistRangeDistFrom

1333− , "to" .= toJSON drDistanceTo

1403+ , "to" .= drDistanceTo

1334− , gddrField .= toJSON drLatLon]]

1404+ , gddrField .= drLatLon]]

1335

1405

1336 toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =

1406 toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =

1337 object ["geo_polygon" .=

1407 object ["geo_polygon" .=

@@ -1341,7 +1411,7 @@ instance ToJSON Filter where

1341 toJSON (IdsFilter (MappingName mappingName) values) =

1411 toJSON (IdsFilter (MappingName mappingName) values) =

1342 object ["ids" .=

1412 object ["ids" .=

1343 object ["type" .= mappingName

1413 object ["type" .= mappingName

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

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

1345

1415

1346 toJSON (LimitFilter limit) =

1416 toJSON (LimitFilter limit) =

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

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

@@ -1360,7 +1430,7 @@ instance ToJSON Filter where

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

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

1361 object ["range" .=

1431 object ["range" .=

1362 object [ fieldName .= object (rangeValueToPair rangeValue)

1432 object [ fieldName .= object (rangeValueToPair rangeValue)

1363− , "execution" .= toJSON rangeExecution

1433+ , "execution" .= rangeExecution

1364 , "_cache" .= cache]]

1434 , "_cache" .= cache]]

1365

1435

1366 toJSON (RegexpFilter (FieldName fieldName)

1436 toJSON (RegexpFilter (FieldName fieldName)

@@ -1368,14 +1438,14 @@ instance ToJSON Filter where

1368 object ["regexp" .=

1438 object ["regexp" .=

1369 object [fieldName .=

1439 object [fieldName .=

1370 object ["value" .= regexText

1440 object ["value" .= regexText

1371− , "flags" .= toJSON flags]

1441+ , "flags" .= flags]

1372 , "_name" .= cacheName

1442 , "_name" .= cacheName

1373 , "_cache" .= cache

1443 , "_cache" .= cache

1374 , "_cache_key" .= cacheKey]]

1444 , "_cache_key" .= cacheKey]]

1375

1445

1376instance ToJSON GeoPoint where

1446instance ToJSON GeoPoint where

1377 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

1447 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =

1378− object [ geoPointField .= toJSON geoPointLatLon ]

1448+ object [ geoPointField .= geoPointLatLon ]

1379

1449

1380

1450

1381instance ToJSON Query where

1451instance ToJSON Query where

@@ -1395,82 +1465,82 @@ instance ToJSON Query where

1395 getTermValue (Term _ v) = v

1465 getTermValue (Term _ v) = v

1396 toJSON (IdsQuery idsQueryMappingName docIds) =

1466 toJSON (IdsQuery idsQueryMappingName docIds) =

1397 object [ "ids" .= object conjoined ]

1467 object [ "ids" .= object conjoined ]

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

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

1399 , "values" .= fmap toJSON docIds ]

1469 , "values" .= fmap toJSON docIds ]

1400

1470

1401 toJSON (QueryQueryStringQuery qQueryStringQuery) =

1471 toJSON (QueryQueryStringQuery qQueryStringQuery) =

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

1472+ object [ "query_string" .= qQueryStringQuery ]

1403

1473

1404 toJSON (QueryMatchQuery matchQuery) =

1474 toJSON (QueryMatchQuery matchQuery) =

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

1475+ object [ "match" .= matchQuery ]

1406

1476

1407 toJSON (QueryMultiMatchQuery multiMatchQuery) =

1477 toJSON (QueryMultiMatchQuery multiMatchQuery) =

1408 toJSON multiMatchQuery

1478 toJSON multiMatchQuery

1409

1479

1410 toJSON (QueryBoolQuery boolQuery) =

1480 toJSON (QueryBoolQuery boolQuery) =

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

1481+ object [ "bool" .= boolQuery ]

1412

1482

1413 toJSON (QueryBoostingQuery boostingQuery) =

1483 toJSON (QueryBoostingQuery boostingQuery) =

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

1484+ object [ "boosting" .= boostingQuery ]

1415

1485

1416 toJSON (QueryCommonTermsQuery commonTermsQuery) =

1486 toJSON (QueryCommonTermsQuery commonTermsQuery) =

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

1487+ object [ "common" .= commonTermsQuery ]

1418

1488

1419 toJSON (ConstantScoreFilter csFilter boost) =

1489 toJSON (ConstantScoreFilter csFilter boost) =

1420− object [ "constant_score" .= toJSON csFilter

1490+ object [ "constant_score" .= csFilter

1421− , "boost" .= toJSON boost]

1491+ , "boost" .= boost]

1422

1492

1423 toJSON (ConstantScoreQuery query boost) =

1493 toJSON (ConstantScoreQuery query boost) =

1424− object [ "constant_score" .= toJSON query

1494+ object [ "constant_score" .= query

1425− , "boost" .= toJSON boost]

1495+ , "boost" .= boost]

1426

1496

1427 toJSON (QueryDisMaxQuery disMaxQuery) =

1497 toJSON (QueryDisMaxQuery disMaxQuery) =

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

1498+ object [ "dis_max" .= disMaxQuery ]

1429

1499

1430 toJSON (QueryFilteredQuery qFilteredQuery) =

1500 toJSON (QueryFilteredQuery qFilteredQuery) =

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

1501+ object [ "filtered" .= qFilteredQuery ]

1432

1502

1433 toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =

1503 toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =

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

1504+ object [ "fuzzy_like_this" .= fuzzyQuery ]

1435

1505

1436 toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =

1506 toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =

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

1507+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]

1438

1508

1439 toJSON (QueryFuzzyQuery fuzzyQuery) =

1509 toJSON (QueryFuzzyQuery fuzzyQuery) =

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

1510+ object [ "fuzzy" .= fuzzyQuery ]

1441

1511

1442 toJSON (QueryHasChildQuery childQuery) =

1512 toJSON (QueryHasChildQuery childQuery) =

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

1513+ object [ "has_child" .= childQuery ]

1444

1514

1445 toJSON (QueryHasParentQuery parentQuery) =

1515 toJSON (QueryHasParentQuery parentQuery) =

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

1516+ object [ "has_parent" .= parentQuery ]

1447

1517

1448 toJSON (QueryIndicesQuery qIndicesQuery) =

1518 toJSON (QueryIndicesQuery qIndicesQuery) =

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

1519+ object [ "indices" .= qIndicesQuery ]

1450

1520

1451 toJSON (MatchAllQuery boost) =

1521 toJSON (MatchAllQuery boost) =

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

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

1453

1523

1454 toJSON (QueryMoreLikeThisQuery query) =

1524 toJSON (QueryMoreLikeThisQuery query) =

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

1525+ object [ "more_like_this" .= query ]

1456

1526

1457 toJSON (QueryMoreLikeThisFieldQuery query) =

1527 toJSON (QueryMoreLikeThisFieldQuery query) =

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

1528+ object [ "more_like_this_field" .= query ]

1459

1529

1460 toJSON (QueryNestedQuery query) =

1530 toJSON (QueryNestedQuery query) =

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

1531+ object [ "nested" .= query ]

1462

1532

1463 toJSON (QueryPrefixQuery query) =

1533 toJSON (QueryPrefixQuery query) =

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

1534+ object [ "prefix" .= query ]

1465

1535

1466 toJSON (QueryRangeQuery query) =

1536 toJSON (QueryRangeQuery query) =

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

1537+ object [ "range" .= query ]

1468

1538

1469 toJSON (QueryRegexpQuery query) =

1539 toJSON (QueryRegexpQuery query) =

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

1540+ object [ "regexp" .= query ]

1471

1541

1472 toJSON (QuerySimpleQueryStringQuery query) =

1542 toJSON (QuerySimpleQueryStringQuery query) =

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

1543+ object [ "simple_query_string" .= query ]

1474

1544

1475

1545

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

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

@@ -1483,7 +1553,7 @@ omitNulls = object . filter notNull where

1483instance ToJSON SimpleQueryStringQuery where

1553instance ToJSON SimpleQueryStringQuery where

1484 toJSON SimpleQueryStringQuery {..} =

1554 toJSON SimpleQueryStringQuery {..} =

1485 omitNulls (base ++ maybeAdd)

1555 omitNulls (base ++ maybeAdd)

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

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

1487 maybeAdd = [ "fields" .= simpleQueryStringField

1557 maybeAdd = [ "fields" .= simpleQueryStringField

1488 , "default_operator" .= simpleQueryStringOperator

1558 , "default_operator" .= simpleQueryStringOperator

1489 , "analyzer" .= simpleQueryStringAnalyzer

1559 , "analyzer" .= simpleQueryStringAnalyzer

@@ -1519,7 +1589,7 @@ instance ToJSON RegexpQuery where

1519 rqQueryBoost) =

1589 rqQueryBoost) =

1520 object [ rqQueryField .= omitNulls base ]

1590 object [ rqQueryField .= omitNulls base ]

1521 where base = [ "value" .= regexpQueryQuery

1591 where base = [ "value" .= regexpQueryQuery

1522− , "flags" .= toJSON rqQueryFlags

1592+ , "flags" .= rqQueryFlags

1523 , "boost" .= rqQueryBoost ]

1593 , "boost" .= rqQueryBoost ]

1524

1594

1525

1595

@@ -1535,7 +1605,7 @@ instance ToJSON QueryStringQuery where

1535 qsLenient qsLocale) =

1605 qsLenient qsLocale) =

1536 omitNulls base

1606 omitNulls base

1537 where

1607 where

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

1608+ base = [ "query" .= qsQueryString

1539 , "default_field" .= qsDefaultField

1609 , "default_field" .= qsDefaultField

1540 , "default_operator" .= qsOperator

1610 , "default_operator" .= qsOperator

1541 , "analyzer" .= qsAnalyzer

1611 , "analyzer" .= qsAnalyzer

@@ -1557,21 +1627,21 @@ instance ToJSON QueryStringQuery where

1557instance ToJSON RangeQuery where

1627instance ToJSON RangeQuery where

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

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

1559 object [ fieldName .= conjoined ]

1629 object [ fieldName .= conjoined ]

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

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

1561

1631

1562

1632

1563instance ToJSON PrefixQuery where

1633instance ToJSON PrefixQuery where

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

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

1565 object [ fieldName .= omitNulls base ]

1635 object [ fieldName .= omitNulls base ]

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

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

1567 , "boost" .= boost ]

1637 , "boost" .= boost ]

1568

1638

1569

1639

1570instance ToJSON NestedQuery where

1640instance ToJSON NestedQuery where

1571 toJSON (NestedQuery nqPath nqScoreType nqQuery) =

1641 toJSON (NestedQuery nqPath nqScoreType nqQuery) =

1572− object [ "path" .= toJSON nqPath

1642+ object [ "path" .= nqPath

1573− , "score_mode" .= toJSON nqScoreType

1643+ , "score_mode" .= nqScoreType

1574− , "query" .= toJSON nqQuery ]

1644+ , "query" .= nqQuery ]

1575

1645

1576

1646

1577instance ToJSON MoreLikeThisFieldQuery where

1647instance ToJSON MoreLikeThisFieldQuery where

@@ -1579,7 +1649,7 @@ instance ToJSON MoreLikeThisFieldQuery where

1579 percent mtf mqt stopwords mindf maxdf

1649 percent mtf mqt stopwords mindf maxdf

1580 minwl maxwl boostTerms boost analyzer) =

1650 minwl maxwl boostTerms boost analyzer) =

1581 object [ fieldName .= omitNulls base ]

1651 object [ fieldName .= omitNulls base ]

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

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

1583 , "percent_terms_to_match" .= percent

1653 , "percent_terms_to_match" .= percent

1584 , "min_term_freq" .= mtf

1654 , "min_term_freq" .= mtf

1585 , "max_query_terms" .= mqt

1655 , "max_query_terms" .= mqt

@@ -1598,7 +1668,7 @@ instance ToJSON MoreLikeThisQuery where

1598 mtf mqt stopwords mindf maxdf

1668 mtf mqt stopwords mindf maxdf

1599 minwl maxwl boostTerms boost analyzer) =

1669 minwl maxwl boostTerms boost analyzer) =

1600 omitNulls base

1670 omitNulls base

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

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

1602 , "fields" .= fields

1672 , "fields" .= fields

1603 , "percent_terms_to_match" .= percent

1673 , "percent_terms_to_match" .= percent

1604 , "min_term_freq" .= mtf

1674 , "min_term_freq" .= mtf

@@ -1615,34 +1685,34 @@ instance ToJSON MoreLikeThisQuery where

1615

1685

1616instance ToJSON IndicesQuery where

1686instance ToJSON IndicesQuery where

1617 toJSON (IndicesQuery indices query noMatch) =

1687 toJSON (IndicesQuery indices query noMatch) =

1618− omitNulls [ "indices" .= toJSON indices

1688+ omitNulls [ "indices" .= indices

1619− , "no_match_query" .= toJSON noMatch

1689+ , "no_match_query" .= noMatch

1620− , "query" .= toJSON query ]

1690+ , "query" .= query ]

1621

1691

1622

1692

1623instance ToJSON HasParentQuery where

1693instance ToJSON HasParentQuery where

1624 toJSON (HasParentQuery queryType query scoreType) =

1694 toJSON (HasParentQuery queryType query scoreType) =

1625− omitNulls [ "parent_type" .= toJSON queryType

1695+ omitNulls [ "parent_type" .= queryType

1626− , "score_type" .= toJSON scoreType

1696+ , "score_type" .= scoreType

1627− , "query" .= toJSON query ]

1697+ , "query" .= query ]

1628

1698

1629

1699

1630instance ToJSON HasChildQuery where

1700instance ToJSON HasChildQuery where

1631 toJSON (HasChildQuery queryType query scoreType) =

1701 toJSON (HasChildQuery queryType query scoreType) =

1632− omitNulls [ "query" .= toJSON query

1702+ omitNulls [ "query" .= query

1633− , "score_type" .= toJSON scoreType

1703+ , "score_type" .= scoreType

1634− , "type" .= toJSON queryType ]

1704+ , "type" .= queryType ]

1635

1705

1636

1706

1637instance ToJSON FuzzyQuery where

1707instance ToJSON FuzzyQuery where

1638 toJSON (FuzzyQuery (FieldName fieldName) queryText

1708 toJSON (FuzzyQuery (FieldName fieldName) queryText

1639 prefixLength maxEx fuzziness boost) =

1709 prefixLength maxEx fuzziness boost) =

1640 object [ fieldName .= omitNulls base ]

1710 object [ fieldName .= omitNulls base ]

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

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

1642− , "fuzziness" .= toJSON fuzziness

1712+ , "fuzziness" .= fuzziness

1643− , "prefix_length" .= toJSON prefixLength

1713+ , "prefix_length" .= prefixLength

1644− , "boost" .= toJSON boost

1714+ , "boost" .= boost

1645− , "max_expansions" .= toJSON maxEx ]

1715+ , "max_expansions" .= maxEx ]

1646

1716

1647

1717

1648instance ToJSON FuzzyLikeFieldQuery where

1718instance ToJSON FuzzyLikeFieldQuery where

@@ -1650,41 +1720,41 @@ instance ToJSON FuzzyLikeFieldQuery where

1650 fieldText maxTerms ignoreFreq fuzziness prefixLength

1720 fieldText maxTerms ignoreFreq fuzziness prefixLength

1651 boost analyzer) =

1721 boost analyzer) =

1652 object [ fieldName .=

1722 object [ fieldName .=

1653− omitNulls [ "like_text" .= toJSON fieldText

1723+ omitNulls [ "like_text" .= fieldText

1654− , "max_query_terms" .= toJSON maxTerms

1724+ , "max_query_terms" .= maxTerms

1655− , "ignore_tf" .= toJSON ignoreFreq

1725+ , "ignore_tf" .= ignoreFreq

1656− , "fuzziness" .= toJSON fuzziness

1726+ , "fuzziness" .= fuzziness

1657− , "prefix_length" .= toJSON prefixLength

1727+ , "prefix_length" .= prefixLength

1658− , "analyzer" .= toJSON analyzer

1728+ , "analyzer" .= analyzer

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

1729+ , "boost" .= boost ]]

1660

1730

1661

1731

1662instance ToJSON FuzzyLikeThisQuery where

1732instance ToJSON FuzzyLikeThisQuery where

1663 toJSON (FuzzyLikeThisQuery fields text maxTerms

1733 toJSON (FuzzyLikeThisQuery fields text maxTerms

1664 ignoreFreq fuzziness prefixLength boost analyzer) =

1734 ignoreFreq fuzziness prefixLength boost analyzer) =

1665 omitNulls base

1735 omitNulls base

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

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

1667− , "like_text" .= toJSON text

1737+ , "like_text" .= text

1668− , "max_query_terms" .= toJSON maxTerms

1738+ , "max_query_terms" .= maxTerms

1669− , "ignore_tf" .= toJSON ignoreFreq

1739+ , "ignore_tf" .= ignoreFreq

1670− , "fuzziness" .= toJSON fuzziness

1740+ , "fuzziness" .= fuzziness

1671− , "prefix_length" .= toJSON prefixLength

1741+ , "prefix_length" .= prefixLength

1672− , "analyzer" .= toJSON analyzer

1742+ , "analyzer" .= analyzer

1673− , "boost" .= toJSON boost ]

1743+ , "boost" .= boost ]

1674

1744

1675

1745

1676instance ToJSON FilteredQuery where

1746instance ToJSON FilteredQuery where

1677 toJSON (FilteredQuery query fFilter) =

1747 toJSON (FilteredQuery query fFilter) =

1678− object [ "query" .= toJSON query

1748+ object [ "query" .= query

1679− , "filter" .= toJSON fFilter ]

1749+ , "filter" .= fFilter ]

1680

1750

1681

1751

1682instance ToJSON DisMaxQuery where

1752instance ToJSON DisMaxQuery where

1683 toJSON (DisMaxQuery queries tiebreaker boost) =

1753 toJSON (DisMaxQuery queries tiebreaker boost) =

1684 omitNulls base

1754 omitNulls base

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

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

1686− , "boost" .= toJSON boost

1756+ , "boost" .= boost

1687− , "tie_breaker" .= toJSON tiebreaker ]

1757+ , "tie_breaker" .= tiebreaker ]

1688

1758

1689

1759

1690instance ToJSON CommonTermsQuery where

1760instance ToJSON CommonTermsQuery where

@@ -1692,38 +1762,38 @@ instance ToJSON CommonTermsQuery where

1692 (QueryString query) cf lfo hfo msm

1762 (QueryString query) cf lfo hfo msm

1693 boost analyzer disableCoord) =

1763 boost analyzer disableCoord) =

1694 object [fieldName .= omitNulls base ]

1764 object [fieldName .= omitNulls base ]

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

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

1696− , "cutoff_frequency" .= toJSON cf

1766+ , "cutoff_frequency" .= cf

1697− , "low_freq_operator" .= toJSON lfo

1767+ , "low_freq_operator" .= lfo

1698− , "minimum_should_match" .= toJSON msm

1768+ , "minimum_should_match" .= msm

1699− , "boost" .= toJSON boost

1769+ , "boost" .= boost

1700− , "analyzer" .= toJSON analyzer

1770+ , "analyzer" .= analyzer

1701− , "disable_coord" .= toJSON disableCoord

1771+ , "disable_coord" .= disableCoord

1702− , "high_freq_operator" .= toJSON hfo ]

1772+ , "high_freq_operator" .= hfo ]

1703

1773

1704

1774

1705instance ToJSON CommonMinimumMatch where

1775instance ToJSON CommonMinimumMatch where

1706 toJSON (CommonMinimumMatch mm) = toJSON mm

1776 toJSON (CommonMinimumMatch mm) = toJSON mm

1707 toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =

1777 toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =

1708− object [ "low_freq" .= toJSON lowF

1778+ object [ "low_freq" .= lowF

1709− , "high_freq" .= toJSON highF ]

1779+ , "high_freq" .= highF ]

1710

1780

1711instance ToJSON BoostingQuery where

1781instance ToJSON BoostingQuery where

1712 toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =

1782 toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =

1713− object [ "positive" .= toJSON bqPositiveQuery

1783+ object [ "positive" .= bqPositiveQuery

1714− , "negative" .= toJSON bqNegativeQuery

1784+ , "negative" .= bqNegativeQuery

1715− , "negative_boost" .= toJSON bqNegativeBoost ]

1785+ , "negative_boost" .= bqNegativeBoost ]

1716

1786

1717

1787

1718instance ToJSON BoolQuery where

1788instance ToJSON BoolQuery where

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

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

1720 omitNulls base

1790 omitNulls base

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

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

1722− , "must_not" .= toJSON notM

1792+ , "must_not" .= notM

1723− , "should" .= toJSON shouldM

1793+ , "should" .= shouldM

1724− , "minimum_should_match" .= toJSON bqMin

1794+ , "minimum_should_match" .= bqMin

1725− , "boost" .= toJSON boost

1795+ , "boost" .= boost

1726− , "disable_coord" .= toJSON disableCoord ]

1796+ , "disable_coord" .= disableCoord ]

1727

1797

1728

1798

1729instance ToJSON MatchQuery where

1799instance ToJSON MatchQuery where

@@ -1733,13 +1803,13 @@ instance ToJSON MatchQuery where

1733 analyzer maxExpansions lenient) =

1803 analyzer maxExpansions lenient) =

1734 object [ fieldName .= omitNulls base ]

1804 object [ fieldName .= omitNulls base ]

1735 where base = [ "query" .= mqQueryString

1805 where base = [ "query" .= mqQueryString

1736− , "operator" .= toJSON booleanOperator

1806+ , "operator" .= booleanOperator

1737− , "zero_terms_query" .= toJSON zeroTermsQuery

1807+ , "zero_terms_query" .= zeroTermsQuery

1738− , "cutoff_frequency" .= toJSON cutoffFrequency

1808+ , "cutoff_frequency" .= cutoffFrequency

1739− , "type" .= toJSON matchQueryType

1809+ , "type" .= matchQueryType

1740− , "analyzer" .= toJSON analyzer

1810+ , "analyzer" .= analyzer

1741− , "max_expansions" .= toJSON maxExpansions

1811+ , "max_expansions" .= maxExpansions

1742− , "lenient" .= toJSON lenient ]

1812+ , "lenient" .= lenient ]

1743

1813

1744

1814

1745instance ToJSON MultiMatchQuery where

1815instance ToJSON MultiMatchQuery where

@@ -1748,14 +1818,14 @@ instance ToJSON MultiMatchQuery where

1748 object ["multi_match" .= omitNulls base]

1818 object ["multi_match" .= omitNulls base]

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

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

1750 , "query" .= query

1820 , "query" .= query

1751− , "operator" .= toJSON boolOp

1821+ , "operator" .= boolOp

1752− , "zero_terms_query" .= toJSON ztQ

1822+ , "zero_terms_query" .= ztQ

1753− , "tiebreaker" .= toJSON tb

1823+ , "tiebreaker" .= tb

1754− , "type" .= toJSON mmqt

1824+ , "type" .= mmqt

1755− , "cutoff_frequency" .= toJSON cf

1825+ , "cutoff_frequency" .= cf

1756− , "analyzer" .= toJSON analyzer

1826+ , "analyzer" .= analyzer

1757− , "max_expansions" .= toJSON maxEx

1827+ , "max_expansions" .= maxEx

1758− , "lenient" .= toJSON lenient ]

1828+ , "lenient" .= lenient ]

1759

1829

1760

1830

1761instance ToJSON MultiMatchQueryType where

1831instance ToJSON MultiMatchQueryType where

@@ -1867,7 +1937,7 @@ instance ToJSON FieldHighlight where

1867

1937

1868instance ToJSON Highlights where

1938instance ToJSON Highlights where

1869 toJSON (Highlights global fields) =

1939 toJSON (Highlights global fields) =

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

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

1871 : highlightSettingsPairs global)

1941 : highlightSettingsPairs global)

1872

1942

1873instance ToJSON HighlightSettings where

1943instance ToJSON HighlightSettings where

@@ -1945,16 +2015,16 @@ instance ToJSON SortSpec where

1945 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

2015 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

1946 dsSortMode dsMissingSort dsNestedFilter)) =

2016 dsSortMode dsMissingSort dsNestedFilter)) =

1947 object [dsSortFieldName .= omitNulls base] where

2017 object [dsSortFieldName .= omitNulls base] where

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

2018+ base = [ "order" .= dsSortOrder

1949 , "ignore_unmapped" .= dsIgnoreUnmapped

2019 , "ignore_unmapped" .= dsIgnoreUnmapped

1950 , "mode" .= dsSortMode

2020 , "mode" .= dsSortMode

1951 , "missing" .= dsMissingSort

2021 , "missing" .= dsMissingSort

1952 , "nested_filter" .= dsNestedFilter ]

2022 , "nested_filter" .= dsNestedFilter ]

1953

2023

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

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

1955− object [ "unit" .= toJSON units

2025+ object [ "unit" .= units

1956− , field .= toJSON gdsLatLon

2026+ , field .= gdsLatLon

1957− , "order" .= toJSON gdsSortOrder ]

2027+ , "order" .= gdsSortOrder ]

1958

2028

1959

2029

1960instance ToJSON SortOrder where

2030instance ToJSON SortOrder where

@@ -2016,7 +2086,7 @@ instance ToJSON OptimizeBbox where

2016instance ToJSON GeoBoundingBoxConstraint where

2086instance ToJSON GeoBoundingBoxConstraint where

2017 toJSON (GeoBoundingBoxConstraint

2087 toJSON (GeoBoundingBoxConstraint

2018 (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =

2088 (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =

2019− object [gbbcGeoBBField .= toJSON gbbcConstraintBox

2089+ object [gbbcGeoBBField .= gbbcConstraintBox

2020 , "_cache" .= cache

2090 , "_cache" .= cache

2021 , "type" .= type']

2091 , "type" .= type']

2022

2092

@@ -2028,8 +2098,8 @@ instance ToJSON GeoFilterType where

2028

2098

2029instance ToJSON GeoBoundingBox where

2099instance ToJSON GeoBoundingBox where

2030 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =

2100 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =

2031− object ["top_left" .= toJSON gbbTopLeft

2101+ object ["top_left" .= gbbTopLeft

2032− , "bottom_right" .= toJSON gbbBottomRight]

2102+ , "bottom_right" .= gbbBottomRight]

2033

2103

2034

2104

2035instance ToJSON LatLon where

2105instance ToJSON LatLon where

@@ -2062,9 +2132,9 @@ instance ToJSON Term where

2062

2132

2063

2133

2064instance ToJSON BoolMatch where

2134instance ToJSON BoolMatch where

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

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

2066 "_cache" .= cache]

2136 "_cache" .= cache]

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

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

2068 "_cache" .= cache]

2138 "_cache" .= cache]

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

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

2070 "_cache" .= cache]

2140 "_cache" .= cache]

tests/tests.hs+181−114

@@ -1,30 +1,33 @@

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4−

4+{-# OPTIONS_GHC -fno-warn-orphans #-}

5module 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

11−import Data.List (nub)

12+import Data.List (nub)

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

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

13−import qualified Data.List.NonEmpty as NE

14+import qualified Data.List.NonEmpty as NE

14−import qualified Data.Map.Strict as M

15+import qualified Data.Map.Strict as M

15−import Data.Text (Text)

16+import Data.Text (Text)

16−import qualified Data.Text as T

17+import qualified Data.Text as T

17−import Data.Time.Calendar (Day (..))

18+import Data.Time.Calendar (Day (..))

18−import Data.Time.Clock (UTCTime (..), secondsToDiffTime)

19+import Data.Time.Clock (UTCTime (..),

20+ secondsToDiffTime)

19−import qualified Data.Vector as V

21+import qualified Data.Vector as V

20import Database.Bloodhound

22import Database.Bloodhound

21−import GHC.Generics (Generic)

23+import GHC.Generics (Generic)

22import Network.HTTP.Client

24import Network.HTTP.Client

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

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

24−import Prelude hiding (filter, putStrLn)

26+import Prelude hiding (filter, putStrLn)

25import Test.Hspec

27import Test.Hspec

28+import Test.QuickCheck.Property.Monoid

27−import Test.Hspec.QuickCheck (prop)

30+import Test.Hspec.QuickCheck (prop)

28import Test.QuickCheck

31import Test.QuickCheck

30testServer :: Server

33testServer :: Server

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

34testMapping :: MappingName

37testMapping :: MappingName

35testMapping = MappingName "tweet"

38testMapping = MappingName "tweet"

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

41+withTestEnv = withBH defaultManagerSettings testServer

42+

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

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

38validateStatus resp expected =

44validateStatus resp expected =

39 (NHTS.statusCode $ responseStatus resp)

45 (NHTS.statusCode $ responseStatus resp)

40 `shouldBe` (expected :: Int)

46 `shouldBe` (expected :: Int)

42−createExampleIndex :: IO Reply

48+createExampleIndex :: BH IO Reply

43−createExampleIndex = createIndex testServer defaultIndexSettings testIndex

49+createExampleIndex = createIndex defaultIndexSettings testIndex

44−deleteExampleIndex :: IO Reply

50+deleteExampleIndex :: BH IO Reply

45−deleteExampleIndex = deleteIndex testServer testIndex

51+deleteExampleIndex = deleteIndex testIndex

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

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

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

70 Just (ServerVersion majorVer minorVer patchVer)

76 Just (ServerVersion majorVer minorVer patchVer)

71mkServerVersion _ = Nothing

77mkServerVersion _ = Nothing

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

79+getServerVersion :: IO (Maybe ServerVersion)

74−getServerVersion s = liftM extractVersion (getStatus s)

80+getServerVersion = liftM extractVersion (withTestEnv getStatus)

75 where

81 where

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

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

77 toInt = read . T.unpack

83 toInt = read . T.unpack

78 parseVersion v = map toInt (version' v)

84 parseVersion v = map toInt (version' v)

79 extractVersion = join . liftM (mkServerVersion . parseVersion)

85 extractVersion = join . liftM (mkServerVersion . parseVersion)

81−

82−

83testServerBranch :: IO (Maybe ServerVersion)

87testServerBranch :: IO (Maybe ServerVersion)

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

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

86atleast :: ServerVersion -> IO Bool

90atleast :: ServerVersion -> IO Bool

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

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

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

136 , age = 1000

140 , age = 1000

137 , location = Location 40.12 (-71.34) }

141 , location = Location 40.12 (-71.34) }

138

142

139−insertData :: IO ()

143+insertData :: BH IO ()

140insertData = do

144insertData = do

141 _ <- deleteExampleIndex

145 _ <- deleteExampleIndex

142 _ <- createExampleIndex

146 _ <- createExampleIndex

143− _ <- putMapping testServer testIndex testMapping TweetMapping

147+ _ <- putMapping testIndex testMapping TweetMapping

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

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

145− _ <- refreshIndex testServer testIndex

149+ _ <- refreshIndex testIndex

146 return ()

150 return ()

147

151

148−insertOther :: IO ()

152+insertOther :: BH IO ()

149insertOther = do

153insertOther = do

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

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

151− _ <- refreshIndex testServer testIndex

155+ _ <- refreshIndex testIndex

152 return ()

156 return ()

153

157

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

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

155searchTweet search = do

159searchTweet search = do

156− reply <- searchByIndex testServer testIndex search

160+ reply <- searchByIndex testIndex search

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

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

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

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

159 return myTweet

163 return myTweet

160

164

161−searchExpectNoResults :: Search -> IO ()

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

162searchExpectNoResults search = do

166searchExpectNoResults search = do

163− reply <- searchByIndex testServer testIndex search

167+ reply <- searchByIndex testIndex search

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

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

165 let emptyHits = fmap (hits . searchHits) result

169 let emptyHits = fmap (hits . searchHits) result

170+ liftIO $

166− emptyHits `shouldBe` Right []

171+ emptyHits `shouldBe` Right []

167

172

168−searchExpectAggs :: Search -> IO ()

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

169searchExpectAggs search = do

174searchExpectAggs search = do

170− reply <- searchAll testServer search

175+ reply <- searchAll search

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

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

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

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

178+ liftIO $

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

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

174

180

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

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

176searchValidBucketAgg search aggKey extractor = do

182searchValidBucketAgg search aggKey extractor = do

177− reply <- searchAll testServer search

183+ reply <- searchAll search

178 let bucketDocs = docCount . head . buckets

184 let bucketDocs = docCount . head . buckets

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

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

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

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

187+ liftIO $

181− count `shouldBe` Just 1

188+ count `shouldBe` Just 1

182

189

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

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

184searchTermsAggHint hints = do

191searchTermsAggHint hints = do

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

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

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

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

187 forM_ hints $ searchExpectAggs . search

194 forM_ hints $ searchExpectAggs . search

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

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

189

196

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

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

191searchTweetHighlight search = do

198searchTweetHighlight search = do

192− reply <- searchByIndex testServer testIndex search

199+ reply <- searchByIndex testIndex search

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

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

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

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

195 return myHighlight

202 return myHighlight

@@ -219,30 +226,65 @@ instance Arbitrary RegexpFlag where

219 , pure Interval

226 , pure Interval

220 ]

227 ]

221

228

229+arbitraryScore :: Gen Score

230+arbitraryScore = fmap getPositive <$> arbitrary

231+

232+instance Arbitrary Text where

233+ arbitrary = T.pack <$> arbitrary

234+

235+instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where

236+ arbitrary = M.fromList <$> arbitrary

237+

238+instance Arbitrary IndexName where

239+ arbitrary = IndexName <$> arbitrary

240+

241+instance Arbitrary MappingName where

242+ arbitrary = MappingName <$> arbitrary

243+

244+instance Arbitrary DocId where

245+ arbitrary = DocId <$> arbitrary

246+

247+instance Arbitrary a => Arbitrary (Hit a) where

248+ arbitrary = Hit <$> arbitrary

249+ <*> arbitrary

250+ <*> arbitrary

251+ <*> arbitraryScore

252+ <*> arbitrary

253+ <*> arbitrary

254+

255+

256+instance Arbitrary a => Arbitrary (SearchHits a) where

257+ arbitrary = sized $ \n -> resize (n `div` 2) $ do

258+ tot <- getPositive <$> arbitrary

259+ score <- arbitraryScore

260+ hs <- arbitrary

261+ return $ SearchHits tot score hs

262+

222main :: IO ()

263main :: IO ()

223main = hspec $ do

264main = hspec $ do

224

265

225 describe "index create/delete API" $ do

266 describe "index create/delete API" $ do

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

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

227 -- priming state.

268 -- priming state.

228 _ <- deleteExampleIndex

269 _ <- deleteExampleIndex

229 resp <- createExampleIndex

270 resp <- createExampleIndex

230 deleteResp <- deleteExampleIndex

271 deleteResp <- deleteExampleIndex

272+ liftIO $ do

231− validateStatus resp 200

273+ validateStatus resp 200

232− validateStatus deleteResp 200

274+ validateStatus deleteResp 200

233

275

234

276

235 describe "document API" $ do

277 describe "document API" $ do

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

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

237 _ <- insertData

279 _ <- insertData

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

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

239 let newTweet = eitherDecode

281 let newTweet = eitherDecode

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

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

241− fmap _source newTweet `shouldBe` Right exampleTweet

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

242

284

243

285

244 describe "bulk API" $ do

286 describe "bulk API" $ do

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

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

246 _ <- insertData

288 _ <- insertData

247 let firstTest = BulkTest "blah"

289 let firstTest = BulkTest "blah"

248 let secondTest = BulkTest "bloo"

290 let secondTest = BulkTest "bloo"

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

251 let secondDoc = BulkCreate testIndex

293 let secondDoc = BulkCreate testIndex

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

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

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

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

254− _ <- bulk testServer stream

296+ _ <- bulk stream

255− _ <- refreshIndex testServer testIndex

297+ _ <- refreshIndex testIndex

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

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

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

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

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

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

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

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

302+ liftIO $ do

260− fmap _source maybeFirst `shouldBe` Right firstTest

303+ fmap _source maybeFirst `shouldBe` Right firstTest

261− fmap _source maybeSecond `shouldBe` Right secondTest

304+ fmap _source maybeSecond `shouldBe` Right secondTest

262

305

263

306

264 describe "query API" $ do

307 describe "query API" $ do

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

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

266 _ <- insertData

309 _ <- insertData

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

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

268 let filter = IdentityFilter <&&> IdentityFilter

311 let filter = IdentityFilter <&&> IdentityFilter

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

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

270 myTweet <- searchTweet search

313 myTweet <- searchTweet search

314+ liftIO $

271− myTweet `shouldBe` Right exampleTweet

315+ myTweet `shouldBe` Right exampleTweet

272

316

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

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

274 _ <- insertData

318 _ <- insertData

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

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

276 let filter = IdentityFilter <&&> IdentityFilter

320 let filter = IdentityFilter <&&> IdentityFilter

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

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

278 myTweet <- searchTweet search

322 myTweet <- searchTweet search

323+ liftIO $

279− myTweet `shouldBe` Right exampleTweet

324+ myTweet `shouldBe` Right exampleTweet

280

325

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

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

282 _ <- insertData

327 _ <- insertData

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

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

284 let search = mkSearch (Just query) Nothing

329 let search = mkSearch (Just query) Nothing

285 myTweet <- searchTweet search

330 myTweet <- searchTweet search

331+ liftIO $

286− myTweet `shouldBe` Right exampleTweet

332+ myTweet `shouldBe` Right exampleTweet

287

333

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

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

289 _ <- insertData

335 _ <- insertData

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

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

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

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

292 let search = mkSearch (Just query) Nothing

338 let search = mkSearch (Just query) Nothing

293 myTweet <- searchTweet search

339 myTweet <- searchTweet search

340+ liftIO $

294− myTweet `shouldBe` Right exampleTweet

341+ myTweet `shouldBe` Right exampleTweet

295

342

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

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

297 _ <- insertData

344 _ <- insertData

298 let innerQuery = QueryMatchQuery $

345 let innerQuery = QueryMatchQuery $

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

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

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

301 mkBoolQuery [innerQuery] [] []

348 mkBoolQuery [innerQuery] [] []

302 let search = mkSearch (Just query) Nothing

349 let search = mkSearch (Just query) Nothing

303 myTweet <- searchTweet search

350 myTweet <- searchTweet search

351+ liftIO $

304− myTweet `shouldBe` Right exampleTweet

352+ myTweet `shouldBe` Right exampleTweet

305

353

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

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

307 _ <- insertData

355 _ <- insertData

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

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

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

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

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

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

311 let search = mkSearch (Just query) Nothing

359 let search = mkSearch (Just query) Nothing

312 myTweet <- searchTweet search

360 myTweet <- searchTweet search

361+ liftIO $

313− myTweet `shouldBe` Right exampleTweet

362+ myTweet `shouldBe` Right exampleTweet

314

363

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

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

316 _ <- insertData

365 _ <- insertData

317 let query = QueryCommonTermsQuery $

366 let query = QueryCommonTermsQuery $

318 CommonTermsQuery (FieldName "user")

367 CommonTermsQuery (FieldName "user")

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

321 Or Or Nothing Nothing Nothing Nothing

370 Or Or Nothing Nothing Nothing Nothing

322 let search = mkSearch (Just query) Nothing

371 let search = mkSearch (Just query) Nothing

323 myTweet <- searchTweet search

372 myTweet <- searchTweet search

373+ liftIO $

324− myTweet `shouldBe` Right exampleTweet

374+ myTweet `shouldBe` Right exampleTweet

325

375

326

376

327 describe "sorting" $ do

377 describe "sorting" $ do

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

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

329 _ <- insertData

379 _ <- insertData

330 _ <- insertOther

380 _ <- insertOther

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

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

332 let search = Search Nothing

382 let search = Search Nothing

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

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

334− False 0 10

384+ False (From 0) (Size 10)

335− reply <- searchByIndex testServer testIndex search

385+ reply <- searchByIndex testIndex search

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

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

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

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

388+ liftIO $

338− myTweet `shouldBe` Right otherTweet

389+ myTweet `shouldBe` Right otherTweet

339

390

340

391

341 describe "filtering API" $ do

392 describe "filtering API" $ do

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

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

343 _ <- insertData

394 _ <- insertData

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

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

345 <&&> IdentityFilter

396 <&&> IdentityFilter

346 let search = mkSearch Nothing (Just queryFilter)

397 let search = mkSearch Nothing (Just queryFilter)

347 myTweet <- searchTweet search

398 myTweet <- searchTweet search

399+ liftIO $

348− myTweet `shouldBe` Right exampleTweet

400+ myTweet `shouldBe` Right exampleTweet

349

401

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

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

351 _ <- insertData

403 _ <- insertData

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

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

353 let search = mkSearch Nothing (Just termFilter)

405 let search = mkSearch Nothing (Just termFilter)

354 myTweet <- searchTweet search

406 myTweet <- searchTweet search

407+ liftIO $

355− myTweet `shouldBe` Right exampleTweet

408+ myTweet `shouldBe` Right exampleTweet

356

409

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

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

358 _ <- insertData

411 _ <- insertData

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

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

360 myTweet <- searchTweet search

413 myTweet <- searchTweet search

414+ liftIO $

361− myTweet `shouldBe` Right exampleTweet

415+ myTweet `shouldBe` Right exampleTweet

362

416

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

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

364 _ <- insertData

418 _ <- insertData

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

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

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

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

367 let geoFilter = GeoBoundingBoxFilter bbConstraint

421 let geoFilter = GeoBoundingBoxFilter bbConstraint

368 let search = mkSearch Nothing (Just geoFilter)

422 let search = mkSearch Nothing (Just geoFilter)

369 myTweet <- searchTweet search

423 myTweet <- searchTweet search

424+ liftIO $

370− myTweet `shouldBe` Right exampleTweet

425+ myTweet `shouldBe` Right exampleTweet

371

426

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

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

373 _ <- insertData

428 _ <- insertData

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

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

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

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

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

377 let search = mkSearch Nothing (Just geoFilter)

432 let search = mkSearch Nothing (Just geoFilter)

378 searchExpectNoResults search

433 searchExpectNoResults search

379

434

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

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

381 _ <- insertData

436 _ <- insertData

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

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

383 let distance = Distance 10.0 Miles

438 let distance = Distance 10.0 Miles

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

385 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False

440 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False

386 let search = mkSearch Nothing (Just geoFilter)

441 let search = mkSearch Nothing (Just geoFilter)

387 myTweet <- searchTweet search

442 myTweet <- searchTweet search

443+ liftIO $

388− myTweet `shouldBe` Right exampleTweet

444+ myTweet `shouldBe` Right exampleTweet

389

445

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

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

391 _ <- insertData

447 _ <- insertData

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

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

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

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

394 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange

450 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange

395 let search = mkSearch Nothing (Just geoFilter)

451 let search = mkSearch Nothing (Just geoFilter)

396 myTweet <- searchTweet search

452 myTweet <- searchTweet search

453+ liftIO $

397− myTweet `shouldBe` Right exampleTweet

454+ myTweet `shouldBe` Right exampleTweet

398

455

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

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

400 _ <- insertData

457 _ <- insertData

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

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

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

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

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

404 let search = mkSearch Nothing (Just geoFilter)

461 let search = mkSearch Nothing (Just geoFilter)

405 searchExpectNoResults search

462 searchExpectNoResults search

406

463

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

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

408 _ <- insertData

465 _ <- insertData

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

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

410 LatLon 40.0 (-72.00),

467 LatLon 40.0 (-72.00),

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

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

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

414 let search = mkSearch Nothing (Just geoFilter)

471 let search = mkSearch Nothing (Just geoFilter)

415 myTweet <- searchTweet search

472 myTweet <- searchTweet search

473+ liftIO $

416− myTweet `shouldBe` Right exampleTweet

474+ myTweet `shouldBe` Right exampleTweet

417

475

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

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

419 _ <- insertData

477 _ <- insertData

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

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

421 LatLon 40.0 (-71.00),

479 LatLon 40.0 (-71.00),

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

425 let search = mkSearch Nothing (Just geoFilter)

483 let search = mkSearch Nothing (Just geoFilter)

426 searchExpectNoResults search

484 searchExpectNoResults search

427

485

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

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

429 _ <- insertData

487 _ <- insertData

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

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

431 let search = mkSearch Nothing (Just filter)

489 let search = mkSearch Nothing (Just filter)

432 myTweet <- searchTweet search

490 myTweet <- searchTweet search

491+ liftIO $

433− myTweet `shouldBe` Right exampleTweet

492+ myTweet `shouldBe` Right exampleTweet

434

493

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

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

436 _ <- insertData

495 _ <- insertData

437 let filter = RangeFilter (FieldName "age")

496 let filter = RangeFilter (FieldName "age")

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

497 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))

439 RangeExecutionIndex False

498 RangeExecutionIndex False

440 let search = mkSearch Nothing (Just filter)

499 let search = mkSearch Nothing (Just filter)

441 myTweet <- searchTweet search

500 myTweet <- searchTweet search

501+ liftIO $

442− myTweet `shouldBe` Right exampleTweet

502+ myTweet `shouldBe` Right exampleTweet

443

503

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

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

445 _ <- insertData

505 _ <- insertData

446 let filter = RangeFilter (FieldName "postDate")

506 let filter = RangeFilter (FieldName "postDate")

447 (RangeDateGtLt

507 (RangeDateGtLt

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

454 RangeExecutionIndex False

514 RangeExecutionIndex False

455 let search = mkSearch Nothing (Just filter)

515 let search = mkSearch Nothing (Just filter)

456 myTweet <- searchTweet search

516 myTweet <- searchTweet search

517+ liftIO $

457− myTweet `shouldBe` Right exampleTweet

518+ myTweet `shouldBe` Right exampleTweet

458

519

459

520

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

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

461 _ <- insertData

522 _ <- insertData

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

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

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

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

464 let search = mkSearch Nothing (Just filter)

525 let search = mkSearch Nothing (Just filter)

465 myTweet <- searchTweet search

526 myTweet <- searchTweet search

527+ liftIO $

466− myTweet `shouldBe` Right exampleTweet

528+ myTweet `shouldBe` Right exampleTweet

467

529

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

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

469 _ <- insertData

531 _ <- insertData

470 let filter = RegexpFilter (FieldName "user")

532 let filter = RegexpFilter (FieldName "user")

471 (Regexp "boy") AllRegexpFlags

533 (Regexp "boy") AllRegexpFlags

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

474 searchExpectNoResults search

536 searchExpectNoResults search

475

537

476 describe "Aggregation API" $ do

538 describe "Aggregation API" $ do

477− it "returns term aggregation results" $ do

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

478 _ <- insertData

540 _ <- insertData

479 let terms = TermsAgg $ mkTermsAggregation "user"

541 let terms = TermsAgg $ mkTermsAggregation "user"

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

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

481 searchExpectAggs search

543 searchExpectAggs search

482 searchValidBucketAgg search "users" toTerms

544 searchValidBucketAgg search "users" toTerms

483

545

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

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

485 _ <- insertData

547 _ <- insertData

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

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

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

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

488 searchExpectAggs search

550 searchExpectAggs search

489 searchValidBucketAgg search "users" toTerms

551 searchValidBucketAgg search "users" toTerms

490

552

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

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

492 _ <- insertData

554 _ <- insertData

493 searchTermsAggHint [Map, Ordinals]

555 searchTermsAggHint [Map, Ordinals]

494

556

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

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

496 _ <- insertData

558 _ <- insertData

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

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

498

560

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

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

500 _ <- insertData

562 _ <- insertData

501 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

563 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

502

564

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

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

504 _ <- insertData

566 _ <- insertData

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

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

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

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

507 searchExpectAggs search

569 searchExpectAggs search

508 searchValidBucketAgg search "byDate" toDateHistogram

570 searchValidBucketAgg search "byDate" toDateHistogram

509

571

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

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

511 _ <- insertData

573 _ <- insertData

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

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

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

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

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

521

583

522 describe "Highlights API" $ do

584 describe "Highlights API" $ do

523

585

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

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

525 _ <- insertData

587 _ <- insertData

526 _ <- insertOther

588 _ <- insertOther

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

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

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

529

591

530 let search = mkHighlightSearch (Just query) testHighlight

592 let search = mkHighlightSearch (Just query) testHighlight

531 myHighlight <- searchTweetHighlight search

593 myHighlight <- searchTweetHighlight search

594+ liftIO $

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

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

533

596

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

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

535 _ <- insertData

598 _ <- insertData

536 _ <- insertOther

599 _ <- insertOther

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

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

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

539

602

540 let search = mkHighlightSearch (Just query) testHighlight

603 let search = mkHighlightSearch (Just query) testHighlight

541 myHighlight <- searchTweetHighlight search

604 myHighlight <- searchTweetHighlight search

605+ liftIO $

542− myHighlight `shouldBe` Right Nothing

606+ myHighlight `shouldBe` Right Nothing

543

607

544

608

545

609

@@ -582,4 +646,7 @@ main = hspec $ do

582 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))

646 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))

583 , "test2" .= (toJSON ("some value" :: Text))]

647 , "test2" .= (toJSON ("some value" :: Text))]

584 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)

648 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)

585− , ("test2", String "some value")])

649+ , ("test2", String "some value")])

650+ describe "Monoid (SearchHits a)" $ do

651+ prop "abides the monoid laws" $ eq $

652+ prop_Monoid (T :: T (SearchHits ()))