53c397e · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Merge remote-tracking branch 'upstream/master' into scanType

53c397eJosh Berman11 years ago

README.md+30−18

compare with master

unifiedsplit

@@ -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+12−5

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

1name: bloodhound

2−version: 0.6.0.2

2+version: 0.7.1.0

3synopsis: ElasticSearch client library for Haskell

4description: ElasticSearch made awesome for Haskell hackers

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

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

34 mtl >= 1.0 && <2.3,

35 transformers >= 0.2 && <0.5,

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

37− vector >= 0.10.9 && <0.11,

37+ vector >= 0.10.9 && <0.12,

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

39 exceptions,

40− data-default-class

40+ data-default-class,

41+ blaze-builder,

42+ unordered-containers

41 default-language: Haskell2010

43 default-language: Haskell2010

43test-suite tests

45test-suite tests

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

64 default-language: Haskell2010

66 default-language: Haskell2010

66test-suite doctests

68test-suite doctests

69+ ghc-options: -threaded -Wall

67 default-language: Haskell2010

70 default-language: Haskell2010

68 type: exitcode-stdio-1.0

71 type: exitcode-stdio-1.0

69 main-is: doctests.hs

72 main-is: doctests.hs

70− hs-source-dirs: tests

73+ hs-source-dirs: tests, src

71 if impl(ghc >= 7.8)

74 if impl(ghc >= 7.8)

72 build-depends: base,

75 build-depends: base,

73 directory,

76 directory,

74− doctest,

77+ doctest >= 0.10.1,

75 doctest-prop,

78 doctest-prop,

76 filepath

79 filepath

77 else

80 else

78 buildable: False

81 buildable: False

82+

83+Source-Repository head

84+ Type: git

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

changelog.md+7

@@ -1,3 +1,10 @@

1+0.7.0.0

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

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

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

10.6.0.1

80.6.0.1

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

9===================

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

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

@@ -48,9 +51,14 @@ module Database.Bloodhound.Client

48 , getStatus

51 , getStatus

49 , encodeBulkOperations

52 , encodeBulkOperations

50 , encodeBulkOperation

53 , encodeBulkOperation

54+ -- * Reply-handling tools

55+ , isVersionConflict

56+ , isSuccess

57+ , isCreated

51 )

58 )

52 where

59 where

61+import qualified Blaze.ByteString.Builder as BB

54import Control.Applicative

62import Control.Applicative

55import Control.Monad

63import Control.Monad

56import Control.Monad.Catch

64import Control.Monad.Catch

@@ -59,8 +67,9 @@ import Data.Aeson

59import Data.ByteString.Lazy.Builder

67import Data.ByteString.Lazy.Builder

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

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

61import Data.Default.Class

69import Data.Default.Class

70+import Data.Ix

62import Data.Maybe (fromMaybe)

71import Data.Maybe (fromMaybe)

63−import Data.Monoid ((<>))

72+import Data.Monoid

64import Data.Text (Text)

73import Data.Text (Text)

65import qualified Data.Text as T

74import qualified Data.Text as T

66import qualified Data.Text.Encoding as T

75import qualified Data.Text.Encoding as T

@@ -68,6 +77,7 @@ import qualified Data.Vector as V

68import Network.HTTP.Client

77import Network.HTTP.Client

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

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

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

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

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

71import Prelude hiding (filter, head)

81import Prelude hiding (filter, head)

72import URI.ByteString hiding (Query)

82import URI.ByteString hiding (Query)

@@ -82,7 +92,7 @@ import Database.Bloodhound.Types

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

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

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

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

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

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

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

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

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

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

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

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

88-- >>> import GHC.Generics

98-- >>> import GHC.Generics

@@ -162,14 +172,8 @@ joinPath ps = do

162 Server s <- bhServer <$> getBHEnv

172 Server s <- bhServer <$> getBHEnv

163 return $ joinPath' (s:ps)

173 return $ joinPath' (s:ps)

164

174

165−appendQueryParam :: Text -> Text -> Text

166−appendQueryParam originalUrl newParams = originalUrl <> joiner <> newParams

167− where joiner

168− | T.any (== '?') originalUrl = "&"

169− | otherwise = "?"

170−

171appendSearchTypeParam :: Text -> SearchType -> Text

