f615ac2 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Merge remote-tracking branch 'upstream/master' into source-in-search

f615ac2Thomas van Noort11 years ago

.travis.yml+8−6

compare with master

unifiedsplit

@@ -7,12 +7,14 @@

7# release of a major GHC version. Setting HPVER implictly sets

8# GHCVER. Omit lines with versions you don't need/want testing for.

9env:

10− - GHCVER=7.6.3 ESVER=1.4.1

10+ - GHCVER=7.6.3 ESVER=1.6.0

11− - GHCVER=7.8.3 ESVER=1.0.3

11+ # - GHCVER=7.8.3 ESVER=1.0.3 # Deprecated

12− - GHCVER=7.8.3 ESVER=1.1.2

12+ # - GHCVER=7.8.3 ESVER=1.1.2 # Deprecated

13− - GHCVER=7.8.3 ESVER=1.2.4

13+ - GHCVER=7.8.3 ESVER=1.2.4

14− - GHCVER=7.8.3 ESVER=1.3.6

14+ - GHCVER=7.8.3 ESVER=1.3.6

15− - GHCVER=7.8.3 ESVER=1.4.1

15+ - GHCVER=7.8.3 ESVER=1.4.1

16+ - GHCVER=7.10.1 ESVER=1.5.2

17+ - GHCVER=7.10.1 ESVER=1.6.0

17# services:

19# services:

18# - elasticsearch

20# - elasticsearch

README.md+30−18

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

225-- λ> encode $ Location 10.0 10.0

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

227

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

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

229

230```

231

@@ -276,23 +276,22 @@ let eitherResult = eitherDecode body :: Either String (EsResult Tweet)

276Right (EsResult {_index = "twitter"

277 , _type = "tweet"

278 , _id = "1"

279− , _version = 2

279+ , foundResult = Just (EsResultFound { _version = 2

280− , found = Just True

281− , _source = Tweet {user = "bitemyapp"

280+ , _source = Tweet {user = "bitemyapp"

282− , postDate = 2009-06-18 00:00:10 UTC

281+ , postDate = 2009-06-18 00:00:10 UTC

283− , message = "Use haskell!"

282+ , message = "Use haskell!"

284− , age = 10000

283+ , age = 10000

285− , location = Location {lat = 40.12, lon = -71.34}}})

284+ , location = Location {lat = 40.12, lon = -71.34}}})})

286

285

287−-- _source in EsResult is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.

286+-- _source in EsResultFound is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.

288

287

289-- use the _source record accessor to get at your document

288-- use the _source record accessor to get at your document

290−fmap _source eitherResult

289+fmap (fmap _source . foundResult) eitherResult

291−Right (Tweet {user = "bitemyapp"

290+Right (Just (Tweet {user = "bitemyapp"

292− , postDate = 2009-06-18 00:00:10 UTC

291+ , postDate = 2009-06-18 00:00:10 UTC

293− , message = "Use haskell!"

292+ , message = "Use haskell!"

294− , age = 10000

293+ , age = 10000

295− , location = Location {lat = 40.12, lon = -71.34}})

294+ , location = Location {lat = 40.12, lon = -71.34}}))

296

295

297```

296```

298

297

@@ -368,7 +367,7 @@ let encodedOperations = encodeBulkOperations stream

368

367

369-- to insert into a particular server

368-- to insert into a particular server

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

369-- bulk :: V.Vector BulkOperation -> IO Reply

371−_ <- withBH' $ bulk stream

370+_ <- withBH' $ bulk streamp

372

371

373```

372```

374

373

@@ -383,7 +382,7 @@ Search

383

382

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

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

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

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

386−-- mkSearch query filter = Search query filter Nothing False (From 0) (Size 10)

385+-- mkSearch query filter = Search query filter Nothing False (From 0) (Size 10) Nothing

387

386

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

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

389

388

@@ -486,9 +485,22 @@ let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending

486-- -> Maybe Sort

485-- -> Maybe Sort

487-- -> TrackSortScores

486-- -> TrackSortScores

488-- -> From -> Size

487-- -> From -> Size

488+-- -> Maybe [FieldName]

489

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

491−let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False (From 0) (Size 10)

491+let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False (From 0) (Size 10) Nothing

492+

493+```

494+

495+### Field selection

496+

497+If you only want certain fields from the source document returned, you can

498+set the "fields" field of the Search record.

499+

500+``` {.haskell}

501+

502+let search' = mkSearch (Just (MatchAllQuery Nothing)) Nothing

503+ search = search' { fields = Just [FieldName "updated"] }

492

504

493```