175appendSearchTypeParam :: Text -> SearchType -> Text

172−appendSearchTypeParam originalUrl st = appendQueryParam originalUrl (keyEq <> stParams)

176+appendSearchTypeParam originalUrl st = addQuery [(keyEq, Just stParams)] originalUrl

173 where keyEq = "search_type="

177 where keyEq = "search_type="

174 stParams

178 stParams

175 | st == SearchTypeDfsQueryThenFetch = "dfs_query_then_fetch"

179 | st == SearchTypeDfsQueryThenFetch = "dfs_query_then_fetch"

@@ -180,6 +184,15 @@ appendSearchTypeParam originalUrl st = appendQueryParam originalUrl (keyEq <> st

180 -- used to catch 'SearchTypeQueryThenFetch', which is also the default

184 -- used to catch 'SearchTypeQueryThenFetch', which is also the default

181 | otherwise = "query_then_fetch"

185 | otherwise = "query_then_fetch"

182

186

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

188+-- need any encoding

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

190+addQuery q u = u <> rendered

191+ where

192+ rendered =

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

194+ prependQuestionMark = True

195+

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

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

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

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

185

198

@@ -202,7 +215,7 @@ get = flip (dispatch NHTM.methodGet) Nothing

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

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

203head = flip (dispatch NHTM.methodHead) Nothing

216head = flip (dispatch NHTM.methodHead) Nothing

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

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

205−put = dispatch NHTM.methodPost

218+put = dispatch NHTM.methodPut

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

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

207post = dispatch NHTM.methodPost

220post = dispatch NHTM.methodPost

208

221

@@ -303,6 +316,35 @@ openIndex = openOrCloseIndexes OpenIndex

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

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

304closeIndex = openOrCloseIndexes CloseIndex

317closeIndex = openOrCloseIndexes CloseIndex

305

318

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

320+-- Explained in further detail at

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

322+--

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

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

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

326+putTemplate indexTemplate (TemplateName templateName) =

327+ bindM2 put url (return body)

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

329+ body = Just $ encode indexTemplate

330+

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

332+--

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

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

335+templateExists (TemplateName templateName) = do

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

337+ return exists

338+

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

340+--

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

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

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

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

345+deleteTemplate (TemplateName templateName) =

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

347+

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

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

307-- for documents in indexes.

349-- for documents in indexes.

308--

350--

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

314 -> MappingName -> a -> m Reply

356 -> MappingName -> a -> m Reply

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

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

316 bindM2 put url (return body)

358 bindM2 put url (return body)

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

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

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

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

318 body = Just $ encode mapping

362 body = Just $ encode mapping

319

363

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

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

@@ -328,22 +372,38 @@ putMapping (IndexName indexName) (MappingName mappingName) mapping =

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

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

329deleteMapping (IndexName indexName)

373deleteMapping (IndexName indexName)

330 (MappingName mappingName) =

374 (MappingName mappingName) =

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

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

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

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

332

378

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

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

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

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

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

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

336-- primary key for the document.

382-- primary key for the document.

337--

383--

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

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

339-- >>> print resp

385-- >>> print resp

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

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

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

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

342− -> doc -> DocId -> m Reply

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

343indexDocument (IndexName indexName)

389indexDocument (IndexName indexName)

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

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

345 bindM2 put url (return body)

391 bindM2 put url (return body)

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

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

393+ versionCtlParams = case idsVersionControl cfg of

394+ NoVersionControl -> []

395+ InternalVersion v -> versionParams v "internal"

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

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

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

399+ vt = T.pack . show . docVersionNumber

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

401+ , ("version_type", Just t)

402+ ]

403+ parentParams = case idsParent cfg of

404+ Nothing -> []

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

406+ params = versionCtlParams ++ parentParams

347 body = Just (encode document)

407 body = Just (encode document)

348

408

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

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

@@ -524,9 +584,9 @@ scanSearch search = do

524--

584--

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

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

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

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

527−-- 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}

587+-- 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}

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

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

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

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

530

590

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

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

532-- the 'Query' and the 'Aggregation'.

592-- the 'Query' and the 'Aggregation'.

@@ -536,7 +596,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From

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

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

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

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

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

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

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

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

540

600

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

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

542-- the 'Query' and the 'Aggregation'.

602-- the 'Query' and the 'Aggregation'.

@@ -545,7 +605,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear

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

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

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

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

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

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

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

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

549

609

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

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

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

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

@@ -555,9 +615,9 @@ mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing

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

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

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

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

557-- >>> search

617-- >>> search

558−-- 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}

618+-- 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}

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

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

560−-- 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}

620+-- 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}

561pageSearch :: From -- ^ The result offset

621pageSearch :: From -- ^ The result offset

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

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

563 -> Search -- ^ The current seach

623 -> Search -- ^ The current seach

@@ -591,3 +651,17 @@ setURI req URI{..} = do

591 Scheme "https" -> True

651 Scheme "https" -> True

592 _ -> False

652 _ -> False

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

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

654+

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

656+-- indexing a document?

657+isVersionConflict :: Reply -> Bool

658+isVersionConflict = statusCheck (== 409)

659+

660+isSuccess :: Reply -> Bool

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

662+

663+isCreated :: Reply -> Bool

664+isCreated = statusCheck (== 201)

665+

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

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

src/Database/Bloodhound/Types.hs+217−18

@@ -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 , SearchType(..)

71 , SearchType(..)

@@ -95,7 +105,10 @@ module Database.Bloodhound.Types

95 , RegexpFlags(..)

105 , RegexpFlags(..)

96 , RegexpFlag(..)

106 , RegexpFlag(..)

97 , FieldName(..)

107 , FieldName(..)

108+ , Script(..)

98 , IndexName(..)

109 , IndexName(..)

110+ , TemplateName(..)

111+ , TemplatePattern(..)

99 , MappingName(..)

112 , MappingName(..)

100 , DocId(..)

113 , DocId(..)

101 , CacheName(..)

114 , CacheName(..)

@@ -191,6 +204,8 @@ module Database.Bloodhound.Types

191 , Bucket(..)

204 , Bucket(..)

192 , BucketAggregation(..)

205 , BucketAggregation(..)

193 , TermsAggregation(..)

206 , TermsAggregation(..)

207+ , ValueCountAggregation(..)

208+ , FilterAggregation(..)

194 , DateHistogramAggregation(..)

209 , DateHistogramAggregation(..)

195

210

196 , Highlights(..)

211 , Highlights(..)

@@ -217,13 +232,16 @@ import Control.Monad.Writer

217import Data.Aeson

232import Data.Aeson

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

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

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

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

220−import Data.List (nub)

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

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

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

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

222import qualified Data.Map.Strict as M

238import qualified Data.Map.Strict as M

239+import Data.Maybe

223import Data.Text (Text)

240import Data.Text (Text)

224import qualified Data.Text as T

241import qualified Data.Text as T

225import Data.Time.Clock (UTCTime)

242import Data.Time.Clock (UTCTime)

226import qualified Data.Vector as V

243import qualified Data.Vector as V

244+import GHC.Enum

227import GHC.Generics (Generic)

245import GHC.Generics (Generic)

228import Network.HTTP.Client

246import Network.HTTP.Client

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

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

@@ -341,6 +359,20 @@ data FieldType = GeoPointType

341data FieldDefinition =

359data FieldDefinition =

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

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

343

361

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

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

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

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

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

367+

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

369+-}

370+data IndexTemplate =

371+ IndexTemplate { templatePattern :: TemplatePattern

372+ , templateSettings :: Maybe IndexSettings

373+ , templateMappings :: [Value]

374+ }

375+

344data MappingField =

376data MappingField =

345 MappingField { mappingFieldName :: FieldName

377 MappingField { mappingFieldName :: FieldName

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

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

@@ -368,14 +400,95 @@ data BulkOperation =

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

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

369

401

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

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

371− successful Elasticsearch responses.

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

372-}

404-}

373data EsResult a = EsResult { _index :: Text

405data EsResult a = EsResult { _index :: Text

374 , _type :: Text

406 , _type :: Text

375 , _id :: Text

407 , _id :: Text

376− , _version :: Int

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

377− , found :: Maybe Bool

409+

410+

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

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

413+-}

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

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

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

416+

417+

418+

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

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

421+-}