505```

494

506

Setup.hsmode 100644 → 100755+4−48

@@ -1,51 +1,7 @@

1−{-# OPTIONS_GHC -Wall #-}

1+#!/usr/bin/env runhaskell

2−module Main (main) where

4−import Data.List ( nub )

3+module Main where

5−import Data.Version ( showVersion )

6−import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )

7−import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )

8−import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )

9−import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )

10−import Distribution.Simple.BuildPaths ( autogenModulesDir )

4+import Distribution.Simple

11−import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))

12−import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )

13−import Distribution.Text ( display )

14−import Distribution.Verbosity ( Verbosity, normal )

15−import System.FilePath ( (</>) )

17main :: IO ()

6main :: IO ()

18−main = defaultMainWithHooks simpleUserHooks

7+main = defaultMain

19− { buildHook = \pkg lbi hooks flags -> do

20− generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi

21− buildHook simpleUserHooks pkg lbi hooks flags

22− , postHaddock = \args flags pkg lbi -> do

23− -- copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")]

24− postHaddock simpleUserHooks args flags pkg lbi

25− }

26−

27−haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath

28−haddockOutputDir flags pkg = destDir where

29− baseDir = case haddockDistPref flags of

30− NoFlag -> "."

31− Flag x -> x

32− destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)

33−

34−generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()

35−generateBuildModule verbosity pkg lbi = do

36− let dir = autogenModulesDir lbi

37− createDirectoryIfMissingVerbose verbosity True dir

38− withLibLBI pkg lbi $ \_ libcfg -> do

39− withTestLBI pkg lbi $ \suite suitecfg -> do

40− rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines

41− [ "module Build_" ++ testName suite ++ " where"

42− , "deps :: [String]"

43− , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))

44− ]

45− where

46− formatdeps = map (formatone . snd)

47− formatone p = case packageName p of

48− PackageName n -> n ++ "-" ++ showVersion (packageVersion p)

49−

50−testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]

51−testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys

bloodhound.cabal+14−9

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

1name: bloodhound

2−version: 0.6.0.0

2+version: 0.7.0.1

3synopsis: ElasticSearch client library for Haskell

4description: ElasticSearch made awesome for Haskell hackers

5homepage: https://github.com/bitemyapp/bloodhound

@@ -16,9 +16,6 @@ source-repository head

16 type: git

17 location: https://github.com/bitemyapp/bloodhound.git

19−flag DevelopmentMode

20− Default: False

21−

22library

19library

23 ghc-options: -Wall

20 ghc-options: -Wall

24 exposed-modules: Database.Bloodhound

21 exposed-modules: Database.Bloodhound

@@ -29,7 +26,7 @@ library

29 build-depends: base >= 4.3 && <5,

26 build-depends: base >= 4.3 && <5,

30 bytestring >= 0.10.0 && <0.11,

27 bytestring >= 0.10.0 && <0.11,

31 containers >= 0.5.0.0 && <0.6,

28 containers >= 0.5.0.0 && <0.6,

32− aeson >= 0.7 && <0.9,

29+ aeson >= 0.7 && <0.10,

33 http-client >= 0.3 && <0.5,

30 http-client >= 0.3 && <0.5,

34 semigroups >= 0.15 && <0.17,

31 semigroups >= 0.15 && <0.17,

35 time >= 1.4 && <1.6,

32 time >= 1.4 && <1.6,

@@ -37,10 +34,12 @@ library

37 mtl >= 1.0 && <2.3,

34 mtl >= 1.0 && <2.3,

38 transformers >= 0.2 && <0.5,

35 transformers >= 0.2 && <0.5,

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

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

40− vector >= 0.10.9 && <0.11,

37+ vector >= 0.10.9 && <0.12,

41 uri-bytestring >= 0.1 && <0.2,

38 uri-bytestring >= 0.1 && <0.2,

42 exceptions,

39 exceptions,

43− data-default-class

40+ data-default-class,

41+ blaze-builder,

42+ unordered-containers

44 default-language: Haskell2010

43 default-language: Haskell2010

46test-suite tests

45test-suite tests

@@ -50,6 +49,7 @@ test-suite tests

50 hs-source-dirs: tests

49 hs-source-dirs: tests

51 build-depends: base,

50 build-depends: base,

52 bloodhound,

51 bloodhound,

52+ bytestring,

53 http-client,

54 http-types,

55 containers,

@@ -66,15 +66,20 @@ test-suite tests

66 default-language: Haskell2010

68test-suite doctests

69+ ghc-options: -threaded -Wall

69 default-language: Haskell2010

70 default-language: Haskell2010

70 type: exitcode-stdio-1.0

71 type: exitcode-stdio-1.0

71 main-is: doctests.hs

72 main-is: doctests.hs

72− hs-source-dirs: tests

73+ hs-source-dirs: tests, src

73 if impl(ghc >= 7.8)

74 if impl(ghc >= 7.8)

74 build-depends: base,

75 build-depends: base,

75 directory,

76 directory,

76− doctest,

77+ doctest >= 0.10.1,

77 doctest-prop,

78 doctest-prop,

78 filepath

79 filepath

79 else

80 else

80 buildable: False

81 buildable: False

82+

83+Source-Repository head

84+ Type: git

85+ Location: git://github.com/bitemyapp/bloodhound.git

changelog.md+19

@@ -1,3 +1,22 @@

1+0.7.0.0

2+===================

4+* Added QueryFilter thanks to Bjørn Nordbø!

6+* Support for optimistic concurrency control thanks again to @MichaelXavier!

8+0.6.0.1

9+===================

10+

11+* Allow Aeson 0.9

12+

13+0.6.0.0

14+===================

15+

16+* Moved to BHMonad, thanks to @MichaelXavier! Now there's a reader of config information and IO is lifted.

17+

18+* SearchHits have a Monoid now, makes combining search results nicer, allows for defaulting when a search cannot be performed.

19+

10.5.0.0

200.5.0.0

2===================

21===================

src/Database/Bloodhound/Client.hs+96−14

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

27 , indexExists

28 , openIndex

29 , closeIndex

30+ , putTemplate

31+ , templateExists

32+ , deleteTemplate

30 , putMapping

33 , putMapping

31 , deleteMapping

34 , deleteMapping

32 , indexDocument

35 , indexDocument

@@ -47,9 +50,14 @@ module Database.Bloodhound.Client

47 , getStatus

50 , getStatus

48 , encodeBulkOperations

51 , encodeBulkOperations

49 , encodeBulkOperation

52 , encodeBulkOperation

53+ -- * Reply-handling tools

54+ , isVersionConflict

55+ , isSuccess

56+ , isCreated

50 )

57 )

51 where

58 where

60+import qualified Blaze.ByteString.Builder as BB

53import Control.Applicative

61import Control.Applicative

54import Control.Monad

62import Control.Monad

55import Control.Monad.Catch

63import Control.Monad.Catch

@@ -58,7 +66,9 @@ import Data.Aeson

58import Data.ByteString.Lazy.Builder

66import Data.ByteString.Lazy.Builder

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

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

60import Data.Default.Class

68import Data.Default.Class

69+import Data.Ix

61import Data.Maybe (fromMaybe)

70import Data.Maybe (fromMaybe)

71+import Data.Monoid

62import Data.Text (Text)

72import Data.Text (Text)

63import qualified Data.Text as T

73import qualified Data.Text as T

64import qualified Data.Text.Encoding as T

74import qualified Data.Text.Encoding as T

@@ -66,6 +76,7 @@ import qualified Data.Vector as V

66import Network.HTTP.Client

76import Network.HTTP.Client

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

77import qualified Network.HTTP.Types.Method as NHTM

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

78import qualified Network.HTTP.Types.Status as NHTS

79+import qualified Network.HTTP.Types.URI as NHTU

69import Prelude hiding (filter, head)

80import Prelude hiding (filter, head)

70import URI.ByteString hiding (Query)

81import URI.ByteString hiding (Query)

@@ -80,7 +91,7 @@ import Database.Bloodhound.Types

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

91-- >>> let runBH' = withBH defaultManagerSettings testServer

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

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

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

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

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

94+-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)

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

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

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

96-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping

86-- >>> import GHC.Generics

97-- >>> import GHC.Generics

@@ -160,6 +171,16 @@ joinPath ps = do

160 Server s <- bhServer <$> getBHEnv

171 Server s <- bhServer <$> getBHEnv

161 return $ joinPath' (s:ps)

172 return $ joinPath' (s:ps)

162

173

174+-- | Severely dumbed down query renderer. Assumes your data doesn't

175+-- need any encoding

176+addQuery :: [(Text, Maybe Text)] -> Text -> Text

177+addQuery q u = u <> rendered

178+ where

179+ rendered =

180+ T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q

181+ prependQuestionMark = True

182+

183+

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

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

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

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

165

186

@@ -182,7 +203,7 @@ get = flip (dispatch NHTM.methodGet) Nothing

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

203head :: MonadBH m => Text -> m Reply

183head = flip (dispatch NHTM.methodHead) Nothing

204head = flip (dispatch NHTM.methodHead) Nothing

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

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

185−put = dispatch NHTM.methodPost

206+put = dispatch NHTM.methodPut

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

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

187post = dispatch NHTM.methodPost

208post = dispatch NHTM.methodPost

188

209

@@ -283,6 +304,35 @@ openIndex = openOrCloseIndexes OpenIndex

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

304closeIndex :: MonadBH m => IndexName -> m Reply

284closeIndex = openOrCloseIndexes CloseIndex

305closeIndex = openOrCloseIndexes CloseIndex

285

306

307+-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.

308+-- Explained in further detail at

309+-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>

310+--

311+-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]

312+-- >>> resp <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")

313+putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply

314+putTemplate indexTemplate (TemplateName templateName) =

315+ bindM2 put url (return body)

316+ where url = joinPath ["_template", templateName]

317+ body = Just $ encode indexTemplate

318+

319+-- | 'templateExists' checks to see if a template exists.

320+--

321+-- >>> exists <- runBH' $ templateExists (TemplateName "tweet-tpl")

322+templateExists :: MonadBH m => TemplateName -> m Bool

323+templateExists (TemplateName templateName) = do

324+ (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]

325+ return exists

326+

327+-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.

328+--

329+-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]

330+-- >>> _ <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")

331+-- >>> resp <- runBH' $ deleteTemplate (TemplateName "tweet-tpl")

332+deleteTemplate :: MonadBH m => TemplateName -> m Reply

333+deleteTemplate (TemplateName templateName) =

334+ delete =<< joinPath ["_template", templateName]

335+

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

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

287-- for documents in indexes.

337-- for documents in indexes.

288--

338--

@@ -294,7 +344,9 @@ putMapping :: (MonadBH m, ToJSON a) => IndexName

294 -> MappingName -> a -> m Reply

344 -> MappingName -> a -> m Reply

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

345putMapping (IndexName indexName) (MappingName mappingName) mapping =

296 bindM2 put url (return body)

346 bindM2 put url (return body)

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

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

348+ -- "_mapping" and mappingName above were originally transposed

349+ -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"

298 body = Just $ encode mapping

350 body = Just $ encode mapping

299

351

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

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

@@ -308,22 +360,38 @@ putMapping (IndexName indexName) (MappingName mappingName) mapping =

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

360deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply

309deleteMapping (IndexName indexName)

361deleteMapping (IndexName indexName)

310 (MappingName mappingName) =

362 (MappingName mappingName) =

363+ -- "_mapping" and mappingName below were originally transposed

364+ -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"

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

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

312

366

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

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

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

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

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

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

316-- primary key for the document.

370-- primary key for the document.

317--

371--

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

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

319-- >>> print resp

373-- >>> print resp

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}

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

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

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

322− -> doc -> DocId -> m Reply

376+ -> IndexDocumentSettings -> doc -> DocId -> m Reply

323indexDocument (IndexName indexName)

377indexDocument (IndexName indexName)

324− (MappingName mappingName) document (DocId docId) =

378+ (MappingName mappingName) cfg document (DocId docId) =

325 bindM2 put url (return body)

379 bindM2 put url (return body)

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

380+ where url = addQuery params <$> joinPath [indexName, mappingName, docId]

381+ versionCtlParams = case idsVersionControl cfg of

382+ NoVersionControl -> []

383+ InternalVersion v -> versionParams v "internal"

384+ ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"

385+ ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"

386+ ForceVersion (ExternalDocVersion v) -> versionParams v "force"

387+ vt = T.pack . show . docVersionNumber

388+ versionParams v t = [ ("version", Just $ vt v)

389+ , ("version_type", Just t)

390+ ]

391+ parentParams = case idsParent cfg of

392+ Nothing -> []

393+ Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]

394+ params = versionCtlParams ++ parentParams

327 body = Just (encode document)

395 body = Just (encode document)

328

396

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

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

@@ -469,9 +537,9 @@ searchByType (IndexName indexName)

469--

537--

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

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

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

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

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, source = Nothing}

540+-- 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, fields = Nothing, source = Nothing}

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

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

474−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) Nothing

542+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) Nothing Nothing

475

543

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

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

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

545-- the 'Query' and the 'Aggregation'.

@@ -481,7 +549,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From

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

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

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

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

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

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

484−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) Nothing

552+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) Nothing Nothing

485

553

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

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

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

555-- the 'Query' and the 'Aggregation'.

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

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

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

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

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

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

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

493−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) Nothing

561+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) Nothing Nothing

494

562

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

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

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

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

@@ -500,9 +568,9 @@ mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing

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

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

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

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

502-- >>> search

570-- >>> search

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, source = Nothing}

571+-- 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, fields = Nothing, source = Nothing}

504-- >>> pageSearch (From 10) (Size 100) search

572-- >>> pageSearch (From 10) (Size 100) search

505−-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100, source = Nothing}

573+-- 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, fields = Nothing, source = Nothing}

506pageSearch :: From -- ^ The result offset

574pageSearch :: From -- ^ The result offset

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

575 -> Size -- ^ The number of results to return

508 -> Search -- ^ The current seach

576 -> Search -- ^ The current seach

@@ -536,3 +604,17 @@ setURI req URI{..} = do

536 Scheme "https" -> True

604 Scheme "https" -> True

537 _ -> False

605 _ -> False

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

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

607+

608+-- | Was there an optimistic concurrency control conflict when

609+-- indexing a document?

610+isVersionConflict :: Reply -> Bool

611+isVersionConflict = statusCheck (== 409)

612+

613+isSuccess :: Reply -> Bool

614+isSuccess = statusCheck (inRange (200, 299))

615+

616+isCreated :: Reply -> Bool

617+isCreated = statusCheck (== 201)

618+

619+statusCheck :: (Int -> Bool) -> Reply -> Bool

620+statusCheck prd = prd . NHTS.statusCode . responseStatus

src/Database/Bloodhound/Types.hs+216−16

@@ -29,6 +29,7 @@

29module Database.Bloodhound.Types

30 ( defaultCache

31 , defaultIndexSettings

32+ , defaultIndexDocumentSettings

32 , mkSort

33 , mkSort

33 , showText

34 , showText

34 , unpackId

35 , unpackId

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

41 , mkTermsAggregation

42 , mkTermsAggregation

42 , mkTermsScriptAggregation

43 , mkTermsScriptAggregation

43 , mkDateHistogram

44 , mkDateHistogram

45+ , mkDocVersion

46+ , docVersionNumber

44 , toTerms

47 , toTerms

45 , toDateHistogram

48 , toDateHistogram

46 , omitNulls

49 , omitNulls

@@ -53,9 +56,16 @@ module Database.Bloodhound.Types

53 , Existence(..)

56 , Existence(..)

54 , NullValue(..)

57 , NullValue(..)

55 , IndexSettings(..)

58 , IndexSettings(..)

59+ , IndexTemplate(..)

56 , Server(..)

60 , Server(..)

57 , Reply

61 , Reply

58 , EsResult(..)

62 , EsResult(..)

63+ , EsResultFound(..)

64+ , DocVersion

65+ , ExternalDocVersion(..)

66+ , VersionControl(..)

67+ , DocumentParent(..)

68+ , IndexDocumentSettings(..)

59 , Query(..)

69 , Query(..)

60 , Search(..)

70 , Search(..)

61 , SearchResult(..)

71 , SearchResult(..)

@@ -98,7 +108,10 @@ module Database.Bloodhound.Types

98 , RegexpFlags(..)

108 , RegexpFlags(..)

99 , RegexpFlag(..)

109 , RegexpFlag(..)

100 , FieldName(..)

110 , FieldName(..)

111+ , Script(..)

101 , IndexName(..)

112 , IndexName(..)

113+ , TemplateName(..)

114+ , TemplatePattern(..)

102 , MappingName(..)

115 , MappingName(..)

103 , DocId(..)

116 , DocId(..)

104 , CacheName(..)

117 , CacheName(..)

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

194 , Bucket(..)

207 , Bucket(..)

195 , BucketAggregation(..)

208 , BucketAggregation(..)

196 , TermsAggregation(..)

209 , TermsAggregation(..)

210+ , ValueCountAggregation(..)

211+ , FilterAggregation(..)

197 , DateHistogramAggregation(..)

212 , DateHistogramAggregation(..)

198

213

199 , Highlights(..)

214 , Highlights(..)

@@ -220,13 +235,16 @@ import Control.Monad.Writer

220import Data.Aeson

235import Data.Aeson

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

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

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

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

223−import Data.List (nub)

238+import Data.List (nub, foldl')

224import Data.List.NonEmpty (NonEmpty (..), toList)

239import Data.List.NonEmpty (NonEmpty (..), toList)

240+import qualified Data.HashMap.Strict as HM (union)

225import qualified Data.Map.Strict as M

241import qualified Data.Map.Strict as M

242+import Data.Maybe

226import Data.Text (Text)

243import Data.Text (Text)

227import qualified Data.Text as T

244import qualified Data.Text as T

228import Data.Time.Clock (UTCTime)

245import Data.Time.Clock (UTCTime)

229import qualified Data.Vector as V

246import qualified Data.Vector as V

247+import GHC.Enum

230import GHC.Generics (Generic)

248import GHC.Generics (Generic)

231import Network.HTTP.Client

249import Network.HTTP.Client

232import qualified Network.HTTP.Types.Method as NHTM

250import qualified Network.HTTP.Types.Method as NHTM

@@ -344,6 +362,20 @@ data FieldType = GeoPointType

344data FieldDefinition =

362data FieldDefinition =

345 FieldDefinition { fieldType :: FieldType } deriving (Eq, Show)

363 FieldDefinition { fieldType :: FieldType } deriving (Eq, Show)

346

364

365+{-| An 'IndexTemplate' defines a template that will automatically be

366+ applied to new indices created. The templates include both

367+ 'IndexSettings' and mappings, and a simple 'TemplatePattern' that

368+ controls if the template will be applied to the index created.

369+ Specify mappings as follows: @[toJSON TweetMapping, ...]@

370+

371+ https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html

372+-}

373+data IndexTemplate =

374+ IndexTemplate { templatePattern :: TemplatePattern

375+ , templateSettings :: Maybe IndexSettings

376+ , templateMappings :: [Value]

377+ }

378+

347data MappingField =

379data MappingField =

348 MappingField { mappingFieldName :: FieldName

380 MappingField { mappingFieldName :: FieldName

349 , fieldDefinition :: FieldDefinition } deriving (Eq, Show)

381 , fieldDefinition :: FieldDefinition } deriving (Eq, Show)

@@ -371,14 +403,95 @@ data BulkOperation =

371 | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)

403 | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show)

372

404

373{-| 'EsResult' describes the standard wrapper JSON document that you see in

405{-| 'EsResult' describes the standard wrapper JSON document that you see in

374− successful Elasticsearch responses.

406+ successful Elasticsearch lookups or lookups that couldn't find the document.

375-}

407-}

376data EsResult a = EsResult { _index :: Text

408data EsResult a = EsResult { _index :: Text

377 , _type :: Text

409 , _type :: Text

378 , _id :: Text

410 , _id :: Text

379− , _version :: Int

411+ , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)

380− , found :: Maybe Bool

412+

413+

414+{-| 'EsResultFound' contains the document and its metadata inside of an

415+ 'EsResult' when the document was successfully found.

416+-}

417+data EsResultFound a = EsResultFound { _version :: DocVersion

381− , _source :: a } deriving (Eq, Show)

418+ , _source :: a } deriving (Eq, Show)

419+

420+

421+

422+{-| 'DocVersion' is an integer version number for a document between 1

423+and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.

424+-}

425+newtype DocVersion = DocVersion {

426+ docVersionNumber :: Int

427+ } deriving (Eq, Show, Ord, ToJSON)

428+

429+-- | Smart constructor for in-range doc version

430+mkDocVersion :: Int -> Maybe DocVersion

431+mkDocVersion i

432+ | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =

433+ Just $ DocVersion i

434+ | otherwise = Nothing

435+

436+

437+{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its

438+own version numbers instead of ones from ES.

439+-}

440+newtype ExternalDocVersion = ExternalDocVersion DocVersion

441+ deriving (Eq, Show, Ord, Bounded, Enum, ToJSON)

442+

443+{-| 'VersionControl' is specified when indexing documents as a

444+optimistic concurrency control.

445+-}

446+data VersionControl = NoVersionControl

447+ -- ^ Don't send a version. This is a pure overwrite.

448+ | InternalVersion DocVersion

449+ -- ^ Use the default ES versioning scheme. Only

450+ -- index the document if the version is the same

451+ -- as the one specified. Only applicable to

452+ -- updates, as you should be getting Version from

453+ -- a search result.

454+ | ExternalGT ExternalDocVersion

455+ -- ^ Use your own version numbering. Only index

456+ -- the document if the version is strictly higher

457+ -- OR the document doesn't exist. The given

458+ -- version will be used as the new version number

459+ -- for the stored document. N.B. All updates must

460+ -- increment this number, meaning there is some

461+ -- global, external ordering of updates.

462+ | ExternalGTE ExternalDocVersion

463+ -- ^ Use your own version numbering. Only index

464+ -- the document if the version is equal or higher

465+ -- than the stored version. Will succeed if there

466+ -- is no existing document. The given version will

467+ -- be used as the new version number for the

468+ -- stored document. Use with care, as this could

469+ -- result in data loss.

470+ | ForceVersion ExternalDocVersion

471+ -- ^ The document will always be indexed and the

472+ -- given version will be the new version. This is

473+ -- typically used for correcting errors. Use with

474+ -- care, as this could result in data loss.

475+ deriving (Show, Eq, Ord)

476+

477+{-| 'DocumentParent' is used to specify a parent document.

478+-}

479+newtype DocumentParent = DocumentParent DocId

480+ deriving (Eq, Show)

481+

482+{-| 'IndexDocumentSettings' are special settings supplied when indexing

483+a document. For the best backwards compatiblity when new fields are

484+added, you should probably prefer to start with 'defaultIndexDocumentSettings'

485+-}

486+data IndexDocumentSettings =

487+ IndexDocumentSettings { idsVersionControl :: VersionControl

488+ , idsParent :: Maybe DocumentParent

489+ } deriving (Eq, Show)

490+

491+{-| Reasonable default settings. Chooses no version control and no parent.

492+-}

493+defaultIndexDocumentSettings :: IndexDocumentSettings

494+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing

382

495

383{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order

496{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order

384 dependent with later sorts acting as tie-breakers for earlier sorts.

497 dependent with later sorts acting as tie-breakers for earlier sorts.

@@ -474,6 +587,14 @@ newtype Server = Server Text deriving (Eq, Show)

474-}

587-}

475newtype IndexName = IndexName Text deriving (Eq, Generic, Show)

588newtype IndexName = IndexName Text deriving (Eq, Generic, Show)

476

589

590+{-| 'TemplateName' is used to describe which template to query/create/delete

591+-}

592+newtype TemplateName = TemplateName Text deriving (Eq, Show, Generic)

593+

594+{-| 'TemplatePattern' represents a pattern which is matched against index names

595+-}

596+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, Generic)

597+

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

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

478 the data in the indices.

599 the data in the indices.

479-}

600-}

@@ -494,6 +615,12 @@ newtype QueryString = QueryString Text deriving (Eq, Generic, Show)

494-}

615-}

495newtype FieldName = FieldName Text deriving (Eq, Show)

616newtype FieldName = FieldName Text deriving (Eq, Show)

496

617

618+

619+{-| 'Script' is often used in place of 'FieldName' to specify more

620+complex ways of extracting a value from a document.

621+-}

622+newtype Script = Script { scriptText :: Text } deriving (Eq, Show)

623+

497{-| 'CacheName' is used in 'RegexpFilter' for describing the

624{-| 'CacheName' is used in 'RegexpFilter' for describing the

498 'CacheKey' keyed caching behavior.

625 'CacheKey' keyed caching behavior.

499-}

626-}

@@ -610,6 +737,7 @@ data Search = Search { queryBody :: Maybe Query

610 , trackSortScores :: TrackSortScores

737 , trackSortScores :: TrackSortScores

611 , from :: From

738 , from :: From

612 , size :: Size

739 , size :: Size

740+ , fields :: Maybe [FieldName]

613 , source :: Maybe Source } deriving (Eq, Show)

741 , source :: Maybe Source } deriving (Eq, Show)

614

742

615data Source =

743data Source =

@@ -1006,6 +1134,7 @@ data Filter = AndFilter [Filter] Cache

1006 | LimitFilter Int

1134 | LimitFilter Int

1007 | MissingFilter FieldName Existence NullValue

1135 | MissingFilter FieldName Existence NullValue

1008 | PrefixFilter FieldName PrefixValue Cache

1136 | PrefixFilter FieldName PrefixValue Cache

1137+ | QueryFilter Query Cache

1009 | RangeFilter FieldName RangeValue RangeExecution Cache

1138 | RangeFilter FieldName RangeValue RangeExecution Cache

1010 | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey

1139 | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey

1011 | TermFilter Term Cache

1140 | TermFilter Term Cache

@@ -1210,7 +1339,9 @@ data Interval = Year

1210 | FractionalInterval Float TimeInterval deriving (Eq, Show)

1339 | FractionalInterval Float TimeInterval deriving (Eq, Show)

1211

1340

1212data Aggregation = TermsAgg TermsAggregation

1341data Aggregation = TermsAgg TermsAggregation

1213− | DateHistogramAgg DateHistogramAggregation deriving (Eq, Show)

1342+ | DateHistogramAgg DateHistogramAggregation

1343+ | ValueCountAgg ValueCountAggregation

1344+ | FilterAgg FilterAggregation deriving (Eq, Show)

1214

1345

1215

1346

1216data TermsAggregation = TermsAggregation { term :: Either Text Text

1347data TermsAggregation = TermsAggregation { term :: Either Text Text

@@ -1228,6 +1359,7 @@ data TermsAggregation = TermsAggregation { term :: Either Text Text

1228data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName

1359data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName

1229 , dateInterval :: Interval

1360 , dateInterval :: Interval

1230 , dateFormat :: Maybe Text

1361 , dateFormat :: Maybe Text

1362+ -- pre and post deprecated in 1.5

1231 , datePreZone :: Maybe Text

1363 , datePreZone :: Maybe Text

1232 , datePostZone :: Maybe Text

1364 , datePostZone :: Maybe Text

1233 , datePreOffset :: Maybe Text

1365 , datePreOffset :: Maybe Text

@@ -1235,6 +1367,13 @@ data DateHistogramAggregation = DateHistogramAggregation { dateField :: Fie

1235 , dateAggs :: Maybe Aggregations

1367 , dateAggs :: Maybe Aggregations

1236 } deriving (Eq, Show)

1368 } deriving (Eq, Show)

1237

1369

1370+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.

1371+data ValueCountAggregation = FieldValueCount FieldName

1372+ | ScriptValueCount Script deriving (Eq, Show)

1373+

1374+-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.

1375+data FilterAggregation = FilterAggregation { faFilter :: Filter

1376+ , faAggs :: Maybe Aggregations} deriving (Eq, Show)

1238

1377

1239mkTermsAggregation :: Text -> TermsAggregation

1378mkTermsAggregation :: Text -> TermsAggregation

1240mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

1379mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

@@ -1308,6 +1447,13 @@ instance ToJSON Aggregation where

1308 "post_offset" .= postOffset

1447 "post_offset" .= postOffset

1309 ],

1448 ],

1310 "aggs" .= dateHistoAggs ]

1449 "aggs" .= dateHistoAggs ]

1450+ toJSON (ValueCountAgg a) = object ["value_count" .= v]

1451+ where v = case a of

1452+ (FieldValueCount (FieldName n)) -> object ["field" .= n]

1453+ (ScriptValueCount (Script s)) -> object ["script" .= s]

1454+ toJSON (FilterAgg (FilterAggregation filt ags)) =

1455+ omitNulls [ "filter" .= filt

1456+ , "aggs" .= ags]

1311

1457

1312type AggregationResults = M.Map Text Value

1458type AggregationResults = M.Map Text Value

1313

1459

@@ -1447,6 +1593,13 @@ instance ToJSON Filter where

1447 object [fieldName .= fieldValue

1593 object [fieldName .= fieldValue

1448 , "_cache" .= cache]]

1594 , "_cache" .= cache]]

1449

1595

1596+ toJSON (QueryFilter query False) =

1597+ object ["query" .= toJSON query ]

1598+ toJSON (QueryFilter query True) =

1599+ object ["fquery" .=

1600+ object [ "query" .= toJSON query

1601+ , "_cache" .= True ]]

1602+

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

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

1451 object ["range" .=

1604 object ["range" .=

1452 object [ fieldName .= object (rangeValueToPair rangeValue)

1605 object [ fieldName .= object (rangeValueToPair rangeValue)

@@ -1887,6 +2040,8 @@ instance ToJSON IgnoreTermFrequency

1887instance ToJSON MaxQueryTerms

2040instance ToJSON MaxQueryTerms

1888instance ToJSON TypeName

2041instance ToJSON TypeName

1889instance ToJSON IndexName

2042instance ToJSON IndexName

2043+instance ToJSON TemplateName

2044+instance ToJSON TemplatePattern

1890instance ToJSON BoostTerms

2045instance ToJSON BoostTerms

1891instance ToJSON MaxWordLength

2046instance ToJSON MaxWordLength

1892instance ToJSON MinWordLength

2047instance ToJSON MinWordLength

@@ -1923,22 +2078,43 @@ instance FromJSON Status where

1923

2078

1924

2079

1925instance ToJSON IndexSettings where

2080instance ToJSON IndexSettings where

1926− toJSON (IndexSettings s r) = object ["settings" .= object ["shards" .= s, "replicas" .= r]]

2081+ toJSON (IndexSettings s r) = object ["settings" .=

1927−

2082+ object ["index" .=

2083+ object ["number_of_shards" .= s, "number_of_replicas" .= r]

2084+ ]

2085+ ]

2086+

2087+instance ToJSON IndexTemplate where

2088+ toJSON (IndexTemplate p s m) = merge

2089+ (object [ "template" .= p

2090+ , "mappings" .= foldl' merge (object []) m

2091+ ])

2092+ (toJSON s)

2093+ where

2094+ merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2

2095+ merge o Null = o

2096+ merge _ _ = undefined

1928

2097

1929instance (FromJSON a) => FromJSON (EsResult a) where

2098instance (FromJSON a) => FromJSON (EsResult a) where

1930− parseJSON (Object v) = EsResult <$>

2099+ parseJSON jsonVal@(Object v) = do

2100+ found <- v .:? "found" .!= False

2101+ fr <- if found

2102+ then parseJSON jsonVal

2103+ else return Nothing

1931− v .: "_index" <*>

2104+ EsResult <$> v .: "_index" <*>

1932− v .: "_type" <*>

2105+ v .: "_type" <*>

1933− v .: "_id" <*>

2106+ v .: "_id" <*>

1934− v .: "_version" <*>

2107+ pure fr

1935− v .:? "found" <*>

1936− v .: "_source"

1937 parseJSON _ = empty

2108 parseJSON _ = empty

1938

2109

2110+instance (FromJSON a) => FromJSON (EsResultFound a) where

2111+ parseJSON (Object v) = EsResultFound <$>

2112+ v .: "_version" <*>

2113+ v .: "_source"

2114+ parseJSON _ = empty

1939

2115

1940instance ToJSON Search where

2116instance ToJSON Search where

1941− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize sSource) =

2117+ toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize sFields sSource) =

1942 omitNulls [ "query" .= query

2118 omitNulls [ "query" .= query

1943 , "filter" .= sFilter

2119 , "filter" .= sFilter

1944 , "sort" .= sort

2120 , "sort" .= sort

@@ -1947,6 +2123,7 @@ instance ToJSON Search where

1947 , "from" .= sFrom

2123 , "from" .= sFrom

1948 , "size" .= sSize

2124 , "size" .= sSize

1949 , "track_scores" .= sTrackSortScores

2125 , "track_scores" .= sTrackSortScores

2126+ , "fields" .= sFields

1950 , "_source" .= sSource]

2127 , "_source" .= sSource]

1951

2128

1952

2129

@@ -2212,3 +2389,26 @@ instance FromJSON ShardResult where

2212 v .: "successful" <*>

2389 v .: "successful" <*>

2213 v .: "failed"

2390 v .: "failed"

2214 parseJSON _ = empty

2391 parseJSON _ = empty

2392+

2393+

2394+instance FromJSON DocVersion where

2395+ parseJSON v = do

2396+ i <- parseJSON v

2397+ maybe (fail "DocVersion out of range") return $ mkDocVersion i

2398+

2399+instance Bounded DocVersion where

2400+ minBound = DocVersion 1

2401+ maxBound = DocVersion 9200000000000000000 -- 9.2e+18

2402+

2403+instance Enum DocVersion where

2404+ succ x

2405+ | x /= maxBound = DocVersion (succ $ docVersionNumber x)

2406+ | otherwise = succError "DocVersion"

2407+ pred x

2408+ | x /= minBound = DocVersion (pred $ docVersionNumber x)

2409+ | otherwise = predError "DocVersion"

2410+ toEnum i =

2411+ fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i

2412+ fromEnum = docVersionNumber

2413+ enumFrom = boundedEnumFrom

2414+ enumFromThen = boundedEnumFromThen

stack.yaml+2−1

@@ -2,7 +2,8 @@ flags: {}

2packages:

3- '.'

4extra-deps:

5+- doctest-0.10.1

5- doctest-prop-0.2.0.1

6- doctest-prop-0.2.0.1

6- quickcheck-properties-0.1

7- quickcheck-properties-0.1

7- uri-bytestring-0.1.2

8- uri-bytestring-0.1.2

8−resolver: lts-2.11

9+resolver: lts-2.18

tests/doctests.hsnew file+4

@@ -0,0 +1,4 @@

1+import Test.DocTest

3+main :: IO ()

4+main = doctest ["-i src", "Database.Bloodhound"]

tests/doctests.hscdeleted−74

@@ -1,74 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ForeignFunctionInterface #-}

3−-----------------------------------------------------------------------------

4−-- |

5−-- Module : Main (doctests)

7−-- License : BSD-style (see the file LICENSE)

8−-- Maintainer : Chris Allen <cma@bitemyapp.com>

9−-- Stability : provisional

10−-- Portability : portable

11−--

12−-- This module provides doctests for a project based on the actual versions

13−-- of the packages it was built with. It requires a corresponding Setup.lhs

14−-- to be added to the project

15−-----------------------------------------------------------------------------

16−

17−module Main where

18−

19−import Build_doctests (deps)

20−import Control.Applicative

21−import Control.Monad

22−import Data.List

23−import System.Directory

24−import System.FilePath

25−import Test.DocTest

26−

27−##if defined(mingw32_HOST_OS)

28−##if defined(i386_HOST_ARCH)

29−##define USE_CP

30−import Control.Applicative

31−import Control.Exception

32−import Foreign.C.Types

33−foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool

34−foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt

35−##elif defined(x86_64_HOST_ARCH)

36−##define USE_CP

37−import Control.Applicative

38−import Control.Exception

39−import Foreign.C.Types

40−foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool

41−foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt

42−##endif

43−##endif

44−

45−-- | Run in a modified codepage where we can print UTF-8 values on Windows.

46−withUnicode :: IO a -> IO a

47−##ifdef USE_CP

48−withUnicode m = do

49− cp <- c_GetConsoleCP

50− (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp

51−##else

52−withUnicode m = m

53−##endif

54−

55−main :: IO ()

56−main = withUnicode $ getSources >>= \sources -> doctest $

57− "-isrc"

58− : "-idist/build/autogen"

59− : "-optP-include"

60− : "-optPdist/build/autogen/cabal_macros.h"

61− : "-hide-all-packages"

62− : map ("-package="++) deps ++ sources

63−

64−getSources :: IO [FilePath]

65−getSources = filter (isSuffixOf ".hs") <$> go "src"

66− where

67− go dir = do

68− (dirs, files) <- getFilesAndDirectories dir

69− (files ++) . concat <$> mapM go dirs

70−

71−getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])

72−getFilesAndDirectories dir = do

73− c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir

74− (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

tests/tests.hs+158−46

@@ -5,6 +5,7 @@

5module Main where

7import Control.Applicative

8+import Control.Exception

8import Control.Monad

9import Control.Monad

9import Control.Monad.Reader

10import Control.Monad.Reader

10import Data.Aeson

11import Data.Aeson

@@ -13,6 +14,7 @@ import Data.List (nub)

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

14import Data.List.NonEmpty (NonEmpty (..))

14import qualified Data.List.NonEmpty as NE

15import qualified Data.List.NonEmpty as NE

15import qualified Data.Map.Strict as M

16import qualified Data.Map.Strict as M

17+import Data.Monoid

16import Data.Text (Text)

18import Data.Text (Text)

17import qualified Data.Text as T

19import qualified Data.Text as T

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

20import Data.Time.Calendar (Day (..))

@@ -23,9 +25,9 @@ import Database.Bloodhound

23import GHC.Generics (Generic)

25import GHC.Generics (Generic)

24import Network.HTTP.Client

26import Network.HTTP.Client

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

27import qualified Network.HTTP.Types.Status as NHTS

26−import Prelude hiding (filter, putStrLn)

28+import Prelude hiding (filter)

27import Test.Hspec

29import Test.Hspec

28−import Test.QuickCheck.Property.Monoid

30+import Test.QuickCheck.Property.Monoid (prop_Monoid, eq, T(..))

30import Test.Hspec.QuickCheck (prop)

32import Test.Hspec.QuickCheck (prop)

31import Test.QuickCheck

33import Test.QuickCheck

@@ -46,7 +48,7 @@ validateStatus resp expected =

46 `shouldBe` (expected :: Int)

48 `shouldBe` (expected :: Int)

48createExampleIndex :: BH IO Reply

50createExampleIndex :: BH IO Reply

49−createExampleIndex = createIndex defaultIndexSettings testIndex

51+createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex

50deleteExampleIndex :: BH IO Reply

52deleteExampleIndex :: BH IO Reply

51deleteExampleIndex = deleteIndex testIndex

53deleteExampleIndex = deleteIndex testIndex

@@ -120,7 +122,14 @@ instance ToJSON TweetMapping where

120 toJSON TweetMapping =

122 toJSON TweetMapping =

121 object ["tweet" .=

123 object ["tweet" .=

122 object ["properties" .=

124 object ["properties" .=

125+ object [ "user" .= object ["type" .= ("string" :: Text)]

126+ -- Serializing the date as a date is breaking other tests, mysteriously.

127+ -- , "postDate" .= object [ "type" .= ("date" :: Text)

128+ -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]

129+ , "message" .= object ["type" .= ("string" :: Text)]

130+ , "age" .= object ["type" .= ("integer" :: Text)]

123− object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]

131+ , "location" .= object ["type" .= ("geo_point" :: Text)]

132+ ]]]

124

133

125exampleTweet :: Tweet

134exampleTweet :: Tweet

126exampleTweet = Tweet { user = "bitemyapp"

135exampleTweet = Tweet { user = "bitemyapp"

@@ -140,32 +149,42 @@ otherTweet = Tweet { user = "notmyapp"

140 , age = 1000

149 , age = 1000

141 , location = Location 40.12 (-71.34) }

150 , location = Location 40.12 (-71.34) }

142

151

143−insertData :: BH IO ()

152+resetIndex :: BH IO ()

144−insertData = do

153+resetIndex = do

145 _ <- deleteExampleIndex

154 _ <- deleteExampleIndex

146 _ <- createExampleIndex

155 _ <- createExampleIndex

147 _ <- putMapping testIndex testMapping TweetMapping

156 _ <- putMapping testIndex testMapping TweetMapping

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

149− _ <- refreshIndex testIndex

150 return ()

157 return ()

151

158

159+insertData :: BH IO Reply

160+insertData = do

161+ resetIndex

162+ insertData' defaultIndexDocumentSettings

163+

164+insertData' :: IndexDocumentSettings -> BH IO Reply

165+insertData' ids = do

166+ r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")

167+ _ <- refreshIndex testIndex

168+ return r

169+

152insertOther :: BH IO ()

170insertOther :: BH IO ()

153insertOther = do

171insertOther = do

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

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

155 _ <- refreshIndex testIndex

173 _ <- refreshIndex testIndex

156 return ()

174 return ()

157

175

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

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

159searchTweet search = do

177searchTweet search = do

160− reply <- searchByIndex testIndex search

178+ result <- searchTweets search

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

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

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

163 return myTweet

180 return myTweet

164

181

182+searchTweets :: Search -> BH IO (Either String (SearchResult Tweet))

183+searchTweets search = eitherDecode . responseBody <$> searchByIndex testIndex search

184+

165searchExpectNoResults :: Search -> BH IO ()

185searchExpectNoResults :: Search -> BH IO ()

166searchExpectNoResults search = do

186searchExpectNoResults search = do

167− reply <- searchByIndex testIndex search

187+ result <- searchTweets search

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

169 let emptyHits = fmap (hits . searchHits) result

188 let emptyHits = fmap (hits . searchHits) result

170 liftIO $

189 liftIO $

171 emptyHits `shouldBe` Right []

190 emptyHits `shouldBe` Right []

@@ -178,7 +197,8 @@ searchExpectAggs search = do

178 liftIO $

197 liftIO $

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

198 (result >>= aggregations >>= isEmpty) `shouldBe` Just False

180

199

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

200+searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>

201+ Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()

182searchValidBucketAgg search aggKey extractor = do

202searchValidBucketAgg search aggKey extractor = do

183 reply <- searchAll search

203 reply <- searchAll search

184 let bucketDocs = docCount . head . buckets

204 let bucketDocs = docCount . head . buckets

@@ -196,8 +216,7 @@ searchTermsAggHint hints = do

196

216

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

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

198searchTweetHighlight search = do

218searchTweetHighlight search = do

199− reply <- searchByIndex testIndex search

219+ result <- searchTweets search

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

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

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

202 return myHighlight

221 return myHighlight

203

222

@@ -271,6 +290,9 @@ instance Arbitrary a => Arbitrary (SearchHits a) where

271 hs <- arbitrary

290 hs <- arbitrary

272 return $ SearchHits tot score hs

291 return $ SearchHits tot score hs

273

292

293+getSource :: EsResult a -> Maybe a

294+getSource = fmap _source . foundResult

295+

274main :: IO ()

296main :: IO ()

275main = hspec $ do

297main = hspec $ do

276

298

@@ -291,8 +313,40 @@ main = hspec $ do

291 docInserted <- getDocument testIndex testMapping (DocId "1")

313 docInserted <- getDocument testIndex testMapping (DocId "1")

292 let newTweet = eitherDecode

314 let newTweet = eitherDecode

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

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

294− liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)

316+ liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))

295−

317+

318+ it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do

319+ doc <- getDocument testIndex testMapping (DocId "bogus")

320+ let noTweet = eitherDecode

321+ (responseBody doc) :: Either String (EsResult Tweet)

322+ liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing

323+

324+ it "can use optimistic concurrency control" $ withTestEnv $ do

325+ let ev = ExternalDocVersion minBound

326+ let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }

327+ resetIndex

328+ res <- insertData' cfg

329+ liftIO $ isCreated res `shouldBe` True

330+ res' <- insertData' cfg

331+ liftIO $ isVersionConflict res' `shouldBe` True

332+

333+ describe "template API" $ do

334+ it "can create a template" $ withTestEnv $ do

335+ let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]

336+ resp <- putTemplate idxTpl (TemplateName "tweet-tpl")

337+ liftIO $ validateStatus resp 200

338+

339+ it "can detect if a template exists" $ withTestEnv $ do

340+ exists <- templateExists (TemplateName "tweet-tpl")

341+ liftIO $ exists `shouldBe` True

342+

343+ it "can delete a template" $ withTestEnv $ do

344+ resp <- deleteTemplate (TemplateName "tweet-tpl")

345+ liftIO $ validateStatus resp 200

346+

347+ it "can detect if a template doesn't exist" $ withTestEnv $ do

348+ exists <- templateExists (TemplateName "tweet-tpl")

349+ liftIO $ exists `shouldBe` False

296

350

297 describe "bulk API" $ do

351 describe "bulk API" $ do

298 it "inserts all documents we request" $ withTestEnv $ do

352 it "inserts all documents we request" $ withTestEnv $ do

@@ -311,8 +365,8 @@ main = hspec $ do

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

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

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

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

313 liftIO $ do

367 liftIO $ do

314− fmap _source maybeFirst `shouldBe` Right firstTest

368+ fmap getSource maybeFirst `shouldBe` Right (Just firstTest)

315− fmap _source maybeSecond `shouldBe` Right secondTest

369+ fmap getSource maybeSecond `shouldBe` Right (Just secondTest)

316

370

317

371

318 describe "query API" $ do

372 describe "query API" $ do

@@ -344,8 +398,8 @@ main = hspec $ do

344

398

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

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

346 _ <- insertData

400 _ <- insertData

347− let fields = [FieldName "user", FieldName "message"]

401+ let flds = [FieldName "user", FieldName "message"]

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

402+ let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")

349 let search = mkSearch (Just query) Nothing

403 let search = mkSearch (Just query) Nothing

350 myTweet <- searchTweet search

404 myTweet <- searchTweet search

351 liftIO $

405 liftIO $

@@ -392,9 +446,8 @@ main = hspec $ do

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

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

393 let search = Search Nothing

447 let search = Search Nothing

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

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

395− False (From 0) (Size 10) Nothing

449+ False (From 0) (Size 10) Nothing Nothing

396− reply <- searchByIndex testIndex search

450+ result <- searchTweets search

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

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

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

399 liftIO $

452 liftIO $

400 myTweet `shouldBe` Right otherTweet

453 myTweet `shouldBe` Right otherTweet

@@ -517,8 +570,8 @@ main = hspec $ do

517 let filter = RangeFilter (FieldName "postDate")

570 let filter = RangeFilter (FieldName "postDate")

518 (RangeDateGtLt

571 (RangeDateGtLt

519 (GreaterThanD (UTCTime

572 (GreaterThanD (UTCTime

520− (ModifiedJulianDay 55000)

573+ (ModifiedJulianDay 54000)

521− (secondsToDiffTime 9)))

574+ (secondsToDiffTime 0)))

522 (LessThanD (UTCTime

575 (LessThanD (UTCTime

523 (ModifiedJulianDay 55000)

576 (ModifiedJulianDay 55000)

524 (secondsToDiffTime 11))))

577 (secondsToDiffTime 11))))

@@ -528,7 +581,6 @@ main = hspec $ do

528 liftIO $

581 liftIO $

529 myTweet `shouldBe` Right exampleTweet

582 myTweet `shouldBe` Right exampleTweet

530

583

531−

532 it "returns document for regexp filter" $ withTestEnv $ do

584 it "returns document for regexp filter" $ withTestEnv $ do

533 _ <- insertData

585 _ <- insertData

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

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

@@ -546,6 +598,20 @@ main = hspec $ do

546 let search = mkSearch Nothing (Just filter)

598 let search = mkSearch Nothing (Just filter)

547 searchExpectNoResults search

599 searchExpectNoResults search

548

600

601+ it "returns document for query filter, uncached" $ withTestEnv $ do

602+ _ <- insertData

603+ let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True

604+ search = mkSearch Nothing (Just filter)

605+ myTweet <- searchTweet search

606+ liftIO $ myTweet `shouldBe` Right exampleTweet

607+

608+ it "returns document for query filter, cached" $ withTestEnv $ do

609+ _ <- insertData

610+ let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False

611+ search = mkSearch Nothing (Just filter)

612+ myTweet <- searchTweet search

613+ liftIO $ myTweet `shouldBe` Right exampleTweet

614+

549 describe "Aggregation API" $ do

615 describe "Aggregation API" $ do

550 it "returns term aggregation results" $ withTestEnv $ do

616 it "returns term aggregation results" $ withTestEnv $ do

551 _ <- insertData

617 _ <- insertData

@@ -561,36 +627,63 @@ main = hspec $ do

561 searchExpectAggs search

627 searchExpectAggs search

562 searchValidBucketAgg search "users" toTerms

628 searchValidBucketAgg search "users" toTerms

563

629

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

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

565 _ <- insertData

631 _ <- insertData

566 searchTermsAggHint [Map, Ordinals]

632 searchTermsAggHint [Map, Ordinals]

567

633

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

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

569 _ <- insertData

635 _ <- insertData

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

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

571

637

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

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

573 _ <- insertData

639 _ <- insertData

574 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

640 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

575

641

576− it "returns date histogram aggregation results" $ withTestEnv $ do

642+

643+ it "can execute value_count aggregations" $ withTestEnv $ do

577 _ <- insertData

644 _ <- insertData

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

645+ _ <- insertOther

646+ let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>

647+ mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))

579− let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)

648+ let search = mkAggregateSearch Nothing ags

580− searchExpectAggs search

649+ let docCountPair k n = (k, object ["value" .= Number n])

581− searchValidBucketAgg search "byDate" toDateHistogram

650+ res <- searchTweets search

651+ liftIO $

652+ fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2

653+ , docCountPair "bogus_count" 0

654+ ]))

582

655

583− it "returns date histogram using fractional date" $ withTestEnv $ do

656+ it "can execute filter aggregations" $ withTestEnv $ do

584 _ <- insertData

657 _ <- insertData

658+ _ <- insertOther

659+ let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>

660+ mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))

661+ let search = mkAggregateSearch Nothing ags

662+ let docCountPair k n = (k, object ["doc_count" .= Number n])

663+ res <- searchTweets search

664+ liftIO $

665+ fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1

666+ , docCountPair "notmyapps" 1

667+ ]))

668+ -- Interaction of date serialization and date histogram aggregation is broken.

669+ -- it "returns date histogram aggregation results" $ withTestEnv $ do

670+ -- _ <- insertData

671+ -- let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute

672+ -- let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)

673+ -- searchExpectAggs search

674+ -- searchValidBucketAgg search "byDate" toDateHistogram

675+

676+ -- it "returns date histogram using fractional date" $ withTestEnv $ do

677+ -- _ <- insertData

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

678+ -- let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]

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

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

587− let intervals = periods ++ fractionals

680+ -- let intervals = periods ++ fractionals

588− let histogram = mkDateHistogram (FieldName "postDate")

681+ -- let histogram = mkDateHistogram (FieldName "postDate")

589− let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)

682+ -- let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)

590− let expect interval = searchExpectAggs (search interval)

683+ -- let expect interval = searchExpectAggs (search interval)

591− let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram

684+ -- let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram

592− forM_ intervals expect

685+ -- forM_ intervals expect

593− forM_ intervals valid

686+ -- forM_ intervals valid

594

687

595 describe "Highlights API" $ do

688 describe "Highlights API" $ do

596

689

@@ -686,3 +779,22 @@ main = hspec $ do

686 describe "Monoid (SearchHits a)" $ do

779 describe "Monoid (SearchHits a)" $ do

687 prop "abides the monoid laws" $ eq $

780 prop "abides the monoid laws" $ eq $

688 prop_Monoid (T :: T (SearchHits ()))

781 prop_Monoid (T :: T (SearchHits ()))

782+

783+ describe "mkDocVersion" $ do

784+ prop "can never construct an out of range docVersion" $ \i ->

785+ let res = mkDocVersion i

786+ in case res of

787+ Nothing -> property True

788+ Just dv -> (dv >= minBound) .&&.

789+ (dv <= maxBound) .&&.

790+ docVersionNumber dv === i

791+

792+ describe "Enum DocVersion" $ do

793+ it "follows the laws of Enum, Bounded" $ do

794+ evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall

795+ evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall

796+ evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall

797+ evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall

798+ enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]

799+ enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]

800+ enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]

upload-docs.sh+1−1

@@ -10,7 +10,7 @@ if [ ! -f "$cabal_file" ]; then

10fi

12pkg=bloodhound

13−ver=0.6.0.0

13+ver=0.7.0.1

15if [ -z "$pkg" ]; then

16 echo "Unable to determine package name"