422+newtype DocVersion = DocVersion {

423+ docVersionNumber :: Int

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

425+

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

427+mkDocVersion :: Int -> Maybe DocVersion

428+mkDocVersion i

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

430+ Just $ DocVersion i

431+ | otherwise = Nothing

432+

433+

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

435+own version numbers instead of ones from ES.

436+-}

437+newtype ExternalDocVersion = ExternalDocVersion DocVersion

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

439+

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

441+optimistic concurrency control.

442+-}

443+data VersionControl = NoVersionControl

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

445+ | InternalVersion DocVersion

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

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

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

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

450+ -- a search result.

451+ | ExternalGT ExternalDocVersion

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

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

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

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

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

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

458+ -- global, external ordering of updates.

459+ | ExternalGTE ExternalDocVersion

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

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

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

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

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

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

466+ -- result in data loss.

467+ | ForceVersion ExternalDocVersion

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

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

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

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

472+ deriving (Show, Eq, Ord)

473+

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

475+-}

476+newtype DocumentParent = DocumentParent DocId

477+ deriving (Eq, Show)

478+

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

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

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

482+-}

483+data IndexDocumentSettings =

484+ IndexDocumentSettings { idsVersionControl :: VersionControl

485+ , idsParent :: Maybe DocumentParent

486+ } deriving (Eq, Show)

487+

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

489+-}

490+defaultIndexDocumentSettings :: IndexDocumentSettings

491+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing

379

492

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

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

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

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

@@ -471,6 +584,14 @@ newtype Server = Server Text deriving (Eq, Show)

471-}

584-}

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

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

473

586

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

588+-}

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

590+

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

592+-}

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

594+

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

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

475 the data in the indices.

596 the data in the indices.

476-}

597-}

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

491-}

612-}

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

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

493

614

615+

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

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

618+-}

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

620+

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

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

495 'CacheKey' keyed caching behavior.

622 'CacheKey' keyed caching behavior.

496-}

623-}

@@ -607,7 +734,8 @@ data Search = Search { queryBody :: Maybe Query

607 , trackSortScores :: TrackSortScores

734 , trackSortScores :: TrackSortScores

608 , from :: From

735 , from :: From

609 , size :: Size

736 , size :: Size

610− , searchType :: SearchType } deriving (Eq, Show)

737+ , searchType :: SearchType

738+ , fields :: Maybe [FieldName] } deriving (Eq, Show)

611

739

612data SearchType = SearchTypeQueryThenFetch

740data SearchType = SearchTypeQueryThenFetch

613 | SearchTypeDfsQueryThenFetch

741 | SearchTypeDfsQueryThenFetch

@@ -997,6 +1125,7 @@ data Filter = AndFilter [Filter] Cache

997 | LimitFilter Int

1125 | LimitFilter Int

998 | MissingFilter FieldName Existence NullValue

1126 | MissingFilter FieldName Existence NullValue

999 | PrefixFilter FieldName PrefixValue Cache

1127 | PrefixFilter FieldName PrefixValue Cache

1128+ | QueryFilter Query Cache

1000 | RangeFilter FieldName RangeValue RangeExecution Cache

1129 | RangeFilter FieldName RangeValue RangeExecution Cache

1001 | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey

1130 | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey

1002 | TermFilter Term Cache

1131 | TermFilter Term Cache

@@ -1204,7 +1333,9 @@ data Interval = Year

1204 | FractionalInterval Float TimeInterval deriving (Eq, Show)

1333 | FractionalInterval Float TimeInterval deriving (Eq, Show)

1205

1334

1206data Aggregation = TermsAgg TermsAggregation

1335data Aggregation = TermsAgg TermsAggregation

1207− | DateHistogramAgg DateHistogramAggregation deriving (Eq, Show)

1336+ | DateHistogramAgg DateHistogramAggregation

1337+ | ValueCountAgg ValueCountAggregation

1338+ | FilterAgg FilterAggregation deriving (Eq, Show)

1208

1339

1209

1340

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

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

@@ -1230,6 +1361,13 @@ data DateHistogramAggregation = DateHistogramAggregation { dateField :: Fie

1230 , dateAggs :: Maybe Aggregations

1361 , dateAggs :: Maybe Aggregations

1231 } deriving (Eq, Show)

1362 } deriving (Eq, Show)

1232

1363

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

1365+data ValueCountAggregation = FieldValueCount FieldName

1366+ | ScriptValueCount Script deriving (Eq, Show)

1367+

1368+-- | 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.

1369+data FilterAggregation = FilterAggregation { faFilter :: Filter

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

1233

1371

1234mkTermsAggregation :: Text -> TermsAggregation

1372mkTermsAggregation :: Text -> TermsAggregation

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

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

@@ -1303,6 +1441,13 @@ instance ToJSON Aggregation where

1303 "post_offset" .= postOffset

1441 "post_offset" .= postOffset

1304 ],

1442 ],

1305 "aggs" .= dateHistoAggs ]

1443 "aggs" .= dateHistoAggs ]

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

1445+ where v = case a of

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

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

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

1449+ omitNulls [ "filter" .= filt

1450+ , "aggs" .= ags]

1306

1451

1307type AggregationResults = M.Map Text Value

1452type AggregationResults = M.Map Text Value

1308

1453

@@ -1442,6 +1587,13 @@ instance ToJSON Filter where

1442 object [fieldName .= fieldValue

1587 object [fieldName .= fieldValue

1443 , "_cache" .= cache]]

1588 , "_cache" .= cache]]

1444

1589

1590+ toJSON (QueryFilter query False) =

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

1592+ toJSON (QueryFilter query True) =

1593+ object ["fquery" .=

1594+ object [ "query" .= toJSON query

1595+ , "_cache" .= True ]]

1596+

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

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

1446 object ["range" .=

1598 object ["range" .=

1447 object [ fieldName .= object (rangeValueToPair rangeValue)

1599 object [ fieldName .= object (rangeValueToPair rangeValue)

@@ -1882,6 +2034,8 @@ instance ToJSON IgnoreTermFrequency

1882instance ToJSON MaxQueryTerms

2034instance ToJSON MaxQueryTerms

1883instance ToJSON TypeName

2035instance ToJSON TypeName

1884instance ToJSON IndexName

2036instance ToJSON IndexName

2037+instance ToJSON TemplateName

2038+instance ToJSON TemplatePattern

1885instance ToJSON BoostTerms

2039instance ToJSON BoostTerms

1886instance ToJSON MaxWordLength

2040instance ToJSON MaxWordLength

1887instance ToJSON MinWordLength

2041instance ToJSON MinWordLength

@@ -1918,22 +2072,43 @@ instance FromJSON Status where

1918

2072

1919

2073

1920instance ToJSON IndexSettings where

2074instance ToJSON IndexSettings where

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

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

1922−

2076+ object ["index" .=

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

2078+ ]

2079+ ]

2080+

2081+instance ToJSON IndexTemplate where

2082+ toJSON (IndexTemplate p s m) = merge

2083+ (object [ "template" .= p

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

2085+ ])

2086+ (toJSON s)

2087+ where

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

2089+ merge o Null = o

2090+ merge _ _ = undefined

1923

2091

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

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

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

2093+ parseJSON jsonVal@(Object v) = do

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

2095+ fr <- if found

2096+ then parseJSON jsonVal

2097+ else return Nothing

1926− v .: "_index" <*>

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

1927− v .: "_type" <*>

2099+ v .: "_type" <*>

1928− v .: "_id" <*>

2100+ v .: "_id" <*>

1929− v .: "_version" <*>

2101+ pure fr

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

1931− v .: "_source"

1932 parseJSON _ = empty

2102 parseJSON _ = empty

1933

2103

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

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

2106+ v .: "_version" <*>

2107+ v .: "_source"

2108+ parseJSON _ = empty

1934

2109

1935instance ToJSON Search where

2110instance ToJSON Search where

1936− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _) =

2111+ toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields) =

1937 omitNulls [ "query" .= query

2112 omitNulls [ "query" .= query

1938 , "filter" .= sFilter

2113 , "filter" .= sFilter

1939 , "sort" .= sort

2114 , "sort" .= sort

@@ -1941,7 +2116,8 @@ instance ToJSON Search where

1941 , "highlight" .= highlight

2116 , "highlight" .= highlight

1942 , "from" .= sFrom

2117 , "from" .= sFrom

1943 , "size" .= sSize

2118 , "size" .= sSize

1944− , "track_scores" .= sTrackSortScores]

2119+ , "track_scores" .= sTrackSortScores

2120+ , "fields" .= sFields]

1945

2121

1946

2122

1947instance ToJSON FieldHighlight where

2123instance ToJSON FieldHighlight where

@@ -2188,3 +2364,26 @@ instance FromJSON ShardResult where

2188 v .: "successful" <*>

2364 v .: "successful" <*>

2189 v .: "failed"

2365 v .: "failed"

2190 parseJSON _ = empty

2366 parseJSON _ = empty

2367+

2368+

2369+instance FromJSON DocVersion where

2370+ parseJSON v = do

2371+ i <- parseJSON v

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

2373+

2374+instance Bounded DocVersion where

2375+ minBound = DocVersion 1

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

2377+

2378+instance Enum DocVersion where

2379+ succ x

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

2381+ | otherwise = succError "DocVersion"

2382+ pred x

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

2384+ | otherwise = predError "DocVersion"

2385+ toEnum i =

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

2387+ fromEnum = docVersionNumber

2388+ enumFrom = boundedEnumFrom

2389+ 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+126−23

@@ -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 (..))

@@ -25,7 +27,7 @@ import Network.HTTP.Client

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

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

26import Prelude hiding (filter)

28import 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

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

147 , age = 1000

149 , age = 1000

148 , location = Location 40.12 (-71.34) }

150 , location = Location 40.12 (-71.34) }

149

151

150−insertData :: BH IO ()

152+resetIndex :: BH IO ()

151−insertData = do

153+resetIndex = do

152 _ <- deleteExampleIndex

154 _ <- deleteExampleIndex

153 _ <- createExampleIndex

155 _ <- createExampleIndex

154 _ <- putMapping testIndex testMapping TweetMapping

156 _ <- putMapping testIndex testMapping TweetMapping

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

156− _ <- refreshIndex testIndex

157 return ()

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+

159insertOther :: BH IO ()

170insertOther :: BH IO ()

160insertOther = do

171insertOther = do

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

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

162 _ <- refreshIndex testIndex

173 _ <- refreshIndex testIndex

163 return ()

174 return ()

164

175

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

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

166searchTweet search = do

177searchTweet search = do

167− reply <- searchByIndex testIndex search

178+ result <- searchTweets search

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

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

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

170 return myTweet

180 return myTweet

171

181

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

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

184+

172searchExpectNoResults :: Search -> BH IO ()

185searchExpectNoResults :: Search -> BH IO ()

173searchExpectNoResults search = do

186searchExpectNoResults search = do

174− reply <- searchByIndex testIndex search

187+ result <- searchTweets search

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

176 let emptyHits = fmap (hits . searchHits) result

188 let emptyHits = fmap (hits . searchHits) result

177 liftIO $

189 liftIO $

178 emptyHits `shouldBe` Right []

190 emptyHits `shouldBe` Right []

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

204

216

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

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

206searchTweetHighlight search = do

218searchTweetHighlight search = do

207− reply <- searchByIndex testIndex search

219+ result <- searchTweets search

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

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

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

210 return myHighlight

221 return myHighlight

211

222

@@ -268,6 +279,9 @@ instance Arbitrary a => Arbitrary (SearchHits a) where

268 hs <- arbitrary

279 hs <- arbitrary

269 return $ SearchHits tot score hs

280 return $ SearchHits tot score hs

270

281

282+getSource :: EsResult a -> Maybe a

283+getSource = fmap _source . foundResult

284+

271main :: IO ()

285main :: IO ()

272main = hspec $ do

286main = hspec $ do

273

287

@@ -288,8 +302,40 @@ main = hspec $ do

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

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

289 let newTweet = eitherDecode

303 let newTweet = eitherDecode

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

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

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

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

292−

306+

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

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

309+ let noTweet = eitherDecode

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

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

312+

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

314+ let ev = ExternalDocVersion minBound

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

316+ resetIndex

317+ res <- insertData' cfg

318+ liftIO $ isCreated res `shouldBe` True

319+ res' <- insertData' cfg

320+ liftIO $ isVersionConflict res' `shouldBe` True

321+

322+ describe "template API" $ do

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

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

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

326+ liftIO $ validateStatus resp 200

327+

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

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

330+ liftIO $ exists `shouldBe` True

331+

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

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

334+ liftIO $ validateStatus resp 200

335+

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

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

338+ liftIO $ exists `shouldBe` False

293

339

294 describe "bulk API" $ do

340 describe "bulk API" $ do

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

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

@@ -308,8 +354,8 @@ main = hspec $ do

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

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

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

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

310 liftIO $ do

356 liftIO $ do

311− fmap _source maybeFirst `shouldBe` Right firstTest

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

312− fmap _source maybeSecond `shouldBe` Right secondTest

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

313

359

314

360

315 describe "query API" $ do

361 describe "query API" $ do

@@ -341,8 +387,8 @@ main = hspec $ do

341

387

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

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

343 _ <- insertData

389 _ <- insertData

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

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

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

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

346 let search = mkSearch (Just query) Nothing

392 let search = mkSearch (Just query) Nothing

347 myTweet <- searchTweet search

393 myTweet <- searchTweet search

348 liftIO $

394 liftIO $

@@ -389,9 +435,8 @@ main = hspec $ do

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

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

390 let search = Search Nothing

436 let search = Search Nothing

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

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

392− False (From 0) (Size 10)

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

393− reply <- searchByIndex testIndex search

439+ result <- searchTweets search

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

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

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

396 liftIO $

441 liftIO $

397 myTweet `shouldBe` Right otherTweet

442 myTweet `shouldBe` Right otherTweet

@@ -525,7 +570,6 @@ main = hspec $ do

525 liftIO $

570 liftIO $

526 myTweet `shouldBe` Right exampleTweet

571 myTweet `shouldBe` Right exampleTweet

527

572

528−

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

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

530 _ <- insertData

574 _ <- insertData

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

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

@@ -543,6 +587,20 @@ main = hspec $ do

543 let search = mkSearch Nothing (Just filter)

587 let search = mkSearch Nothing (Just filter)

544 searchExpectNoResults search

588 searchExpectNoResults search

545

589

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

591+ _ <- insertData

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

593+ search = mkSearch Nothing (Just filter)

594+ myTweet <- searchTweet search

595+ liftIO $ myTweet `shouldBe` Right exampleTweet

596+

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

598+ _ <- insertData

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

600+ search = mkSearch Nothing (Just filter)

601+ myTweet <- searchTweet search

602+ liftIO $ myTweet `shouldBe` Right exampleTweet

603+

546 describe "Aggregation API" $ do

604 describe "Aggregation API" $ do

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

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

548 _ <- insertData

606 _ <- insertData

@@ -570,6 +628,32 @@ main = hspec $ do

570 _ <- insertData

628 _ <- insertData

571 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

629 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]

572

630

631+

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

633+ _ <- insertData

634+ _ <- insertOther

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

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

637+ let search = mkAggregateSearch Nothing ags

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

639+ res <- searchTweets search

640+ liftIO $

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

642+ , docCountPair "bogus_count" 0

643+ ]))

644+

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

646+ _ <- insertData

647+ _ <- insertOther

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

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

650+ let search = mkAggregateSearch Nothing ags

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

652+ res <- searchTweets search

653+ liftIO $

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

655+ , docCountPair "notmyapps" 1

656+ ]))

573 -- Interaction of date serialization and date histogram aggregation is broken.

657 -- Interaction of date serialization and date histogram aggregation is broken.

574 -- it "returns date histogram aggregation results" $ withTestEnv $ do

658 -- it "returns date histogram aggregation results" $ withTestEnv $ do

575 -- _ <- insertData

659 -- _ <- insertData

@@ -659,3 +743,22 @@ main = hspec $ do

659 describe "Monoid (SearchHits a)" $ do

743 describe "Monoid (SearchHits a)" $ do

660 prop "abides the monoid laws" $ eq $

744 prop "abides the monoid laws" $ eq $

661 prop_Monoid (T :: T (SearchHits ()))

745 prop_Monoid (T :: T (SearchHits ()))

746+

747+ describe "mkDocVersion" $ do

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

749+ let res = mkDocVersion i

750+ in case res of

751+ Nothing -> property True

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

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

754+ docVersionNumber dv === i

755+

756+ describe "Enum DocVersion" $ do

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

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

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

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

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

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

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

764+ 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.1

13+ver=0.7.0.1

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

16 echo "Unable to determine package name"